aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/asn1/doc/src/notes.xml68
-rw-r--r--lib/asn1/doc/src/ref_man.xml3
-rw-r--r--lib/asn1/src/asn1ct_gen.erl48
-rw-r--r--lib/asn1/src/asn1ct_gen_per.erl2
-rw-r--r--lib/asn1/test/asn1_SUITE.erl12
-rw-r--r--lib/asn1/test/asn1_SUITE_data/EnumN2N.asn122
-rw-r--r--lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn13
-rw-r--r--lib/asn1/test/asn1_SUITE_data/ImportsFrom2.asn15
-rw-r--r--lib/asn1/vsn.mk2
-rw-r--r--lib/common_test/doc/src/Makefile2
-rw-r--r--lib/common_test/doc/src/basics_chapter.xml2
-rw-r--r--lib/common_test/doc/src/ct_netconfc.xml2
-rw-r--r--lib/common_test/doc/src/ct_ssh.xml2
-rw-r--r--lib/common_test/doc/src/notes.xml94
-rw-r--r--lib/common_test/src/ct.erl6
-rw-r--r--lib/common_test/src/ct_config.erl6
-rw-r--r--lib/common_test/src/ct_conn_log_h.erl16
-rw-r--r--lib/common_test/src/ct_event.erl4
-rw-r--r--lib/common_test/src/ct_framework.erl42
-rw-r--r--lib/common_test/src/ct_ftp.erl26
-rw-r--r--lib/common_test/src/ct_gen_conn.erl10
-rw-r--r--lib/common_test/src/ct_groups.erl4
-rw-r--r--lib/common_test/src/ct_hooks.erl6
-rw-r--r--lib/common_test/src/ct_logs.erl50
-rw-r--r--lib/common_test/src/ct_make.erl54
-rw-r--r--lib/common_test/src/ct_master.erl26
-rw-r--r--lib/common_test/src/ct_master_event.erl6
-rw-r--r--lib/common_test/src/ct_master_logs.erl12
-rw-r--r--lib/common_test/src/ct_master_status.erl4
-rw-r--r--lib/common_test/src/ct_netconfc.erl2
-rw-r--r--lib/common_test/src/ct_property_test.erl6
-rw-r--r--lib/common_test/src/ct_release_test.erl19
-rw-r--r--lib/common_test/src/ct_repeat.erl10
-rw-r--r--lib/common_test/src/ct_run.erl68
-rw-r--r--lib/common_test/src/ct_ssh.erl78
-rw-r--r--lib/common_test/src/ct_telnet.erl30
-rw-r--r--lib/common_test/src/ct_telnet_client.erl4
-rw-r--r--lib/common_test/src/ct_testspec.erl4
-rw-r--r--lib/common_test/src/ct_util.erl14
-rw-r--r--lib/common_test/src/ct_webtool.erl34
-rw-r--r--lib/common_test/src/cth_conn_log.erl2
-rw-r--r--lib/common_test/src/cth_log_redirect.erl8
-rw-r--r--lib/common_test/src/cth_surefire.erl4
-rw-r--r--lib/common_test/src/test_server.erl34
-rw-r--r--lib/common_test/src/test_server_ctrl.erl157
-rw-r--r--lib/common_test/src/test_server_gl.erl12
-rw-r--r--lib/common_test/src/test_server_io.erl8
-rw-r--r--lib/common_test/src/test_server_node.erl18
-rw-r--r--lib/common_test/src/test_server_sup.erl26
-rw-r--r--lib/common_test/src/unix_telnet.erl10
-rw-r--r--lib/common_test/src/vts.erl6
-rw-r--r--lib/common_test/test/Makefile3
-rw-r--r--lib/common_test/test/ct_config_SUITE.erl10
-rw-r--r--lib/common_test/test/ct_keep_logs_SUITE.erl4
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl2
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/ns.erl2
-rw-r--r--lib/common_test/test/ct_surefire_SUITE.erl8
-rw-r--r--lib/common_test/test/ct_test_support.erl117
-rw-r--r--lib/common_test/test/ct_testspec_1_SUITE.erl8
-rw-r--r--lib/common_test/test/ct_unicode_SUITE.erl218
-rw-r--r--lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl98
-rw-r--r--lib/common_test/test/ct_verbosity_SUITE.erl6
-rw-r--r--lib/common_test/test/erl2html2_SUITE.erl6
-rw-r--r--lib/common_test/test/test_server_test_lib.erl4
-rw-r--r--lib/common_test/test_server/ts_install.erl4
-rw-r--r--lib/common_test/test_server/ts_make.erl4
-rw-r--r--lib/common_test/vsn.mk2
-rw-r--r--lib/compiler/doc/src/notes.xml174
-rw-r--r--lib/compiler/src/Makefile3
-rw-r--r--lib/compiler/src/compile.erl11
-rw-r--r--lib/compiler/src/compiler.app.src3
-rwxr-xr-xlib/compiler/src/genop.tab2
-rw-r--r--lib/compiler/src/sys_core_bsm.erl355
-rw-r--r--lib/compiler/src/sys_core_fold.erl320
-rw-r--r--lib/compiler/src/v3_kernel.erl27
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl2
-rw-r--r--lib/compiler/test/beam_type_SUITE.erl25
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl21
-rw-r--r--lib/compiler/test/compile_SUITE.erl1
-rw-r--r--lib/compiler/test/core_SUITE.erl8
-rw-r--r--lib/compiler/test/core_SUITE_data/non_variable_apply.core80
-rw-r--r--lib/compiler/test/misc_SUITE.erl3
-rw-r--r--lib/compiler/test/warnings_SUITE.erl4
-rw-r--r--lib/compiler/vsn.mk2
-rw-r--r--lib/crypto/c_src/crypto.c962
-rw-r--r--lib/crypto/doc/src/crypto.xml23
-rw-r--r--lib/crypto/doc/src/notes.xml128
-rw-r--r--lib/crypto/src/crypto.erl94
-rw-r--r--lib/crypto/test/blowfish_SUITE.erl5
-rw-r--r--lib/crypto/test/crypto_SUITE.erl129
-rw-r--r--lib/crypto/vsn.mk2
-rw-r--r--lib/debugger/doc/src/notes.xml36
-rw-r--r--lib/debugger/vsn.mk2
-rw-r--r--lib/dialyzer/doc/src/notes.xml69
-rw-r--r--lib/dialyzer/src/dialyzer.erl169
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl121
-rw-r--r--lib/dialyzer/src/dialyzer_callgraph.erl5
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl75
-rw-r--r--lib/dialyzer/src/dialyzer_cl_parse.erl5
-rw-r--r--lib/dialyzer/src/dialyzer_codeserver.erl28
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl76
-rw-r--r--lib/dialyzer/src/dialyzer_dataflow.erl80
-rw-r--r--lib/dialyzer/src/dialyzer_gui_wx.erl20
-rw-r--r--lib/dialyzer/src/dialyzer_options.erl2
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl443
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl159
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl203
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl76
-rw-r--r--lib/dialyzer/src/typer.erl62
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs6
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/gen_event_incorrect_return2
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args6
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks2
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour12
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour_old4
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return2
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec6
-rw-r--r--lib/dialyzer/test/options2_SUITE_data/results/unused_unknown_type2
-rw-r--r--lib/dialyzer/test/options2_SUITE_data/src/unused_unknown_type.erl10
-rw-r--r--lib/dialyzer/test/plt_SUITE.erl86
-rw-r--r--lib/dialyzer/vsn.mk2
-rw-r--r--lib/diameter/doc/src/diameter.xml13
-rw-r--r--lib/diameter/doc/src/diameter_codec.xml19
-rw-r--r--lib/diameter/doc/src/diameter_dict.xml13
-rw-r--r--lib/diameter/doc/src/notes.xml70
-rw-r--r--lib/diameter/examples/code/node.erl29
-rw-r--r--lib/diameter/include/diameter_gen.hrl720
-rw-r--r--lib/diameter/src/base/diameter.erl1
-rw-r--r--lib/diameter/src/base/diameter_capx.erl89
-rw-r--r--lib/diameter/src/base/diameter_codec.erl524
-rw-r--r--lib/diameter/src/base/diameter_config.erl62
-rw-r--r--lib/diameter/src/base/diameter_dict.erl154
-rw-r--r--lib/diameter/src/base/diameter_gen.erl709
-rw-r--r--lib/diameter/src/base/diameter_lib.erl33
-rw-r--r--lib/diameter/src/base/diameter_peer_fsm.erl229
-rw-r--r--lib/diameter/src/base/diameter_reg.erl4
-rw-r--r--lib/diameter/src/base/diameter_service.erl219
-rw-r--r--lib/diameter/src/base/diameter_traffic.erl1210
-rw-r--r--lib/diameter/src/base/diameter_types.erl300
-rw-r--r--lib/diameter/src/base/diameter_watchdog.erl183
-rw-r--r--lib/diameter/src/compiler/diameter_codegen.erl101
-rw-r--r--lib/diameter/src/diameter.app.src10
-rw-r--r--lib/diameter/src/diameter.appup.src6
-rw-r--r--lib/diameter/src/modules.mk4
-rw-r--r--lib/diameter/src/transport/diameter_sctp.erl319
-rw-r--r--lib/diameter/src/transport/diameter_sctp_sup.erl3
-rw-r--r--lib/diameter/src/transport/diameter_tcp.erl491
-rw-r--r--lib/diameter/test/diameter_capx_SUITE.erl2
-rw-r--r--lib/diameter/test/diameter_codec_SUITE.erl19
-rw-r--r--lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl11
-rw-r--r--lib/diameter/test/diameter_codec_test.erl33
-rw-r--r--lib/diameter/test/diameter_compiler_SUITE.erl10
-rw-r--r--lib/diameter/test/diameter_dict_SUITE.erl145
-rw-r--r--lib/diameter/test/diameter_dpr_SUITE.erl113
-rw-r--r--lib/diameter/test/diameter_examples_SUITE.erl10
-rw-r--r--lib/diameter/test/diameter_gen_sctp_SUITE.erl455
-rw-r--r--lib/diameter/test/diameter_gen_tcp_SUITE.erl4
-rw-r--r--lib/diameter/test/diameter_relay_SUITE.erl4
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl216
-rw-r--r--lib/diameter/test/diameter_transport_SUITE.erl30
-rw-r--r--lib/diameter/test/diameter_util.erl65
-rw-r--r--lib/diameter/test/diameter_watchdog_SUITE.erl104
-rw-r--r--lib/diameter/test/modules.mk3
-rw-r--r--lib/diameter/vsn.mk2
-rw-r--r--lib/edoc/doc/src/notes.xml24
-rw-r--r--lib/edoc/vsn.mk2
-rw-r--r--lib/eldap/test/eldap_basic_SUITE.erl5
-rw-r--r--lib/erl_docgen/doc/src/notes.xml39
-rw-r--r--lib/erl_interface/doc/src/notes.xml39
-rw-r--r--lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c16
-rw-r--r--lib/erl_interface/test/ei_decode_encode_SUITE.erl2
-rw-r--r--lib/erl_interface/vsn.mk2
-rw-r--r--lib/eunit/doc/src/notes.xml15
-rw-r--r--lib/eunit/vsn.mk2
-rw-r--r--lib/hipe/cerl/erl_types.erl89
-rw-r--r--lib/hipe/doc/src/notes.xml95
-rw-r--r--lib/hipe/vsn.mk2
-rw-r--r--lib/inets/doc/src/http_uri.xml2
-rw-r--r--lib/inets/doc/src/httpc.xml4
-rw-r--r--lib/inets/doc/src/notes.xml39
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl45
-rw-r--r--lib/inets/src/http_lib/http_uri.erl2
-rw-r--r--lib/inets/src/http_lib/http_util.erl2
-rw-r--r--lib/inets/src/http_server/httpd_util.erl2
-rw-r--r--lib/inets/src/http_server/mod_disk_log.erl27
-rw-r--r--lib/inets/src/http_server/mod_log.erl4
-rw-r--r--lib/inets/test/httpd_SUITE.erl129
-rw-r--r--lib/inets/test/httpd_basic_SUITE.erl2
-rw-r--r--lib/inets/test/uri_SUITE.erl2
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/jinterface/doc/src/notes.xml28
-rw-r--r--lib/jinterface/vsn.mk2
-rw-r--r--lib/kernel/doc/src/disk_log.xml4
-rw-r--r--lib/kernel/doc/src/error_logger.xml20
-rw-r--r--lib/kernel/doc/src/inet.xml11
-rw-r--r--lib/kernel/doc/src/kernel_app.xml2
-rw-r--r--lib/kernel/doc/src/net_kernel.xml2
-rw-r--r--lib/kernel/doc/src/notes.xml170
-rw-r--r--lib/kernel/src/Makefile2
-rw-r--r--lib/kernel/src/disk_log_1.erl2
-rw-r--r--lib/kernel/src/erts_debug.erl35
-rw-r--r--lib/kernel/src/group.erl2
-rw-r--r--lib/kernel/src/group_history.erl4
-rw-r--r--lib/kernel/src/inet.erl3
-rw-r--r--lib/kernel/src/inet_parse.erl98
-rw-r--r--lib/kernel/src/inet_tcp_dist.erl6
-rw-r--r--lib/kernel/src/kernel.app.src4
-rw-r--r--lib/kernel/src/kernel.appup.src4
-rw-r--r--lib/kernel/test/disk_log_SUITE.erl50
-rw-r--r--lib/kernel/test/gen_tcp_api_SUITE.erl2
-rw-r--r--lib/kernel/test/gen_tcp_misc_SUITE.erl44
-rw-r--r--lib/kernel/test/gen_udp_SUITE.erl2
-rw-r--r--lib/kernel/test/inet_SUITE.erl158
-rw-r--r--lib/kernel/test/inet_sockopt_SUITE.erl2
-rw-r--r--lib/kernel/test/os_SUITE.erl49
-rw-r--r--lib/kernel/test/sendfile_SUITE.erl6
-rw-r--r--lib/kernel/vsn.mk2
-rw-r--r--lib/megaco/doc/src/notes.xml19
-rw-r--r--lib/megaco/vsn.mk4
-rw-r--r--lib/mnesia/doc/src/notes.xml21
-rw-r--r--lib/mnesia/src/mnesia_controller.erl4
-rw-r--r--lib/mnesia/vsn.mk2
-rw-r--r--lib/observer/doc/src/notes.xml57
-rw-r--r--lib/observer/src/etop.erl6
-rw-r--r--lib/observer/src/etop_txt.erl41
-rw-r--r--lib/observer/src/observer_lib.erl6
-rw-r--r--lib/observer/src/observer_sys_wx.erl55
-rw-r--r--lib/observer/src/ttb.erl12
-rw-r--r--lib/observer/vsn.mk2
-rw-r--r--lib/orber/test/multi_ORB_SUITE.erl2
-rw-r--r--lib/orber/test/orber_test_lib.erl2
-rw-r--r--lib/parsetools/doc/src/notes.xml29
-rw-r--r--lib/parsetools/include/yeccpre.hrl13
-rw-r--r--lib/parsetools/src/yecc.erl6
-rw-r--r--lib/parsetools/vsn.mk2
-rw-r--r--lib/public_key/doc/src/notes.xml35
-rw-r--r--lib/public_key/doc/src/public_key.xml39
-rw-r--r--lib/public_key/include/public_key.hrl3
-rw-r--r--lib/public_key/src/pubkey_crl.erl35
-rw-r--r--lib/public_key/src/public_key.erl161
-rw-r--r--lib/public_key/vsn.mk2
-rw-r--r--lib/reltool/doc/src/notes.xml20
-rw-r--r--lib/reltool/doc/src/reltool_examples.xml629
-rw-r--r--lib/reltool/src/reltool.erl4
-rw-r--r--lib/reltool/src/reltool.hrl4
-rw-r--r--lib/reltool/src/reltool_app_win.erl8
-rw-r--r--lib/reltool/src/reltool_fgraph_win.erl2
-rw-r--r--lib/reltool/src/reltool_mod_win.erl6
-rw-r--r--lib/reltool/src/reltool_server.erl39
-rw-r--r--lib/reltool/src/reltool_sys_win.erl22
-rw-r--r--lib/reltool/src/reltool_target.erl39
-rw-r--r--lib/reltool/src/reltool_utils.erl12
-rw-r--r--lib/reltool/vsn.mk2
-rw-r--r--lib/runtime_tools/doc/src/notes.xml57
-rw-r--r--lib/runtime_tools/src/dbg.erl220
-rw-r--r--lib/runtime_tools/src/observer_backend.erl16
-rw-r--r--lib/runtime_tools/vsn.mk2
-rw-r--r--lib/sasl/doc/src/notes.xml29
-rw-r--r--lib/sasl/src/format_lib_supp.erl123
-rw-r--r--lib/sasl/src/misc_supp.erl20
-rw-r--r--lib/sasl/src/rb.erl113
-rw-r--r--lib/sasl/src/rb_format_supp.erl10
-rw-r--r--lib/sasl/src/release_handler.erl20
-rw-r--r--lib/sasl/src/systools_make.erl46
-rw-r--r--lib/sasl/src/systools_rc.erl32
-rw-r--r--lib/sasl/src/systools_relup.erl12
-rw-r--r--lib/sasl/test/release_handler_SUITE.erl103
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/Makefile.src18
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/ebin/u.app8
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u.erl50
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u_sup.erl38
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.app8
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.appup3
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u.erl55
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u_sup.erl38
-rw-r--r--lib/sasl/test/sasl_report_SUITE.erl4
-rw-r--r--lib/sasl/vsn.mk2
-rw-r--r--lib/snmp/doc/src/notes.xml21
-rw-r--r--lib/snmp/src/agent/snmp_generic.erl2
-rw-r--r--lib/snmp/test/snmp_manager_test.erl2
-rw-r--r--lib/snmp/vsn.mk2
-rw-r--r--lib/ssh/doc/src/notes.xml170
-rw-r--r--lib/ssh/doc/src/ssh.xml44
-rw-r--r--lib/ssh/doc/src/ssh_app.xml44
-rw-r--r--lib/ssh/doc/src/ssh_sftp.xml12
-rw-r--r--lib/ssh/src/ssh_auth.erl59
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl78
-rw-r--r--lib/ssh/src/ssh_dbg.erl93
-rw-r--r--lib/ssh/src/ssh_io.erl8
-rw-r--r--lib/ssh/src/ssh_options.erl6
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE.erl77
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa3846
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa384.pub1
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa5217
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa521.pub1
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key3846
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key384.pub1
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key5217
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key521.pub1
-rw-r--r--lib/ssh/test/ssh_options_SUITE.erl4
-rw-r--r--lib/ssh/test/ssh_property_test_SUITE.erl2
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE.erl2
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/doc/src/notes.xml116
-rw-r--r--lib/ssl/doc/src/ssl.xml5
-rw-r--r--lib/ssl/src/dtls_connection.erl93
-rw-r--r--lib/ssl/src/dtls_handshake.hrl3
-rw-r--r--lib/ssl/src/dtls_socket.erl19
-rw-r--r--lib/ssl/src/dtls_udp_listener.erl47
-rw-r--r--lib/ssl/src/ssl.erl14
-rw-r--r--lib/ssl/src/ssl_alert.erl76
-rw-r--r--lib/ssl/src/ssl_alert.hrl1
-rw-r--r--lib/ssl/src/ssl_cipher.erl4
-rw-r--r--lib/ssl/src/ssl_connection.erl36
-rw-r--r--lib/ssl/src/ssl_handshake.erl20
-rw-r--r--lib/ssl/src/tls_connection.erl19
-rw-r--r--lib/ssl/test/Makefile1
-rw-r--r--lib/ssl/test/erl_make_certs.erl477
-rw-r--r--lib/ssl/test/make_certs.erl2
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl295
-rw-r--r--lib/ssl/test/ssl_crl_SUITE.erl12
-rw-r--r--lib/ssl/test/ssl_sni_SUITE.erl47
-rw-r--r--lib/ssl/test/ssl_test_lib.erl201
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl196
-rw-r--r--lib/stdlib/doc/src/ets.xml23
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml2
-rw-r--r--lib/stdlib/doc/src/lists.xml4
-rw-r--r--lib/stdlib/doc/src/notes.xml470
-rw-r--r--lib/stdlib/doc/src/rand.xml2
-rw-r--r--lib/stdlib/doc/src/sys.xml2
-rw-r--r--lib/stdlib/src/array.erl2
-rw-r--r--lib/stdlib/src/c.erl28
-rw-r--r--lib/stdlib/src/epp.erl24
-rw-r--r--lib/stdlib/src/erl_compile.erl4
-rw-r--r--lib/stdlib/src/erl_lint.erl152
-rw-r--r--lib/stdlib/src/erl_parse.yrl6
-rw-r--r--lib/stdlib/src/error_logger_file_h.erl2
-rw-r--r--lib/stdlib/src/escript.erl6
-rw-r--r--lib/stdlib/src/gen.erl2
-rw-r--r--lib/stdlib/src/io_lib_format.erl21
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl2
-rw-r--r--lib/stdlib/src/lib.erl69
-rw-r--r--lib/stdlib/src/ms_transform.erl62
-rw-r--r--lib/stdlib/src/otp_internal.erl14
-rw-r--r--lib/stdlib/src/proc_lib.erl15
-rw-r--r--lib/stdlib/src/shell.erl46
-rw-r--r--lib/stdlib/src/string.erl10
-rw-r--r--lib/stdlib/src/sys.erl6
-rw-r--r--lib/stdlib/test/c_SUITE.erl53
-rw-r--r--lib/stdlib/test/epp_SUITE.erl29
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl132
-rw-r--r--lib/stdlib/test/ms_transform_SUITE.erl15
-rw-r--r--lib/stdlib/test/proc_lib_SUITE.erl59
-rw-r--r--lib/stdlib/test/shell_SUITE.erl79
-rw-r--r--lib/stdlib/vsn.mk2
-rw-r--r--lib/syntax_tools/doc/src/notes.xml17
-rw-r--r--lib/syntax_tools/src/erl_tidy.erl2
-rw-r--r--lib/syntax_tools/test/syntax_tools_SUITE.erl6
-rw-r--r--lib/syntax_tools/vsn.mk2
-rw-r--r--lib/tools/doc/src/lcnt.xml106
-rw-r--r--lib/tools/doc/src/lcnt_chapter.xml11
-rw-r--r--lib/tools/doc/src/notes.xml55
-rw-r--r--lib/tools/src/cover.erl42
-rw-r--r--lib/tools/src/lcnt.erl77
-rw-r--r--lib/tools/src/make.erl48
-rw-r--r--lib/tools/src/tools.app.src2
-rw-r--r--lib/tools/test/lcnt_SUITE.erl7
-rw-r--r--lib/tools/test/make_SUITE.erl43
-rw-r--r--lib/tools/vsn.mk2
-rw-r--r--lib/wx/c_src/egl_impl.h2
-rw-r--r--lib/wx/doc/src/notes.xml17
-rw-r--r--lib/wx/vsn.mk2
-rw-r--r--lib/xmerl/doc/src/notes.xml40
-rw-r--r--lib/xmerl/src/xmerl_sax_old_dom.erl9
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.erl171
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_base.erlsrc293
-rw-r--r--lib/xmerl/src/xmerl_sax_simple_dom.erl7
-rw-r--r--lib/xmerl/test/Makefile1
-rw-r--r--lib/xmerl/test/xmerl_sax_SUITE.erl76
-rw-r--r--lib/xmerl/test/xmerl_sax_SUITE_data/test_data_1.xml4
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE.erl17
-rw-r--r--lib/xmerl/vsn.mk2
386 files changed, 13156 insertions, 7763 deletions
diff --git a/lib/asn1/doc/src/notes.xml b/lib/asn1/doc/src/notes.xml
index 499a7e40c3..03452648bb 100644
--- a/lib/asn1/doc/src/notes.xml
+++ b/lib/asn1/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2004</year><year>2016</year>
+ <year>2004</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -32,6 +32,72 @@
<p>This document describes the changes made to the asn1 application.</p>
+<section><title>Asn1 5.0.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed compilation error of generated code caused by a
+ missing quotation of function names as part of an
+ external call for encoding.</p>
+ <p>
+ Own Id: OTP-14519 Aux Id: ERIERL-49 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Asn1 5.0</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Add compile option <c>-compile(no_native)</c> in modules
+ with <c>on_load</c> directive which is not yet supported
+ by HiPE.</p>
+ <p>
+ Own Id: OTP-14316 Aux Id: PR-1390 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>The <c>error</c> tuple returned from the <c>encode</c>
+ and <c>decode</c> functions will now include the stack
+ backtrace to make it easier to understand what went
+ wrong.</p>
+ <p>
+ Own Id: OTP-13961</p>
+ </item>
+ <item>
+ <p>The deprecated module <c>asn1rt</c> has been removed.
+ The deprecated functions <c>asn1ct:encode/3</c> and
+ <c>asn1ct:decode/3</c> have been removed. The
+ undocumented function <c>asn1ct:encode/2</c> has been
+ removed.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14146</p>
+ </item>
+ <item>
+ <p>The new '<c>maps</c>' option changes the
+ representation of the types <c>SEQUENCE</c> and
+ <c>SET</c> to be maps (instead of records).</p>
+ <p>
+ Own Id: OTP-14219</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Asn1 4.0.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/asn1/doc/src/ref_man.xml b/lib/asn1/doc/src/ref_man.xml
index d70e2bc05f..14f6818cae 100644
--- a/lib/asn1/doc/src/ref_man.xml
+++ b/lib/asn1/doc/src/ref_man.xml
@@ -4,7 +4,7 @@
<application xmlns:xi="http://www.w3.org/2001/XInclude">
<header>
<copyright>
- <year>1997</year><year>2016</year>
+ <year>1997</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -34,6 +34,5 @@
contains modules with compile-time and runtime support for ASN.1.</p>
</description>
<xi:include href="asn1ct.xml"/>
- <xi:include href="asn1rt.xml"/>
</application>
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 838d59a512..806f8420ec 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -145,27 +145,37 @@ pgen_n2nconversion(_Erules,#typedef{name=TypeName,typespec=#type{def={'ENUMERATE
pgen_n2nconversion(_Erules,_) ->
true.
-pgen_name2numfunc(_TypeName,[], _) ->
+pgen_name2numfunc(TypeNameAsAtom,Mapping,Ext) when is_atom(TypeNameAsAtom) ->
+ FuncName = list_to_atom("name2num_"++atom_to_list(TypeNameAsAtom)),
+ pgen_name2numfunc1(FuncName,Mapping,Ext).
+
+pgen_name2numfunc1(_FuncName,[], _) ->
true;
-pgen_name2numfunc(TypeName,[{Atom,Number}], extension_marker) ->
- emit(["name2num_",TypeName,"(",{asis,Atom},") ->",Number,";",nl]),
- emit(["name2num_",TypeName,"({asn1_enum, Num}) -> Num.",nl,nl]);
-pgen_name2numfunc(TypeName,[{Atom,Number}], _) ->
- emit(["name2num_",TypeName,"(",{asis,Atom},") ->",Number,".",nl,nl]);
-pgen_name2numfunc(TypeName,[{Atom,Number}|NNRest], EM) ->
- emit(["name2num_",TypeName,"(",{asis,Atom},") ->",Number,";",nl]),
- pgen_name2numfunc(TypeName,NNRest, EM).
-
-pgen_num2namefunc(_TypeName,[], _) ->
+pgen_name2numfunc1(FuncName,[{Atom,Number}], extension_marker) ->
+ emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,";",nl]),
+ emit([{asis,FuncName},"({asn1_enum, Num}) -> Num.",nl,nl]);
+pgen_name2numfunc1(FuncName,[{Atom,Number}], _) ->
+ emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,".",nl,nl]);
+pgen_name2numfunc1(FuncName,[{Atom,Number}|NNRest], EM) ->
+ emit([{asis,FuncName},"(",{asis,Atom},") ->",Number,";",nl]),
+ pgen_name2numfunc1(FuncName,NNRest, EM).
+
+pgen_num2namefunc(TypeNameAsAtom,Mapping,Ext) when is_atom(TypeNameAsAtom) ->
+ FuncName = list_to_atom("num2name_"++atom_to_list(TypeNameAsAtom)),
+ pgen_num2namefunc1(FuncName,Mapping,Ext).
+
+pgen_num2namefunc1(_FuncName,[], _) ->
true;
-pgen_num2namefunc(TypeName,[{Atom,Number}], extension_marker) ->
- emit(["num2name_",TypeName,"(",Number,") ->",{asis,Atom},";",nl]),
- emit(["num2name_",TypeName,"(ExtensionNum) -> {asn1_enum, ExtensionNum}.",nl,nl]);
-pgen_num2namefunc(TypeName,[{Atom,Number}], _) ->
- emit(["num2name_",TypeName,"(",Number,") ->",{asis,Atom},".",nl,nl]);
-pgen_num2namefunc(TypeName,[{Atom,Number}|NNRest], EM) ->
- emit(["num2name_",TypeName,"(",Number,") ->",{asis,Atom},";",nl]),
- pgen_num2namefunc(TypeName,NNRest, EM).
+pgen_num2namefunc1(FuncName,[{Atom,Number}], extension_marker) ->
+ emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},";",nl]),
+ emit([{asis,FuncName},"(ExtensionNum) -> {asn1_enum, ExtensionNum}.",nl,nl]);
+pgen_num2namefunc1(FuncName,[{Atom,Number}], _) ->
+ emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},".",nl,nl]);
+pgen_num2namefunc1(FuncName,[{Atom,Number}|NNRest], EM) ->
+ emit([{asis,FuncName},"(",Number,") ->",{asis,Atom},";",nl]),
+ pgen_num2namefunc1(FuncName,NNRest, EM).
+
+
pgen_objects(_,_,_,[]) ->
true;
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl
index 28b4e46b0c..82e9326294 100644
--- a/lib/asn1/src/asn1ct_gen_per.erl
+++ b/lib/asn1/src/asn1ct_gen_per.erl
@@ -101,7 +101,7 @@ gen_encode_user(Erules,D) when is_record(D,typedef) ->
#'Externaltypereference'{module=CurrMod,type=Etype} ->
emit([{asis,enc_func(Etype)},"(Val).",nl]);
#'Externaltypereference'{module=Emod,type=Etype} ->
- emit([{asis,Emod},":",enc_func(Etype),"(Val).",nl])
+ emit([{asis,Emod},":",{asis,enc_func(Etype)},"(Val).",nl])
end.
diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl
index 5fe6945ff2..f94b4278bf 100644
--- a/lib/asn1/test/asn1_SUITE.erl
+++ b/lib/asn1/test/asn1_SUITE.erl
@@ -1198,14 +1198,14 @@ testComment(Config) ->
testName2Number(Config) ->
N2NOptions0 = [{n2n,Type} ||
- Type <- ['CauseMisc', 'CauseProtocol',
- 'CauseRadioNetwork',
- 'CauseTransport','CauseNas']],
+ Type <- ['Cause-Misc', 'CauseProtocol']],
N2NOptions = [?NO_MAPS_MODULE|N2NOptions0],
- asn1_test_lib:compile("S1AP-IEs", Config, N2NOptions),
+ asn1_test_lib:compile("EnumN2N", Config, N2NOptions),
- 0 = 'S1AP-IEs':name2num_CauseMisc('control-processing-overload'),
- 'unknown-PLMN' = 'S1AP-IEs':num2name_CauseMisc(5),
+ 0 = 'EnumN2N':'name2num_Cause-Misc'('control-processing-overload'),
+ 'unknown-PLMN' = 'EnumN2N':'num2name_Cause-Misc'(5),
+ 4 = 'EnumN2N':name2num_CauseProtocol('semantic-error'),
+ 'transfer-syntax-error' = 'EnumN2N':num2name_CauseProtocol(0),
%% OTP-10144
%% Test that n2n option generates name2num and num2name functions supporting
diff --git a/lib/asn1/test/asn1_SUITE_data/EnumN2N.asn1 b/lib/asn1/test/asn1_SUITE_data/EnumN2N.asn1
index a724f2f3f5..a610eb6230 100644
--- a/lib/asn1/test/asn1_SUITE_data/EnumN2N.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/EnumN2N.asn1
@@ -1,6 +1,28 @@
EnumN2N DEFINITIONS AUTOMATIC TAGS ::=
BEGIN
+Cause-Misc ::= ENUMERATED {
+ control-processing-overload,
+ not-enough-user-plane-processing-resources,
+ hardware-failure,
+ om-intervention,
+ unspecified,
+ unknown-PLMN,
+...
+}
+
+CauseProtocol ::= ENUMERATED {
+ transfer-syntax-error,
+ abstract-syntax-error-reject,
+ abstract-syntax-error-ignore-and-notify,
+ message-not-compatible-with-receiver-state,
+ semantic-error,
+ abstract-syntax-error-falsely-constructed-message,
+ unspecified,
+ ...
+}
+
+
NoExt ::= ENUMERATED {
blue(0),
red(1),
diff --git a/lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn1 b/lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn1
index 32b8f75dde..dee3cd5048 100644
--- a/lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/ImportsFrom.asn1
@@ -1,8 +1,9 @@
ImportsFrom DEFINITIONS AUTOMATIC TAGS ::=
BEGIN
-IMPORTS Int FROM ImportsFrom2;
+IMPORTS Int, Quoted-Seq FROM ImportsFrom2;
i Int ::= 42
+My-Seq ::= Quoted-Seq
END
diff --git a/lib/asn1/test/asn1_SUITE_data/ImportsFrom2.asn1 b/lib/asn1/test/asn1_SUITE_data/ImportsFrom2.asn1
index b0c29d24ae..a8e619e215 100644
--- a/lib/asn1/test/asn1_SUITE_data/ImportsFrom2.asn1
+++ b/lib/asn1/test/asn1_SUITE_data/ImportsFrom2.asn1
@@ -2,6 +2,11 @@ ImportsFrom2 DEFINITIONS AUTOMATIC TAGS ::=
BEGIN
IMPORTS Int FROM ImportsFrom3;
+Quoted-Seq ::= SEQUENCE {
+ x INTEGER(0..17),
+ y INTEGER(0..666)
+}
+
LocalDef ::= OCTET STRING
END
diff --git a/lib/asn1/vsn.mk b/lib/asn1/vsn.mk
index e4bf3e2236..ec92d324eb 100644
--- a/lib/asn1/vsn.mk
+++ b/lib/asn1/vsn.mk
@@ -1 +1 @@
-ASN1_VSN = 4.0.4
+ASN1_VSN = 5.0.1
diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile
index e3e478ab7f..faa2d58a06 100644
--- a/lib/common_test/doc/src/Makefile
+++ b/lib/common_test/doc/src/Makefile
@@ -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.
diff --git a/lib/common_test/doc/src/basics_chapter.xml b/lib/common_test/doc/src/basics_chapter.xml
index 9be71ae5df..95599ca1f1 100644
--- a/lib/common_test/doc/src/basics_chapter.xml
+++ b/lib/common_test/doc/src/basics_chapter.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2003</year><year>2016</year>
+ <year>2003</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/common_test/doc/src/ct_netconfc.xml b/lib/common_test/doc/src/ct_netconfc.xml
index ab83f50733..7ec8f23073 100644
--- a/lib/common_test/doc/src/ct_netconfc.xml
+++ b/lib/common_test/doc/src/ct_netconfc.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2010</year><year>2016</year>
+ <year>2010</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/common_test/doc/src/ct_ssh.xml b/lib/common_test/doc/src/ct_ssh.xml
index 63627d8840..0c7efed154 100644
--- a/lib/common_test/doc/src/ct_ssh.xml
+++ b/lib/common_test/doc/src/ct_ssh.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2010</year><year>2016</year>
+ <year>2010</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml
index a0079fd0c0..37a1846160 100644
--- a/lib/common_test/doc/src/notes.xml
+++ b/lib/common_test/doc/src/notes.xml
@@ -33,6 +33,100 @@
<file>notes.xml</file>
</header>
+<section><title>Common_Test 1.15.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ In OTP-20.0, the behavior of c, make, and ct_make was
+ changed so that in some cases the beam files by default
+ would be written to the directory where the source files
+ were found. This is now changed back to the old behavior
+ so beam files are by default written to current
+ directory.</p>
+ <p>
+ Own Id: OTP-14489 Aux Id: ERL-438 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Common_Test 1.15</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Errors in the documentation for user HTML stylesheets
+ have been corrected.</p>
+ <p>
+ Own Id: OTP-14332 Aux Id: seq13299 </p>
+ </item>
+ <item>
+ <p>Internal code change: Calls to <c>catch</c> followed
+ by a call to <c>erlang:get_stacktrace/0</c> has been
+ rewritten to use <c>try</c> instead of <c>catch</c> to
+ make the code future-proof.</p>
+ <p>
+ Own Id: OTP-14400</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>The <c>ct_slave</c> modules now handle nodenames in
+ the same way as nodenames passed to <c>-sname</c>. That
+ means <c>ct_slave:start('[email protected]').</c> will now
+ work.</p>
+ <p>
+ Own Id: OTP-13806</p>
+ </item>
+ <item>
+ <p>
+ Added the new option, <c>keep_logs</c>. If setting the
+ value for this option to an integer, N, common_test will
+ remove all ct_run.* directories in the current log
+ directory, except the N newest.</p>
+ <p>
+ Own Id: OTP-14179</p>
+ </item>
+ <item>
+ <p>
+ The existing <c>ct_netconfc:open/1,2</c> opens an SSH
+ connection with one SSH channel realizing one Netconf
+ session. To allow testing of multiple sessions over the
+ same SSH connection, the following functions are added to
+ <c>ct_netconfc</c>:</p>
+ <p>
+ * <c>connect/1,2</c> - establish an SSH connection *
+ <c>disconnect/1</c> - close the given SSH connection *
+ <c>session/1,2,3</c> - open an ssh channel on the given
+ connection and send 'hello' to start a Netconf session</p>
+ <p>
+ Own Id: OTP-14284</p>
+ </item>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ <item>
+ <p>
+ The function ct_ssh:shell/2,3 is added.</p>
+ <p>
+ Own Id: OTP-14415 Aux Id: seq13315 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Common_Test 1.14</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 662732d475..19b0ee20fe 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.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.
@@ -917,13 +917,13 @@ comment(Comment) when is_list(Comment) ->
Formatted =
case (catch io_lib:format("~ts",[Comment])) of
{'EXIT',_} -> % it's a list not a string
- io_lib:format("~p",[Comment]);
+ io_lib:format("~tp",[Comment]);
String ->
String
end,
send_html_comment(lists:flatten(Formatted));
comment(Comment) ->
- Formatted = io_lib:format("~p",[Comment]),
+ Formatted = io_lib:format("~tp",[Comment]),
send_html_comment(lists:flatten(Formatted)).
%%%-----------------------------------------------------------------
diff --git a/lib/common_test/src/ct_config.erl b/lib/common_test/src/ct_config.erl
index 99de311570..d48ae830bb 100644
--- a/lib/common_test/src/ct_config.erl
+++ b/lib/common_test/src/ct_config.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.
@@ -171,8 +171,8 @@ reload_config(KeyOrName) ->
process_default_configs(Opts) ->
lists:flatmap(fun({config,[_|_] = FileOrFiles}) ->
- case {io_lib:printable_list(FileOrFiles),
- io_lib:printable_list(hd(FileOrFiles))} of
+ case {io_lib:printable_unicode_list(FileOrFiles),
+ io_lib:printable_unicode_list(hd(FileOrFiles))} of
{false,true} ->
FileOrFiles;
{true,false} ->
diff --git a/lib/common_test/src/ct_conn_log_h.erl b/lib/common_test/src/ct_conn_log_h.erl
index 6c1e46925f..cf0a228e1b 100644
--- a/lib/common_test/src/ct_conn_log_h.erl
+++ b/lib/common_test/src/ct_conn_log_h.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2012-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.
@@ -186,7 +186,7 @@ format_head(ConnMod,_,Time,Text) ->
io_lib:format("~n~ts",[Head]).
format_title(raw,#conn_log{client=Client}=Info) ->
- io_lib:format("Client ~w ~s ~ts",[Client,actionstr(Info),serverstr(Info)]);
+ io_lib:format("Client ~tw ~s ~ts",[Client,actionstr(Info),serverstr(Info)]);
format_title(_,Info) ->
Title = pad_char_end(?WIDTH,pretty_title(Info),$=),
io_lib:format("~n~ts", [Title]).
@@ -197,9 +197,9 @@ format_data(ConnMod,LogType,Data) ->
ConnMod:format_data(LogType,Data).
format_error(raw,Report) ->
- io_lib:format("~n~p~n",[Report]);
+ io_lib:format("~n~tp~n",[Report]);
format_error(pretty,Report) ->
- [io_lib:format("~n ~p: ~p",[K,V]) || {K,V} <- Report].
+ [io_lib:format("~n ~tp: ~tp",[K,V]) || {K,V} <- Report].
%%%-----------------------------------------------------------------
@@ -230,7 +230,7 @@ pretty_head({{{Y,Mo,D},{H,Mi,S}},MicroS},ConnMod,Text0) ->
micro2milli(MicroS)]).
pretty_title(#conn_log{client=Client}=Info) ->
- io_lib:format("= Client ~w ~s ~ts ",
+ io_lib:format("= Client ~tw ~s ~ts ",
[Client,actionstr(Info),serverstr(Info)]).
actionstr(#conn_log{action=send}) -> "----->";
@@ -245,11 +245,11 @@ actionstr(_) -> "<---->".
serverstr(#conn_log{name=undefined,address={undefined,_}}) ->
io_lib:format("server",[]);
serverstr(#conn_log{name=undefined,address=Address}) ->
- io_lib:format("~p",[Address]);
+ io_lib:format("~tp",[Address]);
serverstr(#conn_log{name=Alias,address={undefined,_}}) ->
- io_lib:format("~w",[Alias]);
+ io_lib:format("~tw",[Alias]);
serverstr(#conn_log{name=Alias,address=Address}) ->
- io_lib:format("~w(~p)",[Alias,Address]).
+ io_lib:format("~tw(~tp)",[Alias,Address]).
month(1) -> "Jan";
month(2) -> "Feb";
diff --git a/lib/common_test/src/ct_event.erl b/lib/common_test/src/ct_event.erl
index 5fa9f410bf..1a0ee4f3cd 100644
--- a/lib/common_test/src/ct_event.erl
+++ b/lib/common_test/src/ct_event.erl
@@ -1,7 +1,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.
@@ -151,7 +151,7 @@ init(RecvPids) ->
%%--------------------------------------------------------------------
handle_event(Event,State=#state{receivers=RecvPids}) ->
print("~n=== ~w ===~n", [?MODULE]),
- print("~w: ~w~n", [Event#event.name,Event#event.data]),
+ print("~tw: ~tw~n", [Event#event.name,Event#event.data]),
lists:foreach(fun(Recv) -> report_event(Recv,Event) end, RecvPids),
{ok,State}.
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 141c7f5b0a..6066470233 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -312,7 +312,7 @@ add_defaults(Mod,Func, GroupPath) ->
end;
{'EXIT',Reason} ->
ErrStr = io_lib:format("~n*** ERROR *** "
- "~w:suite/0 failed: ~p~n",
+ "~w:suite/0 failed: ~tp~n",
[Suite,Reason]),
io:format(ErrStr, []),
io:format(?def_gl, ErrStr, []),
@@ -335,7 +335,7 @@ add_defaults(Mod,Func, GroupPath) ->
false ->
ErrStr = io_lib:format("~n*** ERROR *** "
"Invalid return value from "
- "~w:suite/0: ~p~n",
+ "~w:suite/0: ~tp~n",
[Suite,SuiteInfo]),
io:format(ErrStr, []),
io:format(?def_gl, ErrStr, []),
@@ -344,7 +344,7 @@ add_defaults(Mod,Func, GroupPath) ->
SuiteInfo ->
ErrStr = io_lib:format("~n*** ERROR *** "
"Invalid return value from "
- "~w:suite/0: ~p~n", [Suite,SuiteInfo]),
+ "~w:suite/0: ~tp~n", [Suite,SuiteInfo]),
io:format(ErrStr, []),
io:format(?def_gl, ErrStr, []),
{suite0_failed,bad_return_value}
@@ -371,7 +371,7 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo) ->
{value,{error,BadGr0Val,GrName}} ->
Gr0ErrStr = io_lib:format("~n*** ERROR *** "
"Invalid return value from "
- "~w:group(~w): ~p~n",
+ "~w:group(~tw): ~tp~n",
[Mod,GrName,BadGr0Val]),
io:format(Gr0ErrStr, []),
io:format(?def_gl, Gr0ErrStr, []),
@@ -393,7 +393,7 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo) ->
{error,BadTC0Val} ->
TC0ErrStr = io_lib:format("~n*** ERROR *** "
"Invalid return value from "
- "~w:~w/0: ~p~n",
+ "~w:~tw/0: ~tp~n",
[Mod,Func,BadTC0Val]),
io:format(TC0ErrStr, []),
io:format(?def_gl, TC0ErrStr, []),
@@ -921,7 +921,7 @@ error_notification(Mod,Func,_Args,{Error,Loc}) ->
end,
ErrorStr = case ErrorSpec of
{badmatch,Descr} ->
- Descr1 = lists:flatten(io_lib:format("~P",[Descr,10])),
+ Descr1 = lists:flatten(io_lib:format("~tP",[Descr,10])),
if length(Descr1) > 50 ->
Descr2 = string:substr(Descr1,1,50),
io_lib:format("{badmatch,~ts...}",[Descr2]);
@@ -931,15 +931,15 @@ error_notification(Mod,Func,_Args,{Error,Loc}) ->
{test_case_failed,Reason} ->
case (catch io_lib:format("{test_case_failed,~ts}", [Reason])) of
{'EXIT',_} ->
- io_lib:format("{test_case_failed,~p}", [Reason]);
+ io_lib:format("{test_case_failed,~tp}", [Reason]);
Result -> Result
end;
{'EXIT',_Reason} = EXIT ->
- io_lib:format("~P", [EXIT,5]);
+ io_lib:format("~tP", [EXIT,5]);
{Spec,_Reason} when is_atom(Spec) ->
- io_lib:format("~w", [Spec]);
+ io_lib:format("~tw", [Spec]);
Other ->
- io_lib:format("~P", [Other,5])
+ io_lib:format("~tP", [Other,5])
end,
ErrorHtml =
"<font color=\"brown\">" ++ ct_logs:escape_chars(ErrorStr) ++ "</font>",
@@ -996,16 +996,16 @@ error_notification(Mod,Func,_Args,{Error,Loc}) ->
%% if a function specified by all/0 does not exist, we
%% pick up undef here
[{LastMod,LastFunc}|_] when ErrorStr == "undef" ->
- PrintError("~w:~w could not be executed~nReason: ~ts",
+ PrintError("~w:~tw could not be executed~nReason: ~ts",
[LastMod,LastFunc,ErrorStr]);
[{LastMod,LastFunc}|_] ->
- PrintError("~w:~w failed~nReason: ~ts", [LastMod,LastFunc,ErrorStr]);
+ PrintError("~w:~tw failed~nReason: ~ts", [LastMod,LastFunc,ErrorStr]);
[{LastMod,LastFunc,LastLine}|_] ->
%% print error to console, we are only
%% interested in the last executed expression
- PrintError("~w:~w failed on line ~w~nReason: ~ts",
+ PrintError("~w:~tw failed on line ~w~nReason: ~ts",
[LastMod,LastFunc,LastLine,ErrorStr]),
case ct_util:read_suite_data({seq,Mod,Func}) of
@@ -1178,7 +1178,7 @@ get_all(Mod, ConfTests) ->
case ct_util:get_testdata({error_in_suite,Mod}) of
undefined ->
ErrStr = io_lib:format("~n*** ERROR *** "
- "~w:all/0 failed: ~p~n",
+ "~w:all/0 failed: ~tp~n",
[Mod,ExitReason]),
io:format(?def_gl, ErrStr, []),
%% save the error info so it doesn't get printed twice
@@ -1294,8 +1294,8 @@ save_seq(Mod,Seq,SeqTCs,All) ->
check_private(Seq,TCs,All) ->
Bad = lists:filter(fun(TC) -> lists:member(TC,All) end, TCs),
if Bad /= [] ->
- Reason = io_lib:format("regular test cases not allowed in sequence ~p: "
- "~p",[Seq,Bad]),
+ Reason = io_lib:format("regular test cases not allowed in sequence ~tp: "
+ "~tp",[Seq,Bad]),
throw({error,list_to_atom(lists:flatten(Reason))});
true ->
ok
@@ -1312,7 +1312,7 @@ check_multiple(Mod,Seq,TCs) ->
end,TCs),
if Bad /= [] ->
Reason = io_lib:format("test cases found in multiple sequences: "
- "~p",[Bad]),
+ "~tp",[Bad]),
throw({error,list_to_atom(lists:flatten(Reason))});
true ->
ok
@@ -1340,15 +1340,15 @@ end_per_suite(_Config) ->
%% if the group config functions are missing in the suite,
%% use these instead
init_per_group(GroupName, Config) ->
- ct:comment(io_lib:format("start of ~p", [GroupName])),
- ct_logs:log("TEST INFO", "init_per_group/2 for ~w missing "
+ ct:comment(io_lib:format("start of ~tp", [GroupName])),
+ ct_logs:log("TEST INFO", "init_per_group/2 for ~tw missing "
"in suite, using default.",
[GroupName]),
Config.
end_per_group(GroupName, _) ->
- ct:comment(io_lib:format("end of ~p", [GroupName])),
- ct_logs:log("TEST INFO", "end_per_group/2 for ~w missing "
+ ct:comment(io_lib:format("end of ~tp", [GroupName])),
+ ct_logs:log("TEST INFO", "end_per_group/2 for ~tw missing "
"in suite, using default.",
[GroupName]),
ok.
diff --git a/lib/common_test/src/ct_ftp.erl b/lib/common_test/src/ct_ftp.erl
index 84e664b387..8effb06e7e 100644
--- a/lib/common_test/src/ct_ftp.erl
+++ b/lib/common_test/src/ct_ftp.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.
@@ -119,19 +119,19 @@ open(KeyOrName) ->
_ ->
case ct:get_config(KeyOrName) of
undefined ->
- log(heading(open,KeyOrName),"Failed: ~p\n",
+ log(heading(open,KeyOrName),"Failed: ~tp\n",
[{not_available,KeyOrName}]),
{error,{not_available,KeyOrName}};
_ ->
case ct:get_config({KeyOrName,username}) of
undefined ->
- log(heading(open,KeyOrName),"Failed: ~p\n",
+ log(heading(open,KeyOrName),"Failed: ~tp\n",
[{not_available,{KeyOrName,username}}]),
{error,{not_available,{KeyOrName,username}}};
Username ->
case ct:get_config({KeyOrName,password}) of
undefined ->
- log(heading(open,KeyOrName),"Failed: ~p\n",
+ log(heading(open,KeyOrName),"Failed: ~tp\n",
[{not_available,{KeyOrName,password}}]),
{error,{not_available,{KeyOrName,password}}};
Password ->
@@ -145,7 +145,7 @@ open(KeyOrName,Username,Password) ->
log(heading(open,KeyOrName),"",[]),
case ct:get_config({KeyOrName,ftp}) of
undefined ->
- log(heading(open,KeyOrName),"Failed: ~p\n",
+ log(heading(open,KeyOrName),"Failed: ~tp\n",
[{not_available,{KeyOrName,ftp}}]),
{error,{not_available,{KeyOrName,ftp}}};
Addr ->
@@ -284,7 +284,7 @@ init(KeyOrName,{IP,Port},{Username,Password}) ->
case ftp_connect(IP,Port,Username,Password) of
{ok,FtpPid} ->
log(heading(init,KeyOrName),
- "Opened ftp connection:\nIP: ~p\nUsername: ~p\nPassword: ~p\n",
+ "Opened ftp connection:\nIP: ~tp\nUsername: ~tp\nPassword: ~p\n",
[IP,Username,lists:duplicate(length(Password),$*)]),
{ok,FtpPid,#state{ftp_pid=FtpPid,target_name=KeyOrName}};
Error ->
@@ -308,28 +308,28 @@ ftp_connect(IP,Port,Username,Password) ->
%% @hidden
handle_msg({send,LocalFile,RemoteFile},State) ->
log(heading(send,State#state.target_name),
- "LocalFile: ~p\nRemoteFile: ~p\n",[LocalFile,RemoteFile]),
+ "LocalFile: ~tp\nRemoteFile: ~tp\n",[LocalFile,RemoteFile]),
Result = ftp:send(State#state.ftp_pid,LocalFile,RemoteFile),
{Result,State};
handle_msg({recv,RemoteFile,LocalFile},State) ->
log(heading(recv,State#state.target_name),
- "RemoteFile: ~p\nLocalFile: ~p\n",[RemoteFile,LocalFile]),
+ "RemoteFile: ~tp\nLocalFile: ~tp\n",[RemoteFile,LocalFile]),
Result = ftp:recv(State#state.ftp_pid,RemoteFile,LocalFile),
{Result,State};
handle_msg({cd,Dir},State) ->
- log(heading(cd,State#state.target_name),"Dir: ~p\n",[Dir]),
+ log(heading(cd,State#state.target_name),"Dir: ~tp\n",[Dir]),
Result = ftp:cd(State#state.ftp_pid,Dir),
{Result,State};
handle_msg({ls,Dir},State) ->
- log(heading(ls,State#state.target_name),"Dir: ~p\n",[Dir]),
+ log(heading(ls,State#state.target_name),"Dir: ~tp\n",[Dir]),
Result = ftp:ls(State#state.ftp_pid,Dir),
{Result,State};
handle_msg({type,Type},State) ->
- log(heading(type,State#state.target_name),"Type: ~p\n",[Type]),
+ log(heading(type,State#state.target_name),"Type: ~tp\n",[Type]),
Result = ftp:type(State#state.ftp_pid,Type),
{Result,State};
handle_msg({delete,File},State) ->
- log(heading(delete,State#state.target_name),"Delete file: ~p\n",[File]),
+ log(heading(delete,State#state.target_name),"Delete file: ~tp\n",[File]),
Result = ftp:delete(State#state.ftp_pid,File),
{Result,State}.
@@ -368,7 +368,7 @@ call(Pid,Msg) ->
heading(Function,Name) ->
- io_lib:format("ct_ftp:~w ~p",[Function,Name]).
+ io_lib:format("ct_ftp:~tw ~tp",[Function,Name]).
log(Heading,Str,Args) ->
ct_gen_conn:log(Heading,Str,Args).
diff --git a/lib/common_test/src/ct_gen_conn.erl b/lib/common_test/src/ct_gen_conn.erl
index 88b05cf955..badb7c52ae 100644
--- a/lib/common_test/src/ct_gen_conn.erl
+++ b/lib/common_test/src/ct_gen_conn.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.
@@ -247,7 +247,7 @@ do_start(Opts) ->
Error;
{'DOWN',MRef,process,_,Reason} ->
log("ct_gen_conn:start",
- "Connection process died: ~p\n",
+ "Connection process died: ~tp\n",
[Reason]),
{error,{connection_process_died,Reason}}
end.
@@ -327,7 +327,7 @@ loop(Opts) ->
case Opts#gen_opts.reconnect of
true ->
log("Connection down!\nOpening new!",
- "Reason: ~p\nAddress: ~p\n",
+ "Reason: ~tp\nAddress: ~tp\n",
[Reason,Opts#gen_opts.address]),
case reconnect(Opts) of
{ok, NewPid, NewState} ->
@@ -338,12 +338,12 @@ loop(Opts) ->
Error ->
ct_util:unregister_connection(self()),
log("Reconnect failed. Giving up!",
- "Reason: ~p\n",
+ "Reason: ~tp\n",
[Error])
end;
false ->
ct_util:unregister_connection(self()),
- log("Connection closed!","Reason: ~p\n",[Reason])
+ log("Connection closed!","Reason: ~tp\n",[Reason])
end;
{'EXIT',Pid,Reason} ->
case Opts#gen_opts.ct_util_server of
diff --git a/lib/common_test/src/ct_groups.erl b/lib/common_test/src/ct_groups.erl
index 333151ee1b..2235365a0e 100644
--- a/lib/common_test/src/ct_groups.erl
+++ b/lib/common_test/src/ct_groups.erl
@@ -210,7 +210,7 @@ find(Mod, _GrNames, _TCs, [BadTerm | _Gs], Known, _Defs, _FindAll) ->
"group "++atom_to_list(lists:last(Known))++
" in "++atom_to_list(Mod)++":groups/0"
end,
- Term = io_lib:format("~p", [BadTerm]),
+ Term = io_lib:format("~tp", [BadTerm]),
E = "Bad term "++lists:flatten(Term)++" in "++Where,
throw({error,list_to_atom(E)});
@@ -447,7 +447,7 @@ make_conf(Mod, Name, Props, TestSpec) ->
{false,false} ->
ct_logs:log("TEST INFO", "init_per_group/2 and "
"end_per_group/2 missing for group "
- "~w in ~w, using default.",
+ "~tw in ~w, using default.",
[Name,Mod]),
{{ct_framework,init_per_group},
{ct_framework,end_per_group},
diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl
index 8cdc6d8c75..f0592a40be 100644
--- a/lib/common_test/src/ct_hooks.erl
+++ b/lib/common_test/src/ct_hooks.erl
@@ -235,7 +235,7 @@ call([{Hook, call_id, NextFun} | Rest], Config, Meta, Hooks) ->
call(resort(NewRest,NewHooks,Meta), Config, Meta, NewHooks)
catch Error:Reason ->
Trace = erlang:get_stacktrace(),
- ct_logs:log("Suite Hook","Failed to start a CTH: ~p:~p",
+ ct_logs:log("Suite Hook","Failed to start a CTH: ~tp:~tp",
[Error,{Reason,Trace}]),
call([], {fail,"Failed to start CTH"
", see the CT Log for details"}, Meta, Hooks)
@@ -424,11 +424,11 @@ catch_apply(M,F,A) ->
erlang:apply(M,F,A)
catch _:Reason ->
Trace = erlang:get_stacktrace(),
- ct_logs:log("Suite Hook","Call to CTH failed: ~w:~p",
+ ct_logs:log("Suite Hook","Call to CTH failed: ~w:~tp",
[error,{Reason,Trace}]),
throw({error_in_cth_call,
lists:flatten(
- io_lib:format("~w:~w/~w CTH call failed",
+ io_lib:format("~w:~tw/~w CTH call failed",
[M,F,length(A)]))})
end.
diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index 978af0f149..ba7660fe6a 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -139,7 +139,7 @@ close(Info, StartDir) ->
LogCacheBin =
case make_last_run_index() of
{error, Reason} -> % log server not responding
- io:format("Warning! ct_logs not responding: ~p~n", [Reason]),
+ io:format("Warning! ct_logs not responding: ~tp~n", [Reason]),
undefined;
LCB ->
LCB
@@ -175,7 +175,7 @@ close(Info, StartDir) ->
ok ->
ok;
Error ->
- io:format("Warning! Cleanup failed: ~p~n", [Error])
+ io:format("Warning! Cleanup failed: ~tp~n", [Error])
end,
_ = make_all_suites_index(stop),
make_all_runs_index(stop),
@@ -425,7 +425,7 @@ add_external_logs(Logs) ->
%%% @doc Print a link to a given file stored in the priv_dir of the
%%% calling test suite.
add_link(Heading,File,Type) ->
- log(Heading,"<a href=\"~ts\" type=~p>~ts</a>\n",
+ log(Heading,"<a href=\"~ts\" type=~tp>~ts</a>\n",
[uri(filename:join("log_private",File)),Type,File]).
@@ -567,7 +567,7 @@ get_header("default") ->
[log_timestamp(?now)]);
get_header(Heading) ->
io_lib:format("\n-----------------------------"
- "-----------------------\n~s ~s\n",
+ "-----------------------\n~ts ~s\n",
[Heading,log_timestamp(?now)]).
@@ -704,8 +704,8 @@ logger(Parent, Mode, Verbosity) ->
case copy_priv_files(PrivFilesSrc, PrivFilesDestTop) of
{error,Src1,Dest1,Reason1} ->
io:format(?def_gl, "ERROR! "++
- "Priv file ~p could not be copied to ~p. "++
- "Reason: ~p~n",
+ "Priv file ~tp could not be copied to ~tp. "++
+ "Reason: ~tp~n",
[Src1,Dest1,Reason1]),
exit({priv_file_error,Dest1});
ok ->
@@ -713,8 +713,8 @@ logger(Parent, Mode, Verbosity) ->
{error,Src2,Dest2,Reason2} ->
io:format(?def_gl,
"ERROR! "++
- "Priv file ~p could not be copied to ~p. "
- ++"Reason: ~p~n",
+ "Priv file ~tp could not be copied to ~tp. "
+ ++"Reason: ~tp~n",
[Src2,Dest2,Reason2]),
exit({priv_file_error,Dest2});
ok ->
@@ -891,7 +891,7 @@ logger_loop(State) ->
logger_loop(State);
{set_stylesheet,TC,SSFile} ->
Fd = State#logger_state.ct_log_fd,
- io:format(Fd, "~p loading external style sheet: ~ts~n",
+ io:format(Fd, "~tp loading external style sheet: ~ts~n",
[TC,SSFile]),
logger_loop(State#logger_state{stylesheet = SSFile});
{clear_stylesheet,_} when State#logger_state.stylesheet == undefined ->
@@ -952,7 +952,7 @@ create_io_fun(FromPid, CtLogFd, EscChars) ->
[IoList,"\n",IoStr]
catch
_:_Reason ->
- io:format(CtLogFd, "Logging fails! Str: ~p, Args: ~p~n",
+ io:format(CtLogFd, "Logging fails! Str: ~tp, Args: ~tp~n",
[Str,Args]),
%% stop the testcase, we need to see the fault
exit(FromPid, {log_printout_error,Str,Args}),
@@ -1151,7 +1151,7 @@ open_ctlog(MiscIoName) ->
Dir = filename:dirname(Cwd),
Variables = ct_run:variables_file_name(Dir),
io:format(Fd,
- "Can not read the file \'~ts\' Reason: ~w\n"
+ "Can not read the file \'~ts\' Reason: ~tw\n"
"No configuration found for test!!\n",
[Variables,Reason])
end,
@@ -1213,7 +1213,7 @@ print_style(Fd, IoFormat, StyleSheet) ->
end.
print_style_error(Fd, IoFormat, StyleSheet, Reason) ->
- IO = io_lib:format("\n<!-- Failed to load stylesheet ~ts: ~p -->\n",
+ IO = io_lib:format("\n<!-- Failed to load stylesheet ~ts: ~tp -->\n",
[StyleSheet,Reason]),
IoFormat(Fd, IO, []),
print_style(Fd, IoFormat, undefined).
@@ -1256,11 +1256,11 @@ make_last_run_index(StartTime) ->
case catch make_last_run_index1(StartTime,IndexName) of
{'EXIT', Reason} ->
io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"),
- io:format("~p~n", [Reason]),
+ io:format("~tp~n", [Reason]),
{error, Reason};
{error, Reason} ->
io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"),
- io:format("~p~n", [Reason]),
+ io:format("~tp~n", [Reason]),
{error, Reason};
ok ->
ok;
@@ -1561,7 +1561,7 @@ get_missing_suites(_,_) ->
[].
term_to_text(Term) ->
- lists:flatten(io_lib:format("~p.\n", [Term])).
+ lists:flatten(io_lib:format("~tp.\n", [Term])).
%%% Headers and footers.
@@ -1829,7 +1829,7 @@ count_cases(Dir) ->
Summary
end;
{error, Reason} ->
- io:format("\nFailed to read ~p: ~p (skipped)\n",
+ io:format("\nFailed to read ~tp: ~tp (skipped)\n",
[LogFile,Reason]),
error
end
@@ -1911,10 +1911,10 @@ config_table_header() ->
config_table1([{Key,Value}|Vars]) ->
[xhtml(["<tr><td>", atom_to_list(Key), "</td>\n",
- "<td><pre>",io_lib:format("~p",[Value]),"</pre></td></tr>\n"],
+ "<td><pre>",io_lib:format("~tp",[Value]),"</pre></td></tr>\n"],
["<tr class=\"", odd_or_even(), "\">\n",
"<td>", atom_to_list(Key), "</td>\n",
- "<td>", io_lib:format("~p",[Value]), "</td>\n</tr>\n"]) |
+ "<td>", io_lib:format("~tp",[Value]), "</td>\n</tr>\n"]) |
config_table1(Vars)];
config_table1([]) ->
[xhtml("","</tbody>\n"),"</table>\n"].
@@ -2474,17 +2474,17 @@ make_all_suites_index(NewTestData = {_TestName,DirName}) ->
LogDirData) of
{'EXIT',Reason} ->
io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"),
- io:format("~p~n", [Reason]),
+ io:format("~tp~n", [Reason]),
{error,Reason};
{error,Reason} ->
io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"),
- io:format("~p~n", [Reason]),
+ io:format("~tp~n", [Reason]),
{error,Reason};
ok ->
ok;
Err ->
io:format("Unknown internal error while updating ~ts. "
- "Please report.\n(Err: ~p, ID: 1)",
+ "Please report.\n(Err: ~tp, ID: 1)",
[AbsIndexName,Err]),
{error, Err}
end,
@@ -2703,11 +2703,11 @@ make_all_suites_index1(When, AbsIndexName, AllTestLogDirs) ->
case catch make_all_suites_index2(IndexName, AllTestLogDirs) of
{'EXIT', Reason} ->
io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"),
- io:format("~p~n", [Reason]),
+ io:format("~tp~n", [Reason]),
{error, Reason};
{error, Reason} ->
io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"),
- io:format("~p~n", [Reason]),
+ io:format("~tp~n", [Reason]),
{error, Reason};
{ok,TempData} ->
case When of
@@ -2721,7 +2721,7 @@ make_all_suites_index1(When, AbsIndexName, AllTestLogDirs) ->
end;
Err ->
io:format("Unknown internal error while updating ~ts. "
- "Please report.\n(Err: ~p, ID: 1)",
+ "Please report.\n(Err: ~tp, ID: 1)",
[AbsIndexName,Err]),
{error, Err}
end.
@@ -3200,7 +3200,7 @@ get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) ->
TestName1 = if is_list(TestName) ->
lists:flatten(TestName);
true ->
- lists:flatten(io_lib:format("~p", [TestName]))
+ lists:flatten(io_lib:format("~tp", [TestName]))
end,
Basic = basic_html(),
LabelStr =
diff --git a/lib/common_test/src/ct_make.erl b/lib/common_test/src/ct_make.erl
index f22959d457..220cb0473d 100644
--- a/lib/common_test/src/ct_make.erl
+++ b/lib/common_test/src/ct_make.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -96,7 +96,7 @@ read_emakefile(Emakefile,Opts) ->
Mods = [filename:rootname(F) || F <- filelib:wildcard("*.erl")],
[{Mods, Opts}];
{error,Other} ->
- io:format("make: Trouble reading 'Emakefile':~n~p~n",[Other]),
+ io:format("make: Trouble reading 'Emakefile':~n~tp~n",[Other]),
error
end.
@@ -151,7 +151,7 @@ get_opts_from_emakefile(Mods,Emakefile,Opts) ->
{error,enoent} ->
[{Mods, Opts}];
{error,Other} ->
- io:format("make: Trouble reading 'Emakefile':~n~p~n",[Other]),
+ io:format("make: Trouble reading 'Emakefile':~n~tp~n",[Other]),
error
end.
@@ -280,15 +280,47 @@ recompile(File, NoExec, Load, Opts) ->
do_recompile(_File, true, _Load, _Opts) ->
out_of_date;
-do_recompile(File, false, noload, Opts) ->
+do_recompile(File, false, Load, Opts) ->
io:format("Recompile: ~ts\n",[File]),
- compile:file(File, [report_errors, report_warnings, error_summary |Opts]);
-do_recompile(File, false, load, Opts) ->
- io:format("Recompile: ~ts\n",[File]),
- c:c(File, Opts);
-do_recompile(File, false, netload, Opts) ->
- io:format("Recompile: ~ts\n",[File]),
- c:nc(File, Opts).
+ case compile:file(File, [report_errors, report_warnings |Opts]) of
+ Ok when is_tuple(Ok), element(1,Ok)==ok ->
+ maybe_load(element(2,Ok), Load, Opts);
+ _Error ->
+ error
+ end.
+
+maybe_load(_Mod, noload, _Opts) ->
+ ok;
+maybe_load(Mod, Load, Opts) ->
+ %% We have compiled File with options Opts. Find out where the
+ %% output file went to, and load it.
+ case compile:output_generated(Opts) of
+ true ->
+ Dir = proplists:get_value(outdir,Opts,"."),
+ do_load(Dir, Mod, Load);
+ false ->
+ io:format("** Warning: No object file created - nothing loaded **~n"),
+ ok
+ end.
+
+do_load(Dir, Mod, load) ->
+ code:purge(Mod),
+ case code:load_abs(filename:join(Dir, Mod),Mod) of
+ {module,Mod} ->
+ {ok,Mod};
+ Other ->
+ Other
+ end;
+do_load(Dir, Mod, netload) ->
+ Obj = atom_to_list(Mod) ++ code:objfile_extension(),
+ Fname = filename:join(Dir, Obj),
+ case file:read_file(Fname) of
+ {ok,Bin} ->
+ rpc:eval_everywhere(code,load_binary,[Mod,Fname,Bin]),
+ {ok,Mod};
+ Other ->
+ Other
+ end.
exists(File) ->
case file:read_file_info(File) of
diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl
index 4eef27d2a5..6e6d1879c2 100644
--- a/lib/common_test/src/ct_master.erl
+++ b/lib/common_test/src/ct_master.erl
@@ -1,7 +1,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.
@@ -434,7 +434,7 @@ init_master1(Parent,NodeOptsList,InitOptions,LogDirs) ->
init_master2(Parent,NodeOptsList,LogDirs) ->
process_flag(trap_exit,true),
Cookie = erlang:get_cookie(),
- log(all,"Cookie","~w",[Cookie]),
+ log(all,"Cookie","~tw",[Cookie]),
log(all,"Starting Tests",
"Tests starting on: ~p",[[N || {N,_} <- NodeOptsList]]),
SpawnAndMon =
@@ -454,7 +454,7 @@ master_loop(#state{node_ctrl_pids=[],
results=Finished}) ->
Str =
lists:map(fun({Node,Result}) ->
- io_lib:format("~-40.40.*ts~p\n",
+ io_lib:format("~-40.40.*ts~tp\n",
[$_,atom_to_list(Node),Result])
end,lists:reverse(Finished)),
log(all,"TEST RESULTS",Str,[]),
@@ -488,7 +488,7 @@ master_loop(State=#state{node_ctrl_pids=NodeCtrlPids,
Bad
end,
log(all,"Test Info",
- "Test on node ~w failed! Reason: ~p",
+ "Test on node ~w failed! Reason: ~tp",
[Node,Error]),
{Locks1,Blocked1} =
update_queue(exit,Node,Locks,Blocked),
@@ -501,7 +501,7 @@ master_loop(State=#state{node_ctrl_pids=NodeCtrlPids,
undefined ->
%% ignore (but report) exit from master_logger etc
log(all,"Test Info",
- "Warning! Process ~w has terminated. Reason: ~p",
+ "Warning! Process ~w has terminated. Reason: ~tp",
[Pid,Reason]),
master_loop(State)
end;
@@ -584,7 +584,7 @@ update_queue(take,Node,From,Lock={Op,Resource},Locks,Blocked) ->
%% Blocked: [{{Operation,Resource},Node,WaitingPid},...]
case lists:keysearch(Lock,1,Locks) of
{value,{_Lock,Owner}} -> % other node has lock
- log(html,"Lock Info","Node ~w blocked on ~w by ~w. Resource: ~p",
+ log(html,"Lock Info","Node ~w blocked on ~w by ~w. Resource: ~tp",
[Node,Op,Owner,Resource]),
Blocked1 = Blocked ++ [{Lock,Node,From}],
{Locks,Blocked1};
@@ -599,7 +599,7 @@ update_queue(release,Node,_From,Lock={Op,Resource},Locks,Blocked) ->
case lists:keysearch(Lock,1,Blocked) of
{value,E={Lock,SomeNode,WaitingPid}} ->
Blocked1 = lists:delete(E,Blocked),
- log(html,"Lock Info","Node ~w proceeds with ~w. Resource: ~p",
+ log(html,"Lock Info","Node ~w proceeds with ~w. Resource: ~tp",
[SomeNode,Op,Resource]),
reply(ok,WaitingPid), % waiting process may start
{Locks1,Blocked1};
@@ -678,7 +678,7 @@ refresh_logs([D|Dirs],Refreshed) ->
refresh_logs([],Refreshed) ->
Str =
lists:map(fun({D,Result}) ->
- io_lib:format("Refreshing logs in ~p... ~p",
+ io_lib:format("Refreshing logs in ~tp... ~tp",
[D,Result])
end,Refreshed),
log(all,"Info",Str,[]).
@@ -712,7 +712,7 @@ init_node_ctrl(MasterPid,Cookie,Opts) ->
{ok, _} = start_ct_event(),
ct_event:add_handler([{master,MasterPid}]),
- %% log("Running test with options: ~p~n", [Opts]),
+ %% log("Running test with options: ~tp~n", [Opts]),
Result = case (catch ct:run_test(Opts)) of
ok -> finished_ok;
Other -> Other
@@ -828,7 +828,7 @@ start_nodes(InitOptions)->
"with callback ~w~n", [NodeName,Callback]);
{error, Reason, _NodeName} ->
io:format("Failed to start node ~w with callback ~w! "
- "Reason: ~p~n", [NodeName, Callback, Reason])
+ "Reason: ~tp~n", [NodeName, Callback, Reason])
end;
{true, true}->
io:format("WARNING: Node ~w is alive but has node_start "
@@ -857,10 +857,10 @@ eval_on_nodes(InitOptions)->
evaluate(Node, [{M,F,A}|MFAs])->
case rpc:call(Node, M, F, A) of
{badrpc,Reason}->
- io:format("WARNING: Failed to call ~w:~w/~w on node ~w "
- "due to ~p~n", [M,F,length(A),Node,Reason]);
+ io:format("WARNING: Failed to call ~w:~tw/~w on node ~w "
+ "due to ~tp~n", [M,F,length(A),Node,Reason]);
Result->
- io:format("Called ~w:~w/~w on node ~w, result: ~p~n",
+ io:format("Called ~w:~tw/~w on node ~w, result: ~tp~n",
[M,F,length(A),Node,Result])
end,
evaluate(Node, MFAs);
diff --git a/lib/common_test/src/ct_master_event.erl b/lib/common_test/src/ct_master_event.erl
index d28ef42c20..d535d1274e 100644
--- a/lib/common_test/src/ct_master_event.erl
+++ b/lib/common_test/src/ct_master_event.erl
@@ -1,7 +1,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.
@@ -71,7 +71,7 @@ stop() ->
{error,Reason} ->
ct_master_logs:log("Error",
"No response from CT Master Event.\n"
- "Reason = ~p\n"
+ "Reason = ~tp\n"
"Terminating now!\n",[Reason]),
%% communication with event manager fails, kill it
catch exit(whereis(?CT_MEVMGR_REF), kill);
@@ -135,7 +135,7 @@ handle_event(#event{name=start_logging,node=Node,data=RunDir},State) ->
handle_event(#event{name=Name,node=Node,data=Data},State) ->
print("~n=== ~w ===~n", [?MODULE]),
- print("~w on ~w: ~p~n", [Name,Node,Data]),
+ print("~tw on ~w: ~tp~n", [Name,Node,Data]),
{ok,State}.
%%--------------------------------------------------------------------
diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl
index 52003f752d..d8ecd641ed 100644
--- a/lib/common_test/src/ct_master_logs.erl
+++ b/lib/common_test/src/ct_master_logs.erl
@@ -1,7 +1,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.
@@ -110,16 +110,16 @@ init(Parent,LogDir,Nodes) ->
case copy_priv_files(PrivFilesSrc, PrivFilesDestTop) of
{error,Src1,Dest1,Reason1} ->
io:format(user, "ERROR! "++
- "Priv file ~p could not be copied to ~p. "++
- "Reason: ~p~n",
+ "Priv file ~tp could not be copied to ~tp. "++
+ "Reason: ~tp~n",
[Src1,Dest1,Reason1]),
exit({priv_file_error,Dest1});
ok ->
case copy_priv_files(PrivFilesSrc, PrivFilesDestRun) of
{error,Src2,Dest2,Reason2} ->
io:format(user, "ERROR! "++
- "Priv file ~p could not be copied to ~p. "++
- "Reason: ~p~n",
+ "Priv file ~tp could not be copied to ~tp. "++
+ "Reason: ~tp~n",
[Src2,Dest2,Reason2]),
exit({priv_file_error,Dest2});
ok ->
@@ -170,7 +170,7 @@ loop(State) ->
case catch io:format(Fd,Str++"\n",Args) of
{'EXIT',Reason} ->
io:format(Fd,
- "Logging fails! Str: ~p, Args: ~p~n",
+ "Logging fails! Str: ~tp, Args: ~tp~n",
[Str,Args]),
exit({logging_failed,Reason}),
ok;
diff --git a/lib/common_test/src/ct_master_status.erl b/lib/common_test/src/ct_master_status.erl
index 7d3e54e645..b27fdd341e 100644
--- a/lib/common_test/src/ct_master_status.erl
+++ b/lib/common_test/src/ct_master_status.erl
@@ -1,7 +1,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.
@@ -71,7 +71,7 @@ init(_) ->
%%
handle_event(#event{name=Name,node=Node,data=Data},State) ->
print("~n=== ~w ===~n", [?MODULE]),
- print("~w on ~w: ~p~n", [Name,Node,Data]),
+ print("~tw on ~w: ~tp~n", [Name,Node,Data]),
{ok,State}.
%%--------------------------------------------------------------------
diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl
index b77570c121..2c4b97df20 100644
--- a/lib/common_test/src/ct_netconfc.erl
+++ b/lib/common_test/src/ct_netconfc.erl
@@ -1,7 +1,7 @@
%%----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2012-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.
diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl
index 12c3d726d3..94ccb59af9 100644
--- a/lib/common_test/src/ct_property_test.erl
+++ b/lib/common_test/src/ct_property_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.
@@ -134,7 +134,7 @@ mk_ct_return(Other, Tool) ->
try lists:last(hd(Tool:counterexample()))
of
{set,{var,_},{call,M,F,Args}} ->
- {fail, io_lib:format("~p:~p/~p returned bad result",[M,F,length(Args)])}
+ {fail, io_lib:format("~p:~tp/~p returned bad result",[M,F,length(Args)])}
catch
_:_ ->
{fail, Other}
@@ -174,7 +174,7 @@ compile_tests(Path, ToolModule) ->
BeamFiles = [F || F<-FileNames,
filename:extension(F) == ".beam"],
_ = [file:delete(F) || F<-BeamFiles],
- ct:pal("Compiling in ~p:~n Deleted ~p~n MacroDefs=~p",[Path,BeamFiles,MacroDefs]),
+ ct:pal("Compiling in ~tp:~n Deleted ~p~n MacroDefs=~p",[Path,BeamFiles,MacroDefs]),
Result = make:all([load|MacroDefs]),
ok = file:set_cwd(Cwd),
Result.
diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl
index 6e3cad0a50..551a7e06d7 100644
--- a/lib/common_test/src/ct_release_test.erl
+++ b/lib/common_test/src/ct_release_test.erl
@@ -445,7 +445,7 @@ init_upgrade_test(Level) ->
end,
case OldRel of
false ->
- ct:log("Release ~p is not available."
+ ct:log("Release ~tp is not available."
" Upgrade on '~p' level can not be tested.",
[FromVsn,Level]),
undefined;
@@ -522,8 +522,8 @@ upgrade(Apps,Level,Callback,CreateDir,InstallDir,Config) ->
{ToVsn,ToRel,ToAppsVsns} =
upgrade_system(Apps, FromRel, CreateDir,
InstallDir, Data),
- ct:log("Upgrade from: OTP-~ts, ~p",[FromVsn, FromAppsVsns]),
- ct:log("Upgrade to: OTP-~ts, ~p",[ToVsn, ToAppsVsns]),
+ ct:log("Upgrade from: OTP-~ts, ~tp",[FromVsn, FromAppsVsns]),
+ ct:log("Upgrade to: OTP-~ts, ~tp",[ToVsn, ToAppsVsns]),
do_upgrade(Callback, FromVsn, FromAppsVsns, ToRel,
ToAppsVsns, InstallDir)
end
@@ -727,9 +727,9 @@ do_upgrade({Cb,InitState},FromVsn,FromAppsVsns,ToRel,ToAppsVsns,InstallDir) ->
do_callback(Node,Mod,Func,Args) ->
Dir = filename:dirname(code:which(Mod)),
_ = rpc:call(Node,code,add_path,[Dir]),
- ct:log("Calling ~p:~p/1",[Mod,Func]),
+ ct:log("Calling ~p:~tp/1",[Mod,Func]),
R = rpc:call(Node,Mod,Func,Args),
- ct:log("~p:~p/~w returned: ~p",[Mod,Func,length(Args),R]),
+ ct:log("~p:~tp/~w returned: ~tp",[Mod,Func,length(Args),R]),
case R of
{badrpc,Error} ->
throw({fail,{test_upgrade_callback,Mod,Func,Args,Error}});
@@ -860,10 +860,7 @@ copy_file(Src, Dest, Opts) ->
end.
write_file(FName, Conts) ->
- Enc = file:native_name_encoding(),
- {ok, Fd} = file:open(FName, [write]),
- ok = file:write(Fd, unicode:characters_to_binary(Conts,Enc,Enc)),
- ok = file:close(Fd).
+ file:write_file(FName, unicode:characters_to_binary(Conts)).
%% Substitute all occurrences of %Var% for Val in the given scripts
subst_src_scripts(Scripts, SrcDir, DestDir, Vars, Opts) ->
@@ -879,7 +876,7 @@ subst_src_script(Script, SrcDir, DestDir, Vars, Opts) ->
subst_file(Src, Dest, Vars, Opts) ->
{ok, Bin} = file:read_file(Src),
- Conts = binary_to_list(Bin),
+ Conts = unicode:characters_to_list(Bin),
NConts = subst(Conts, Vars),
write_file(Dest, NConts),
case lists:member(preserve, Opts) of
@@ -891,7 +888,7 @@ subst_file(Src, Dest, Vars, Opts) ->
end.
subst(Str, [{Var,Val}|Vars]) ->
- subst(re:replace(Str,"%"++Var++"%",Val,[{return,list}]),Vars);
+ subst(re:replace(Str,"%"++Var++"%",Val,[{return,list},unicode]),Vars);
subst(Str, []) ->
Str.
diff --git a/lib/common_test/src/ct_repeat.erl b/lib/common_test/src/ct_repeat.erl
index dac596a135..c043c9846c 100644
--- a/lib/common_test/src/ct_repeat.erl
+++ b/lib/common_test/src/ct_repeat.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
@@ -43,7 +43,7 @@ loop_test(If,Args) when is_list(Args) ->
no_loop ->
false;
E = {error,_} ->
- io:format("Common Test error: ~p\n\n",[E]),
+ io:format("Common Test error: ~tp\n\n",[E]),
ok = file:set_cwd(Cwd),
E;
{repeat,N} ->
@@ -89,18 +89,18 @@ loop(If,Type,N,Data0,Data1,Args,TPid,AccResult) ->
{'EXIT',Pid,Reason} ->
case Reason of
{user_error,What} ->
- io:format("\nTest run failed!\nReason: ~p\n\n\n", [What]),
+ io:format("\nTest run failed!\nReason: ~tp\n\n\n", [What]),
cancel(TPid),
{error,What};
_ ->
io:format("Test run crashed! This could be an internal error "
"- please report!\n\n"
- "~p\n\n\n",[Reason]),
+ "~tp\n\n\n",[Reason]),
cancel(TPid),
{error,Reason}
end;
{Pid,{error,Reason}} ->
- io:format("\nTest run failed!\nReason: ~p\n\n\n",[Reason]),
+ io:format("\nTest run failed!\nReason: ~tp\n\n\n",[Reason]),
cancel(TPid),
{error,Reason};
{Pid,Result} ->
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index ce30babc0d..14f28f9ca3 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -121,13 +121,13 @@ script_start() ->
%% used for purpose of testing the run_test interface
io:format(user, "~n-------------------- START ARGS "
"--------------------~n", []),
- io:format(user, "--- Init args:~n~p~n", [FlagFilter(Init)]),
- io:format(user, "--- CT args:~n~p~n", [FlagFilter(CtArgs)]),
+ io:format(user, "--- Init args:~n~tp~n", [FlagFilter(Init)]),
+ io:format(user, "--- CT args:~n~tp~n", [FlagFilter(CtArgs)]),
EnvArgs = opts2args(EnvStartOpts),
- io:format(user, "--- Env opts -> args:~n~p~n =>~n~p~n",
+ io:format(user, "--- Env opts -> args:~n~tp~n =>~n~tp~n",
[EnvStartOpts,EnvArgs]),
Merged = merge_arguments(CtArgs ++ EnvArgs),
- io:format(user, "--- Merged args:~n~p~n", [FlagFilter(Merged)]),
+ io:format(user, "--- Merged args:~n~tp~n", [FlagFilter(Merged)]),
io:format(user, "-----------------------------------"
"-----------------~n~n", []),
Merged;
@@ -160,18 +160,18 @@ script_start(Args) ->
{'EXIT',Pid,Reason} ->
case Reason of
{user_error,What} ->
- io:format("\nTest run failed!\nReason: ~p\n\n\n",
+ io:format("\nTest run failed!\nReason: ~tp\n\n\n",
[What]),
finish(Tracing, ?EXIT_STATUS_TEST_RUN_FAILED, Args);
_ ->
io:format("Test run crashed! "
"This could be an internal error "
"- please report!\n\n"
- "~p\n\n\n", [Reason]),
+ "~tp\n\n\n", [Reason]),
finish(Tracing, ?EXIT_STATUS_TEST_RUN_FAILED, Args)
end;
{Pid,{error,Reason}} ->
- io:format("\nTest run failed! Reason:\n~p\n\n\n",[Reason]),
+ io:format("\nTest run failed! Reason:\n~tp\n\n\n",[Reason]),
finish(Tracing, ?EXIT_STATUS_TEST_RUN_FAILED, Args);
{Pid,Result} ->
io:nl(),
@@ -219,7 +219,7 @@ analyze_test_result([], _) ->
analyze_test_result(interactive_mode, _) ->
interactive_mode;
analyze_test_result(Unknown, _) ->
- io:format("\nTest run failed! Reason:\n~p\n\n\n",[Unknown]),
+ io:format("\nTest run failed! Reason:\n~tp\n\n\n",[Unknown]),
?EXIT_STATUS_TEST_RUN_FAILED.
finish(Tracing, ExitStatus, Args) ->
@@ -760,7 +760,7 @@ script_start4(#opts{label = Label, profile = Profile,
if Config == [] ->
ok;
true ->
- io:format("\nInstalling: ~p\n\n", [Config])
+ io:format("\nInstalling: ~tp\n\n", [Config])
end,
case install([{config,Config},{event_handler,EvHandlers},
{ct_hooks, CTHooks},
@@ -909,9 +909,9 @@ install(Opts, LogDir) ->
case whereis(ct_util_server) of
undefined ->
VarFile = variables_file_name(LogDir),
- case file:open(VarFile, [write]) of
+ case file:open(VarFile, [write, {encoding,utf8}]) of
{ok,Fd} ->
- _ = [io:format(Fd, "~p.\n", [Opt]) || Opt <- ConfOpts],
+ _ = [io:format(Fd, "~tp.\n", [Opt]) || Opt <- ConfOpts],
ok = file:close(Fd);
{error,Reason} ->
io:format("CT failed to install configuration data. Please "
@@ -1828,10 +1828,10 @@ compile_and_run(Tests, Skip, Opts, Args) ->
case lists:member(all, Conns) of
true ->
Conns1 = ct_util:override_silence_all_connections(),
- ct_logs:log("Silent connections", "~p", [Conns1]);
+ ct_logs:log("Silent connections", "~tp", [Conns1]);
false ->
ct_util:override_silence_connections(Conns),
- ct_logs:log("Silent connections", "~p", [Conns])
+ ct_logs:log("Silent connections", "~tp", [Conns])
end
end,
log_ts_names(Opts#opts.testspec_files),
@@ -1924,7 +1924,7 @@ possibly_spawn(true, Tests, Skip, Opts) ->
TestRunPid = spawn_link(TestRun),
receive
{'EXIT',TestRunPid,{ok,TestResult}} ->
- io:format(user, "~nCommon Test returned ~p~n~n",
+ io:format(user, "~nCommon Test returned ~tp~n~n",
[TestResult]);
{'EXIT',TestRunPid,Error} ->
exit(Error)
@@ -1943,7 +1943,7 @@ auto_compile(TestSuites) ->
case application:get_env(common_test, include) of
{ok,UserInclDirs} when length(UserInclDirs) > 0 ->
io:format("Including the following directories:~n"),
- [begin io:format("~p~n",[UserInclDir]), {i,UserInclDir} end ||
+ [begin io:format("~tp~n",[UserInclDir]), {i,UserInclDir} end ||
UserInclDir <- UserInclDirs];
_ ->
[]
@@ -2284,7 +2284,7 @@ do_run_test(Tests, Skip, Opts0) ->
NoOfSuites = length(Suites1),
ct_util:warn_duplicates(Suites1),
{ok,Cwd} = file:get_cwd(),
- io:format("~nCWD set to: ~p~n", [Cwd]),
+ io:format("~nCWD set to: ~tp~n", [Cwd]),
if NoOfCases == unknown ->
io:format("~nTEST INFO: ~w test(s), ~w suite(s)~n~n",
[NoOfTests,NoOfSuites]),
@@ -2354,7 +2354,7 @@ do_run_test(Tests, Skip, Opts0) ->
case ct_util:get_testdata(severe_error) of
undefined -> ok;
SevereError ->
- ct_logs:log("SEVERE ERROR", "~p\n", [SevereError]),
+ ct_logs:log("SEVERE ERROR", "~tp\n", [SevereError]),
exit(SevereError)
end,
@@ -2425,7 +2425,7 @@ start_cover(Opts=#opts{coverspec=CovData,cover_stop=CovStop},LogDir) ->
if (CovNodes /= []) and (CovNodes /= undefined) ->
ct_logs:log("COVER INFO",
"Nodes included in cover "
- "session: ~w",
+ "session: ~tw",
[CovNodes]),
cover:start(CovNodes);
true ->
@@ -2439,7 +2439,7 @@ start_cover(Opts=#opts{coverspec=CovData,cover_stop=CovStop},LogDir) ->
{error,Reason} ->
ct_logs:log("COVER INFO",
"Importing cover data from: ~ts fails! "
- "Reason: ~p", [Imp,Reason])
+ "Reason: ~tp", [Imp,Reason])
end
end, CovImport),
{TsCoverInfo,Opts}.
@@ -2773,7 +2773,7 @@ run_make(Targets, TestDir0, Mod, UserInclude) ->
{up_to_date,_} ->
ok;
{'EXIT',Reason} ->
- io:format("{error,{make_crashed,~p}\n", [Reason]),
+ io:format("{error,{make_crashed,~tp}\n", [Reason]),
{error,{make_crashed,TestDir,Reason}};
{error,ModInfo} ->
io:format("{error,make_failed}\n", []),
@@ -2782,7 +2782,7 @@ run_make(Targets, TestDir0, Mod, UserInclude) ->
{error,{make_failed,Bad}}
end;
{error,_} ->
- io:format("{error,{invalid_directory,~p}}\n", [TestDir0]),
+ io:format("{error,{invalid_directory,~tp}}\n", [TestDir0]),
{error,{invalid_directory,TestDir0}}
end.
@@ -2832,7 +2832,7 @@ maybe_interpret2(Suite, Cases, StepOpts) ->
_ -> ok
catch
_:_Error ->
- io:format(user, "Invalid breakpoint: ~w:~w/1~n",
+ io:format(user, "Invalid breakpoint: ~w:~tw/1~n",
[Suite,Case])
end
end || Case <- Cases, is_atom(Case)],
@@ -2963,7 +2963,7 @@ ct_hooks_args2opts([],Acc) ->
parse_cth_args(String) ->
try
- true = io_lib:printable_list(String),
+ true = io_lib:printable_unicode_list(String),
{ok,Toks,_} = erl_scan:string(String++"."),
{ok, Args} = erl_parse:parse_term(Toks),
Args
@@ -3042,7 +3042,7 @@ rel_to_abs(CtArgs) ->
_ = if Dir /= Abs ->
_ = code:del_path(Dir),
_ = code:del_path(Abs),
- io:format(user, "Converting ~p to ~p and re-inserting "
+ io:format(user, "Converting ~tp to ~tp and re-inserting "
"with add_pathz/1~n",
[Dir, Abs]);
true ->
@@ -3056,7 +3056,7 @@ rel_to_abs(CtArgs) ->
_ = if Dir /= Abs ->
_ = code:del_path(Dir),
_ = code:del_path(Abs),
- io:format(user, "Converting ~p to ~p and re-inserting "
+ io:format(user, "Converting ~tp to ~tp and re-inserting "
"with add_patha/1~n",
[Dir, Abs]);
true ->
@@ -3126,7 +3126,7 @@ opts2args(EnvStartOpts) ->
({group,G}) when is_atom(G) ->
[{group,[atom_to_list(G)]}];
({group,Gs}) when is_list(Gs) ->
- LOfGStrs = [lists:flatten(io_lib:format("~w",[G])) ||
+ LOfGStrs = [lists:flatten(io_lib:format("~tw",[G])) ||
G <- Gs],
[{group,LOfGStrs}];
({testcase,Case}) when is_atom(Case) ->
@@ -3178,10 +3178,10 @@ opts2args(EnvStartOpts) ->
({event_handler,EHs}) when is_list(EHs) ->
[{event_handler,[atom_to_list(EH) || EH <- EHs]}];
({event_handler,{EH,Arg}}) when is_atom(EH) ->
- ArgStr = lists:flatten(io_lib:format("~p", [Arg])),
+ ArgStr = lists:flatten(io_lib:format("~tp", [Arg])),
[{event_handler_init,[atom_to_list(EH),ArgStr]}];
({event_handler,{EHs,Arg}}) when is_list(EHs) ->
- ArgStr = lists:flatten(io_lib:format("~p", [Arg])),
+ ArgStr = lists:flatten(io_lib:format("~tp", [Arg])),
Strs = lists:flatmap(fun(EH) ->
[atom_to_list(EH),
ArgStr,"and"]
@@ -3212,25 +3212,25 @@ opts2args(EnvStartOpts) ->
({ct_hooks,[]}) ->
[];
({ct_hooks,CTHs}) when is_list(CTHs) ->
- io:format(user,"ct_hooks: ~p",[CTHs]),
+ io:format(user,"ct_hooks: ~tp",[CTHs]),
Strs = lists:flatmap(
fun({CTH,Arg,Prio}) ->
[atom_to_list(CTH),
lists:flatten(
- io_lib:format("~p",[Arg])),
+ io_lib:format("~tp",[Arg])),
lists:flatten(
- io_lib:format("~p",[Prio])),
+ io_lib:format("~tp",[Prio])),
"and"];
({CTH,Arg}) ->
[atom_to_list(CTH),
lists:flatten(
- io_lib:format("~p",[Arg])),
+ io_lib:format("~tp",[Arg])),
"and"];
(CTH) when is_atom(CTH) ->
[atom_to_list(CTH),"and"]
end,CTHs),
[_LastAnd|StrsR] = lists:reverse(Strs),
- io:format(user,"return: ~p",[lists:reverse(StrsR)]),
+ io:format(user,"return: ~tp",[lists:reverse(StrsR)]),
[{ct_hooks,lists:reverse(StrsR)}];
({Opt,As=[A|_]}) when is_atom(A) ->
[{Opt,[atom_to_list(Atom) || Atom <- As]}];
@@ -3312,7 +3312,7 @@ start_trace(Args) ->
ok ->
true;
{_,Error} ->
- io:format("Warning! Tracing not started. Reason: ~p~n~n",
+ io:format("Warning! Tracing not started. Reason: ~tp~n~n",
[Error]),
false
end;
diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl
index 5ac91f396b..ca62357e1c 100644
--- a/lib/common_test/src/ct_ssh.erl
+++ b/lib/common_test/src/ct_ssh.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -161,7 +161,7 @@ connect(KeyOrName, ExtraOpts) when is_list(ExtraOpts) ->
connect(KeyOrName, ConnType, ExtraOpts) ->
case ct:get_config(KeyOrName) of
undefined ->
- log(heading(connect,KeyOrName), "Failed: ~p\n",
+ log(heading(connect,KeyOrName), "Failed: ~tp\n",
[{not_available,KeyOrName}]),
{error,{not_available,KeyOrName}};
SSHData ->
@@ -214,18 +214,18 @@ connect(KeyOrName, ConnType, ExtraOpts) ->
end,
case {Addr,proplists:get_value(port, AllOpts1)} of
{undefined,_} ->
- log(heading(connect,KeyOrName), "Failed: ~p\n",
+ log(heading(connect,KeyOrName), "Failed: ~tp\n",
[{not_available,{KeyOrName,ConnType1}}]),
{error,{not_available,{KeyOrName,ConnType1}}};
{_,undefined} ->
try_log(heading(connect,KeyOrName),
- "Opening ~w connection to ~p:22\n",
+ "Opening ~w connection to ~tp:22\n",
[ConnType1,Addr]),
ct_gen_conn:start(KeyOrName, {ConnType1,Addr,22},
AllOpts1, ?MODULE);
{_,Port} ->
try_log(heading(connect,KeyOrName),
- "Opening ~w connection to ~p:~w\n",
+ "Opening ~w connection to ~tp:~w\n",
[ConnType1,Addr,Port]),
ct_gen_conn:start(KeyOrName, {ConnType1,Addr,Port},
AllOpts1, ?MODULE)
@@ -995,7 +995,7 @@ init(KeyOrName, {ConnType,Addr,Port}, AllOpts) ->
SSHRef = element(2, Ok),
try_log(heading(init,KeyOrName),
"Opened ~w connection:\n"
- "Host: ~p (~p)\nUser: ~p\nPassword: ~p\n",
+ "Host: ~tp (~p)\nUser: ~tp\nPassword: ~p\n",
[ConnType,Addr,Port,User,lists:duplicate(length(Password),$*)]),
{ok,SSHRef,#state{ssh_ref=SSHRef, conn_type=ConnType,
target=KeyOrName}}
@@ -1033,11 +1033,11 @@ handle_msg({exec,Chn,Command,TO}, State) ->
end,
case Chn1 of
{error,_} = ChnError ->
- log(heading(exec,Target), "Opening channel failed: ~p", [ChnError]),
+ log(heading(exec,Target), "Opening channel failed: ~tp", [ChnError]),
{ChnError,State};
_ ->
try_log(heading(exec,Target),
- "SSH Ref: ~p, Chn: ~p, Command: ~p, Timeout: ~p",
+ "SSH Ref: ~p, Chn: ~p, Command: ~tp, Timeout: ~p",
[SSHRef,Chn1,Command,TO]),
case ssh_connection:exec(SSHRef, Chn1, Command, TO) of
success ->
@@ -1060,7 +1060,7 @@ handle_msg({send,Chn,Type,Data,TO}, State) ->
#state{ssh_ref=SSHRef, target=Target} = State,
try_log(heading(send,Target),
"SSH Ref: ~p, Chn: ~p, Type: ~p, Timeout: ~p~n"
- "Data: ~p", [SSHRef,Chn,Type,TO,Data]),
+ "Data: ~tp", [SSHRef,Chn,Type,TO,Data]),
Result = ssh_connection:send(SSHRef, Chn, Type, Data, TO),
{Result,State};
@@ -1068,7 +1068,7 @@ handle_msg({send_and_receive,Chn,Type,Data,End,TO}, State) ->
#state{ssh_ref=SSHRef, target=Target} = State,
try_log(heading(send_and_receive,Target),
"SSH Ref: ~p, Chn: ~p, Type: ~p, Timeout: ~p~n"
- "Data: ~p", [SSHRef,Chn,Type,TO,Data]),
+ "Data: ~tp", [SSHRef,Chn,Type,TO,Data]),
case ssh_connection:send(SSHRef, Chn, Type, Data, TO) of
ok ->
Result = do_recv_response(SSHRef, Chn, [], End, TO),
@@ -1080,7 +1080,7 @@ handle_msg({send_and_receive,Chn,Type,Data,End,TO}, State) ->
handle_msg({subsystem,Chn,Subsystem,TO}, State) ->
#state{ssh_ref=SSHRef, target=Target} = State,
try_log(heading(subsystem,Target),
- "SSH Ref: ~p, Chn: ~p, Subsys: ~p, Timeout: ~p",
+ "SSH Ref: ~p, Chn: ~p, Subsys: ~tp, Timeout: ~p",
[SSHRef,Chn,Subsystem,TO]),
Result = ssh_connection:subsystem(SSHRef, Chn, Subsystem, TO),
{Result,State};
@@ -1097,151 +1097,151 @@ handle_msg({shell,Chn,TO}, State) ->
handle_msg({read_file,Srv,File}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:read_file(ref(Srv,SSHRef), File),S};
handle_msg({write_file,Srv,File,Iolist}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:write_file(ref(Srv,SSHRef), File, Iolist),S};
handle_msg({list_dir,Srv,Path}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:list_dir(ref(Srv,SSHRef), Path),S};
handle_msg({open,Srv,File,Mode}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:open(ref(Srv,SSHRef), File, Mode),S};
handle_msg({opendir,Srv,Path}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:opendir(ref(Srv,SSHRef), Path),S};
handle_msg({close,Srv,Handle}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:close(ref(Srv,SSHRef), Handle),S};
handle_msg({read,Srv,Handle,Len}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:read(ref(Srv,SSHRef), Handle, Len),S};
handle_msg({pread,Srv,Handle,Position,Length}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:pread(ref(Srv,SSHRef),Handle,Position,Length),S};
handle_msg({aread,Srv,Handle,Len}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:aread(ref(Srv,SSHRef), Handle, Len),S};
handle_msg({apread,Srv,Handle,Position,Length}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:apread(ref(Srv,SSHRef), Handle, Position, Length),S};
handle_msg({write,Srv,Handle,Data}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:write(ref(Srv,SSHRef), Handle, Data),S};
handle_msg({pwrite,Srv,Handle,Position,Data}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:pwrite(ref(Srv,SSHRef), Handle, Position, Data),S};
handle_msg({awrite,Srv,Handle,Data}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:awrite(ref(Srv,SSHRef), Handle, Data),S};
handle_msg({apwrite,Srv,Handle,Position,Data}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:apwrite(ref(Srv,SSHRef), Handle, Position, Data),S};
handle_msg({position,Srv,Handle,Location}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:position(ref(Srv,SSHRef), Handle, Location),S};
handle_msg({read_file_info,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:read_file_info(ref(Srv,SSHRef), Name),S};
handle_msg({get_file_info,Srv,Handle}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:get_file_info(ref(Srv,SSHRef), Handle),S};
handle_msg({read_link_info,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:read_link_info(ref(Srv,SSHRef), Name),S};
handle_msg({write_file_info,Srv,Name,Info}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:write_file_info(ref(Srv,SSHRef), Name, Info),S};
handle_msg({read_link,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:read_link(ref(Srv,SSHRef), Name),S};
handle_msg({make_symlink,Srv,Name,Target}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:make_symlink(ref(Srv,SSHRef), Name, Target),S};
handle_msg({rename,Srv,OldName,NewName}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:rename(ref(Srv,SSHRef), OldName, NewName),S};
handle_msg({delete,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:delete(ref(Srv,SSHRef), Name),S};
handle_msg({make_dir,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:make_dir(ref(Srv,SSHRef), Name),S};
handle_msg({del_dir,Srv,Name}=Cmd, S=#state{ssh_ref=SSHRef}) ->
try_log(heading(sftp,S#state.target),
- "SSH Ref: ~p, Server: ~p~nCmd: ~p",
+ "SSH Ref: ~p, Server: ~p~nCmd: ~tp",
[SSHRef,ref(Srv,SSHRef),mod(Cmd)]),
{ssh_sftp:del_dir(ref(Srv,SSHRef), Name),S}.
@@ -1285,7 +1285,7 @@ do_recv_response(SSH, Chn, Data, End, Timeout) ->
{ssh_cm, SSH, {data,Chn,_,NewData}} ->
ssh_connection:adjust_window(SSH, Chn, size(NewData)),
- debug("RECVD~n~p", [binary_to_list(NewData)]),
+ debug("RECVD~n~tp", [binary_to_list(NewData)]),
DataAcc = Data ++ binary_to_list(NewData),
if is_function(End) ->
case End(DataAcc) of
@@ -1338,7 +1338,7 @@ do_recv_response(SSH, Chn, Data, End, Timeout) ->
%% {ok,WCh};
Other ->
- debug("UNEXPECTED MESSAGE~n~p ~p~n~p", [SSH,Chn,Other]),
+ debug("UNEXPECTED MESSAGE~n~p ~p~n~tp", [SSH,Chn,Other]),
do_recv_response(SSH, Chn, Data, End, Timeout)
after Timeout ->
@@ -1391,7 +1391,7 @@ mod(Cmd) ->
%%%-----------------------------------------------------------------
%%%
heading(Function, Ref) ->
- io_lib:format("ct_ssh:~w ~p",[Function,Ref]).
+ io_lib:format("ct_ssh:~tw ~tp",[Function,Ref]).
%%%-----------------------------------------------------------------
%%%
diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl
index bff1112ab9..14d9d381da 100644
--- a/lib/common_test/src/ct_telnet.erl
+++ b/lib/common_test/src/ct_telnet.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.
@@ -251,7 +251,7 @@ open(KeyOrName,ConnType,TargetMod) ->
open(KeyOrName,ConnType,TargetMod,Extra) ->
case ct:get_config({KeyOrName,ConnType}) of
undefined ->
- log(undefined,open,"Failed: ~p",[{not_available,KeyOrName}]),
+ log(undefined,open,"Failed: ~tp",[{not_available,KeyOrName}]),
{error,{not_available,KeyOrName,ConnType}};
Addr ->
Addr1 =
@@ -273,7 +273,7 @@ open(KeyOrName,ConnType,TargetMod,Extra) ->
end;
Bool -> Bool
end,
- log(undefined,open,"Connecting to ~p(~p)",
+ log(undefined,open,"Connecting to ~tp(~tp)",
[KeyOrName,Addr1]),
Reconnect =
case ct:get_config({telnet_settings,reconnection_attempts}) of
@@ -672,7 +672,7 @@ set_telnet_defaults([{tcp_nodelay,NoDelay}|Ss],S) ->
set_telnet_defaults(Ss,S#state{tcp_nodelay=NoDelay});
set_telnet_defaults([Unknown|Ss],S) ->
force_log(S,error,
- "Bad element in telnet_settings: ~p",[Unknown]),
+ "Bad element in telnet_settings: ~tp",[Unknown]),
set_telnet_defaults(Ss,S);
set_telnet_defaults([],S) ->
S.
@@ -680,7 +680,7 @@ set_telnet_defaults([],S) ->
%% @hidden
handle_msg({cmd,Cmd,Opts},State) ->
start_gen_log(heading(cmd,State#state.name)),
- log(State,cmd,"Cmd: ~p",[Cmd]),
+ log(State,cmd,"Cmd: ~tp",[Cmd]),
%% whatever is in the buffer from previous operations
%% will be ignored as we go ahead with this telnet cmd
@@ -715,7 +715,7 @@ handle_msg({cmd,Cmd,Opts},State) ->
case teln_cmd(State#state.teln_pid, Cmd, State#state.prx,
Newline, TO) of
{ok,Data,_PromptType,Rest} ->
- log(State,recv,"Return: ~p",[{ok,Data}]),
+ log(State,recv,"Return: ~tp",[{ok,Data}]),
{{ok,Data},Rest,true};
Error ->
Retry = {retry,{Error,
@@ -723,14 +723,14 @@ handle_msg({cmd,Cmd,Opts},State) ->
State#state.type},
State#state.teln_pid,
{cmd,Cmd,Opts}}},
- log(State,recv,"Return: ~p",[Error]),
+ log(State,recv,"Return: ~tp",[Error]),
{Retry,[],false}
end,
end_gen_log(),
{Return,State#state{buffer=NewBuffer,prompt=Prompt}};
handle_msg({send,Cmd,Opts},State) ->
start_gen_log(heading(send,State#state.name)),
- log(State,send,"Sending: ~p",[Cmd]),
+ log(State,send,"Sending: ~tp",[Cmd]),
debug_cont_gen_log("Throwing Buffer:",[]),
debug_log_lines(State#state.buffer),
@@ -762,12 +762,12 @@ handle_msg(get_data,State) ->
log(State,cmd,"Reading data...",[]),
{ok,Data,Buffer} = teln_get_all_data(State,State#state.buffer,[],[],
State#state.poll_limit),
- log(State,recv,"Return: ~p",[{ok,Data}]),
+ log(State,recv,"Return: ~tp",[{ok,Data}]),
end_gen_log(),
{{ok,Data},State#state{buffer=Buffer}};
handle_msg({expect,Pattern,Opts},State) ->
start_gen_log(heading(expect,State#state.name)),
- log(State,expect,"Expect: ~p\nOpts = ~p\n",[Pattern,Opts]),
+ log(State,expect,"Expect: ~tp\nOpts = ~tp\n",[Pattern,Opts]),
{Return,NewBuffer,Prompt} =
case teln_expect(State#state.name,
State#state.teln_pid,
@@ -779,15 +779,15 @@ handle_msg({expect,Pattern,Opts},State) ->
P = check_if_prompt_was_reached(Data,[]),
{{ok,Data},Rest,P};
{ok,Data,HaltReason,Rest} ->
- force_log(State,expect,"HaltReason: ~p",[HaltReason]),
+ force_log(State,expect,"HaltReason: ~tp",[HaltReason]),
P = check_if_prompt_was_reached(Data,HaltReason),
{{ok,Data,HaltReason},Rest,P};
{error,Reason,Rest} ->
- force_log(State,expect,"Expect failed\n~p",[{error,Reason}]),
+ force_log(State,expect,"Expect failed\n~tp",[{error,Reason}]),
P = check_if_prompt_was_reached([],Reason),
{{error,Reason},Rest,P};
{error,Reason} ->
- force_log(State,expect,"Expect failed\n~p",[{error,Reason}]),
+ force_log(State,expect,"Expect failed\n~tp",[{error,Reason}]),
P = check_if_prompt_was_reached([],Reason),
{{error,Reason},[],P}
end,
@@ -896,7 +896,7 @@ check_if_prompt_was_reached(_,_) ->
heading(Action,undefined) ->
io_lib:format("~w ~w",[?MODULE,Action]);
heading(Action,Name) ->
- io_lib:format("~w ~w for ~p",[?MODULE,Action,Name]).
+ io_lib:format("~w ~w for ~tp",[?MODULE,Action,Name]).
force_log(State,Action,String,Args) ->
log(State,Action,String,Args,true).
@@ -1294,7 +1294,7 @@ get_data1(Pid) ->
%% one_expect: split data chunk at prompts
one_expect(Name,Pid,Data,Pattern,EO) when EO#eo.prompt_check==false ->
-% io:format("Raw Data ~p Pattern ~p EO ~p ",[Data,Pattern,EO]),
+% io:format("Raw Data ~tp Pattern ~tp EO ~tp ",[Data,Pattern,EO]),
one_expect1(Name,Pid,Data,Pattern,[],EO#eo{found_prompt=false});
one_expect(Name,Pid,Data,Pattern,EO) ->
case match_prompt(Data,EO#eo.prx) of
diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl
index 5df7e279ac..c8d217cd2a 100644
--- a/lib/common_test/src/ct_telnet_client.erl
+++ b/lib/common_test/src/ct_telnet_client.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.
@@ -120,7 +120,7 @@ get_data(Pid) ->
init(Parent, Server, Port, Timeout, KeepAlive, NoDelay, ConnName) ->
case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,NoDelay}], Timeout) of
{ok,Sock} ->
- dbg("~p connected to: ~p (port: ~w, keep_alive: ~w)\n",
+ dbg("~tp connected to: ~tp (port: ~w, keep_alive: ~w)\n",
[ConnName,Server,Port,KeepAlive]),
send([?IAC,?DO,?SUPPRESS_GO_AHEAD], Sock, ConnName),
Parent ! {open,self()},
diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl
index 180786273d..09839bd35d 100644
--- a/lib/common_test/src/ct_testspec.erl
+++ b/lib/common_test/src/ct_testspec.erl
@@ -344,7 +344,7 @@ create_spec_tree([Spec|Specs],TS,JoinWithNext,Known) ->
create_spec_tree(Specs,TS,JoinWithNext,Known)};
{error,Reason} ->
ReasonStr =
- lists:flatten(io_lib:format("~s",
+ lists:flatten(io_lib:format("~ts",
[file:format_error(Reason)])),
throw({error,{SpecAbsName,ReasonStr}})
end
@@ -1101,7 +1101,7 @@ check_term(Term) when is_tuple(Term) ->
true ->
io:format("~nSuspicious term, "
"please check:~n"
- "~p~n", [Term]),
+ "~tp~n", [Term]),
invalid;
false ->
invalid
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl
index 802e9be97c..abf131f4df 100644
--- a/lib/common_test/src/ct_util.erl
+++ b/lib/common_test/src/ct_util.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.
@@ -207,7 +207,7 @@ do_start(Parent, Mode, LogDir, Verbosity) ->
catch
_:CTHReason ->
ErrorInfo = if is_atom(CTHReason) ->
- io_lib:format("{~p,~p}",
+ io_lib:format("{~tp,~tp}",
[CTHReason,
erlang:get_stacktrace()]);
true ->
@@ -490,7 +490,7 @@ loop(Mode,TestData,StartDir) ->
?MAX_IMPORTANCE,
"CT Error Notification",
"Connection process died: "
- "Pid: ~w, Address: ~p, "
+ "Pid: ~w, Address: ~tp, "
"Callback: ~w\n"
"Reason: ~ts\n\n",
[Pid,A,CB,ErrorHtml]),
@@ -501,7 +501,7 @@ loop(Mode,TestData,StartDir) ->
_ ->
%% Let process crash in case of error, this shouldn't happen!
io:format("\n\nct_util_server got EXIT "
- "from ~w: ~p\n\n", [Pid,Reason]),
+ "from ~w: ~tp\n\n", [Pid,Reason]),
ok = file:set_cwd(StartDir),
exit(Reason)
end
@@ -977,12 +977,12 @@ get_profile_data(Profile, Key, StartDir) ->
end,
case Result of
{error,enoent} when Profile /= default ->
- io:format(?def_gl, "~nERROR! Missing profile file ~p~n", [File]),
+ io:format(?def_gl, "~nERROR! Missing profile file ~tp~n", [File]),
undefined;
{error,enoent} when Profile == default ->
undefined;
{error,Reason} ->
- io:format(?def_gl,"~nERROR! Error in profile file ~p: ~p~n",
+ io:format(?def_gl,"~nERROR! Error in profile file ~tp: ~tp~n",
[WhichFile,Reason]),
undefined;
{ok,Data} ->
@@ -993,7 +993,7 @@ get_profile_data(Profile, Key, StartDir) ->
Data;
_ ->
io:format(?def_gl,
- "~nERROR! Invalid profile data in ~p~n",
+ "~nERROR! Invalid profile data in ~tp~n",
[WhichFile]),
[]
end,
diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl
index 87af442fd3..9016aca899 100644
--- a/lib/common_test/src/ct_webtool.erl
+++ b/lib/common_test/src/ct_webtool.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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.
@@ -120,10 +120,10 @@ debug_app(Mod) ->
out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S)
when W==webtool;W==mod_esi->
- io:format("~w: (~p)~ncall ~s~n", [TS,Pid,ffunc(MFA)]),
+ io:format("~w: (~p)~ncall ~ts~n", [TS,Pid,ffunc(MFA)]),
[{M,F,length(A)}|S];
out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) ->
- io:format("~w: (~p)~nreturned from ~s -> ~p~n", [TS,Pid,ffunc(MFA),R]),
+ io:format("~w: (~p)~nreturned from ~ts -> ~tp~n", [TS,Pid,ffunc(MFA),R]),
S;
out(_,_,_,_) ->
ok.
@@ -171,7 +171,7 @@ script_start([App,Browser]) ->
IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"),
os:cmd("\"" ++ IExplore ++ "\" " ++ Url);
_ when OSType == win32 ->
- io:format("Starting ~w...\n",[Browser]),
+ io:format("Starting ~tw...\n",[Browser]),
os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url);
B when B==firefox; B==mozilla ->
io:format("Sending URL to ~w...",[Browser]),
@@ -194,7 +194,7 @@ script_start([App,Browser]) ->
os:cmd(BStr ++ " " ++ Url)
end;
_ ->
- io:format("Starting ~w...\n",[Browser]),
+ io:format("Starting ~tw...\n",[Browser]),
os:cmd(atom_to_list(Browser) ++ " " ++ Url)
end,
ok;
@@ -379,7 +379,7 @@ print_url(ConfigData)->
Server=proplists:get_value(server_name,ConfigData,"undefined"),
Port=proplists:get_value(port,ConfigData,"undefined"),
{A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"),
- io:format("WebTool is available at http://~s:~w/~n",[Server,Port]),
+ io:format("WebTool is available at http://~ts:~w/~n",[Server,Port]),
io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]).
@@ -859,8 +859,8 @@ handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)->
%%! Here the tool disappears from the webtool interface!!
io:format("\n=======ERROR (webtool, line ~w) =======\n"
"Could not start application \'~p\'\n\n"
- "~w:~w(~s) ->\n"
- "~p\n\n",
+ "~w:~tw(~ts) ->\n"
+ "~tp\n\n",
[?LINE,Name,M,F,format_args(A),Exit]),
ets:delete(Data,Name);
_OK->
@@ -883,16 +883,16 @@ handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)->
%%! Here the tool disappears from the webtool interface!!
io:format("\n=======ERROR (webtool, line ~w) =======\n"
"Could not start application \'~p\'\n\n"
- "supervisor:start_child(~p,~p) ->\n"
- "~p\n\n",
+ "supervisor:start_child(~p,~tp) ->\n"
+ "~tp\n\n",
[?LINE,Name,Pid,ChildSpec,{error,Reason}]),
ets:delete(Data,Name);
Error ->
%%! Here the tool disappears from the webtool interface!!
io:format("\n=======ERROR (webtool, line ~w) =======\n"
"Could not start application \'~p\'\n\n"
- "supervisor:start_child(~p,~p) ->\n"
- "~p\n\n",
+ "supervisor:start_child(~p,~tp) ->\n"
+ "~tp\n\n",
[?LINE,Name,Pid,ChildSpec,Error]),
ets:delete(Data,Name)
end;
@@ -924,7 +924,7 @@ handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)->
io:format("\n=======ERROR (webtool, line ~w) =======\n"
"Could not start application \'~p\'\n\n"
"application:start(~p,~p) ->\n"
- "~p\n\n",
+ "~tp\n\n",
[?LINE,Name,Real_name,temporary,Error]),
ets:delete(Data,Name)
end;
@@ -940,7 +940,7 @@ handle_app({Name,Incorrect},Data,_Pid,Cmd)->
%%! Here the tool disappears from the webtool interface!!
io:format("\n=======ERROR (webtool, line ~w) =======\n"
"Could not ~w application \'~p\'\n\n"
- "Incorrect data: ~p\n\n",
+ "Incorrect data: ~tp\n\n",
[?LINE,Cmd,Name,Incorrect]),
ets:delete(Data,Name).
@@ -1202,12 +1202,12 @@ filter_tool_files(Dir,[File|Rest]) ->
%%%-----------------------------------------------------------------
%%% format functions
ffunc({M,F,A}) when is_list(A) ->
- io_lib:format("~w:~w(~s)\n",[M,F,format_args(A)]);
+ io_lib:format("~w:~tw(~ts)\n",[M,F,format_args(A)]);
ffunc({M,F,A}) when is_integer(A) ->
- io_lib:format("~w:~w/~w\n",[M,F,A]).
+ io_lib:format("~w:~tw/~w\n",[M,F,A]).
format_args([]) ->
"";
format_args(Args) ->
- Str = lists:append(["~p"|lists:duplicate(length(Args)-1,",~p")]),
+ Str = lists:append(["~tp"|lists:duplicate(length(Args)-1,",~tp")]),
io_lib:format(Str,Args).
diff --git a/lib/common_test/src/cth_conn_log.erl b/lib/common_test/src/cth_conn_log.erl
index faff150ac9..7b6f03311a 100644
--- a/lib/common_test/src/cth_conn_log.erl
+++ b/lib/common_test/src/cth_conn_log.erl
@@ -116,7 +116,7 @@ pre_init_per_testcase(_Suite,TestCase,Config,CthState) ->
"<table borders=1>"
"<b>" ++ ConnModStr ++ " logs:</b>\n" ++
[io_lib:format(
- "<tr><td>~p</td><td><a href=\"~ts\">~ts</a>"
+ "<tr><td>~tp</td><td><a href=\"~ts\">~ts</a>"
"</td></tr>",
[S,ct_logs:uri(L),filename:basename(L)])
|| {S,L} <- Ls] ++
diff --git a/lib/common_test/src/cth_log_redirect.erl b/lib/common_test/src/cth_log_redirect.erl
index 1bc9b10d41..8b29d0f96d 100644
--- a/lib/common_test/src/cth_log_redirect.erl
+++ b/lib/common_test/src/cth_log_redirect.erl
@@ -250,26 +250,26 @@ format_header(#eh_state{curr_suite = Suite,
format_header(#eh_state{curr_suite = Suite,
curr_group = undefined,
curr_func = TcOrConf}) ->
- io_lib:format("System report during ~w:~w/1",
+ io_lib:format("System report during ~w:~tw/1",
[Suite,TcOrConf]);
format_header(#eh_state{curr_suite = Suite,
curr_group = Group,
curr_func = Conf}) when Conf == init_per_group;
Conf == end_per_group ->
- io_lib:format("System report during ~w:~w/2 for ~w",
+ io_lib:format("System report during ~w:~w/2 for ~tw",
[Suite,Conf,Group]);
format_header(#eh_state{curr_suite = Suite,
curr_group = Group,
parallel_tcs = true}) ->
- io_lib:format("System report during ~w in ~w",
+ io_lib:format("System report during ~tw in ~w",
[Group,Suite]);
format_header(#eh_state{curr_suite = Suite,
curr_group = Group,
curr_func = TC}) ->
- io_lib:format("System report during ~w:~w/1 in ~w",
+ io_lib:format("System report during ~w:~tw/1 in ~tw",
[Suite,TC,Group]).
code_change(_OldVsn, State, _Extra) ->
diff --git a/lib/common_test/src/cth_surefire.erl b/lib/common_test/src/cth_surefire.erl
index 0bbb217275..da68bd105e 100644
--- a/lib/common_test/src/cth_surefire.erl
+++ b/lib/common_test/src/cth_surefire.erl
@@ -143,7 +143,7 @@ on_tc_fail(_Suite,_TC, Res, State) ->
TC = hd(TCs),
NewTC = TC#testcase{
result =
- {fail,lists:flatten(io_lib:format("~p",[Res]))} },
+ {fail,lists:flatten(io_lib:format("~tp",[Res]))} },
State#state{ test_cases = [NewTC | tl(TCs)]}.
on_tc_skip(Suite,{ConfigFunc,_GrName}, Res, State) ->
@@ -164,7 +164,7 @@ do_tc_skip(Res, State) ->
TC = hd(TCs),
NewTC = TC#testcase{
result =
- {skipped,lists:flatten(io_lib:format("~p",[Res]))} },
+ {skipped,lists:flatten(io_lib:format("~tp",[Res]))} },
State#state{ test_cases = [NewTC | tl(TCs)]}.
init_tc(State, Config) when is_list(Config) == false ->
diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl
index a4a84393c1..ee3a5e4bba 100644
--- a/lib/common_test/src/test_server.erl
+++ b/lib/common_test/src/test_server.erl
@@ -175,7 +175,7 @@ do_cover_compile(Modules) ->
ok.
warn_compile({error,{Reason,Module}}) ->
- io:fwrite("\nWARNING: Could not cover compile ~ts: ~p\n",
+ io:fwrite("\nWARNING: Could not cover compile ~ts: ~tp\n",
[Module,{error,Reason}]).
%% Make sure all modules are loaded and unstick if sticky
@@ -189,7 +189,7 @@ prepare_cover_compile([M|Ms],Sticky) ->
{module,_} ->
prepare_cover_compile([M|Ms],Sticky);
Error ->
- io:fwrite("\nWARNING: Could not load ~w: ~p\n",[M,Error]),
+ io:fwrite("\nWARNING: Could not load ~w: ~tp\n",[M,Error]),
prepare_cover_compile(Ms,Sticky)
end;
{false,_} ->
@@ -450,7 +450,7 @@ run_test_case_msgloop(#st{ref=Ref,pid=Pid,end_conf_pid=EndConfPid0}=St0) ->
exit(Pid, kill),
%% here's the only place we know Reason, so we save
%% it as a comment, potentially replacing user data
- Error = lists:flatten(io_lib:format("Aborted: ~p",
+ Error = lists:flatten(io_lib:format("Aborted: ~tp",
[Reason])),
Error1 = lists:flatten([string:strip(S,left) ||
S <- string:tokens(Error,
@@ -756,13 +756,13 @@ print_end_conf_result(Mod,Func,Conf,Cause,Error) ->
Str2Print =
fun(NoHTML) when NoHTML == stdout; NoHTML == major ->
io_lib:format("WARNING! "
- "~w:end_per_testcase(~w, ~tp)"
+ "~w:end_per_testcase(~tw, ~tp)"
" ~s!\n\tReason: ~tp\n",
[Mod,Func,Conf,Cause,Error]);
(minor) ->
ErrorStr = test_server_ctrl:escape_chars(Error),
io_lib:format("WARNING! "
- "~w:end_per_testcase(~w, ~tp)"
+ "~w:end_per_testcase(~tw, ~tp)"
" ~s!\n\tReason: ~ts\n",
[Mod,Func,Conf,Cause,ErrorStr])
end,
@@ -792,7 +792,7 @@ spawn_fw_call(Mod,IPTC={init_per_testcase,Func},CurrConf,Pid,
_ -> died
end,
group_leader() ! {printout,12,
- "ERROR! ~w:init_per_testcase(~w, ~p)"
+ "ERROR! ~w:init_per_testcase(~tw, ~tp)"
" failed!\n\tReason: ~tp\n",
[Mod,Func,CurrConf,Why]},
%% finished, report back
@@ -820,7 +820,7 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid,
{timetrap_timeout,TVal} ->
group_leader() !
{printout,12,
- "WARNING! ~w:end_per_testcase(~w, ~p)"
+ "WARNING! ~w:end_per_testcase(~tw, ~tp)"
" failed!\n\tReason: timetrap timeout"
" after ~w ms!\n", [Mod,Func,EndConf,TVal]},
W = "<font color=\"red\">"
@@ -829,7 +829,7 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid,
_ ->
group_leader() !
{printout,12,
- "WARNING! ~w:end_per_testcase(~w, ~p)"
+ "WARNING! ~w:end_per_testcase(~tw, ~tp)"
" failed!\n\tReason: ~tp\n",
[Mod,Func,EndConf,Why]},
W = "<font color=\"red\">"
@@ -859,7 +859,7 @@ spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) ->
Comment =
lists:flatten(
io_lib:format("<font color=\"red\">"
- "WARNING! ~w:~w failed!</font>",
+ "WARNING! ~w:~tw failed!</font>",
[FwMod,FwFunc])),
%% finished, report back
SendTo ! {self(),fw_notify_done,
@@ -1341,7 +1341,7 @@ print_init_conf_result(Line,Cause,Reason) ->
Str2Print =
fun(NoHTML) when NoHTML == stdout; NoHTML == major ->
io_lib:format("ERROR! init_per_testcase ~s!\n"
- "\tLocation: ~p\n\tReason: ~tp\n",
+ "\tLocation: ~tp\n\tReason: ~tp\n",
[Cause,Line,Reason]);
(minor) ->
ReasonStr = test_server_ctrl:escape_chars(Reason),
@@ -1413,7 +1413,7 @@ print_end_tc_warning(EndFunc,Reason,Cause,Loc) ->
Str2Print =
fun(NoHTML) when NoHTML == stdout; NoHTML == major ->
io_lib:format("WARNING: ~w ~s!\n"
- "Reason: ~tp\nLine: ~p\n",
+ "Reason: ~tp\nLine: ~tp\n",
[EndFunc,Cause,Reason,Loc]);
(minor) ->
ReasonStr = test_server_ctrl:escape_chars(Reason),
@@ -1515,7 +1515,7 @@ lookup_config(Key,Config) ->
{value,{Key,Val}} ->
Val;
_ ->
- io:format("Could not find element ~p in Config.~n",[Key]),
+ io:format("Could not find element ~tp in Config.~n",[Key]),
undefined
end.
@@ -1600,7 +1600,7 @@ format(Detail, Format, Args) ->
Str =
case catch io_lib:format(Format,Args) of
{'EXIT',_} ->
- io_lib:format("illegal format; ~p with args ~p.\n",
+ io_lib:format("illegal format; ~tp with args ~tp.\n",
[Format,Args]);
Valid -> Valid
end,
@@ -1732,7 +1732,7 @@ fail(Reason) ->
cast_to_list(X) when is_list(X) -> X;
cast_to_list(X) when is_atom(X) -> atom_to_list(X);
-cast_to_list(X) -> lists:flatten(io_lib:format("~p", [X])).
+cast_to_list(X) -> lists:flatten(io_lib:format("~tp", [X])).
@@ -1904,7 +1904,7 @@ ensure_timetrap(Config) ->
Garbage ->
erase(test_server_default_timetrap),
format("=== WARNING: garbage in "
- "test_server_default_timetrap: ~p~n",
+ "test_server_default_timetrap: ~tp~n",
[Garbage])
end,
DTmo = case lists:keysearch(default_timeout,1,Config) of
@@ -1933,7 +1933,7 @@ cancel_default_timetrap(true) ->
Garbage ->
erase(test_server_default_timetrap),
format("=== WARNING: garbage in "
- "test_server_default_timetrap: ~p~n",
+ "test_server_default_timetrap: ~tp~n",
[Garbage]),
error
end.
@@ -1942,7 +1942,7 @@ time_ms({hours,N}, _, _) -> hours(N);
time_ms({minutes,N}, _, _) -> minutes(N);
time_ms({seconds,N}, _, _) -> seconds(N);
time_ms({Other,_N}, _, _) ->
- format("=== ERROR: Invalid time specification: ~p. "
+ format("=== ERROR: Invalid time specification: ~tp. "
"Should be seconds, minutes, or hours.~n", [Other]),
exit({invalid_time_format,Other});
time_ms(Ms, _, _) when is_integer(Ms) -> Ms;
diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl
index 064e375cd5..9412c43187 100644
--- a/lib/common_test/src/test_server_ctrl.erl
+++ b/lib/common_test/src/test_server_ctrl.erl
@@ -232,7 +232,7 @@ parse_cmd_line(['SPEC',Spec|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
parse_cmd_line(Cmds, TermList++SpecList, [Name|Names], Param,
Trc, Cov, TCCB);
{error,Reason} ->
- io:format("Can't open ~w: ~p\n",[Spec, file:format_error(Reason)]),
+ io:format("Can't open ~tw: ~tp\n",[Spec, file:format_error(Reason)]),
parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, TCCB)
end;
parse_cmd_line(['NAME',Name|Cmds], SpecList, Names, Param, Trc, Cov, TCCB) ->
@@ -261,7 +261,7 @@ parse_cmd_line(['COVER',App,CF,Analyse|Cmds], SpecList, Names, Param, Trc, _Cov,
parse_cmd_line(['TESTCASE_CALLBACK',Mod,Func|Cmds], SpecList, Names, Param, Trc, Cov, _) ->
parse_cmd_line(Cmds, SpecList, Names, Param, Trc, Cov, {Mod,Func});
parse_cmd_line([Obj|_Cmds], _SpecList, _Names, _Param, _Trc, _Cov, _TCCB) ->
- io:format("~w: Bad argument: ~w\n", [?MODULE,Obj]),
+ io:format("~w: Bad argument: ~tw\n", [?MODULE,Obj]),
io:format(" Use the `ts' module to start tests.\n", []),
io:format(" (If you ARE using `ts', there is a bug in `ts'.)\n", []),
halt(1);
@@ -280,7 +280,7 @@ parse_cmd_line([], SpecList, Names, Param, Trc, Cov, TCCB) ->
cast_to_list(X) when is_list(X) -> X;
cast_to_list(X) when is_atom(X) -> atom_to_list(X);
-cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])).
+cast_to_list(X) -> lists:flatten(io_lib:format("~tw", [X])).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% START INTERFACE
@@ -878,7 +878,7 @@ handle_call({testcase_callback,ModFunc}, _From, State) ->
ok;
false ->
io:format(user,
- "WARNING! Callback function ~w:~w/4 undefined.~n~n",
+ "WARNING! Callback function ~w:~tw/4 undefined.~n~n",
[Mod,Func])
end;
_ ->
@@ -1016,7 +1016,7 @@ handle_info({'EXIT',Pid,Reason}, State) ->
killed ->
io:format("Suite ~ts was killed\n", [Name]);
_Other ->
- io:format("Suite ~ts was killed with reason ~p\n",
+ io:format("Suite ~ts was killed with reason ~tp\n",
[Name,Reason])
end,
State2 = State#state{jobs=NewJobs},
@@ -1168,10 +1168,10 @@ init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels,
{'EXIT',test_suites_done} ->
ok;
{'EXIT',_Pid,Reason} ->
- print(1, "EXIT, reason ~p", [Reason]);
+ print(1, "EXIT, reason ~tp", [Reason]);
{'EXIT',Reason} ->
report_severe_error(Reason),
- print(1, "EXIT, reason ~p", [Reason])
+ print(1, "EXIT, reason ~tp", [Reason])
end,
Time = TimeMy/1000000,
SuccessStr =
@@ -1263,7 +1263,7 @@ do_spec(SpecName, TimetrapSpec) when is_list(SpecName) ->
{ok,TermList} ->
do_spec_list(TermList,TimetrapSpec);
{error,Reason} ->
- io:format("Can't open ~ts: ~p\n", [SpecName,Reason]),
+ io:format("Can't open ~ts: ~tp\n", [SpecName,Reason]),
{error,{cant_open_spec,Reason}}
end.
@@ -1346,7 +1346,7 @@ do_spec_terms([{require_nodenames,NumNames}|Terms], TopCases, SkipList, Config)
do_spec_terms(Terms, TopCases, SkipList,
update_config(Config, {nodenames,NodeNames}));
do_spec_terms([Other|Terms], TopCases, SkipList, Config) ->
- io:format("** WARNING: Spec file contains unknown directive ~p\n",
+ io:format("** WARNING: Spec file contains unknown directive ~tp\n",
[Other]),
do_spec_terms(Terms, TopCases, SkipList, Config).
@@ -1503,7 +1503,7 @@ do_test_cases(TopCases, SkipCases,
FwMod = get_fw_mod(?MODULE),
case collect_all_cases(TopCases, SkipCases) of
{error,Why} ->
- print(1, "Error starting: ~p", [Why]),
+ print(1, "Error starting: ~tp", [Why]),
exit(test_suites_done);
TestSpec0 ->
N = case remove_conf(TestSpec0) of
@@ -1762,18 +1762,14 @@ make_html_link(LinkName, Target, Explanation) ->
start_minor_log_file(Mod, Func, ParallelTC) ->
MFA = {Mod,Func,1},
LogDir = get(test_server_log_dir_base),
- Name0 = lists:flatten(io_lib:format("~w.~w~ts", [Mod,Func,?html_ext])),
- Name = downcase(Name0),
+ Name = minor_log_file_name(Mod,Func),
AbsName = filename:join(LogDir, Name),
case (ParallelTC orelse (element(1,file:read_file_info(AbsName))==ok)) of
false -> %% normal case, unique name
start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA);
true -> %% special case, duplicate names
Tag = test_server_sup:unique_name(),
- Name1_0 =
- lists:flatten(io_lib:format("~w.~w.~ts~ts", [Mod,Func,Tag,
- ?html_ext])),
- Name1 = downcase(Name1_0),
+ Name1 = minor_log_file_name(Mod,Func,[$.|Tag]),
AbsName1 = filename:join(LogDir, Name1),
start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA)
end.
@@ -1784,7 +1780,7 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
put(test_server_minor_fd, Fd),
test_server_gl:set_minor_fd(group_leader(), Fd, MFA),
- TestDescr = io_lib:format("Test ~w:~w result", [Mod,Func]),
+ TestDescr = io_lib:format("Test ~w:~tw result", [Mod,Func]),
{Header,Footer} =
case test_server_sup:framework_call(get_html_wrapper,
[TestDescr,false,
@@ -1825,13 +1821,13 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) ->
lists:member(no_src, get(test_server_logopts))} of
{true,false} ->
print(Lev, ["$tc_html",
- Info ++ "<a href=\"~ts#~ts\">~w:~w/~w</a> "
+ Info ++ "<a href=\"~ts#~ts\">~w:~tw/~w</a> "
"(click for source code)\n"],
[uri_encode(SrcListing),
uri_encode(atom_to_list(Func)++"-1",utf8),
Mod,Func,Arity]);
_ ->
- print(Lev, ["$tc_html",Info ++ "~w:~w/~w\n"], [Mod,Func,Arity])
+ print(Lev, ["$tc_html",Info ++ "~w:~tw/~w\n"], [Mod,Func,Arity])
end
end,
@@ -1845,6 +1841,19 @@ stop_minor_log_file() ->
ok = file:close(Fd),
put(test_server_minor_fd, undefined).
+minor_log_file_name(Mod,Func) ->
+ minor_log_file_name(Mod,Func,"").
+minor_log_file_name(Mod,Func,Tag) ->
+ Name =
+ downcase(
+ lists:flatten(
+ io_lib:format("~w.~tw~s~s", [Mod,Func,Tag,?html_ext]))),
+ Ok = file:native_name_encoding()==utf8
+ orelse io_lib:printable_latin1_list(Name),
+ if Ok -> Name;
+ true -> exit({error,unicode_name_on_latin1_file_system})
+ end.
+
downcase(S) -> downcase(S, []).
downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
downcase(Rest, [Uc-$A+$a|Result]);
@@ -2736,7 +2745,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
TimetrapData, Mode, Status2);
Bad ->
print(minor,
- "~n*** ~w returned bad elements in Config: ~p.~n",
+ "~n*** ~tw returned bad elements in Config: ~tp.~n",
[Func,Bad]),
Reason = {failed,{Mod,init_per_suite,bad_return}},
Cases2 = skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
@@ -2752,9 +2761,9 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
stop_minor_log_file(),
run_test_cases_loop(Cases, [NewCfg|Config], TimetrapData, Mode, Status2);
{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
- print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
+ print(minor, "~n*** ~w failed in ~tw. Reason: ~tp~n",
[FwMod,FwFunc,Reason]),
- print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
+ print(1, "~w failed in ~tw. Reason: ~tp~n", [FwMod,FwFunc,Reason]),
exit(framework_error);
{_,Fail,_} when element(1,Fail) == 'EXIT';
element(1,Fail) == timetrap_timeout;
@@ -2763,7 +2772,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
{Cases2,Config1,Status3} =
if StartConf ->
ReportAbortRepeat(failed),
- print(minor, "~n*** ~w failed.~n"
+ print(minor, "~n*** ~tw failed.~n"
" Skipping all cases.", [Func]),
Reason = {failed,{Mod,Func,Fail}},
{skip_cases_upto(Ref, Cases, Reason, conf, CurrMode,
@@ -2786,7 +2795,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
{Cases2,Config1,Status3} =
if StartConf ->
ReportAbortRepeat(auto_skipped),
- print(minor, "~n*** ~w auto skipped.~n"
+ print(minor, "~n*** ~tw auto skipped.~n"
" Skipping all cases.", [Func]),
{skip_cases_upto(Ref, Cases, SkipReason, conf, CurrMode,
auto_skip_case),
@@ -2803,7 +2812,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
{_,{Skip,Reason},_} when StartConf and ((Skip==skip) or (Skip==skipped)) ->
ReportAbortRepeat(skipped),
- print(minor, "~n*** ~w skipped.~n"
+ print(minor, "~n*** ~tw skipped.~n"
" Skipping all cases.", [Func]),
set_io_buffering(IOHandler),
stop_minor_log_file(),
@@ -2813,7 +2822,7 @@ run_test_cases_loop([{conf,Ref,Props,{Mod,Func}}|_Cases]=Cs0,
delete_status(Ref, Status2));
{_,{skip_and_save,Reason,_SavedConfig},_} when StartConf ->
ReportAbortRepeat(skipped),
- print(minor, "~n*** ~w skipped.~n"
+ print(minor, "~n*** ~tw skipped.~n"
" Skipping all cases.", [Func]),
set_io_buffering(IOHandler),
stop_minor_log_file(),
@@ -2878,7 +2887,7 @@ run_test_cases_loop([{make,Ref,{Mod,Func,Args}}|Cases0], Config, TimetrapData,
Mode, Status) ->
case run_test_case(Ref, 0, Mod, Func, Args, skip_init, TimetrapData) of
{_,Why={'EXIT',_},_} ->
- print(minor, "~n*** ~w failed.~n"
+ print(minor, "~n*** ~tw failed.~n"
" Skipping all cases.", [Func]),
Reason = {failed,{Mod,Func,Why}},
Cases = skip_cases_upto(Ref, Cases0, Reason, conf, Mode,
@@ -2932,9 +2941,9 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status)
RunInit, TimetrapData, Mode) of
%% callback to framework module failed, exit immediately
{_,{framework_error,{FwMod,FwFunc},Reason},_} ->
- print(minor, "~n*** ~w failed in ~w. Reason: ~p~n",
+ print(minor, "~n*** ~w failed in ~tw. Reason: ~tp~n",
[FwMod,FwFunc,Reason]),
- print(1, "~w failed in ~w. Reason: ~p~n", [FwMod,FwFunc,Reason]),
+ print(1, "~w failed in ~tw. Reason: ~tp~n", [FwMod,FwFunc,Reason]),
stop_minor_log_file(),
exit(framework_error);
%% sequential execution of test case finished
@@ -2965,7 +2974,7 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status)
stop_minor_log_file(),
run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status1);
true -> % skip rest of cases in sequence
- print(minor, "~n*** ~w failed.~n"
+ print(minor, "~n*** ~tw failed.~n"
" Skipping all other cases in sequence.",
[Func]),
Reason = {failed,{Mod,Func}},
@@ -3105,8 +3114,8 @@ print_conf_time(ConfTime) ->
print_props([]) ->
ok;
print_props(Props) ->
- print(major, "=group_props ~p", [Props]),
- print(minor, "Group properties: ~p~n", [Props]).
+ print(major, "=group_props ~tp", [Props]),
+ print(minor, "Group properties: ~tp~n", [Props]).
%% repeat N times: {repeat,N}
%% repeat N times or until all successful: {repeat_until_all_ok,N}
@@ -3253,13 +3262,13 @@ skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
ResultCol = if Type == auto -> ?auto_skip_color;
Type == user -> ?user_skip_color
end,
- print(major, "~n=case ~w:~w", [Mod,Func]),
+ print(major, "~n=case ~w:~tw", [Mod,Func]),
GroupName = case get_name(Mode) of
undefined ->
"";
GrName ->
GrName1 = cast_to_list(GrName),
- print(major, "=group_props ~p", [[{name,GrName1}]]),
+ print(major, "=group_props ~tp", [[{name,GrName1}]]),
GrName1
end,
print(major, "=started ~s", [lists:flatten(timestamp_get(""))]),
@@ -3270,9 +3279,9 @@ skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
print(major, "=result skipped: ~ts", [Comment1])
end,
if CaseNum == 0 ->
- print(2,"*** Skipping ~w ***", [{Mod,Func}]);
+ print(2,"*** Skipping ~tw ***", [{Mod,Func}]);
true ->
- print(2,"*** Skipping test case #~w ~w ***", [CaseNum,{Mod,Func}])
+ print(2,"*** Skipping test case #~w ~tw ***", [CaseNum,{Mod,Func}])
end,
TR = xhtml("<tr valign=\"top\">", ["<tr class=\"",odd_or_even(),"\">"]),
GroupName = case get_name(Mode) of
@@ -3283,7 +3292,7 @@ skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) ->
TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
- "<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
+ "<td>" ++ Col0 ++ "~tw" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "< >" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "0.000s" ++ Col1 ++ "</td>"
"<td><font color=\"~ts\">SKIPPED</font></td>"
@@ -3504,7 +3513,7 @@ wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) ->
{'EXIT',CurrPid,Reason} when Reason /= normal ->
%% unexpected termination of test case process
{value,{_,_,CaseNum,Mod,Func}} = lists:keysearch(CurrPid, 2, Cases),
- print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p",
+ print(1, "Error! Process for test case #~w (~w:~tw) died! Reason: ~tp",
[CaseNum, Mod, Func, Reason]),
exit({unexpected_termination,{CaseNum,Mod,Func},{CurrPid,Reason}})
end;
@@ -3643,7 +3652,7 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) ->
{'EXIT',TCPid,Reason} when Reason /= normal ->
test_server_io:print_buffered(CurrPid),
{value,{_,_,Num,M,F}} = lists:keysearch(TCPid, 2, Cases),
- print(1, "Error! Process for test case #~w (~w:~w) died! Reason: ~p",
+ print(1, "Error! Process for test case #~w (~w:~tw) died! Reason: ~tp",
[Num, M, F, Reason]),
exit({unexpected_termination,{Num,M,F},{TCPid,Reason}})
end.
@@ -3716,7 +3725,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
end,
TSDir = get(test_server_dir),
- print(major, "=case ~w:~w", [Mod, Func]),
+ print(major, "=case ~w:~tw", [Mod, Func]),
MinorName = start_minor_log_file(Mod, Func, self() /= Main),
MinorBase = filename:basename(MinorName),
print(major, "=logfile ~ts", [filename:basename(MinorName)]),
@@ -3778,7 +3787,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
print(html, TR ++ "<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "~w" ++ Col1 ++ "</td>"
"<td>" ++ Col0 ++ "~ts" ++ Col1 ++ "</td>"
- "<td><a href=\"~ts\">~w</a></td>"
+ "<td><a href=\"~ts\">~tw</a></td>"
"<td><a href=\"~ts#top\">&lt;</a> <a href=\"~ts#end\">&gt;</a></td>",
[num2str(Num),fw_name(Mod),GrNameStr,EncMinorBase,Func,
EncMinorBase,EncMinorBase]),
@@ -3894,13 +3903,13 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit,
{'EXIT',_} = Exit ->
print(minor,
"WARNING: There might be slavenodes left in the"
- " system. I tried to kill them, but I failed: ~p\n",
+ " system. I tried to kill them, but I failed: ~tp\n",
[Exit]);
[] -> ok;
List ->
print(minor, "WARNING: ~w slave nodes in system after test"++
"case. Tried to killed them.~n"++
- " Names:~p",
+ " Names:~tp",
[length(List),List])
end;
false ->
@@ -3960,7 +3969,7 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
if_auto_skip(Reason,
fun() -> {?auto_skip_color,auto_skip,auto_skipped} end,
fun() -> {?user_skip_color,skip,skipped} end),
- print(major, "=result ~w: ~p", [ReportTag,Reason1]),
+ print(major, "=result ~w: ~tp", [ReportTag,Reason1]),
print(1, "*** SKIPPED ~ts ***",
[get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
@@ -3993,7 +4002,7 @@ progress(skip, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
progress(failed, CaseNum, Mod, Func, GrName, Loc, timetrap_timeout, T,
Comment0, {St0,St1}) ->
- print(major, "=result failed: timeout, ~p", [Loc]),
+ print(major, "=result failed: timeout, ~tp", [Loc]),
print(1, "*** FAILED ~ts ***",
[get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
test_server_sup:framework_call(report,
@@ -4019,7 +4028,7 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, timetrap_timeout, T,
progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T,
Comment0, {St0,St1}) ->
- print(major, "=result failed: testcase_aborted, ~p", [Loc]),
+ print(major, "=result failed: testcase_aborted, ~tp", [Loc]),
print(1, "*** FAILED ~ts ***",
[get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
test_server_sup:framework_call(report,
@@ -4041,14 +4050,14 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, {testcase_aborted,Reason}, _T,
FormatLoc = test_server_sup:format_loc(Loc),
print(minor, "=== Location: ~ts", [FormatLoc]),
print(minor,
- escape_chars(io_lib:format("=== Reason: {testcase_aborted,~p}",
+ escape_chars(io_lib:format("=== Reason: {testcase_aborted,~tp}",
[Reason])),
[]),
failed;
progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
Comment0, {St0,St1}) ->
- print(major, "=result failed: ~p, ~w", [Reason,unknown_location]),
+ print(major, "=result failed: ~tp, ~w", [Reason,unknown_location]),
print(1, "*** FAILED ~ts ***",
[get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
@@ -4056,7 +4065,7 @@ progress(failed, CaseNum, Mod, Func, GrName, unknown, Reason, Time,
TimeStr = io_lib:format(if is_float(Time) -> "~.3fs";
true -> "~w"
end, [Time]),
- ErrorReason = escape_chars(lists:flatten(io_lib:format("~p", [Reason]))),
+ ErrorReason = escape_chars(lists:flatten(io_lib:format("~tp", [Reason]))),
ErrorReason1 = lists:flatten([string:strip(S,left) ||
S <- string:tokens(ErrorReason,[$\n])]),
ErrorReason2 =
@@ -4093,7 +4102,7 @@ progress(failed, CaseNum, Mod, Func, GrName, Loc, Reason, Time,
end;
true -> {Loc,Loc}
end,
- print(major, "=result failed: ~p, ~p", [Reason,LocMaj]),
+ print(major, "=result failed: ~tp, ~tp", [Reason,LocMaj]),
print(1, "*** FAILED ~ts ***",
[get_info_str(Mod,Func, CaseNum, get(test_server_cases))]),
test_server_sup:framework_call(report, [tc_done,{Mod,{Func,GrName},
@@ -4236,7 +4245,7 @@ update_skip_counters(Pat, {US,AS}) ->
Result.
get_info_str(Mod,Func, 0, _Cases) ->
- io_lib:format("~w", [{Mod,Func}]);
+ io_lib:format("~tw", [{Mod,Func}]);
get_info_str(_Mod,_Func, CaseNum, unknown) ->
"test case " ++ integer_to_list(CaseNum);
get_info_str(_Mod,_Func, CaseNum, Cases) ->
@@ -4251,11 +4260,11 @@ print_if_known(Known, {SK,AK}, {SU,AU}) ->
to_string(Term) when is_list(Term) ->
case (catch io_lib:format("~ts", [Term])) of
- {'EXIT',_} -> lists:flatten(io_lib:format("~p", [Term]));
+ {'EXIT',_} -> lists:flatten(io_lib:format("~tp", [Term]));
String -> lists:flatten(String)
end;
to_string(Term) ->
- lists:flatten(io_lib:format("~p", [Term])).
+ lists:flatten(io_lib:format("~tp", [Term])).
get_last_loc(Loc) when is_tuple(Loc) ->
Loc;
@@ -4327,14 +4336,14 @@ format_exception(Reason={_Error,Stack}) when is_list(Stack) ->
undefined ->
case application:get_env(test_server, format_exception) of
{ok,false} ->
- {"~p",Reason};
+ {"~tp",Reason};
_ ->
do_format_exception(Reason)
end;
FW ->
case application:get_env(FW, format_exception) of
{ok,false} ->
- {"~p",Reason};
+ {"~tp",Reason};
_ ->
do_format_exception(Reason)
end
@@ -4345,13 +4354,13 @@ format_exception(Error) ->
do_format_exception(Reason={Error,Stack}) ->
StackFun = fun(_, _, _) -> false end,
PF = fun(Term, I) ->
- io_lib:format("~." ++ integer_to_list(I) ++ "p", [Term])
+ io_lib:format("~." ++ integer_to_list(I) ++ "tp", [Term])
end,
- case catch lib:format_exception(1, error, Error, Stack, StackFun, PF) of
- {'EXIT',_} ->
- {"~p",Reason};
+ case catch lib:format_exception(1, error, Error, Stack, StackFun, PF, utf8) of
+ {'EXIT',_R} ->
+ {"~tp",Reason};
Formatted ->
- Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list}]),
+ Formatted1 = re:replace(Formatted, "exception error: ", "", [{return,list},unicode]),
{"~ts",lists:flatten(Formatted1)}
end.
@@ -4457,7 +4466,7 @@ format(Detail, Format, Args) ->
Str =
case catch io_lib:format(Format, Args) of
{'EXIT',_} ->
- io_lib:format("illegal format; ~p with args ~p.\n",
+ io_lib:format("illegal format; ~tp with args ~tp.\n",
[Format,Args]);
Valid -> Valid
end,
@@ -4853,7 +4862,7 @@ collect_files(Dir, Pattern, St, Mode) ->
Wc = filename:join([Dir1,Pattern++"{.erl,"++code:objfile_extension()++"}"]),
case catch filelib:wildcard(Wc) of
{'EXIT', Reason} ->
- io:format("Could not collect files: ~p~n", [Reason]),
+ io:format("Could not collect files: ~tp~n", [Reason]),
{error,{collect_fail,Dir,Pattern}};
Files ->
%% convert to module names and remove duplicates
@@ -4897,13 +4906,13 @@ check_deny_req({Req,Val}, DenyList) ->
%%io:format("ValCheck ~p=~p in ~p\n", [Req,Val,DenyList]),
case lists:keysearch(Req, 1, DenyList) of
{value,{_Req,DenyVal}} when Val >= DenyVal ->
- {denied,io_lib:format("Requirement ~p=~p", [Req,Val])};
+ {denied,io_lib:format("Requirement ~tp=~tp", [Req,Val])};
_ ->
check_deny_req(Req, DenyList)
end;
check_deny_req(Req, DenyList) ->
case lists:member(Req, DenyList) of
- true -> {denied,io_lib:format("Requirement ~p", [Req])};
+ true -> {denied,io_lib:format("Requirement ~tp", [Req])};
false -> granted
end.
@@ -5004,7 +5013,7 @@ get_target_info() ->
start_node(Name, Type, Options) ->
T = 10 * ?ACCEPT_TIMEOUT * test_server:timetrap_scale_factor(),
- format(minor, "Attempt to start ~w node ~p with options ~p",
+ format(minor, "Attempt to start ~w node ~tp with options ~tp",
[Type, Name, Options]),
case controller_call({start_node,Name,Type,Options}, T) of
{{ok,Nodename}, Host, Cmd, Info, Warning} ->
@@ -5026,16 +5035,16 @@ start_node(Name, Type, Options) ->
{fail,{Ret, Host, Cmd}} ->
format(minor,
"Failed to start node ~tp on ~tp with command: ~ts~n"
- "Reason: ~p",
+ "Reason: ~tp",
[Name, Host, Cmd, Ret]),
{fail,Ret};
{Ret, undefined, undefined} ->
- format(minor, "Failed to start node ~tp: ~p", [Name,Ret]),
+ format(minor, "Failed to start node ~tp: ~tp", [Name,Ret]),
Ret;
{Ret, Host, Cmd} ->
format(minor,
"Failed to start node ~tp on ~tp with command: ~ts~n"
- "Reason: ~p",
+ "Reason: ~tp",
[Name, Host, Cmd, Ret]),
Ret
end.
@@ -5134,8 +5143,8 @@ display_info([Pid|T], R, M) ->
Reds = fetch(reductions, Info),
LM = length(fetch(messages, Info)),
pformat(io_lib:format("~w", [Pid]),
- io_lib:format("~w", [Call]),
- io_lib:format("~w", [Curr]), Reds, LM),
+ io_lib:format("~tw", [Call]),
+ io_lib:format("~tw", [Curr]), Reds, LM),
display_info(T, R+Reds, M + LM)
end;
display_info([], R, M) ->
@@ -5249,11 +5258,11 @@ read_cover_file(CoverFile) ->
case check_cover_file(List, [], [], []) of
{ok,Exclude,Include,Cross} -> {Exclude,Include,Cross};
error ->
- io:fwrite("Faulty format of CoverFile ~p\n", [CoverFile]),
+ io:fwrite("Faulty format of CoverFile ~tp\n", [CoverFile]),
{[],[],[]}
end;
{error,Reason} ->
- io:fwrite("Can't read CoverFile ~ts\nReason: ~p\n",
+ io:fwrite("Can't read CoverFile ~ts\nReason: ~tp\n",
[CoverFile,Reason]),
{[],[],[]}
end.
@@ -5521,8 +5530,8 @@ write_coverlog_header(CoverLog) ->
case catch io:put_chars(CoverLog,html_header("Coverage results")) of
{'EXIT',Reason} ->
io:format("\n\nERROR: Could not write normal heading in coverlog.\n"
- "CoverLog: ~w\n"
- "Reason: ~p\n",
+ "CoverLog: ~tw\n"
+ "Reason: ~tp\n",
[CoverLog,Reason]),
io:format(CoverLog,"<html><body>\n", []);
_ ->
diff --git a/lib/common_test/src/test_server_gl.erl b/lib/common_test/src/test_server_gl.erl
index 4845b86dd3..ce7682d101 100644
--- a/lib/common_test/src/test_server_gl.erl
+++ b/lib/common_test/src/test_server_gl.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2012-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.
@@ -173,8 +173,8 @@ handle_info({'DOWN',Ref,process,_,Reason}=D, #st{minor_monitor=Ref}=St) ->
case Reason of
normal -> ok;
_ ->
- Data = io_lib:format("=== WARNING === TC: ~w\n"
- "Got down from minor Fd ~w: ~w\n\n",
+ Data = io_lib:format("=== WARNING === TC: ~tw\n"
+ "Got down from minor Fd ~w: ~tw\n\n",
[St#st.tc,St#st.minor,D]),
test_server_io:print_unexpected(Data)
end,
@@ -319,7 +319,7 @@ output(Level, Str, Sender, From, St) when is_atom(Level) ->
output_to_file(Level, dress_output(Str, Sender, St), From, St).
output_to_file(minor, Data0, From, #st{tc={M,F,A},minor=none}) ->
- Data = [io_lib:format("=== ~w:~w/~w\n", [M,F,A]),Data0],
+ Data = [io_lib:format("=== ~w:~tw/~w\n", [M,F,A]),Data0],
test_server_io:print(From, unexpected_io, Data),
ok;
output_to_file(minor, Data, From, #st{tc=TC,minor=Fd}) ->
@@ -328,10 +328,10 @@ output_to_file(minor, Data, From, #st{tc=TC,minor=Fd}) ->
catch
Type:Reason ->
Data1 =
- [io_lib:format("=== ERROR === TC: ~w\n"
+ [io_lib:format("=== ERROR === TC: ~tw\n"
"Failed to write to minor Fd: ~w\n"
"Type: ~w\n"
- "Reason: ~w\n",
+ "Reason: ~tw\n",
[TC,Fd,Type,Reason]),
Data,"\n"],
test_server_io:print(From, unexpected_io, Data1)
diff --git a/lib/common_test/src/test_server_io.erl b/lib/common_test/src/test_server_io.erl
index fdabf17b08..062e3bd8ff 100644
--- a/lib/common_test/src/test_server_io.erl
+++ b/lib/common_test/src/test_server_io.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2012-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.
@@ -359,7 +359,7 @@ handle_info(kill_group_leaders, #st{gls=Gls,stopping=From,
end, St#st{phase=idle,pending_ops=[]}, Ops),
{noreply,St1};
handle_info(Other, St) ->
- io:format("Ignoring: ~p\n", [Other]),
+ io:format("Ignoring: ~tp\n", [Other]),
{noreply,St}.
terminate(_, _) ->
@@ -395,7 +395,7 @@ do_output(Tag, Str, Phase, #st{fds=Fds}=St) ->
none when Phase /= started ->
buffer;
none ->
- S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~p' log file\n",
+ S = io_lib:format("\n*** ERROR: ~w, line ~w: No known '~tp' log file\n",
[?MODULE,?LINE,Tag]),
do_output(stdout, [S,Str], Phase, St);
{value,Fd} ->
@@ -407,7 +407,7 @@ do_output(Tag, Str, Phase, #st{fds=Fds}=St) ->
end
catch _:Error ->
S = io_lib:format("\n*** ERROR: ~w, line ~w: Error writing to "
- "log file '~p': ~p\n",
+ "log file '~tp': ~tp\n",
[?MODULE,?LINE,Tag,Error]),
do_output(stdout, [S,Str], Phase, St)
end
diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl
index 32d7d14a1b..a18ff1fd62 100644
--- a/lib/common_test/src/test_server_node.erl
+++ b/lib/common_test/src/test_server_node.erl
@@ -237,23 +237,23 @@ print_trc(Out,{trace_ts,P,call,{M,F,A},C,Ts},N) ->
io:format(Out,
"~w: ~s~n"
"Process : ~w~n"
- "Call : ~w:~w/~w~n"
- "Arguments : ~p~n"
- "Caller : ~w~n~n",
+ "Call : ~w:~tw/~w~n"
+ "Arguments : ~tp~n"
+ "Caller : ~tw~n~n",
[N,ts(Ts),P,M,F,length(A),A,C]);
print_trc(Out,{trace_ts,P,call,{M,F,A},Ts},N) ->
io:format(Out,
"~w: ~s~n"
"Process : ~w~n"
- "Call : ~w:~w/~w~n"
- "Arguments : ~p~n~n",
+ "Call : ~w:~tw/~w~n"
+ "Arguments : ~tp~n~n",
[N,ts(Ts),P,M,F,length(A),A]);
print_trc(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) ->
io:format(Out,
"~w: ~s~n"
"Process : ~w~n"
- "Return from : ~w:~w/~w~n"
- "Return value : ~p~n~n",
+ "Return from : ~w:~tw/~w~n"
+ "Return value : ~tp~n~n",
[N,ts(Ts),P,M,F,A,R]);
print_trc(Out,{drop,X},N) ->
io:format(Out,
@@ -263,7 +263,7 @@ print_trc(Out,Trace,N) ->
Ts = element(size(Trace),Trace),
io:format(Out,
"~w: ~s~n"
- "Trace : ~p~n~n",
+ "Trace : ~tp~n~n",
[N,ts(Ts),Trace]).
ts({_, _, Micro} = Now) ->
{{Y,M,D},{H,Min,S}} = calendar:now_to_local_time(Now),
@@ -580,7 +580,7 @@ kill_node(SI) ->
cast_to_list(X) when is_list(X) -> X;
cast_to_list(X) when is_atom(X) -> atom_to_list(X);
-cast_to_list(X) -> lists:flatten(io_lib:format("~w", [X])).
+cast_to_list(X) -> lists:flatten(io_lib:format("~tw", [X])).
%%% L contains elements of the forms
diff --git a/lib/common_test/src/test_server_sup.erl b/lib/common_test/src/test_server_sup.erl
index 6922e01fcc..9a26de4774 100644
--- a/lib/common_test/src/test_server_sup.erl
+++ b/lib/common_test/src/test_server_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-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.
@@ -83,7 +83,7 @@ kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) ->
"Testcase process ~w not "
"responding to timetrap "
"timeout:~n"
- " ~p.~n"
+ " ~tp.~n"
"Killing testcase...~n",
[Pid, Trap]),
exit(Pid, kill)
@@ -144,11 +144,11 @@ call_crash(Time,Crash,M,F,A) ->
{'EXIT',Pid,_Reason} when Crash==any ->
ok;
{'EXIT',Reason} ->
- test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.",
+ test_server:format(12, "Wrong crash reason. Wanted ~tp, got ~tp.",
[Crash, Reason]),
exit({wrong_crash_reason,Reason});
{'EXIT',Pid,Reason} ->
- test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.",
+ test_server:format(12, "Wrong crash reason. Wanted ~tp, got ~tp.",
[Crash, Reason]),
exit({wrong_crash_reason,Reason});
{'EXIT',OtherPid,Reason} when OldTrapExit == false ->
@@ -334,11 +334,11 @@ do_appup_tests(_, _Application, Up, Down, Modules) ->
ok ->
test_server:format(minor, "OK~n");
Error ->
- test_server:format(minor, "ERROR ~p~n", [Error]),
+ test_server:format(minor, "ERROR ~tp~n", [Error]),
test_server:fail(Error)
end;
Error ->
- test_server:format(minor, "ERROR ~p~n", [Error]),
+ test_server:format(minor, "ERROR ~tp~n", [Error]),
test_server:fail(Error)
end.
@@ -557,7 +557,7 @@ check_dict(Dict, Reason) ->
[] ->
1; % All ok.
List ->
- io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]),
+ io:format("** ~ts (~ts) ->~n~tp~n",[Reason, Dict, List]),
0
end.
@@ -566,7 +566,7 @@ check_dict_tolerant(Dict, Reason, Mode) ->
[] ->
1; % All ok.
List ->
- io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]),
+ io:format("** ~ts (~ts) ->~n~tp~n",[Reason, Dict, List]),
case Mode of
pedantic ->
0;
@@ -646,7 +646,7 @@ append_files_to_logfile([File|Files]) ->
%% fail, but in that case it will throw an exception so that
%% we will be aware of the problem.
io:format(Fd, "Unable to write the crash dump "
- "to this file: ~p~n", [file:format_error(Error)])
+ "to this file: ~tp~n", [file:format_error(Error)])
end;
_Error ->
io:format(Fd, "Failed to read: ~ts\n", [File])
@@ -802,9 +802,9 @@ format_loc([{Mod,Func,Line}|Rest]) ->
format_loc([{Mod,LineOrFunc}]) ->
format_loc({Mod,LineOrFunc});
format_loc({Mod,Func}) when is_atom(Func) ->
- io_lib:format("{~w,~w}",[Mod,Func]);
+ io_lib:format("{~w,~tw}",[Mod,Func]);
format_loc(Loc) ->
- io_lib:format("~p",[Loc]).
+ io_lib:format("~tp",[Loc]).
format_loc1([{Mod,Func,Line}]) ->
[" ",format_loc1({Mod,Func,Line}),"]"];
@@ -824,12 +824,12 @@ format_loc1({Mod,Func,Line}) ->
true ->
Line
end,
- io_lib:format("{~w,~w,<a href=\"~ts~ts#~s\">~w</a>}",
+ io_lib:format("{~w,~tw,<a href=\"~ts~ts#~ts\">~tw</a>}",
[Mod,Func,
test_server_ctrl:uri_encode(downcase(ModStr)),
?src_listing_ext,Link,Line]);
_ ->
- io_lib:format("{~w,~w,~w}",[Mod,Func,Line])
+ io_lib:format("{~w,~tw,~tw}",[Mod,Func,Line])
end.
downcase(S) -> downcase(S, []).
diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl
index 0f29b2dbb2..8ac467014c 100644
--- a/lib/common_test/src/unix_telnet.erl
+++ b/lib/common_test/src/unix_telnet.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.
@@ -132,25 +132,25 @@ connect1(Name,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Username,Password) ->
Prompt=/=?password ->
{ok,Pid};
Error ->
- log(Name,recv,"Password failed\n~p\n",
+ log(Name,recv,"Password failed\n~tp\n",
[Error]),
{error,Error}
end;
Error ->
- log(Name,recv,"Login to ~p:~p failed\n~p\n",[Ip,Port,Error]),
+ log(Name,recv,"Login to ~p:~p failed\n~tp\n",[Ip,Port,Error]),
{error,Error}
end;
{ok,[{prompt,_OtherPrompt1},{prompt,_OtherPrompt2}],_} ->
{ok,Pid};
Error ->
log(Name,conn_error,
- "Did not get expected prompt from ~p:~p\n~p\n",
+ "Did not get expected prompt from ~p:~p\n~tp\n",
[Ip,Port,Error]),
{error,Error}
end;
Error ->
log(Name,conn_error,
- "Could not open telnet connection to ~p:~p\n~p\n",
+ "Could not open telnet connection to ~p:~p\n~tp\n",
[Ip,Port,Error]),
Error
end,
diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl
index f1c5051164..99a109cfe8 100644
--- a/lib/common_test/src/vts.erl
+++ b/lib/common_test/src/vts.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.
@@ -250,7 +250,7 @@ loop(State) ->
{'EXIT',Pid,Reason} ->
case State#state.test_runner of
Pid ->
- io:format("Test run error: ~p\n",[Reason]),
+ io:format("Test run error: ~tp\n",[Reason]),
loop(State);
_ ->
loop(State)
@@ -551,7 +551,7 @@ case_select(Dir,Suite,Case,N) ->
true = code:add_pathz(Dir),
case catch apply(Suite,all,[]) of
{'EXIT',Reason} ->
- io:format("\n~p\n",[Reason]),
+ io:format("\n~tp\n",[Reason]),
red(["COULD NOT READ TESTCASES!!",br(),
"See erlang shell for info"]);
{skip,_Reason} ->
diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile
index 4f3e0e8266..0d9149f489 100644
--- a/lib/common_test/test/Makefile
+++ b/lib/common_test/test/Makefile
@@ -72,7 +72,8 @@ MODULES= \
ct_release_test_SUITE \
ct_log_SUITE \
ct_SUITE \
- ct_keep_logs_SUITE
+ ct_keep_logs_SUITE \
+ ct_unicode_SUITE
ERL_FILES= $(MODULES:%=%.erl)
HRL_FILES= test_server_test_lib.hrl
diff --git a/lib/common_test/test/ct_config_SUITE.erl b/lib/common_test/test/ct_config_SUITE.erl
index cbbfe408a8..250700741c 100644
--- a/lib/common_test/test/ct_config_SUITE.erl
+++ b/lib/common_test/test/ct_config_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.
@@ -172,10 +172,10 @@ testspec_dynamic(Config) when is_list(Config) ->
%%% HELP FUNCTIONS
%%%-----------------------------------------------------------------
make_spec(DataDir, ConfigDir, Filename, Suites, Config)->
- {ok, Fd} = file:open(filename:join(ConfigDir, Filename), [write]),
- ok = file:write(Fd,
- io_lib:format("{suites, \"~sconfig/test/\", ~p}.~n", [DataDir, Suites])),
- lists:foreach(fun(C)-> ok=file:write(Fd, io_lib:format("~p.~n", [C])) end, Config),
+ {ok, Fd} = file:open(filename:join(ConfigDir, Filename),
+ [write, {encoding,utf8}]),
+ ok = io:format(Fd,"{suites, \"~tsconfig/test/\", ~p}.~n", [DataDir, Suites]),
+ lists:foreach(fun(C)-> ok=io:format(Fd, "~tp.~n", [C]) end, Config),
ok = file:close(Fd).
run_test(Name, Config, CTConfig, SuiteNames)->
diff --git a/lib/common_test/test/ct_keep_logs_SUITE.erl b/lib/common_test/test/ct_keep_logs_SUITE.erl
index 6b7aaa57ac..83b7963d7d 100644
--- a/lib/common_test/test/ct_keep_logs_SUITE.erl
+++ b/lib/common_test/test/ct_keep_logs_SUITE.erl
@@ -72,7 +72,7 @@ keep_logs(Config) ->
LogDir=?config(logdir,Opts),
KeepLogsDir = create_dir(filename:join(LogDir,"keep_logs-")),
Opts1 = lists:keyreplace(logdir,1,Opts,{logdir,KeepLogsDir}),
- ct:log("New LogDir = ~s", [KeepLogsDir]),
+ ct:log("New LogDir = ~ts", [KeepLogsDir]),
%% Create 6 ct_run.* log directories
[ok = ct_test_support:run(Opts1, Config) || _ <- lists:seq(1,3)],
@@ -134,7 +134,7 @@ refresh_logs(Config) ->
LogDir=?config(logdir,Opts0),
KeepLogsDir = create_dir(filename:join(LogDir,"refresh_logs-")),
Opts1 = lists:keyreplace(logdir,1,Opts0,{logdir,KeepLogsDir}),
- ct:log("New LogDir = ~s", [KeepLogsDir]),
+ ct:log("New LogDir = ~ts", [KeepLogsDir]),
%% Create 6 ct_run.* log directories
SuiteOpts = [{suite,Suite},{label,refresh_logs} | Opts1],
diff --git a/lib/common_test/test/ct_netconfc_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE.erl
index 05edb45fe8..e8c7b65140 100644
--- a/lib/common_test/test/ct_netconfc_SUITE.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
index 6a41f0a04c..586589ad40 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.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.
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl
index 3ce2d18c66..cbdb4cf11a 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc_remote_SUITE.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2014-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2014-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.
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
index c40bf9e2cc..63bf9be134 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/ns.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2012-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.
diff --git a/lib/common_test/test/ct_surefire_SUITE.erl b/lib/common_test/test/ct_surefire_SUITE.erl
index 832e105517..a71288fb12 100644
--- a/lib/common_test/test/ct_surefire_SUITE.erl
+++ b/lib/common_test/test/ct_surefire_SUITE.erl
@@ -304,7 +304,7 @@ test_events(Test) ->
check_xml(Case,XmlRe) ->
case filelib:wildcard(XmlRe) of
[] ->
- ct:fail("No xml files found with regexp ~p~n", [XmlRe]);
+ ct:fail("No xml files found with regexp ~tp~n", [XmlRe]);
[_] = Xmls when Case==absolute_path ->
do_check_xml(Case,Xmls);
[_,_] = Xmls ->
@@ -326,12 +326,12 @@ check_xml(Case,XmlRe) ->
%% ...
%% </testsuites>
do_check_xml(Case,[Xml|Xmls]) ->
- ct:log("Checking <a href=~p>~s</a>~n",[Xml,Xml]),
+ ct:log("Checking <a href=~tp>~ts</a>~n",[Xml,Xml]),
{E,_} = xmerl_scan:file(Xml),
Expected = events_to_result(lists:flatten(test_events(Case))),
ParseResult = testsuites(Case,E),
- ct:log("Expecting: ~p~n",[Expected]),
- ct:log("Actual : ~p~n",[ParseResult]),
+ ct:log("Expecting: ~tp~n",[Expected]),
+ ct:log("Actual : ~tp~n",[ParseResult]),
Expected = ParseResult,
do_check_xml(Case,Xmls);
do_check_xml(_,[]) ->
diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl
index ba7aadfeec..44c27e54c2 100644
--- a/lib/common_test/test/ct_test_support.erl
+++ b/lib/common_test/test/ct_test_support.erl
@@ -67,7 +67,7 @@ init_per_suite(Config, Level) ->
end,
case delete_old_logs(os:type(), Config) of
{'EXIT',DelLogsReason} ->
- test_server:format(0, "Failed to delete old log directories: ~p~n",
+ test_server:format(0, "Failed to delete old log directories: ~tp~n",
[DelLogsReason]);
_ ->
ok
@@ -91,7 +91,8 @@ start_slave(NodeName, Config, Level) ->
[_,Host] = string:tokens(atom_to_list(node()), "@"),
test_server:format(0, "Trying to start ~s~n",
[atom_to_list(NodeName)++"@"++Host]),
- case slave:start(Host, NodeName, []) of
+ PR = proplists:get_value(printable_range,Config,io:printable_range()),
+ case slave:start(Host, NodeName, "+pc " ++ atom_to_list(PR)) of
{error,Reason} ->
test_server:fail(Reason);
{ok,CTNode} ->
@@ -119,7 +120,7 @@ start_slave(NodeName, Config, Level) ->
[true = rpc:call(CTNode, code, add_patha, [D]) || D <- PathDirs],
test_server:format(Level, "Dirs added to code path (on ~w):~n",
[CTNode]),
- [io:format("~s~n", [D]) || D <- PathDirs],
+ [io:format("~ts~n", [D]) || D <- PathDirs],
case proplists:get_value(start_sasl, Config) of
true ->
@@ -161,12 +162,12 @@ init_per_testcase(_TestCase, Config) ->
case lists:keysearch(master, 1, Config) of
false->
test_server:format("See Common Test logs here:\n\n"
- "<a href=\"file://~s/all_runs.html\">~s/all_runs.html</a>\n"
- "<a href=\"file://~s/index.html\">~s/index.html</a>",
+ "<a href=\"file://~ts/all_runs.html\">~ts/all_runs.html</a>\n"
+ "<a href=\"file://~ts/index.html\">~ts/index.html</a>",
[LogDir,LogDir,LogDir,LogDir]);
{value, _}->
test_server:format("See CT Master Test logs here:\n\n"
- "<a href=\"file://~s/master_runs.html\">~s/master_runs.html</a>",
+ "<a href=\"file://~ts/master_runs.html\">~ts/master_runs.html</a>",
[LogDir,LogDir])
end,
Config.
@@ -192,11 +193,11 @@ write_testspec(TestSpec, Dir, Name) ->
write_testspec(TestSpec, filename:join(Dir, Name)).
write_testspec(TestSpec, TSFile) ->
- {ok,Dev} = file:open(TSFile, [write]),
- [io:format(Dev, "~p.~n", [Entry]) || Entry <- TestSpec],
+ {ok,Dev} = file:open(TSFile, [write,{encoding,utf8}]),
+ [io:format(Dev, "~tp.~n", [Entry]) || Entry <- TestSpec],
file:close(Dev),
- io:format("Test specification written to: ~p~n", [TSFile]),
- io:format(user, "Test specification written to: ~p~n", [TSFile]),
+ io:format("Test specification written to: ~tp~n", [TSFile]),
+ io:format(user, "Test specification written to: ~tp~n", [TSFile]),
TSFile.
@@ -269,7 +270,7 @@ run(Opts0, Config) when is_list(Opts0) ->
Override =
fun(O={Key,_}, Os) ->
io:format(user, "ADDING START "
- "OPTION: ~p~n", [O]),
+ "OPTION: ~tp~n", [O]),
[O | lists:keydelete(Key, 1, Os)]
end,
lists:foldl(Override, Opts0, OROpts);
@@ -291,14 +292,14 @@ run(Opts0, Config) when is_list(Opts0) ->
run_ct_run_test(Opts,Config) ->
CTNode = proplists:get_value(ct_node, Config),
Level = proplists:get_value(trace_level, Config),
- test_server:format(Level, "~n[RUN #1] Calling ct:run_test(~p) on ~p~n",
+ test_server:format(Level, "~n[RUN #1] Calling ct:run_test(~tp) on ~p~n",
[Opts, CTNode]),
T0 = erlang:monotonic_time(),
CtRunTestResult = rpc:call(CTNode, ct, run_test, [Opts]),
T1 = erlang:monotonic_time(),
Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds),
- test_server:format(Level, "~n[RUN #1] Got return value ~p after ~p ms~n",
+ test_server:format(Level, "~n[RUN #1] Got return value ~tp after ~p ms~n",
[CtRunTestResult,Elapsed]),
case rpc:call(CTNode, erlang, whereis, [ct_util_server]) of
undefined ->
@@ -316,7 +317,7 @@ run_ct_script_start(Opts, Config) ->
CTNode = proplists:get_value(ct_node, Config),
Level = proplists:get_value(trace_level, Config),
Opts1 = [{halt_with,{?MODULE,ct_test_halt}} | Opts],
- test_server:format(Level, "Saving start opts on ~p: ~p~n",
+ test_server:format(Level, "Saving start opts on ~p: ~tp~n",
[CTNode, Opts1]),
rpc:call(CTNode, application, set_env,
[common_test, run_test_start_opts, Opts1]),
@@ -326,7 +327,7 @@ run_ct_script_start(Opts, Config) ->
ExitStatus = rpc:call(CTNode, ct_run, script_start, []),
T1 = erlang:monotonic_time(),
Elapsed = erlang:convert_time_unit(T1-T0, native, milli_seconds),
- test_server:format(Level, "[RUN #2] Got exit status value ~p after ~p ms~n",
+ test_server:format(Level, "[RUN #2] Got exit status value ~tp after ~p ms~n",
[ExitStatus,Elapsed]),
ExitStatus.
@@ -372,12 +373,12 @@ run({M,F,A}, InitCalls, Config) ->
Level = proplists:get_value(trace_level, Config),
lists:foreach(
fun({IM,IF,IA}) ->
- test_server:format(Level, "~nInit call ~w:~w(~p) on ~p...~n",
+ test_server:format(Level, "~nInit call ~w:~tw(~tp) on ~p...~n",
[IM, IF, IA, CTNode]),
Result = rpc:call(CTNode, IM, IF, IA),
- test_server:format(Level, "~n...with result: ~p~n", [Result])
+ test_server:format(Level, "~n...with result: ~tp~n", [Result])
end, InitCalls),
- test_server:format(Level, "~nStarting test with ~w:~w(~p) on ~p~n",
+ test_server:format(Level, "~nStarting test with ~w:~tw(~tp) on ~p~n",
[M, F, A, CTNode]),
rpc:call(CTNode, M, F, A).
@@ -404,7 +405,7 @@ wait_for_ct_stop(Retries, CTNode) ->
Info = (catch process_info(Pid)),
test_server:format(0, "Waiting for CT (~p) to finish (~p)...",
[Pid,Retries]),
- test_server:format(0, "Process info for ~p:~n~p", [Info]),
+ test_server:format(0, "Process info for ~p:~n~tp", [Pid,Info]),
timer:sleep(5000),
wait_for_ct_stop(Retries-1, CTNode)
end.
@@ -414,7 +415,7 @@ wait_for_ct_stop(Retries, CTNode) ->
ct_rpc({M,F,A}, Config) ->
CTNode = proplists:get_value(ct_node, Config),
Level = proplists:get_value(trace_level, Config),
- test_server:format(Level, "~nCalling ~w:~w(~p) on ~p...",
+ test_server:format(Level, "~nCalling ~w:~tw(~tp) on ~p...",
[M,F,A, CTNode]),
rpc:call(CTNode, M, F, A).
@@ -530,7 +531,7 @@ verify_events(TEvs, Evs, Node, Config) ->
verify_events1([TestEv|_], [{TEH,#event{name=stop_logging,node=Node,data=_}}|_], Node, _)
when element(1,TestEv) == TEH, element(2,TestEv) =/= stop_logging ->
- test_server:format("Failed to find ~p in the list of events!~n", [TestEv]),
+ test_server:format("Failed to find ~tp in the list of events!~n", [TestEv]),
exit({event_not_found,TestEv});
verify_events1(TEvs = [TestEv | TestEvs], Evs = [_|Events], Node, Config) ->
@@ -538,8 +539,8 @@ verify_events1(TEvs = [TestEv | TestEvs], Evs = [_|Events], Node, Config) ->
nomatch ->
verify_events1(TEvs, Events, Node, Config);
{'EXIT',Reason} ->
- test_server:format("Failed to find ~p in ~p~n"
- "Reason: ~p~n", [TestEv,Evs,Reason]),
+ test_server:format("Failed to find ~tp in ~tp~n"
+ "Reason: ~tp~n", [TestEv,Evs,Reason]),
exit(Reason);
{Config1,Events1} ->
if is_list(TestEv) ->
@@ -547,13 +548,13 @@ verify_events1(TEvs = [TestEv | TestEvs], Evs = [_|Events], Node, Config) ->
element(1,TestEv) == parallel ; element(1,TestEv) == shuffle ->
ok;
true ->
- test_server:format("Found ~p!", [TestEv])
+ test_server:format("Found ~tp!", [TestEv])
end,
verify_events1(TestEvs, Events1, Node, Config1)
end;
verify_events1([TestEv|_], [], _, _) ->
- test_server:format("Failed to find ~p in the list of events!~n", [TestEv]),
+ test_server:format("Failed to find ~tp in the list of events!~n", [TestEv]),
exit({event_not_found,TestEv});
verify_events1([], Evs, _, Config) ->
@@ -586,8 +587,8 @@ locate(TEvs, Node, Evs, Config) when is_list(TEvs) ->
false ->
nomatch;
true ->
- test_server:format("Found ~p!", [InitStart]),
- test_server:format("Found ~p!", [InitDone]),
+ test_server:format("Found ~tp!", [InitStart]),
+ test_server:format("Found ~tp!", [InitDone]),
verify_events1(TEvs1, Evs1, Node, Config)
end;
_ ->
@@ -635,8 +636,8 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
true
end, Es),
- test_server:format("Found ~p!", [InitStart]),
- test_server:format("Found ~p!", [InitDone]),
+ test_server:format("Found ~tp!", [InitStart]),
+ test_server:format("Found ~tp!", [InitDone]),
{TEs,EvsG};
_ ->
nomatch
@@ -688,10 +689,10 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
[] when Evs2 == [] ->
exit({unmatched,TEv});
[] ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
exit({tc_done_not_found,TEv});
[TcDone|Evs3] ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
RemSize1 = length(Evs3),
if RemSize1 < RemSize ->
{[TcDone|Done],Evs3,RemSize1};
@@ -707,7 +708,7 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
EH == TEH, EvNode == Node, Mod == M,
Func == F, result_match(R, Result)] of
[TcDone|_] ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
{lists:delete(TcDone, Done),RemEvs,RemSize};
[] ->
exit({unmatched,TEv})
@@ -735,7 +736,7 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
[] ->
exit({end_per_group_not_found,TEv});
[_ | RemEvs2] ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
{Done,RemEvs2,length(RemEvs2)}
end;
%% tc_done event for end_per_group
@@ -766,7 +767,7 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
[] ->
exit({end_per_group_not_found,TEv});
[_ | RemEvs2] ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
{Done,RemEvs2,length(RemEvs2)}
end;
%% end_per_group auto- or user skipped
@@ -813,7 +814,7 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
[] ->
exit({unmatched,TEv});
_ ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
Acc
end;
%% start of a sub-group
@@ -866,8 +867,8 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
_ ->
Props = EvProps
end,
- test_server:format("Found ~p!", [InitStart]),
- test_server:format("Found ~p!", [InitDone]),
+ test_server:format("Found ~tp!", [InitStart]),
+ test_server:format("Found ~tp!", [InitDone]),
{TEs,Es};
false ->
nomatch
@@ -908,7 +909,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
[_TcStart, TcDone={TEH,#event{name=tc_done,
node=Node,
data={M,F,_}}} | Evs3] ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
RemSize1 = length(Evs3),
if RemSize1 < RemSize ->
{[TcDone|Done],Evs3,RemSize1};
@@ -924,7 +925,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
EH == TEH, EvNode == Node, Mod == M,
Func == F, result_match(R, Result)] of
[TcDone|_] ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
{lists:delete(TcDone, Done),RemEvs,RemSize};
[] ->
exit({unmatched,TEv})
@@ -965,7 +966,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
_ ->
Props = EvProps1
end,
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
{Done,RemEvs2,length(RemEvs2)}
end;
%% tc_done event for end_per_group
@@ -1009,7 +1010,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
_ ->
Props = EvProps1
end,
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
{Done,RemEvs2,length(RemEvs2)}
end;
%% end_per_group auto-or user skipped
@@ -1050,7 +1051,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
[] ->
exit({unmatched,TEv});
_ ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
Acc
end;
(TEv={TEH,N,D}, Acc) ->
@@ -1061,7 +1062,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
[] ->
exit({unmatched,TEv});
_ ->
- test_server:format("Found ~p!", [TEv]),
+ test_server:format("Found ~tp!", [TEv]),
Acc
end;
%% start of a sub-group
@@ -1232,54 +1233,54 @@ result_match(_, _) ->
log_events(TC, Events, EvLogDir, Opts) ->
LogFile = filename:join(EvLogDir, atom_to_list(TC)++".events"),
- {ok,Dev} = file:open(LogFile, [write]),
+ {ok,Dev} = file:open(LogFile, [write,{encoding,utf8}]),
io:format(Dev, "[~n", []),
log_events1(Events, Dev, " "),
file:close(Dev),
FullLogFile = join_abs_dirs(proplists:get_value(net_dir, Opts),
LogFile),
- ct:log("Events written to logfile: <a href=\"file://~s\">~s</a>~n",
+ ct:log("Events written to logfile: <a href=\"file://~ts\">~ts</a>~n",
[FullLogFile,FullLogFile],[no_css]),
- io:format(user, "Events written to logfile: ~p~n", [LogFile]).
+ io:format(user, "Events written to logfile: ~tp~n", [LogFile]).
log_events1(Evs, Dev, "") ->
log_events1(Evs, Dev, " ");
log_events1([E={_EH,tc_start,{_M,{init_per_group,_GrName,Props}}} | Evs], Dev, Ind) ->
case get_prop(Props) of
undefined ->
- io:format(Dev, "~s[~p,~n", [Ind,E]),
+ io:format(Dev, "~s[~tp,~n", [Ind,E]),
log_events1(Evs, Dev, Ind++" ");
Prop ->
- io:format(Dev, "~s{~w,~n~s[~p,~n", [Ind,Prop,Ind++" ",E]),
+ io:format(Dev, "~s{~w,~n~s[~tp,~n", [Ind,Prop,Ind++" ",E]),
log_events1(Evs, Dev, Ind++" ")
end;
log_events1([E={_EH,tc_done,{_M,{init_per_group,_GrName,_Props},_R}} | Evs], Dev, Ind) ->
- io:format(Dev, "~s~p,~n", [Ind,E]),
+ io:format(Dev, "~s~tp,~n", [Ind,E]),
log_events1(Evs, Dev, Ind++" ");
log_events1([E={_EH,tc_start,{_M,{end_per_group,_GrName,_Props}}} | Evs], Dev, Ind) ->
Ind1 = Ind -- " ",
- io:format(Dev, "~s~p,~n", [Ind1,E]),
+ io:format(Dev, "~s~tp,~n", [Ind1,E]),
log_events1(Evs, Dev, Ind1);
log_events1([E={_EH,tc_done,{_M,{end_per_group,_GrName,Props},_R}} | Evs], Dev, Ind) ->
case get_prop(Props) of
undefined ->
- io:format(Dev, "~s~p],~n", [Ind,E]),
+ io:format(Dev, "~s~tp],~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ");
_Prop ->
- io:format(Dev, "~s~p]},~n", [Ind,E]),
+ io:format(Dev, "~s~tp]},~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ")
end;
log_events1([E={_EH,tc_auto_skip,{_M,{end_per_group,_GrName},_Reason}} | Evs], Dev, Ind) ->
- io:format(Dev, "~s~p],~n", [Ind,E]),
+ io:format(Dev, "~s~tp],~n", [Ind,E]),
log_events1(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]),
+ io:format(Dev, "~s~tp],~n", [Ind,E]),
log_events1(Evs, Dev, Ind--" ");
log_events1([E], Dev, Ind) ->
- io:format(Dev, "~s~p~n].~n", [Ind,E]),
+ io:format(Dev, "~s~tp~n].~n", [Ind,E]),
ok;
log_events1([E | Evs], Dev, Ind) ->
- io:format(Dev, "~s~p,~n", [Ind,E]),
+ io:format(Dev, "~s~tp,~n", [Ind,E]),
log_events1(Evs, Dev, Ind);
log_events1([], _Dev, _Ind) ->
ok.
@@ -1393,10 +1394,10 @@ delete_dirs(LogDir) ->
delete_dirs(_, []) ->
ok;
delete_dirs(LogDir, [Dir | Dirs]) ->
- test_server:format(0, "Removing old log directory: ~s", [Dir]),
+ test_server:format(0, "Removing old log directory: ~ts", [Dir]),
case catch rm_rec(Dir) of
{_,Reason} ->
- test_server:format(0, "Delete failed! (~p)", [Reason]);
+ test_server:format(0, "Delete failed! (~tp)", [Reason]);
ok ->
ok
end,
diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl
index fca5ef3eb3..2d2c42999f 100644
--- a/lib/common_test/test/ct_testspec_1_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_1_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -616,7 +616,7 @@ setup_and_execute(TCName, TestSpec, Config) ->
FullSpecFile = ct_test_support:join_abs_dirs(?config(net_dir, Opts),
SpecFile),
- io:format("~nTest spec created here~n~n<a href=\"file://~s\">~s</a>~n",
+ io:format("~nTest spec created here~n~n<a href=\"file://~ts\">~ts</a>~n",
[FullSpecFile,FullSpecFile]),
ok = ct_test_support:run(Opts, Config),
@@ -638,8 +638,8 @@ setup_and_execute(TCName, TestSpec, Config) ->
create_spec_file(SpecDir, TCName, TestSpec) ->
FileName = filename:join(SpecDir,
atom_to_list(TCName)++".spec"),
- {ok,Dev} = file:open(FileName, [write]),
- [io:format(Dev, "~p.~n", [Term]) || Term <- TestSpec],
+ {ok,Dev} = file:open(FileName, [write,{encoding,utf8}]),
+ [io:format(Dev, "~tp.~n", [Term]) || Term <- TestSpec],
file:close(Dev),
FileName.
diff --git a/lib/common_test/test/ct_unicode_SUITE.erl b/lib/common_test/test/ct_unicode_SUITE.erl
new file mode 100644
index 0000000000..355503a5dc
--- /dev/null
+++ b/lib/common_test/test/ct_unicode_SUITE.erl
@@ -0,0 +1,218 @@
+%%
+%% %CopyrightBegin%
+%%
+%% 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.
+%% 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: ct_unicode_SUITE
+%%%
+%%% Description:
+%%% Test that common_test handles and logs unicode strings and atoms
+%%% correctly.
+%%%
+%%% The suite used for the test is located in the data directory.
+%%%-------------------------------------------------------------------
+-module(ct_unicode_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+-define(eh, ct_test_support_eh).
+
+%%--------------------------------------------------------------------
+%% TEST SERVER CALLBACK FUNCTIONS
+%%--------------------------------------------------------------------
+
+%%--------------------------------------------------------------------
+%% Description: Since Common Test starts another Test Server
+%% instance, the tests need to be performed on a separate node (or
+%% there will be clashes with logging processes etc).
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+ case file:native_name_encoding() of
+ latin1 -> {skip,"Test is not applicable on latin1 file system"};
+ _ ->
+ ct_test_support:init_per_suite([{printable_range,unicode}|Config])
+ end.
+
+end_per_suite(Config) ->
+ ct_test_support:end_per_suite(Config).
+
+init_per_testcase(TestCase, Config) ->
+ ct_test_support:init_per_testcase(TestCase, Config).
+
+end_per_testcase(TestCase, Config) ->
+ ct_test_support:end_per_testcase(TestCase, Config).
+
+suite() -> [].
+
+all() ->
+ [unicode_atoms_SUITE,
+ unicode_spec].
+
+%%--------------------------------------------------------------------
+%% TEST CASES
+%%--------------------------------------------------------------------
+unicode_atoms_SUITE(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ run_test(unicode_atoms_SUITE,
+ [{dir,DataDir},{suite,unicode_atoms_SUITE}], Config).
+
+unicode_spec(Config) ->
+ DataDir = ?config(data_dir,Config),
+ PrivDir = ?config(priv_dir,Config),
+ CfgName = "unicode_αβ.cfg",
+ Cfg = io_lib:format("{~tw,[{~tw,\"~ts\"}]}.~n",
+ ['key_αβ','subkey_αβ',"value_αβ"]),
+ ok = file:write_file(filename:join(PrivDir,CfgName),
+ unicode:characters_to_binary(Cfg)),
+ TestSpec = [{cases, DataDir, unicode_atoms_SUITE, ['config_αβ']},
+ {config, PrivDir, CfgName}],
+ TestSpecName = ct_test_support:write_testspec(TestSpec, PrivDir,
+ "unicode_αβ.spec"),
+ run_test(unicode_spec,[{spec,TestSpecName}],Config).
+
+%%%-----------------------------------------------------------------
+%%% HELP FUNCTIONS
+%%%-----------------------------------------------------------------
+run_test(Label, Test, Config) ->
+ {Opts,ERPid} = setup_env([{label,Label}|Test], Config),
+ ok = ct_test_support:run(Opts, Config),
+ TestEvents = ct_test_support:get_events(ERPid, Config),
+ ct_test_support:log_events(Label,
+ reformat_events(TestEvents, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
+ ExpEvents = events_to_check(Label),
+ ok = ct_test_support:verify_events(ExpEvents, TestEvents, Config),
+ check_logs([_,_]=get_log_dirs(TestEvents)).
+
+setup_env(Test, Config) ->
+ Opts0 = ct_test_support:get_opts(Config),
+ Level = ?config(trace_level, Config),
+ EvHArgs = [{cbm,ct_test_support},{trace_level,Level}],
+ Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test],
+ ERPid = ct_test_support:start_event_receiver(Config),
+ {Opts,ERPid}.
+
+reformat_events(Events, EH) ->
+ ct_test_support:reformat(Events, EH).
+
+get_log_dirs([{?eh,#event{name=start_logging,data=LogDir}}|Events]) ->
+ [LogDir|get_log_dirs(Events)];
+get_log_dirs([_|Events]) ->
+ get_log_dirs(Events);
+get_log_dirs([]) ->
+ [].
+
+%%%-----------------------------------------------------------------
+%%% TEST EVENTS
+%%%-----------------------------------------------------------------
+events_to_check(Test) ->
+ %% 2 tests (ct:run_test + script_start) is default
+ events_to_check(Test, 2).
+
+events_to_check(_, 0) ->
+ [];
+events_to_check(Test, N) ->
+ test_events(Test) ++ events_to_check(Test, N-1).
+
+test_events(unicode_atoms_SUITE) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,start_info,{1,1,6}},
+ {?eh,tc_start,{unicode_atoms_SUITE,init_per_suite}},
+ {?eh,tc_done,{unicode_atoms_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{unicode_atoms_SUITE,'test_αβ'}},
+ {?eh,tc_done,{unicode_atoms_SUITE,'test_αβ',ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ {?eh,tc_start,{unicode_atoms_SUITE,'fail_αβ_1'}},
+ {?eh,tc_done,{unicode_atoms_SUITE,'fail_αβ_1','_'}},
+ {?eh,test_stats,{1,1,{0,0}}},
+ {?eh,tc_start,{unicode_atoms_SUITE,'fail_αβ_2'}},
+ {?eh,tc_done,{unicode_atoms_SUITE,'fail_αβ_2','_'}},
+ {?eh,test_stats,{1,2,{0,0}}},
+ {?eh,tc_start,{unicode_atoms_SUITE,'fail_αβ_3'}},
+ {?eh,tc_done,{unicode_atoms_SUITE,'fail_αβ_3','_'}},
+ {?eh,test_stats,{1,3,{0,0}}},
+ {?eh,tc_start,{unicode_atoms_SUITE,'fail_αβ_4'}},
+ {?eh,tc_done,{unicode_atoms_SUITE,'fail_αβ_4','_'}},
+ {?eh,test_stats,{1,4,{0,0}}},
+ {?eh,tc_start,{unicode_atoms_SUITE,'skip_αβ'}},
+ {?eh,tc_done,{unicode_atoms_SUITE,'skip_αβ','_'}},
+ {?eh,test_stats,{1,4,{1,0}}},
+ {?eh,tc_start,{unicode_atoms_SUITE,end_per_suite}},
+ {?eh,tc_done,{unicode_atoms_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,stop_logging,[]}
+ ];
+test_events(unicode_spec) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{unicode_atoms_SUITE,init_per_suite}},
+ {?eh,tc_done,{unicode_atoms_SUITE,init_per_suite,ok}},
+ {?eh,tc_start,{unicode_atoms_SUITE,'config_αβ'}},
+ {?eh,tc_done,{unicode_atoms_SUITE,'config_αβ',ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ {?eh,tc_start,{unicode_atoms_SUITE,end_per_suite}},
+ {?eh,tc_done,{unicode_atoms_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,stop_logging,[]}
+ ].
+
+%%%-----------------------------------------------------------------
+%%% Check logs for escaped unicode characters
+check_logs(Dirs) ->
+ ct:log("Checking logs for escaped unicode characters (αβ).~nDirs:~n~tp",
+ [Dirs]),
+ {ok,RE} = re:compile(<<"x{3B[12]}"/utf8>>),
+ case check_logs1(RE,Dirs,[]) of
+ [] ->
+ ok;
+ Match ->
+ MatchStr = string:join(Match,"\n"),
+ ct:log("ERROR: Escaped unicode characters found in:~n~ts",[MatchStr]),
+ ct:fail(escaped_unicode_characters_found)
+ end.
+
+check_logs1(RE,[F|Fs],Match) ->
+ New = case filelib:is_dir(F) of
+ true ->
+ {ok,Files} = file:list_dir(F),
+ check_logs1(RE,[filename:join(F,File)||File<-Files],[]);
+ false ->
+ check_log(RE,F)
+ end,
+ check_logs1(RE,Fs,New++Match);
+check_logs1(_RE,[],Match) ->
+ Match.
+
+check_log(RE,F) ->
+ {ok,Bin} = file:read_file(F),
+ case re:run(Bin,RE,[{capture,none}]) of
+ match ->
+ [F];
+ nomatch ->
+ []
+ end.
diff --git a/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl b/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl
new file mode 100644
index 0000000000..993452500e
--- /dev/null
+++ b/lib/common_test/test/ct_unicode_SUITE_data/unicode_atoms_SUITE.erl
@@ -0,0 +1,98 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009-2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(unicode_atoms_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_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, _Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+groups() ->
+ [].
+
+all() ->
+ ['test_αβ',
+ 'fail_αβ_1',
+ 'fail_αβ_2',
+ 'fail_αβ_3',
+ 'fail_αβ_4',
+ 'skip_αβ'].
+
+'test_αβ'(_Config) ->
+ ct:log("This is test case ~tw",[?FUNCTION_NAME]),
+ ok.
+
+'fail_αβ_1'(_Config) ->
+ ct:log("This is test case ~tw",[?FUNCTION_NAME]),
+ 'α' = 'β',
+ ok.
+
+'fail_αβ_2'(_Config) ->
+ ct:log("This is test case ~tw",[?FUNCTION_NAME]),
+ ct:fail({failing,testcase,?FUNCTION_NAME}),
+ ok.
+
+'fail_αβ_3'(_Config) ->
+ ct:log("This is test case ~tw",[?FUNCTION_NAME]),
+ exit({exiting,testcase,?FUNCTION_NAME}),
+ ok.
+
+'fail_αβ_4'(_Config) ->
+ ct:log("This is test case ~tw",[?FUNCTION_NAME]),
+ S = try throw(ok) catch throw:ok -> erlang:get_stacktrace() end,
+ erlang:raise(error,{error,testcase,?FUNCTION_NAME},S),
+ ok.
+
+'skip_αβ'(_Config) ->
+ ct:log("This is test case ~tw",[?FUNCTION_NAME]),
+ {skip,"Skipping " ++ atom_to_list(?FUNCTION_NAME)}.
+
+
+%% This should not be listed in all/0. It is only to be run explicitly
+%% using a test spec where the config file is declared as well.
+'config_αβ'() ->
+ [{require,'alias_αβ','key_αβ'}].
+'config_αβ'(_Config) ->
+ ct:log("This is test case ~tw",[?FUNCTION_NAME]),
+ Conf = ct:get_config('alias_αβ'),
+ Conf = ct:get_config('key_αβ'),
+ ct:log("Required config: ~tp",[Conf]),
+ ok.
diff --git a/lib/common_test/test/ct_verbosity_SUITE.erl b/lib/common_test/test/ct_verbosity_SUITE.erl
index b9298e54ca..095cd1b70b 100644
--- a/lib/common_test/test/ct_verbosity_SUITE.erl
+++ b/lib/common_test/test/ct_verbosity_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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,8 +47,8 @@
init_per_suite(Config) ->
DataDir = ?config(data_dir, Config),
EvH = filename:join(DataDir,"simple_evh.erl"),
- ct:pal("Compiling ~s: ~p", [EvH,compile:file(EvH,[{outdir,DataDir},
- debug_info])]),
+ ct:pal("Compiling ~ts: ~p", [EvH,compile:file(EvH,[{outdir,DataDir},
+ debug_info])]),
ct_test_support:init_per_suite([{path_dirs,[DataDir]} | Config]).
end_per_suite(Config) ->
diff --git a/lib/common_test/test/erl2html2_SUITE.erl b/lib/common_test/test/erl2html2_SUITE.erl
index bdce43c9c9..53a63578b2 100644
--- a/lib/common_test/test/erl2html2_SUITE.erl
+++ b/lib/common_test/test/erl2html2_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2012-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.
@@ -163,9 +163,9 @@ convert_module(Mod,InclDirs,Config) ->
PrivDir = ?config(priv_dir,Config),
Src = filename:join(DataDir,Mod++".erl"),
Dst = filename:join(PrivDir,Mod++".erl.html"),
- io:format("<a href=\"~s\">~s</a>\n",[Src,filename:basename(Src)]),
+ io:format("<a href=\"~ts\">~s</a>\n",[Src,filename:basename(Src)]),
ok = erl2html2:convert(Src, Dst, InclDirs, "<html><body>"),
- io:format("<a href=\"~s\">~s</a>\n",[Dst,filename:basename(Dst)]),
+ io:format("<a href=\"~ts\">~s</a>\n",[Dst,filename:basename(Dst)]),
{Src,Dst}.
%% Check that there are the same number of lines in each file, and
diff --git a/lib/common_test/test/test_server_test_lib.erl b/lib/common_test/test/test_server_test_lib.erl
index cf5951ae03..c18b89b178 100644
--- a/lib/common_test/test/test_server_test_lib.erl
+++ b/lib/common_test/test/test_server_test_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -81,7 +81,7 @@ prepare_tester_node(Node,Config) ->
[true = rpc:call(Node, code, add_patha, [D]) || D <- PathDirs],
io:format("Dirs added to code path (on ~w):~n",
[Node]),
- [io:format("~s~n", [D]) || D <- PathDirs],
+ [io:format("~ts~n", [D]) || D <- PathDirs],
true = rpc:call(Node, os, putenv,
["TEST_SERVER_FRAMEWORK", "undefined"]),
diff --git a/lib/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl
index 5734bd0787..c4e0223ac7 100644
--- a/lib/common_test/test_server/ts_install.erl
+++ b/lib/common_test/test_server/ts_install.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.
@@ -136,7 +136,7 @@ unix_autoconf(XConf) ->
true ->
OSXEnv = macosx_cflags(),
UnQuotedEnv = assign_vars(unquote(Env++OSXEnv)),
- io:format("Running ~s~nEnv: ~p~n",
+ io:format("Running ~ts~nEnv: ~p~n",
[lists:flatten(Configure ++ Args),UnQuotedEnv]),
Port = open_port({spawn, lists:flatten(["\"",Configure,"\"",Args])},
[stream, eof, {env,UnQuotedEnv}]),
diff --git a/lib/common_test/test_server/ts_make.erl b/lib/common_test/test_server/ts_make.erl
index 456e913c39..ad5b75b529 100644
--- a/lib/common_test/test_server/ts_make.erl
+++ b/lib/common_test/test_server/ts_make.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.
@@ -42,7 +42,7 @@ unmake(Config) when is_list(Config) ->
make(Make, Dir, Makefile) ->
{RunFile, RunCmd, Script} = run_make_script(os:type(), Make, Dir, Makefile),
- case file:write_file(RunFile, Script) of
+ case file:write_file(RunFile, unicode:characters_to_binary(Script)) of
ok ->
Log = filename:join(Dir, "make.log"),
file:delete(Log),
diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk
index e6ae8b2e7a..9fc3f7f797 100644
--- a/lib/common_test/vsn.mk
+++ b/lib/common_test/vsn.mk
@@ -1 +1 @@
-COMMON_TEST_VSN = 1.14
+COMMON_TEST_VSN = 1.15.1
diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml
index 1dc0c808e7..f3d42a909b 100644
--- a/lib/compiler/doc/src/notes.xml
+++ b/lib/compiler/doc/src/notes.xml
@@ -32,6 +32,180 @@
<p>This document describes the changes made to the Compiler
application.</p>
+<section><title>Compiler 7.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>For many releases, it has been legal to override a BIF
+ with a local function having the same name. However,
+ calling a local function with the same name as guard BIF
+ as filter in a list comprehension was not allowed.</p>
+ <p>
+ Own Id: OTP-13690</p>
+ </item>
+ <item>
+ <p>compile:forms/2 would not return the module name as
+ documented when one of the options '<c>from_core</c>',
+ '<c>from_asm</c>', or '<c>from_beam</c>' was given. Also,
+ the compiler would crash if one of those options was
+ combined with '<c>native</c>'.</p>
+ <p>
+ Own Id: OTP-14408 Aux Id: ERL-417 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Optimized test for tuples with an atom as first element.</p>
+ <p>
+ Own Id: OTP-12148</p>
+ </item>
+ <item>
+ <p>
+ Compilation of modules with huge literal binary strings
+ is now much faster.</p>
+ <p>
+ Own Id: OTP-13794</p>
+ </item>
+ <item>
+ <p>Replaced usage of deprecated symbolic <seealso
+ marker="erts:erlang#type-time_unit"><c>time
+ unit</c></seealso> representations.</p>
+ <p>
+ Own Id: OTP-13831 Aux Id: OTP-13735 </p>
+ </item>
+ <item>
+ <p>The undocumented and unsupported module
+ <c>sys_pre_expand</c> has been removed. As a partial
+ replacement for the functionality, there is a new
+ function <c>erl_internal:add_predefined_functions/1</c>
+ and <c>erl_expand_records</c> will now add a module
+ prefix to calls to BIFs and imported functions.</p>
+ <p>
+ Own Id: OTP-13856</p>
+ </item>
+ <item>
+ <p>The internal compiler passes now start all generated
+ variables with "@" to avoid any conflicts with variables
+ in languages such as Elixir or LFE.</p>
+ <p>
+ Own Id: OTP-13924</p>
+ </item>
+ <item>
+ <p>The function <c>fmod/2</c> has been added to the
+ <c>math</c> module.</p>
+ <p>
+ Own Id: OTP-14000</p>
+ </item>
+ <item>
+ <p>Code generation for complicated guards have been
+ improved.</p>
+ <p>
+ Own Id: OTP-14042</p>
+ </item>
+ <item>
+ <p>
+ The compiler has new warnings for repeated identical map
+ keys.</p>
+ <p>
+ A map expression such as,</p>
+ <p>
+ <c> #{'a' => 1, 'b' => 2, 'a' => 3}.</c></p>
+ <p>
+ will produce a warning for the repeated key 'a'.</p>
+ <p>
+ Own Id: OTP-14058</p>
+ </item>
+ <item>
+ <p>By default, there will now be a warning when
+ <c>export_all</c> is used. The warning can be disabled
+ using <c>nowarn_export_all</c>.</p>
+ <p>
+ Own Id: OTP-14071</p>
+ </item>
+ <item>
+ <p>
+ Optimize maps pattern matching by only examining the
+ common keys in each clause first instead of all keys.
+ This will reduce the number of lookups of each key in
+ maps pattern matching.</p>
+ <p>
+ Own Id: OTP-14072</p>
+ </item>
+ <item>
+ <p>There is a new '<c>deterministic</c>' option to omit
+ '<c>source</c>' and '<c>options</c>' tuples in the BEAM
+ file.</p>
+ <p>
+ Own Id: OTP-14087</p>
+ </item>
+ <item>
+ <p>
+ Analyzing modules with binary construction with huge
+ strings is now much faster. The compiler also compiles
+ such modules slightly faster.</p>
+ <p>
+ Own Id: OTP-14125 Aux Id: ERL-308 </p>
+ </item>
+ <item>
+ <p>Atoms may now contain arbitrary Unicode
+ characters.</p>
+ <p>
+ Own Id: OTP-14178</p>
+ </item>
+ <item>
+ <p><c>compile:file/2</c> now accepts the option
+ <c>extra_chunks</c> to include extra chunks in the BEAM
+ file.</p>
+ <p>
+ Own Id: OTP-14221</p>
+ </item>
+ <item>
+ <p>The format of debug information that is stored in BEAM
+ files (when <c>debug_info</c> is used) has been changed.
+ The purpose of the change is to better support other
+ BEAM-based languages such as Elixir or LFE.</p>
+ <p>All tools included in OTP (dialyzer, debugger, cover,
+ and so on) will handle both the new format and the
+ previous format. Tools that retrieve the debug
+ information using <c>beam_lib:chunk(Beam,
+ [abstract_code])</c> will continue to work with both the
+ new and old format. Tools that call
+ <c>beam_lib:chunk(Beam, ["Abst"])</c> will not work with
+ the new format.</p>
+ <p>For more information, see the description of
+ <c>debug_info</c> in the documentation for
+ <c>beam_lib</c> and the description of the
+ <c>{debug_info,{Backend,Data}}</c> option in the
+ documentation for <c>compile</c>.</p>
+ <p>
+ Own Id: OTP-14369 Aux Id: PR-1367 </p>
+ </item>
+ <item>
+ <p>In a future release, <c>erlang:get_stacktrace/0</c>
+ will probably only work when called from within a
+ '<c>try</c>' expression (otherwise it will return
+ <c>[]</c>.</p>
+ <p>To help prepare for that change, the compiler will now
+ by default warn if '<c>get_stacktrace/0</c>' is used in a
+ way that will not work in the future. Note that the
+ warning will not be issued if '<c>get_stacktrace/0</c>'
+ is used in a function that uses neither '<c>catch</c>'
+ nor '<c>try</c>' (because that could be a legal use if
+ the function is called from within a '<c>try</c>'.</p>
+ <p>
+ Own Id: OTP-14401</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Compiler 7.0.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 59b80ade5d..ef6db66ff6 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -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.
@@ -83,6 +83,7 @@ MODULES = \
core_scan \
erl_bifs \
rec_env \
+ sys_core_bsm \
sys_core_dsetel \
sys_core_fold \
sys_core_fold_lists \
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index c6e61d543e..aa2d224bb4 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -264,9 +264,9 @@ format_error({delete_temp,File,Error}) ->
io_lib:format("failed to delete temporary file ~ts: ~ts",
[File,file:format_error(Error)]);
format_error({parse_transform,M,R}) ->
- io_lib:format("error in parse transform '~s': ~tp", [M, R]);
+ io_lib:format("error in parse transform '~ts': ~tp", [M, R]);
format_error({undef_parse_transform,M}) ->
- io_lib:format("undefined parse transform '~s'", [M]);
+ io_lib:format("undefined parse transform '~ts'", [M]);
format_error({core_transform,M,R}) ->
io_lib:format("error in core transform '~s': ~tp", [M, R]);
format_error({crash,Pass,Reason}) ->
@@ -718,8 +718,10 @@ core_passes() ->
| kernel_passes()].
kernel_passes() ->
- %% Destructive setelement/3 optimization and core lint.
- [{pass,sys_core_dsetel},
+ %% Optimizations that must be done after all other optimizations.
+ [{pass,sys_core_bsm},
+ {iff,dcbsm,{listing,"core_bsm"}},
+ {pass,sys_core_dsetel},
{iff,dsetel,{listing,"dsetel"}},
{iff,clint,?pass(core_lint_module)},
@@ -1919,6 +1921,7 @@ pre_load() ->
erl_lint,
erl_parse,
erl_scan,
+ sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
v3_codegen,
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 3961b2af86..3139d68902 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -1,7 +1,7 @@
% This is an -*- erlang -*- file.
%% %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.
@@ -58,6 +58,7 @@
core_lib,
erl_bifs,
rec_env,
+ sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
sys_core_fold_lists,
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 9efb9ad6f8..b5688de339 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1998-2016. All Rights Reserved.
+# Copyright Ericsson AB 1998-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.
diff --git a/lib/compiler/src/sys_core_bsm.erl b/lib/compiler/src/sys_core_bsm.erl
new file mode 100644
index 0000000000..3e04cc33df
--- /dev/null
+++ b/lib/compiler/src/sys_core_bsm.erl
@@ -0,0 +1,355 @@
+%%
+%% %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%
+%%
+%% Purpose : Optimize bit syntax matching.
+
+
+-module(sys_core_bsm).
+-export([module/2,format_error/1]).
+
+-include("core_parse.hrl").
+-import(lists, [member/2,nth/2,reverse/1,usort/1]).
+
+-spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}.
+
+module(#c_module{defs=Ds0}=Mod, Opts) ->
+ {Ds,Ws0} = function(Ds0, [], []),
+ case member(bin_opt_info, Opts) of
+ false ->
+ {ok,Mod#c_module{defs=Ds}};
+ true ->
+ Ws1 = [make_warning(Where, What) || {Where,What} <- Ws0],
+ Ws = usort(Ws1),
+ {ok,Mod#c_module{defs=Ds},Ws}
+ end.
+
+function([{#c_var{name={F,Arity}}=Name,B0}|Fs], FsAcc, Ws0) ->
+ try cerl_trees:mapfold(fun bsm_an/2, Ws0, B0) of
+ {B,Ws} ->
+ function(Fs, [{Name,B}|FsAcc], Ws)
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [F,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end;
+function([], Fs, Ws) ->
+ {reverse(Fs),Ws}.
+
+-type error() :: atom().
+-spec format_error(error()) -> nonempty_string().
+
+format_error(bin_opt_alias) ->
+ "INFO: the '=' operator will prevent delayed sub binary optimization";
+format_error(bin_partition) ->
+ "INFO: matching non-variables after a previous clause matching a variable "
+ "will prevent delayed sub binary optimization";
+format_error(bin_left_var_used_in_guard) ->
+ "INFO: a variable to the left of the binary pattern is used in a guard; "
+ "will prevent delayed sub binary optimization";
+format_error(bin_argument_order) ->
+ "INFO: matching anything else but a plain variable to the left of "
+ "binary pattern will prevent delayed sub binary optimization; "
+ "SUGGEST changing argument order";
+format_error(bin_var_used) ->
+ "INFO: using a matched out sub binary will prevent "
+ "delayed sub binary optimization";
+format_error(orig_bin_var_used_in_guard) ->
+ "INFO: using the original binary variable in a guard will prevent "
+ "delayed sub binary optimization";
+format_error(bin_var_used_in_guard) ->
+ "INFO: using a matched out sub binary in a guard will prevent "
+ "delayed sub binary optimization".
+
+
+%%%
+%%% Annotate bit syntax matching to faciliate optimization in further passes.
+%%%
+
+bsm_an(Core0, Ws0) ->
+ case bsm_an(Core0) of
+ {ok,Core} ->
+ {Core,Ws0};
+ {ok,Core,W} ->
+ {Core,[W|Ws0]}
+ end.
+
+bsm_an(#c_case{arg=#c_var{}=V}=Case) ->
+ bsm_an_1([V], Case);
+bsm_an(#c_case{arg=#c_values{es=Es}}=Case) ->
+ bsm_an_1(Es, Case);
+bsm_an(Other) ->
+ {ok,Other}.
+
+bsm_an_1(Vs, #c_case{clauses=Cs}=Case) ->
+ case bsm_leftmost(Cs) of
+ none -> {ok,Case};
+ Pos -> bsm_an_2(Vs, Cs, Case, Pos)
+ end.
+
+bsm_an_2(Vs, Cs, Case, Pos) ->
+ case bsm_nonempty(Cs, Pos) of
+ true -> bsm_an_3(Vs, Cs, Case, Pos);
+ false -> {ok,Case}
+ end.
+
+bsm_an_3(Vs, Cs, Case, Pos) ->
+ try
+ bsm_ensure_no_partition(Cs, Pos),
+ {ok,bsm_do_an(Vs, Pos, Cs, Case)}
+ catch
+ throw:{problem,Where,What} ->
+ {ok,Case,{Where,What}}
+ end.
+
+bsm_do_an(Vs0, Pos, Cs0, Case) ->
+ case nth(Pos, Vs0) of
+ #c_var{name=Vname}=V0 ->
+ Cs = bsm_do_an_var(Vname, Pos, Cs0, []),
+ V = bsm_annotate_for_reuse(V0),
+ Bef = lists:sublist(Vs0, Pos-1),
+ Aft = lists:nthtail(Pos, Vs0),
+ case Bef ++ [V|Aft] of
+ [_] ->
+ Case#c_case{arg=V,clauses=Cs};
+ Vs ->
+ Case#c_case{arg=#c_values{es=Vs},clauses=Cs}
+ end;
+ _ ->
+ Case
+ end.
+
+bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) ->
+ case nth(S, Ps) of
+ #c_var{name=VarName} ->
+ case core_lib:is_var_used(V, G) of
+ true -> bsm_problem(C0, orig_bin_var_used_in_guard);
+ false -> ok
+ end,
+ case core_lib:is_var_used(VarName, G) of
+ true -> bsm_problem(C0, bin_var_used_in_guard);
+ false -> ok
+ end,
+ B1 = bsm_maybe_ctx_to_binary(VarName, B0),
+ B = bsm_maybe_ctx_to_binary(V, B1),
+ C = C0#c_clause{body=B},
+ bsm_do_an_var(V, S, Cs, [C|Acc]);
+ #c_alias{}=P ->
+ case bsm_could_match_binary(P) of
+ false ->
+ bsm_do_an_var(V, S, Cs, [C0|Acc]);
+ true ->
+ bsm_problem(C0, bin_opt_alias)
+ end;
+ P ->
+ case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
+ false ->
+ bsm_do_an_var(V, S, Cs, [C0|Acc]);
+ true ->
+ bsm_problem(C0, bin_var_used)
+ end
+ end;
+bsm_do_an_var(_, _, [], Acc) -> reverse(Acc).
+
+bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
+ Var#c_var{anno=[reuse_for_context|Anno]}.
+
+bsm_is_var_used(V, G, B) ->
+ core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B).
+
+bsm_maybe_ctx_to_binary(V, B) ->
+ case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of
+ false ->
+ B;
+ true ->
+ #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
+ args=[#c_var{name=V}]},
+ body=B}
+ end.
+
+previous_ctx_to_binary(V, Core) ->
+ case Core of
+ #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
+ args=[#c_var{name=V}]}} ->
+ true;
+ _ ->
+ false
+ end.
+
+%% bsm_leftmost(Cs) -> none | ArgumentNumber
+%% Find the leftmost argument that does binary matching. Return
+%% the number of the argument (1-N).
+
+bsm_leftmost(Cs) ->
+ bsm_leftmost_1(Cs, none).
+
+bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) ->
+ bsm_leftmost_2(Ps, Cs, 1, Pos);
+bsm_leftmost_1([], Pos) -> Pos.
+
+bsm_leftmost_2(_, Cs, Pos, Pos) ->
+ bsm_leftmost_1(Cs, Pos);
+bsm_leftmost_2([#c_binary{}|_], Cs, N, _) ->
+ bsm_leftmost_1(Cs, N);
+bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
+ bsm_leftmost_2(Ps, Cs, N+1, Pos);
+bsm_leftmost_2([], Cs, _, Pos) ->
+ bsm_leftmost_1(Cs, Pos).
+
+%% bsm_nonempty(Cs, Pos) -> true|false
+%% Check if at least one of the clauses matches a non-empty
+%% binary in the given argument position.
+%%
+bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
+ case nth(Pos, Ps) of
+ #c_binary{segments=[_|_]} ->
+ true;
+ _ ->
+ bsm_nonempty(Cs, Pos)
+ end;
+bsm_nonempty([], _ ) -> false.
+
+%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem)
+%% We must make sure that matching is not partitioned between
+%% variables like this:
+%% foo(<<...>>) -> ...
+%% foo(<Variable>) when ... -> ...
+%% foo(<Any non-variable pattern>) ->
+%% If there is such partition, we are not allowed to reuse the binary variable
+%% for the match context.
+%%
+%% Also, arguments to the left of the argument that is matched
+%% against a binary, are only allowed to be simple variables, not
+%% used in guards. The reason is that we must know that the binary is
+%% only matched in one place (i.e. there must be only one bs_start_match2
+%% instruction emitted).
+
+bsm_ensure_no_partition(Cs, Pos) ->
+ bsm_ensure_no_partition_1(Cs, Pos, before).
+
+%% Loop through each clause.
+bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) ->
+ State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0),
+ case State of
+ 'after' ->
+ bsm_ensure_no_partition_after(Cs, Pos);
+ _ ->
+ ok
+ end,
+ bsm_ensure_no_partition_1(Cs, Pos, State);
+bsm_ensure_no_partition_1([], _, _) -> ok.
+
+%% Loop through each pattern for this clause.
+bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) ->
+ case State of
+ before when Vstate =:= simple_vars -> within;
+ before -> bsm_problem(Where, Vstate);
+ within when Vstate =:= simple_vars -> within;
+ within -> bsm_problem(Where, Vstate)
+ end;
+bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) ->
+ %% Retrieve the real pattern that the alias refers to and check that.
+ P = bsm_real_pattern(Alias),
+ bsm_ensure_no_partition_2([P], 1, N, Vstate, State);
+bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) ->
+ %% No binary matching yet - therefore no partition.
+ State;
+bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
+ case bsm_could_match_binary(P) of
+ false ->
+ %% If clauses can be freely arranged (Vstate =:= simple_vars),
+ %% a clause that cannot match a binary will not partition the clause.
+ %% Example:
+ %%
+ %% a(Var, <<>>) -> ...
+ %% a(Var, []) -> ...
+ %% a(Var, <<B>>) -> ...
+ %%
+ %% But if the clauses can't be freely rearranged, as in
+ %%
+ %% b(Var, <<X>>) -> ...
+ %% b(1, 2) -> ...
+ %%
+ %% we do have a problem.
+ %%
+ case Vstate of
+ simple_vars -> State;
+ _ -> bsm_problem(P, Vstate)
+ end;
+ true ->
+ %% The pattern P *may* match a binary, so we must update the state.
+ %% (P must be a variable.)
+ case State of
+ within -> 'after';
+ 'after' -> 'after'
+ end
+ end;
+bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) ->
+ case core_lib:is_var_used(V, G) of
+ false ->
+ bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S);
+ true ->
+ bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S)
+ end;
+bsm_ensure_no_partition_2([_|Ps], N, G, _, S) ->
+ bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S).
+
+bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) ->
+ case nth(Pos, Ps) of
+ #c_var{} ->
+ bsm_ensure_no_partition_after(Cs, Pos);
+ _ ->
+ bsm_problem(C, bin_partition)
+ end;
+bsm_ensure_no_partition_after([], _) -> ok.
+
+bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
+bsm_could_match_binary(#c_cons{}) -> false;
+bsm_could_match_binary(#c_tuple{}) -> false;
+bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit);
+bsm_could_match_binary(_) -> true.
+
+bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P);
+bsm_real_pattern(P) -> P.
+
+bsm_problem(Where, What) ->
+ throw({problem,Where,What}).
+
+make_warning(Core, Term) ->
+ case should_suppress_warning(Core) of
+ true ->
+ ok;
+ false ->
+ Anno = cerl:get_ann(Core),
+ Line = get_line(Anno),
+ File = get_file(Anno),
+ {File,[{Line,?MODULE,Term}]}
+ end.
+
+should_suppress_warning(Core) ->
+ Ann = cerl:get_ann(Core),
+ member(compiler_generated, Ann).
+
+get_line([Line|_]) when is_integer(Line) -> Line;
+get_line([_|T]) -> get_line(T);
+get_line([]) -> none.
+
+get_file([{file,File}|_]) -> File;
+get_file([_|T]) -> get_file(T);
+get_file([]) -> "no_file". % should not happen
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 3673a339f6..d73060fb7e 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.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.
@@ -71,7 +71,7 @@
-export([module/2,format_error/1]).
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
- reverse/1,reverse/2,member/2,nth/2,flatten/1,
+ reverse/1,reverse/2,member/2,flatten/1,
unzip/1,keyfind/3]).
-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]).
@@ -107,7 +107,6 @@
{'ok', cerl:c_module(), [_]}.
module(#c_module{defs=Ds0}=Mod, Opts) ->
- put(bin_opt_info, member(bin_opt_info, Opts)),
put(no_inline_list_funcs, not member(inline_list_funcs, Opts)),
case get(new_var_num) of
undefined -> put(new_var_num, 0);
@@ -116,7 +115,6 @@ module(#c_module{defs=Ds0}=Mod, Opts) ->
init_warnings(),
Ds1 = [function_1(D) || D <- Ds0],
erase(no_inline_list_funcs),
- erase(bin_opt_info),
{ok,Mod#c_module{defs=Ds1},get_warnings()}.
function_1({#c_var{name={F,Arity}}=Name,B0}) ->
@@ -383,10 +381,8 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
warn_no_clause_match(Case1, Case),
Expr = eval_case(Case, Sub),
case move_case_into_arg(Case, Sub) of
- impossible ->
- bsm_an(Expr);
- Other ->
- Other
+ impossible -> Expr;
+ Other -> Other
end;
Other ->
expr(Other, Ctxt, Sub)
@@ -399,10 +395,10 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) ->
Op1 = expr(Op0, value, Sub),
As1 = expr_list(As0, value, Sub),
- case Op1 of
- #c_var{} ->
+ case cerl:is_data(Op1) of
+ false ->
App#c_apply{op=Op1,args=As1};
- _ ->
+ true ->
add_warning(App, invalid_call),
Err = #c_call{anno=Anno,
module=#c_literal{val=erlang},
@@ -1462,8 +1458,19 @@ sub_add_scope(Vs, #sub{s=Scope0}=Sub) ->
Sub#sub{s=Scope}.
sub_subst_scope(#sub{v=S0,s=Scope}=Sub) ->
- S = [{-1,#c_var{name=Sv}} || Sv <- cerl_sets:to_list(Scope)]++S0,
- Sub#sub{v=S}.
+ Initial = case S0 of
+ [{NegInt,_}|_] when is_integer(NegInt), NegInt < 0 ->
+ NegInt - 1;
+ _ ->
+ -1
+ end,
+ S = sub_subst_scope_1(cerl_sets:to_list(Scope), Initial, S0),
+ Sub#sub{v=orddict:from_list(S)}.
+
+%% The keys in an orddict must be unique. Make them so!
+sub_subst_scope_1([H|T], Key, Acc) ->
+ sub_subst_scope_1(T, Key-1, [{Key,#c_var{name=H}}|Acc]);
+sub_subst_scope_1([], _, Acc) -> Acc.
sub_is_val(#c_var{name=V}, #sub{v=S,s=Scope}) ->
%% When the bottleneck in sub_del_var/2 was eliminated, this
@@ -2943,15 +2950,8 @@ update_types(Expr, Pat, #sub{t=Tdb0}=Sub) ->
Tdb = update_types_1(Expr, Pat, Tdb0),
Sub#sub{t=Tdb}.
-update_types_1(#c_var{name=V,anno=Anno}, Pat, Types) ->
- case member(reuse_for_context, Anno) of
- true ->
- %% If a variable has been marked for reuse of binary context,
- %% optimizations based on type information are unsafe.
- kill_types(V, Types);
- false ->
- update_types_2(V, Pat, Types)
- end;
+update_types_1(#c_var{name=V}, Pat, Types) ->
+ update_types_2(V, Pat, Types);
update_types_1(_, _, Types) -> Types.
update_types_2(V, [#c_tuple{}=P], Types) ->
@@ -2994,253 +2994,6 @@ copy_type(_, _, Tdb) -> Tdb.
void() -> #c_literal{val=ok}.
-%%%
-%%% Annotate bit syntax matching to faciliate optimization in further passes.
-%%%
-
-bsm_an(#c_case{arg=#c_var{}=V}=Case) ->
- bsm_an_1([V], Case);
-bsm_an(#c_case{arg=#c_values{es=Es}}=Case) ->
- bsm_an_1(Es, Case);
-bsm_an(Other) -> Other.
-
-bsm_an_1(Vs, #c_case{clauses=Cs}=Case) ->
- case bsm_leftmost(Cs) of
- none -> Case;
- Pos -> bsm_an_2(Vs, Cs, Case, Pos)
- end.
-
-bsm_an_2(Vs, Cs, Case, Pos) ->
- case bsm_nonempty(Cs, Pos) of
- true -> bsm_an_3(Vs, Cs, Case, Pos);
- false -> Case
- end.
-
-bsm_an_3(Vs, Cs, Case, Pos) ->
- try
- bsm_ensure_no_partition(Cs, Pos),
- bsm_do_an(Vs, Pos, Cs, Case)
- catch
- throw:{problem,Where,What} ->
- add_bin_opt_info(Where, What),
- Case
- end.
-
-bsm_do_an(Vs0, Pos, Cs0, Case) ->
- case nth(Pos, Vs0) of
- #c_var{name=Vname}=V0 ->
- Cs = bsm_do_an_var(Vname, Pos, Cs0, []),
- V = bsm_annotate_for_reuse(V0),
- Bef = lists:sublist(Vs0, Pos-1),
- Aft = lists:nthtail(Pos, Vs0),
- case Bef ++ [V|Aft] of
- [_] ->
- Case#c_case{arg=V,clauses=Cs};
- Vs ->
- Case#c_case{arg=#c_values{es=Vs},clauses=Cs}
- end;
- _ ->
- Case
- end.
-
-bsm_do_an_var(V, S, [#c_clause{pats=Ps,guard=G,body=B0}=C0|Cs], Acc) ->
- case nth(S, Ps) of
- #c_var{name=VarName} ->
- case core_lib:is_var_used(V, G) of
- true -> bsm_problem(C0, orig_bin_var_used_in_guard);
- false -> ok
- end,
- case core_lib:is_var_used(VarName, G) of
- true -> bsm_problem(C0, bin_var_used_in_guard);
- false -> ok
- end,
- B1 = bsm_maybe_ctx_to_binary(VarName, B0),
- B = bsm_maybe_ctx_to_binary(V, B1),
- C = C0#c_clause{body=B},
- bsm_do_an_var(V, S, Cs, [C|Acc]);
- #c_alias{}=P ->
- case bsm_could_match_binary(P) of
- false ->
- bsm_do_an_var(V, S, Cs, [C0|Acc]);
- true ->
- bsm_problem(C0, bin_opt_alias)
- end;
- P ->
- case bsm_could_match_binary(P) andalso bsm_is_var_used(V, G, B0) of
- false ->
- bsm_do_an_var(V, S, Cs, [C0|Acc]);
- true ->
- bsm_problem(C0, bin_var_used)
- end
- end;
-bsm_do_an_var(_, _, [], Acc) -> reverse(Acc).
-
-bsm_annotate_for_reuse(#c_var{anno=Anno}=Var) ->
- case member(reuse_for_context, Anno) of
- false -> Var#c_var{anno=[reuse_for_context|Anno]};
- true -> Var
- end.
-
-bsm_is_var_used(V, G, B) ->
- core_lib:is_var_used(V, G) orelse core_lib:is_var_used(V, B).
-
-bsm_maybe_ctx_to_binary(V, B) ->
- case core_lib:is_var_used(V, B) andalso not previous_ctx_to_binary(V, B) of
- false ->
- B;
- true ->
- #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
- args=[#c_var{name=V}]},
- body=B}
- end.
-
-previous_ctx_to_binary(V, Core) ->
- case Core of
- #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
- args=[#c_var{name=V}]}} ->
- true;
- _ ->
- false
- end.
-
-%% bsm_leftmost(Cs) -> none | ArgumentNumber
-%% Find the leftmost argument that does binary matching. Return
-%% the number of the argument (1-N).
-
-bsm_leftmost(Cs) ->
- bsm_leftmost_1(Cs, none).
-
-bsm_leftmost_1([#c_clause{pats=Ps}|Cs], Pos) ->
- bsm_leftmost_2(Ps, Cs, 1, Pos);
-bsm_leftmost_1([], Pos) -> Pos.
-
-bsm_leftmost_2(_, Cs, Pos, Pos) ->
- bsm_leftmost_1(Cs, Pos);
-bsm_leftmost_2([#c_binary{}|_], Cs, N, _) ->
- bsm_leftmost_1(Cs, N);
-bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
- bsm_leftmost_2(Ps, Cs, N+1, Pos);
-bsm_leftmost_2([], Cs, _, Pos) ->
- bsm_leftmost_1(Cs, Pos).
-
-%% bsm_nonempty(Cs, Pos) -> true|false
-%% Check if at least one of the clauses matches a non-empty
-%% binary in the given argument position.
-%%
-bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
- case nth(Pos, Ps) of
- #c_binary{segments=[_|_]} ->
- true;
- _ ->
- bsm_nonempty(Cs, Pos)
- end;
-bsm_nonempty([], _ ) -> false.
-
-%% bsm_ensure_no_partition(Cs, Pos) -> ok (exception if problem)
-%% We must make sure that matching is not partitioned between
-%% variables like this:
-%% foo(<<...>>) -> ...
-%% foo(<Variable>) when ... -> ...
-%% foo(<Any non-variable pattern>) ->
-%% If there is such partition, we are not allowed to reuse the binary variable
-%% for the match context.
-%%
-%% Also, arguments to the left of the argument that is matched
-%% against a binary, are only allowed to be simple variables, not
-%% used in guards. The reason is that we must know that the binary is
-%% only matched in one place (i.e. there must be only one bs_start_match2
-%% instruction emitted).
-
-bsm_ensure_no_partition(Cs, Pos) ->
- bsm_ensure_no_partition_1(Cs, Pos, before).
-
-%% Loop through each clause.
-bsm_ensure_no_partition_1([#c_clause{pats=Ps,guard=G}|Cs], Pos, State0) ->
- State = bsm_ensure_no_partition_2(Ps, Pos, G, simple_vars, State0),
- case State of
- 'after' ->
- bsm_ensure_no_partition_after(Cs, Pos);
- _ ->
- ok
- end,
- bsm_ensure_no_partition_1(Cs, Pos, State);
-bsm_ensure_no_partition_1([], _, _) -> ok.
-
-%% Loop through each pattern for this clause.
-bsm_ensure_no_partition_2([#c_binary{}=Where|_], 1, _, Vstate, State) ->
- case State of
- before when Vstate =:= simple_vars -> within;
- before -> bsm_problem(Where, Vstate);
- within when Vstate =:= simple_vars -> within;
- within -> bsm_problem(Where, Vstate)
- end;
-bsm_ensure_no_partition_2([#c_alias{}=Alias|_], 1, N, Vstate, State) ->
- %% Retrieve the real pattern that the alias refers to and check that.
- P = bsm_real_pattern(Alias),
- bsm_ensure_no_partition_2([P], 1, N, Vstate, State);
-bsm_ensure_no_partition_2([_|_], 1, _, _Vstate, before=State) ->
- %% No binary matching yet - therefore no partition.
- State;
-bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
- case bsm_could_match_binary(P) of
- false ->
- %% If clauses can be freely arranged (Vstate =:= simple_vars),
- %% a clause that cannot match a binary will not partition the clause.
- %% Example:
- %%
- %% a(Var, <<>>) -> ...
- %% a(Var, []) -> ...
- %% a(Var, <<B>>) -> ...
- %%
- %% But if the clauses can't be freely rearranged, as in
- %%
- %% b(Var, <<X>>) -> ...
- %% b(1, 2) -> ...
- %%
- %% we do have a problem.
- %%
- case Vstate of
- simple_vars -> State;
- _ -> bsm_problem(P, Vstate)
- end;
- true ->
- %% The pattern P *may* match a binary, so we must update the state.
- %% (P must be a variable.)
- case State of
- within -> 'after';
- 'after' -> 'after'
- end
- end;
-bsm_ensure_no_partition_2([#c_var{name=V}|Ps], N, G, Vstate, S) ->
- case core_lib:is_var_used(V, G) of
- false ->
- bsm_ensure_no_partition_2(Ps, N-1, G, Vstate, S);
- true ->
- bsm_ensure_no_partition_2(Ps, N-1, G, bin_left_var_used_in_guard, S)
- end;
-bsm_ensure_no_partition_2([_|Ps], N, G, _, S) ->
- bsm_ensure_no_partition_2(Ps, N-1, G, bin_argument_order, S).
-
-bsm_ensure_no_partition_after([#c_clause{pats=Ps}=C|Cs], Pos) ->
- case nth(Pos, Ps) of
- #c_var{} ->
- bsm_ensure_no_partition_after(Cs, Pos);
- _ ->
- bsm_problem(C, bin_partition)
- end;
-bsm_ensure_no_partition_after([], _) -> ok.
-
-bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P);
-bsm_could_match_binary(#c_cons{}) -> false;
-bsm_could_match_binary(#c_tuple{}) -> false;
-bsm_could_match_binary(#c_literal{val=Lit}) -> is_bitstring(Lit);
-bsm_could_match_binary(_) -> true.
-
-bsm_real_pattern(#c_alias{pat=P}) -> bsm_real_pattern(P);
-bsm_real_pattern(P) -> P.
-
-bsm_problem(Where, What) ->
- throw({problem,Where,What}).
%%%
%%% Handling of warnings.
@@ -3249,12 +3002,6 @@ bsm_problem(Where, What) ->
init_warnings() ->
put({?MODULE,warnings}, []).
-add_bin_opt_info(Core, Term) ->
- case get(bin_opt_info) of
- true -> add_warning(Core, Term);
- false -> ok
- end.
-
add_warning(Core, Term) ->
case should_suppress_warning(Core) of
true ->
@@ -3376,28 +3123,7 @@ format_error(result_ignored) ->
format_error(invalid_call) ->
"invalid function call";
format_error(useless_building) ->
- "a term is constructed, but never used";
-format_error(bin_opt_alias) ->
- "INFO: the '=' operator will prevent delayed sub binary optimization";
-format_error(bin_partition) ->
- "INFO: matching non-variables after a previous clause matching a variable "
- "will prevent delayed sub binary optimization";
-format_error(bin_left_var_used_in_guard) ->
- "INFO: a variable to the left of the binary pattern is used in a guard; "
- "will prevent delayed sub binary optimization";
-format_error(bin_argument_order) ->
- "INFO: matching anything else but a plain variable to the left of "
- "binary pattern will prevent delayed sub binary optimization; "
- "SUGGEST changing argument order";
-format_error(bin_var_used) ->
- "INFO: using a matched out sub binary will prevent "
- "delayed sub binary optimization";
-format_error(orig_bin_var_used_in_guard) ->
- "INFO: using the original binary variable in a guard will prevent "
- "delayed sub binary optimization";
-format_error(bin_var_used_in_guard) ->
- "INFO: using a matched out sub binary in a guard will prevent "
- "delayed sub binary optimization".
+ "a term is constructed, but never used".
-ifdef(DEBUG).
%% In order for simplify_let/2 to work correctly, the list of
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 004c609311..1fc05109c5 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1313,23 +1313,26 @@ get_vsub(V, Vsub) ->
set_vsub(V, S, Vsub) ->
orddict:store(V, S, Vsub).
-subst_vsub(Key, New, [{K,Key}|Dict]) ->
+subst_vsub(Key, New, Vsub) ->
+ orddict:from_list(subst_vsub_1(Key, New, Vsub)).
+
+subst_vsub_1(Key, New, [{K,Key}|Dict]) ->
%% Fold chained substitution.
- [{K,New}|subst_vsub(Key, New, Dict)];
-subst_vsub(Key, New, [{K,_}|_]=Dict) when Key < K ->
+ [{K,New}|subst_vsub_1(Key, New, Dict)];
+subst_vsub_1(Key, New, [{K,_}|_]=Dict) when Key < K ->
%% Insert the new substitution here, and continue
%% look for chained substitutions.
- [{Key,New}|subst_vsub_1(Key, New, Dict)];
-subst_vsub(Key, New, [{K,_}=E|Dict]) when Key > K ->
- [E|subst_vsub(Key, New, Dict)];
-subst_vsub(Key, New, []) -> [{Key,New}].
+ [{Key,New}|subst_vsub_2(Key, New, Dict)];
+subst_vsub_1(Key, New, [{K,_}=E|Dict]) when Key > K ->
+ [E|subst_vsub_1(Key, New, Dict)];
+subst_vsub_1(Key, New, []) -> [{Key,New}].
-subst_vsub_1(V, S, [{K,V}|Dict]) ->
+subst_vsub_2(V, S, [{K,V}|Dict]) ->
%% Fold chained substitution.
- [{K,S}|subst_vsub_1(V, S, Dict)];
-subst_vsub_1(V, S, [E|Dict]) ->
- [E|subst_vsub_1(V, S, Dict)];
-subst_vsub_1(_, _, []) -> [].
+ [{K,S}|subst_vsub_2(V, S, Dict)];
+subst_vsub_2(V, S, [E|Dict]) ->
+ [E|subst_vsub_2(V, S, Dict)];
+subst_vsub_2(_, _, []) -> [].
get_fsub(F, A, Fsub) ->
case orddict:find({F,A}, Fsub) of
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index 716280a95c..53097d0d7d 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.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.
diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl
index 07dad85c57..86146c614f 100644
--- a/lib/compiler/test/beam_type_SUITE.erl
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -22,7 +22,7 @@
-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
init_per_group/2,end_per_group/2,
integers/1,coverage/1,booleans/1,setelement/1,cons/1,
- tuple/1,record_float/1,binary_float/1]).
+ tuple/1,record_float/1,binary_float/1,float_compare/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -39,7 +39,8 @@ groups() ->
cons,
tuple,
record_float,
- binary_float
+ binary_float,
+ float_compare
]}].
init_per_suite(Config) ->
@@ -151,5 +152,25 @@ binary_float(_Config) ->
binary_negate_float(<<Float/float>>) ->
<<-Float/float>>.
+float_compare(_Config) ->
+ false = do_float_compare(-42.0),
+ false = do_float_compare(-42),
+ false = do_float_compare(0),
+ false = do_float_compare(0.0),
+ true = do_float_compare(42),
+ true = do_float_compare(42.0),
+ ok.
+
+do_float_compare(X) ->
+ %% ERL-433: Used to fail before OTP 20. Was accidentally fixed
+ %% in OTP 20. Add a test case to ensure it stays fixed.
+
+ Y = X + 1.0,
+ case X > 0 of
+ T when (T =:= nil) or (T =:= false) -> T;
+ _T -> Y > 0
+ end.
+
+
id(I) ->
I.
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 75bfbf68cc..c23514b36b 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_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.
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index fd97eea4cb..da99aba346 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_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.
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 89f851ac3b..0ec05456ec 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.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.
@@ -39,7 +39,7 @@
match_string_opt/1,select_on_integer/1,
map_and_binary/1,unsafe_branch_caching/1,
bad_literals/1,good_literals/1,constant_propagation/1,
- parse_xml/1]).
+ parse_xml/1,get_payload/1]).
-export([coverage_id/1,coverage_external_ignore/2]).
@@ -70,7 +70,8 @@ groups() ->
no_partition,calling_a_binary,binary_in_map,
match_string_opt,select_on_integer,
map_and_binary,unsafe_branch_caching,
- bad_literals,good_literals,constant_propagation,parse_xml]}].
+ bad_literals,good_literals,constant_propagation,parse_xml,
+ get_payload]}].
init_per_suite(Config) ->
@@ -1508,6 +1509,20 @@ do_parse_xml(<<"<?xml"/utf8,Rest/binary>> = Bytes) ->
is_next_char_whitespace(<<C/utf8,_/binary>>) ->
C =:= $\s.
+-record(ext_header,
+ {this_hdr = 17,
+ ext_hdr_opts}).
+
+get_payload(Config) ->
+ <<3445:48>> = do_get_payload(#ext_header{ext_hdr_opts = <<3445:48>>}),
+ {'EXIT',_} = (catch do_get_payload(#ext_header{})),
+ ok.
+
+do_get_payload(ExtHdr) ->
+ _ = ExtHdr#ext_header.this_hdr,
+ ExtHdrOptions = ExtHdr#ext_header.ext_hdr_opts,
+ <<_:13,_:35>> = ExtHdr#ext_header.ext_hdr_opts,
+ ExtHdrOptions.
check(F, R) ->
R = F().
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 4e2753ba5f..f647a4030d 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -371,6 +371,7 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
do_listing(Simple, TargetDir, dinline, ".inline"),
do_listing(Simple, TargetDir, dcore, ".core"),
do_listing(Simple, TargetDir, dcopt, ".copt"),
+ do_listing(Simple, TargetDir, dcbsm, ".core_bsm"),
do_listing(Simple, TargetDir, dsetel, ".dsetel"),
do_listing(Simple, TargetDir, dkern, ".kernel"),
do_listing(Simple, TargetDir, dlife, ".life"),
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index f8839da42f..0e07e8dd2e 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -28,7 +28,8 @@
map_core_test/1,eval_case/1,bad_boolean_guard/1,
bs_shadowed_size_var/1,
cover_v3_kernel_1/1,cover_v3_kernel_2/1,cover_v3_kernel_3/1,
- cover_v3_kernel_4/1,cover_v3_kernel_5/1]).
+ cover_v3_kernel_4/1,cover_v3_kernel_5/1,
+ non_variable_apply/1]).
-include_lib("common_test/include/ct.hrl").
@@ -56,7 +57,8 @@ groups() ->
map_core_test,eval_case,bad_boolean_guard,
bs_shadowed_size_var,
cover_v3_kernel_1,cover_v3_kernel_2,cover_v3_kernel_3,
- cover_v3_kernel_4,cover_v3_kernel_5
+ cover_v3_kernel_4,cover_v3_kernel_5,
+ non_variable_apply
]}].
@@ -90,7 +92,7 @@ end_per_group(_GroupName, Config) ->
?comp(cover_v3_kernel_3).
?comp(cover_v3_kernel_4).
?comp(cover_v3_kernel_5).
-
+?comp(non_variable_apply).
try_it(Mod, Conf) ->
Src = filename:join(proplists:get_value(data_dir, Conf),
diff --git a/lib/compiler/test/core_SUITE_data/non_variable_apply.core b/lib/compiler/test/core_SUITE_data/non_variable_apply.core
new file mode 100644
index 0000000000..d9322cc455
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/non_variable_apply.core
@@ -0,0 +1,80 @@
+module 'non_variable_apply' ['module_info'/0,
+ 'module_info'/1,
+ 'non_variable_apply'/0]
+ attributes []
+
+'non_variable_apply'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ let <OkFun> =
+ fun (_@c0) ->
+ %% Line 5
+ case _@c0 of
+ <'ok'> when 'true' ->
+ 'ok'
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'-non_variable_apply/0-fun-0-',1}}] )
+ -| ['compiler_generated'] )
+ end
+ in let <F> =
+ fun (_@c5,_@c4) ->
+ %% Line 6
+ case <_@c5,_@c4> of
+ <F,X> when 'true' ->
+ apply apply 'id'/1 (F) (X)
+ ( <_@c7,_@c6> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c7,_@c6})
+ -| [{'function_name',{'-non_variable_apply/0-fun-1-',2}}] )
+ -| ['compiler_generated'] )
+ end
+ in %% Line 9
+ apply F
+ (OkFun, 'ok')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'non_variable_apply',0}}] )
+ -| ['compiler_generated'] )
+ end
+'id'/1 =
+ %% Line 11
+ fun (_@c0) ->
+ case _@c0 of
+ <I> when 'true' ->
+ I
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'id',1}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('non_variable_apply')
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'module_info',0}}] )
+ -| ['compiler_generated'] )
+ end
+'module_info'/1 =
+ fun (_@c0) ->
+ case _@c0 of
+ <X> when 'true' ->
+ call 'erlang':'get_module_info'
+ ('non_variable_apply', X)
+ ( <_@c1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_@c1})
+ -| [{'function_name',{'module_info',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index 01b064cc10..4bd884d86b 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -161,11 +161,12 @@ md5_1(Beam) ->
%% Cover some code that handles internal errors.
silly_coverage(Config) when is_list(Config) ->
- %% sys_core_fold, sys_core_setel, v3_kernel
+ %% sys_core_fold, sys_core_bsm, sys_core_setel, v3_kernel
BadCoreErlang = {c_module,[],
name,[],[],
[{{c_var,[],{foo,2}},seriously_bad_body}]},
expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end),
+ expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end),
expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end),
expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end),
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index 7c27750556..857995b6a6 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.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.
@@ -529,7 +529,7 @@ bin_opt_info(Config) when is_list(Config) ->
Code,
[bin_opt_info],
{warnings,
- [{4,sys_core_fold,orig_bin_var_used_in_guard},
+ [{4,sys_core_bsm,orig_bin_var_used_in_guard},
{5,beam_bsm,{no_bin_opt,{{t1,1},no_suitable_bs_start_match}}},
{9,beam_bsm,{no_bin_opt,
{binary_used_in,{extfunc,erlang,split_binary,2}}}} ]}}],
diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk
index 5c87304a01..463c264a5f 100644
--- a/lib/compiler/vsn.mk
+++ b/lib/compiler/vsn.mk
@@ -1 +1 @@
-COMPILER_VSN = 7.0.4
+COMPILER_VSN = 7.1
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index 4ae7edd8b2..1d9c1e0f88 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -110,6 +110,10 @@
#endif
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
+# define HAS_EVP_PKEY_CTX
+#endif
+
#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
#include <openssl/modes.h>
@@ -433,13 +437,11 @@ static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NI
static ERL_NIF_TERM strong_rand_range_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_public_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_private_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -452,8 +454,6 @@ static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_
static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
-static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -506,13 +506,11 @@ static ErlNifFunc nif_funcs[] = {
{"strong_rand_range_nif", 1, strong_rand_range_nif},
{"rand_uniform_nif", 2, rand_uniform_nif},
{"mod_exp_nif", 4, mod_exp_nif},
- {"dss_verify_nif", 4, dss_verify_nif},
- {"rsa_verify_nif", 4, rsa_verify_nif},
{"do_exor", 2, do_exor},
{"rc4_set_key", 1, rc4_set_key},
{"rc4_encrypt_with_state", 2, rc4_encrypt_with_state},
- {"rsa_sign_nif", 3, rsa_sign_nif},
- {"dss_sign_nif", 3, dss_sign_nif},
+ {"pkey_sign_nif", 5, pkey_sign_nif},
+ {"pkey_verify_nif", 6, pkey_verify_nif},
{"rsa_public_crypt", 4, rsa_public_crypt},
{"rsa_private_crypt", 4, rsa_private_crypt},
{"rsa_generate_key_nif", 2, rsa_generate_key_nif},
@@ -525,8 +523,6 @@ static ErlNifFunc nif_funcs[] = {
{"srp_host_secret_nif", 5, srp_host_secret_nif},
{"ec_key_generate", 2, ec_key_generate},
- {"ecdsa_sign_nif", 4, ecdsa_sign_nif},
- {"ecdsa_verify_nif", 5, ecdsa_verify_nif},
{"ecdh_compute_key_nif", 3, ecdh_compute_key_nif},
{"rand_seed_nif", 1, rand_seed_nif},
@@ -589,6 +585,23 @@ static ERL_NIF_TERM atom_des_ecb;
static ERL_NIF_TERM atom_blowfish_ecb;
#endif
+static ERL_NIF_TERM atom_rsa;
+static ERL_NIF_TERM atom_dss;
+static ERL_NIF_TERM atom_ecdsa;
+static ERL_NIF_TERM atom_rsa_mgf1_md;
+static ERL_NIF_TERM atom_rsa_padding;
+static ERL_NIF_TERM atom_rsa_pkcs1_pss_padding;
+static ERL_NIF_TERM atom_rsa_x931_padding;
+static ERL_NIF_TERM atom_rsa_pss_saltlen;
+static ERL_NIF_TERM atom_sha224;
+static ERL_NIF_TERM atom_sha256;
+static ERL_NIF_TERM atom_sha384;
+static ERL_NIF_TERM atom_sha512;
+static ERL_NIF_TERM atom_md5;
+static ERL_NIF_TERM atom_ripemd160;
+
+
+
static ErlNifResourceType* hmac_context_rtype;
struct hmac_context
{
@@ -609,7 +622,7 @@ struct digest_type_t {
}md;
};
-struct digest_type_t digest_types[] =
+static struct digest_type_t digest_types[] =
{
{{"md4"}, {&EVP_md4}},
{{"md5"}, {&EVP_md5}},
@@ -666,7 +679,7 @@ struct cipher_type_t {
#define COND_NO_DES_PTR(Ptr) (Ptr)
#endif
-struct cipher_type_t cipher_types[] =
+static struct cipher_type_t cipher_types[] =
{
{{"rc2_cbc"},
#ifndef OPENSSL_NO_RC2
@@ -916,6 +929,20 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
#else
atom_not_supported = enif_make_atom(env,"not_supported");
#endif
+ atom_rsa = enif_make_atom(env,"rsa");
+ atom_dss = enif_make_atom(env,"dss");
+ atom_ecdsa = enif_make_atom(env,"ecdsa");
+ atom_rsa_mgf1_md = enif_make_atom(env,"rsa_mgf1_md");
+ atom_rsa_padding = enif_make_atom(env,"rsa_padding");
+ atom_rsa_pkcs1_pss_padding = enif_make_atom(env,"rsa_pkcs1_pss_padding");
+ atom_rsa_x931_padding = enif_make_atom(env,"rsa_x931_padding");
+ atom_rsa_pss_saltlen = enif_make_atom(env,"rsa_pss_saltlen");
+ atom_sha224 = enif_make_atom(env,"sha224");
+ atom_sha256 = enif_make_atom(env,"sha256");
+ atom_sha384 = enif_make_atom(env,"sha384");
+ atom_sha512 = enif_make_atom(env,"sha512");
+ atom_md5 = enif_make_atom(env,"md5");
+ atom_ripemd160 = enif_make_atom(env,"ripemd160");
init_digest_types(env);
init_cipher_types(env);
@@ -1010,6 +1037,8 @@ static int algo_pubkey_cnt, algo_pubkey_fips_cnt;
static ERL_NIF_TERM algo_pubkey[7]; /* increase when extending the list */
static int algo_cipher_cnt, algo_cipher_fips_cnt;
static ERL_NIF_TERM algo_cipher[24]; /* increase when extending the list */
+static int algo_mac_cnt, algo_mac_fips_cnt;
+static ERL_NIF_TERM algo_mac[2]; /* increase when extending the list */
static void init_algorithms_types(ErlNifEnv* env)
{
@@ -1093,9 +1122,19 @@ static void init_algorithms_types(ErlNifEnv* env)
algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305");
#endif
+ // Validated algorithms first
+ algo_mac_cnt = 0;
+ algo_mac[algo_mac_cnt++] = enif_make_atom(env,"hmac");
+#ifdef HAVE_CMAC
+ algo_mac[algo_mac_cnt++] = enif_make_atom(env,"cmac");
+#endif
+ // Non-validated algorithms follow
+ algo_mac_fips_cnt = algo_mac_cnt;
+
ASSERT(algo_hash_cnt <= sizeof(algo_hash)/sizeof(ERL_NIF_TERM));
ASSERT(algo_pubkey_cnt <= sizeof(algo_pubkey)/sizeof(ERL_NIF_TERM));
ASSERT(algo_cipher_cnt <= sizeof(algo_cipher)/sizeof(ERL_NIF_TERM));
+ ASSERT(algo_mac_cnt <= sizeof(algo_mac)/sizeof(ERL_NIF_TERM));
}
static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -1105,15 +1144,19 @@ static ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
int hash_cnt = fips_mode ? algo_hash_fips_cnt : algo_hash_cnt;
int pubkey_cnt = fips_mode ? algo_pubkey_fips_cnt : algo_pubkey_cnt;
int cipher_cnt = fips_mode ? algo_cipher_fips_cnt : algo_cipher_cnt;
+ int mac_cnt = fips_mode ? algo_mac_fips_cnt : algo_mac_cnt;
#else
int hash_cnt = algo_hash_cnt;
int pubkey_cnt = algo_pubkey_cnt;
int cipher_cnt = algo_cipher_cnt;
+ int mac_cnt = algo_mac_cnt;
#endif
- return enif_make_tuple3(env,
+ return enif_make_tuple4(env,
enif_make_list_from_array(env, algo_hash, hash_cnt),
enif_make_list_from_array(env, algo_pubkey, pubkey_cnt),
- enif_make_list_from_array(env, algo_cipher, cipher_cnt));
+ enif_make_list_from_array(env, algo_cipher, cipher_cnt),
+ enif_make_list_from_array(env, algo_mac, mac_cnt)
+ );
}
static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -2448,44 +2491,6 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
return ret;
}
-static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (sha, Digest, Signature,Key=[P, Q, G, Y]) */
- ErlNifBinary digest_bin, sign_bin;
- BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL;
- ERL_NIF_TERM head, tail;
- DSA *dsa;
- int i;
-
- if (argv[0] != atom_sha
- || !enif_inspect_binary(env, argv[1], &digest_bin)
- || digest_bin.size != SHA_DIGEST_LENGTH
- || !enif_inspect_binary(env, argv[2], &sign_bin)
- || !enif_get_list_cell(env, argv[3], &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_p)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_q)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_g)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_y)
- || !enif_is_empty_list(env,tail)) {
-
- if (dsa_p) BN_free(dsa_p);
- if (dsa_q) BN_free(dsa_q);
- if (dsa_g) BN_free(dsa_g);
- if (dsa_y) BN_free(dsa_y);
- return enif_make_badarg(env);
- }
-
- dsa = DSA_new();
- DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g);
- DSA_set0_key(dsa, dsa_y, NULL);
- i = DSA_verify(0, digest_bin.data, SHA_DIGEST_LENGTH,
- sign_bin.data, sign_bin.size, dsa);
- DSA_free(dsa);
- return(i > 0) ? atom_true : atom_false;
-}
-
static void init_digest_types(ErlNifEnv* env)
{
struct digest_type_t* p = digest_types;
@@ -2532,73 +2537,6 @@ static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len)
return NULL;
}
-static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Digest, Signature, Key=[E,N]) */
- ErlNifBinary digest_bin, sign_bin;
- ERL_NIF_TERM head, tail, ret;
- int i;
- RSA *rsa;
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- EVP_PKEY *pkey;
- EVP_PKEY_CTX *ctx;
-#endif
- const EVP_MD *md;
- const ERL_NIF_TERM type = argv[0];
- struct digest_type_t *digp = NULL;
- BIGNUM *rsa_e;
- BIGNUM *rsa_n;
-
- digp = get_digest_type(type);
- if (!digp) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
-
- rsa = RSA_new();
-
- if (!enif_inspect_binary(env, argv[1], &digest_bin)
- || digest_bin.size != EVP_MD_size(md)
- || !enif_inspect_binary(env, argv[2], &sign_bin)
- || !enif_get_list_cell(env, argv[3], &head, &tail)
- || !get_bn_from_bin(env, head, &rsa_e)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &rsa_n)
- || !enif_is_empty_list(env, tail)) {
-
- ret = enif_make_badarg(env);
- goto done;
- }
-
- (void) RSA_set0_key(rsa, rsa_n, rsa_e, NULL);
-
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- pkey = EVP_PKEY_new();
- EVP_PKEY_set1_RSA(pkey, rsa);
-
- ctx = EVP_PKEY_CTX_new(pkey, NULL);
- EVP_PKEY_verify_init(ctx);
- EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING);
- EVP_PKEY_CTX_set_signature_md(ctx, md);
-
- i = EVP_PKEY_verify(ctx, sign_bin.data, sign_bin.size,
- digest_bin.data, digest_bin.size);
- EVP_PKEY_CTX_free(ctx);
- EVP_PKEY_free(pkey);
-#else
- i = RSA_verify(md->type, digest_bin.data, EVP_MD_size(md),
- sign_bin.data, sign_bin.size, rsa);
-#endif
-
- ret = (i==1 ? atom_true : atom_false);
-
-done:
- RSA_free(rsa);
- return ret;
-}
-
static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Data1, Data2) */
ErlNifBinary d1, d2;
@@ -2702,100 +2640,33 @@ static int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa)
return 1;
}
-static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Digest, Key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C]) */
- ErlNifBinary digest_bin, ret_bin;
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- EVP_PKEY *pkey;
- EVP_PKEY_CTX *ctx;
- size_t rsa_s_len;
-#else
- unsigned rsa_s_len, len;
-#endif
- RSA *rsa;
- int i;
- struct digest_type_t *digp;
- const EVP_MD *md;
-
- digp = get_digest_type(argv[0]);
- if (!digp) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
- if (!enif_inspect_binary(env,argv[1],&digest_bin)
- || digest_bin.size != EVP_MD_size(md)) {
- return enif_make_badarg(env);
- }
+static int get_rsa_public_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa)
+{
+ /* key=[E,N] */
+ ERL_NIF_TERM head, tail;
+ BIGNUM *e, *n;
- rsa = RSA_new();
- if (!get_rsa_private_key(env, argv[2], rsa)) {
- RSA_free(rsa);
- return enif_make_badarg(env);
+ if (!enif_get_list_cell(env, key, &head, &tail)
+ || !get_bn_from_bin(env, head, &e)
+ || !enif_get_list_cell(env, tail, &head, &tail)
+ || !get_bn_from_bin(env, head, &n)
+ || !enif_is_empty_list(env, tail)) {
+ return 0;
}
-
-#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- pkey = EVP_PKEY_new();
- EVP_PKEY_set1_RSA(pkey, rsa);
- rsa_s_len=(size_t)EVP_PKEY_size(pkey);
- enif_alloc_binary(rsa_s_len, &ret_bin);
-
- ctx = EVP_PKEY_CTX_new(pkey, NULL);
- EVP_PKEY_sign_init(ctx);
- EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_PKCS1_PADDING);
- EVP_PKEY_CTX_set_signature_md(ctx, md);
-
- i = EVP_PKEY_sign(ctx, ret_bin.data, &rsa_s_len,
- digest_bin.data, digest_bin.size);
- ASSERT(i<=0 || rsa_s_len <= ret_bin.size);
- EVP_PKEY_CTX_free(ctx);
- EVP_PKEY_free(pkey);
-#else
- enif_alloc_binary(RSA_size(rsa), &ret_bin);
- len = EVP_MD_size(md);
-
- ERL_VALGRIND_ASSERT_MEM_DEFINED(digest_bin.data, len);
- i = RSA_sign(md->type, digest_bin.data, len,
- ret_bin.data, &rsa_s_len, rsa);
-#endif
-
- RSA_free(rsa);
- if (i > 0) {
- ERL_VALGRIND_MAKE_MEM_DEFINED(ret_bin.data, rsa_s_len);
- if (rsa_s_len != ret_bin.size) {
- enif_realloc_binary(&ret_bin, rsa_s_len);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(ret_bin.data, rsa_s_len);
- }
- return enif_make_binary(env,&ret_bin);
- }
- else {
- enif_release_binary(&ret_bin);
- return atom_error;
- }
+ (void) RSA_set0_key(rsa, n, e, NULL);
+ return 1;
}
-
-static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (sha, Digest, Key=[P,Q,G,PrivKey]) */
- ErlNifBinary digest_bin, ret_bin;
+static int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa)
+{
+ /* key=[P,Q,G,KEY] */
ERL_NIF_TERM head, tail;
- unsigned int dsa_s_len;
- DSA* dsa;
BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL;
BIGNUM *dummy_pub_key, *priv_key = NULL;
- int i;
-
- if (argv[0] != atom_sha
- || !enif_inspect_binary(env, argv[1], &digest_bin)
- || digest_bin.size != SHA_DIGEST_LENGTH) {
- return enif_make_badarg(env);
- }
- if (!enif_get_list_cell(env, argv[2], &head, &tail)
+ if (!enif_get_list_cell(env, key, &head, &tail)
|| !get_bn_from_bin(env, head, &dsa_p)
|| !enif_get_list_cell(env, tail, &head, &tail)
|| !get_bn_from_bin(env, head, &dsa_q)
@@ -2808,7 +2679,7 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
if (dsa_q) BN_free(dsa_q);
if (dsa_g) BN_free(dsa_g);
if (priv_key) BN_free(priv_key);
- return enif_make_badarg(env);
+ return 0;
}
/* Note: DSA_set0_key() does not allow setting only the
@@ -2818,27 +2689,39 @@ static ERL_NIF_TERM dss_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
*/
dummy_pub_key = BN_dup(priv_key);
- dsa = DSA_new();
DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g);
DSA_set0_key(dsa, dummy_pub_key, priv_key);
- enif_alloc_binary(DSA_size(dsa), &ret_bin);
- i = DSA_sign(NID_sha1, digest_bin.data, SHA_DIGEST_LENGTH,
- ret_bin.data, &dsa_s_len, dsa);
- DSA_free(dsa);
-
- if (i) {
- if (dsa_s_len != ret_bin.size) {
- enif_realloc_binary(&ret_bin, dsa_s_len);
- }
- return enif_make_binary(env, &ret_bin);
- }
- else {
- enif_release_binary(&ret_bin);
- return atom_error;
- }
+ return 1;
}
+static int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa)
+{
+ /* key=[P, Q, G, Y] */
+ ERL_NIF_TERM head, tail;
+ BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL;
+
+ if (!enif_get_list_cell(env, key, &head, &tail)
+ || !get_bn_from_bin(env, head, &dsa_p)
+ || !enif_get_list_cell(env, tail, &head, &tail)
+ || !get_bn_from_bin(env, head, &dsa_q)
+ || !enif_get_list_cell(env, tail, &head, &tail)
+ || !get_bn_from_bin(env, head, &dsa_g)
+ || !enif_get_list_cell(env, tail, &head, &tail)
+ || !get_bn_from_bin(env, head, &dsa_y)
+ || !enif_is_empty_list(env,tail)) {
+ if (dsa_p) BN_free(dsa_p);
+ if (dsa_q) BN_free(dsa_q);
+ if (dsa_g) BN_free(dsa_g);
+ if (dsa_y) BN_free(dsa_y);
+ return 0;
+ }
+
+ DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g);
+ DSA_set0_key(dsa, dsa_y, NULL);
+ return 1;
+}
+
static int rsa_pad(ERL_NIF_TERM term, int* padding)
{
if (term == atom_rsa_pkcs1_padding) {
@@ -3788,99 +3671,6 @@ badarg:
#endif
}
-static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Digest, Curve, Key) */
-#if defined(HAVE_EC)
- ErlNifBinary digest_bin, ret_bin;
- unsigned int dsa_s_len;
- EC_KEY* key = NULL;
- int i, len;
- struct digest_type_t *digp;
- const EVP_MD *md;
-
- digp = get_digest_type(argv[0]);
- if (!digp) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
- len = EVP_MD_size(md);
-
- if (!enif_inspect_binary(env,argv[1],&digest_bin)
- || digest_bin.size != len
- || !get_ec_key(env, argv[2], argv[3], atom_undefined, &key))
- goto badarg;
-
- enif_alloc_binary(ECDSA_size(key), &ret_bin);
-
- i = ECDSA_sign(EVP_MD_type(md), digest_bin.data, len,
- ret_bin.data, &dsa_s_len, key);
-
- EC_KEY_free(key);
- if (i) {
- if (dsa_s_len != ret_bin.size) {
- enif_realloc_binary(&ret_bin, dsa_s_len);
- }
- return enif_make_binary(env, &ret_bin);
- }
- else {
- enif_release_binary(&ret_bin);
- return atom_error;
- }
-
-badarg:
- if (key)
- EC_KEY_free(key);
- return make_badarg_maybe(env);
-#else
- return atom_notsup;
-#endif
-}
-
-static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Type, Digest, Signature, Curve, Key) */
-#if defined(HAVE_EC)
- ErlNifBinary digest_bin, sign_bin;
- int i, len;
- EC_KEY* key = NULL;
- const ERL_NIF_TERM type = argv[0];
- struct digest_type_t *digp = NULL;
- const EVP_MD *md;
-
- digp = get_digest_type(type);
- if (!digp) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
- len = EVP_MD_size(md);
-
- if (!enif_inspect_binary(env, argv[1], &digest_bin)
- || digest_bin.size != len
- || !enif_inspect_binary(env, argv[2], &sign_bin)
- || !get_ec_key(env, argv[3], atom_undefined, argv[4], &key))
- goto badarg;
-
- i = ECDSA_verify(EVP_MD_type(md), digest_bin.data, len,
- sign_bin.data, sign_bin.size, key);
-
- EC_KEY_free(key);
-
- return (i==1 ? atom_true : atom_false);
-
-badarg:
- if (key)
- EC_KEY_free(key);
- return make_badarg_maybe(env);
-#else
- return atom_notsup;
-#endif
-}
-
/*
(_OthersPublicKey, _MyPrivateKey)
(_OthersPublicKey, _MyEC_Point)
@@ -3939,6 +3729,548 @@ out_err:
#endif
}
+/*================================================================*/
+#define PKEY_BADARG -1
+#define PKEY_NOTSUP 0
+#define PKEY_OK 1
+
+typedef struct PKeyCryptOptions {
+ const EVP_MD *rsa_mgf1_md;
+ ErlNifBinary rsa_oaep_label;
+ const EVP_MD *rsa_oaep_md;
+ int rsa_padding;
+ const EVP_MD *signature_md;
+} PKeyCryptOptions;
+
+typedef struct PKeySignOptions {
+ const EVP_MD *rsa_mgf1_md;
+ int rsa_padding;
+ int rsa_pss_saltlen;
+} PKeySignOptions;
+
+static int get_pkey_digest_type(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM type,
+ const EVP_MD **md)
+{
+ struct digest_type_t *digp = NULL;
+ *md = NULL;
+
+ if (type == atom_none && algorithm == atom_rsa) return PKEY_OK;
+
+ digp = get_digest_type(type);
+ if (!digp) return PKEY_BADARG;
+ if (!digp->md.p) return PKEY_NOTSUP;
+
+ *md = digp->md.p;
+ return PKEY_OK;
+}
+
+
+static int get_pkey_sign_digest(ErlNifEnv *env, ERL_NIF_TERM algorithm,
+ ERL_NIF_TERM type, ERL_NIF_TERM data,
+ unsigned char *md_value, const EVP_MD **mdp,
+ unsigned char **tbsp, size_t *tbslenp)
+{
+ int i;
+ const ERL_NIF_TERM *tpl_terms;
+ int tpl_arity;
+ ErlNifBinary tbs_bin;
+ EVP_MD_CTX *mdctx;
+ const EVP_MD *md = *mdp;
+ unsigned char *tbs = *tbsp;
+ size_t tbslen = *tbslenp;
+ unsigned int tbsleni;
+
+ if ((i = get_pkey_digest_type(env, algorithm, type, &md)) != PKEY_OK) {
+ return i;
+ }
+ if (enif_get_tuple(env, data, &tpl_arity, &tpl_terms)) {
+ if (tpl_arity != 2 || tpl_terms[0] != atom_digest
+ || !enif_inspect_binary(env, tpl_terms[1], &tbs_bin)
+ || (md != NULL && tbs_bin.size != EVP_MD_size(md))) {
+ return PKEY_BADARG;
+ }
+ /* We have a digest (= hashed text) in tbs_bin */
+ tbs = tbs_bin.data;
+ tbslen = tbs_bin.size;
+ } else if (md == NULL) {
+ if (!enif_inspect_binary(env, data, &tbs_bin)) {
+ return PKEY_BADARG;
+ }
+ /* md == NULL, that is no hashing because DigestType argument was atom_none */
+ tbs = tbs_bin.data;
+ tbslen = tbs_bin.size;
+ } else {
+ if (!enif_inspect_binary(env, data, &tbs_bin)) {
+ return PKEY_BADARG;
+ }
+ /* We have the cleartext in tbs_bin and the hash algo info in md */
+ tbs = md_value;
+ mdctx = EVP_MD_CTX_create();
+ if (!mdctx) {
+ return PKEY_BADARG;
+ }
+ /* Looks well, now hash the plain text into a digest according to md */
+ if (EVP_DigestInit_ex(mdctx, md, NULL) <= 0) {
+ EVP_MD_CTX_destroy(mdctx);
+ return PKEY_BADARG;
+ }
+ if (EVP_DigestUpdate(mdctx, tbs_bin.data, tbs_bin.size) <= 0) {
+ EVP_MD_CTX_destroy(mdctx);
+ return PKEY_BADARG;
+ }
+ if (EVP_DigestFinal_ex(mdctx, tbs, &tbsleni) <= 0) {
+ EVP_MD_CTX_destroy(mdctx);
+ return PKEY_BADARG;
+ }
+ tbslen = (size_t)(tbsleni);
+ EVP_MD_CTX_destroy(mdctx);
+ }
+
+ *mdp = md;
+ *tbsp = tbs;
+ *tbslenp = tbslen;
+
+ return PKEY_OK;
+}
+
+
+static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM options,
+ const EVP_MD *md, PKeySignOptions *opt)
+{
+ ERL_NIF_TERM head, tail;
+ const ERL_NIF_TERM *tpl_terms;
+ int tpl_arity;
+ const EVP_MD *opt_md;
+ int i;
+
+ if (!enif_is_list(env, options)) {
+ return PKEY_BADARG;
+ }
+
+ /* defaults */
+ if (algorithm == atom_rsa) {
+ opt->rsa_mgf1_md = NULL;
+ opt->rsa_padding = RSA_PKCS1_PADDING;
+ opt->rsa_pss_saltlen = -2;
+ }
+
+ if (enif_is_empty_list(env, options)) {
+ return PKEY_OK;
+ }
+
+ if (algorithm == atom_rsa) {
+ tail = options;
+ while (enif_get_list_cell(env, tail, &head, &tail)) {
+ if (enif_get_tuple(env, head, &tpl_arity, &tpl_terms) && tpl_arity == 2) {
+ if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) {
+ i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
+ if (i != PKEY_OK) {
+ return i;
+ }
+ opt->rsa_mgf1_md = opt_md;
+ } else if (tpl_terms[0] == atom_rsa_padding) {
+ if (tpl_terms[1] == atom_rsa_pkcs1_padding) {
+ opt->rsa_padding = RSA_PKCS1_PADDING;
+ } else if (tpl_terms[1] == atom_rsa_pkcs1_pss_padding) {
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
+ opt->rsa_padding = RSA_PKCS1_PSS_PADDING;
+ if (opt->rsa_mgf1_md == NULL) {
+ opt->rsa_mgf1_md = md;
+ }
+#else
+ return PKEY_NOTSUP;
+#endif
+ } else if (tpl_terms[1] == atom_rsa_x931_padding) {
+ opt->rsa_padding = RSA_X931_PADDING;
+ } else if (tpl_terms[1] == atom_rsa_no_padding) {
+ opt->rsa_padding = RSA_NO_PADDING;
+ } else {
+ return PKEY_BADARG;
+ }
+ } else if (tpl_terms[0] == atom_rsa_pss_saltlen) {
+ if (!enif_get_int(env, tpl_terms[1], &(opt->rsa_pss_saltlen))
+ || opt->rsa_pss_saltlen < -2) {
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+
+ return PKEY_OK;
+}
+
+static int get_pkey_sign_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, EVP_PKEY **pkey)
+{
+ if (algorithm == atom_rsa) {
+ RSA *rsa = RSA_new();
+
+ if (!get_rsa_private_key(env, key, rsa)) {
+ RSA_free(rsa);
+ return PKEY_BADARG;
+ }
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_RSA(*pkey, rsa)) {
+ EVP_PKEY_free(*pkey);
+ RSA_free(rsa);
+ return PKEY_BADARG;
+ }
+ } else if (algorithm == atom_ecdsa) {
+#if defined(HAVE_EC)
+ EC_KEY *ec = NULL;
+ const ERL_NIF_TERM *tpl_terms;
+ int tpl_arity;
+
+ if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2
+ && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1])
+ && get_ec_key(env, tpl_terms[0], tpl_terms[1], atom_undefined, &ec)) {
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) {
+ EVP_PKEY_free(*pkey);
+ EC_KEY_free(ec);
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+#else
+ return PKEY_NOTSUP;
+#endif
+ } else if (algorithm == atom_dss) {
+ DSA *dsa = DSA_new();
+
+ if (!get_dss_private_key(env, key, dsa)) {
+ DSA_free(dsa);
+ return PKEY_BADARG;
+ }
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_DSA(*pkey, dsa)) {
+ EVP_PKEY_free(*pkey);
+ DSA_free(dsa);
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+
+ return PKEY_OK;
+}
+
+static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
+{/* (Algorithm, Type, Data|{digest,Digest}, Key, Options) */
+ int i;
+ const EVP_MD *md = NULL;
+ unsigned char md_value[EVP_MAX_MD_SIZE];
+ EVP_PKEY *pkey;
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX *ctx;
+ size_t siglen;
+#else
+ unsigned len, siglen;
+#endif
+ PKeySignOptions sig_opt;
+ ErlNifBinary sig_bin; /* signature */
+ unsigned char *tbs; /* data to be signed */
+ size_t tbslen;
+/*char buf[1024];
+enif_get_atom(env,argv[0],buf,1024,ERL_NIF_LATIN1); printf("algo=%s ",buf);
+enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf);
+printf("\r\n");
+*/
+ i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen);
+ if (i != PKEY_OK) {
+ if (i == PKEY_NOTSUP)
+ return atom_notsup;
+ else
+ return enif_make_badarg(env);
+ }
+
+ i = get_pkey_sign_options(env, argv[0], argv[4], md, &sig_opt);
+ if (i != PKEY_OK) {
+ if (i == PKEY_NOTSUP)
+ return atom_notsup;
+ else
+ return enif_make_badarg(env);
+ }
+
+ if (get_pkey_sign_key(env, argv[0], argv[3], &pkey) != PKEY_OK) {
+ return enif_make_badarg(env);
+ }
+
+#ifdef HAS_EVP_PKEY_CTX
+/* printf("EVP interface\r\n");
+ */
+ ctx = EVP_PKEY_CTX_new(pkey, NULL);
+ if (!ctx) goto badarg;
+ if (EVP_PKEY_sign_init(ctx) <= 0) goto badarg;
+ if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg;
+
+ if (argv[0] == atom_rsa) {
+ if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg;
+ if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) {
+ if (sig_opt.rsa_mgf1_md != NULL) {
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,1)
+ if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) <= 0) goto badarg;
+#else
+ EVP_PKEY_CTX_free(ctx);
+ EVP_PKEY_free(pkey);
+ return atom_notsup;
+#endif
+ }
+ if (sig_opt.rsa_pss_saltlen > -2
+ && EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) <= 0)
+ goto badarg;
+ }
+ }
+
+ if (EVP_PKEY_sign(ctx, NULL, &siglen, tbs, tbslen) <= 0) goto badarg;
+ enif_alloc_binary(siglen, &sig_bin);
+
+ if (md != NULL) {
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md));
+ }
+ i = EVP_PKEY_sign(ctx, sig_bin.data, &siglen, tbs, tbslen);
+
+ EVP_PKEY_CTX_free(ctx);
+#else
+/*printf("Old interface\r\n");
+ */
+ if (argv[0] == atom_rsa) {
+ RSA *rsa = EVP_PKEY_get1_RSA(pkey);
+ enif_alloc_binary(RSA_size(rsa), &sig_bin);
+ len = EVP_MD_size(md);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+ i = RSA_sign(md->type, tbs, len, sig_bin.data, &siglen, rsa);
+ RSA_free(rsa);
+ } else if (argv[0] == atom_dss) {
+ DSA *dsa = EVP_PKEY_get1_DSA(pkey);
+ enif_alloc_binary(DSA_size(dsa), &sig_bin);
+ len = EVP_MD_size(md);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+ i = DSA_sign(md->type, tbs, len, sig_bin.data, &siglen, dsa);
+ DSA_free(dsa);
+ } else if (argv[0] == atom_ecdsa) {
+#if defined(HAVE_EC)
+ EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
+ enif_alloc_binary(ECDSA_size(ec), &sig_bin);
+ len = EVP_MD_size(md);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+ i = ECDSA_sign(md->type, tbs, len, sig_bin.data, &siglen, ec);
+ EC_KEY_free(ec);
+#else
+ EVP_PKEY_free(pkey);
+ return atom_notsup;
+#endif
+ } else {
+ goto badarg;
+ }
+#endif
+
+ EVP_PKEY_free(pkey);
+ if (i == 1) {
+ ERL_VALGRIND_MAKE_MEM_DEFINED(sig_bin.data, siglen);
+ if (siglen != sig_bin.size) {
+ enif_realloc_binary(&sig_bin, siglen);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(sig_bin.data, siglen);
+ }
+ return enif_make_binary(env, &sig_bin);
+ } else {
+ enif_release_binary(&sig_bin);
+ return atom_error;
+ }
+
+ badarg:
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX_free(ctx);
+#endif
+ EVP_PKEY_free(pkey);
+ return enif_make_badarg(env);
+}
+
+
+static int get_pkey_verify_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key,
+ EVP_PKEY **pkey)
+{
+ if (algorithm == atom_rsa) {
+ RSA *rsa = RSA_new();
+
+ if (!get_rsa_public_key(env, key, rsa)) {
+ RSA_free(rsa);
+ return PKEY_BADARG;
+ }
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_RSA(*pkey, rsa)) {
+ EVP_PKEY_free(*pkey);
+ RSA_free(rsa);
+ return PKEY_BADARG;
+ }
+ } else if (algorithm == atom_ecdsa) {
+#if defined(HAVE_EC)
+ EC_KEY *ec = NULL;
+ const ERL_NIF_TERM *tpl_terms;
+ int tpl_arity;
+
+ if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2
+ && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1])
+ && get_ec_key(env, tpl_terms[0], atom_undefined, tpl_terms[1], &ec)) {
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) {
+ EVP_PKEY_free(*pkey);
+ EC_KEY_free(ec);
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+#else
+ return PKEY_NOTSUP;
+#endif
+ } else if (algorithm == atom_dss) {
+ DSA *dsa = DSA_new();
+
+ if (!get_dss_public_key(env, key, dsa)) {
+ DSA_free(dsa);
+ return PKEY_BADARG;
+ }
+
+ *pkey = EVP_PKEY_new();
+ if (!EVP_PKEY_assign_DSA(*pkey, dsa)) {
+ EVP_PKEY_free(*pkey);
+ DSA_free(dsa);
+ return PKEY_BADARG;
+ }
+ } else {
+ return PKEY_BADARG;
+ }
+
+ return PKEY_OK;
+}
+
+static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
+{/* (Algorithm, Type, Data|{digest,Digest}, Signature, Key, Options) */
+ int i;
+ const EVP_MD *md = NULL;
+ unsigned char md_value[EVP_MAX_MD_SIZE];
+ EVP_PKEY *pkey;
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX *ctx;
+#else
+#endif
+ PKeySignOptions sig_opt;
+ ErlNifBinary sig_bin; /* signature */
+ unsigned char *tbs; /* data to be signed */
+ size_t tbslen;
+
+ if (!enif_inspect_binary(env, argv[3], &sig_bin)) {
+ return enif_make_badarg(env);
+ }
+
+ i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen);
+ if (i != PKEY_OK) {
+ if (i == PKEY_NOTSUP)
+ return atom_notsup;
+ else
+ return enif_make_badarg(env);
+ }
+
+ i = get_pkey_sign_options(env, argv[0], argv[5], md, &sig_opt);
+ if (i != PKEY_OK) {
+ if (i == PKEY_NOTSUP)
+ return atom_notsup;
+ else
+ return enif_make_badarg(env);
+ }
+
+ if (get_pkey_verify_key(env, argv[0], argv[4], &pkey) != PKEY_OK) {
+ return enif_make_badarg(env);
+ }
+
+#ifdef HAS_EVP_PKEY_CTX
+/* printf("EVP interface\r\n");
+ */
+ ctx = EVP_PKEY_CTX_new(pkey, NULL);
+ if (!ctx) goto badarg;
+ if (EVP_PKEY_verify_init(ctx) <= 0) goto badarg;
+ if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg;
+
+ if (argv[0] == atom_rsa) {
+ if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg;
+ if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) {
+ if (sig_opt.rsa_mgf1_md != NULL) {
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,1)
+ if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) <= 0) goto badarg;
+#else
+ EVP_PKEY_CTX_free(ctx);
+ EVP_PKEY_free(pkey);
+ return atom_notsup;
+#endif
+ }
+ if (sig_opt.rsa_pss_saltlen > -2
+ && EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) <= 0)
+ goto badarg;
+ }
+ }
+
+ if (md != NULL) {
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md));
+ }
+ i = EVP_PKEY_verify(ctx, sig_bin.data, sig_bin.size, tbs, tbslen);
+
+ EVP_PKEY_CTX_free(ctx);
+#else
+/*printf("Old interface\r\n");
+*/
+ if (argv[0] == atom_rsa) {
+ RSA *rsa = EVP_PKEY_get1_RSA(pkey);
+ i = RSA_verify(md->type, tbs, tbslen, sig_bin.data, sig_bin.size, rsa);
+ RSA_free(rsa);
+ } else if (argv[0] == atom_dss) {
+ DSA *dsa = EVP_PKEY_get1_DSA(pkey);
+ i = DSA_verify(0, tbs, tbslen, sig_bin.data, sig_bin.size, dsa);
+ DSA_free(dsa);
+ } else if (argv[0] == atom_ecdsa) {
+#if defined(HAVE_EC)
+ EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
+ i = ECDSA_verify(EVP_MD_type(md), tbs, tbslen, sig_bin.data, sig_bin.size, ec);
+ EC_KEY_free(ec);
+#else
+ EVP_PKEY_free(pkey);
+ return atom_notsup;
+#endif
+ } else {
+ goto badarg;
+ }
+#endif
+
+ EVP_PKEY_free(pkey);
+ if (i == 1) {
+ return atom_true;
+ } else {
+ return atom_false;
+ }
+
+ badarg:
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX_free(ctx);
+#endif
+ EVP_PKEY_free(pkey);
+ return enif_make_badarg(env);
+}
+
+
+/*================================================================*/
+
static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ErlNifBinary seed_bin;
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 89ef529c5d..5b2c46a004 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -159,12 +159,24 @@
<code>digest_type() = md5 | sha | sha224 | sha256 | sha384 | sha512</code>
+ <code>rsa_digest_type() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512</code>
+
+ <code>dss_digest_type() = sha | sha224 | sha256 | sha384 | sha512</code> <p>Note that the actual supported
+ dss_digest_type depends on the underlying crypto library. In OpenSSL version >= 1.0.1 the listed digest are supported, while in 1.0.0 only sha, sha224 and sha256 are supported. In version 0.9.8 only sha is supported.</p>
+
+ <code>ecdsa_digest_type() = sha | sha224 | sha256 | sha384 | sha512</code>
+
+ <code>sign_options() = [{rsa_pad, rsa_sign_padding()} | {rsa_pss_saltlen, integer()}]</code>
+
+ <code>rsa_sign_padding() = rsa_pkcs1_padding | rsa_pkcs1_pss_padding</code>
+
<code> hash_algorithms() = md5 | ripemd160 | sha | sha224 | sha256 | sha384 | sha512 </code> <p>md4 is also supported for hash_init/1 and hash/2.
Note that both md4 and md5 are recommended only for compatibility with existing applications.
</p>
<code> cipher_algorithms() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ctr | aes_gcm |
aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | des_cfb |
des3_cbc | des3_cfb | des_ede3 | rc2_cbc | rc4 </code>
+ <code> mac_algorithms() = hmac | cmac</code>
<code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code>
<p>Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported
with ecdsa and ecdh.
@@ -681,6 +693,7 @@
<func>
<name>sign(Algorithm, DigestType, Msg, Key) -> binary()</name>
+ <name>sign(Algorithm, DigestType, Msg, Key, Options) -> binary()</name>
<fsummary> Create digital signature.</fsummary>
<type>
<v>Algorithm = rsa | dss | ecdsa </v>
@@ -688,8 +701,9 @@
<d>The msg is either the binary "cleartext" data to be
signed or it is the hashed value of "cleartext" i.e. the
digest (plaintext).</d>
- <v>DigestType = digest_type()</v>
+ <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Key = rsa_private() | dss_private() | [ecdh_private(),ecdh_params()]</v>
+ <v>Options = sign_options()</v>
</type>
<desc>
<p>Creates a digital signature.</p>
@@ -835,7 +849,8 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
<type>
<v> AlgorithmList = [{hashs, [hash_algorithms()]},
{ciphers, [cipher_algorithms()]},
- {public_keys, [public_key_algorithms()]}
+ {public_keys, [public_key_algorithms()]},
+ {macs, [mac_algorithms()]}]
</v>
</type>
<desc>
@@ -869,15 +884,17 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
<func>
<name>verify(Algorithm, DigestType, Msg, Signature, Key) -> boolean()</name>
+ <name>verify(Algorithm, DigestType, Msg, Signature, Key, Options) -> boolean()</name>
<fsummary>Verifies a digital signature.</fsummary>
<type>
<v> Algorithm = rsa | dss | ecdsa </v>
<v>Msg = binary() | {digest,binary()}</v>
<d>The msg is either the binary "cleartext" data
or it is the hashed value of "cleartext" i.e. the digest (plaintext).</d>
- <v>DigestType = digest_type()</v>
+ <v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Signature = binary()</v>
<v>Key = rsa_public() | dss_public() | [ecdh_public(),ecdh_params()]</v>
+ <v>Options = sign_options()</v>
</type>
<desc>
<p>Verifies a digital signature</p>
diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml
index 62b013e463..574353ce7a 100644
--- a/lib/crypto/doc/src/notes.xml
+++ b/lib/crypto/doc/src/notes.xml
@@ -31,6 +31,134 @@
</header>
<p>This document describes the changes made to the Crypto application.</p>
+<section><title>Crypto 4.0</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ LibreSSL can now be used by the modernized crypto app.</p>
+ <p>
+ Own Id: OTP-14247</p>
+ </item>
+ <item>
+ <p>
+ Add compile option <c>-compile(no_native)</c> in modules
+ with <c>on_load</c> directive which is not yet supported
+ by HiPE.</p>
+ <p>
+ Own Id: OTP-14316 Aux Id: PR-1390 </p>
+ </item>
+ <item>
+ <p>
+ Fix a bug in aes cfb128 function introduced by the bug
+ fix in GitHub pull request <url
+ href="https://github.com/erlang/otp/pull/1393">#1393</url>.</p>
+ <p>
+ Own Id: OTP-14435 Aux Id: PR-1462, PR-1393, OTP-14313 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Add basic support for CMAC</p>
+ <p>
+ Own Id: OTP-13779 Aux Id: ERL-82 PR-1138 </p>
+ </item>
+ <item>
+ <p>
+ Removed functions deprecated in crypto-3.0 first released
+ in OTP-R16B01</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-13873</p>
+ </item>
+ <item>
+ <p>
+ The <c>crypto</c> application now supports OpenSSL 1.1.</p>
+ <p>
+ Own Id: OTP-13900</p>
+ </item>
+ <item>
+ <p>
+ Allow Erlang/OTP to use OpenSSL in FIPS-140 mode, in
+ order to satisfy specific security requirements (mostly
+ by different parts of the US federal government). </p>
+ <p>
+ See the new crypto users guide "FIPS mode" chapter about
+ building and using the FIPS support which is disabled by
+ default.</p>
+ <p>
+ (Thanks to dszoboszlay and legoscia)</p>
+ <p>
+ Own Id: OTP-13921 Aux Id: PR-1180 </p>
+ </item>
+ <item>
+ <p>
+ Crypto chacha20-poly1305 as in RFC 7539 enabled for
+ OpenSSL >= 1.1.</p>
+ <p>
+ Thanks to mururu.</p>
+ <p>
+ Own Id: OTP-14092 Aux Id: PR-1291 </p>
+ </item>
+ <item>
+ <p>
+ RSA key generation added to <c>crypto:generate_key/2</c>.
+ Thanks to wiml.</p>
+ <p>
+ An interface is also added to
+ <c>public_key:generate_key/1</c>.</p>
+ <p>
+ Own Id: OTP-14140 Aux Id: ERL-165, PR-1299 </p>
+ </item>
+ <item>
+ <p>
+ Raised minimum requirement for OpenSSL version to
+ OpenSSL-0.9.8.c although we recommend a much higher
+ version, that is a version that is still maintained
+ officially by the OpenSSL project. Note that using such
+ an old version may restrict the crypto algorithms
+ supported.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14171</p>
+ </item>
+ <item>
+ <p>
+ Deprecate crypto:rand_uniform/2 as it is not
+ cryptographically strong</p>
+ <p>
+ Own Id: OTP-14274</p>
+ </item>
+ <item>
+ <p>
+ The Crypto application now supports generation of
+ cryptographically strong random numbers (floats &lt; 1.0
+ and integer arbitrary ranges) as a plugin to the 'rand'
+ module.</p>
+ <p>
+ Own Id: OTP-14317 Aux Id: PR-1372 </p>
+ </item>
+ <item>
+ <p>
+ This replaces the hard coded test values for AES, CMAC
+ and GCM ciphers with the full validation set from NIST's
+ CAVP program.</p>
+ <p>
+ Own Id: OTP-14436 Aux Id: PR-1396 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Crypto 3.7.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index d111525214..1df05462c9 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -25,7 +25,7 @@
-export([start/0, stop/0, info_lib/0, info_fips/0, supports/0, enable_fips_mode/1,
version/0, bytes_to_integer/1]).
-export([hash/2, hash_init/1, hash_update/2, hash_final/1]).
--export([sign/4, verify/5]).
+-export([sign/4, sign/5, verify/5, verify/6]).
-export([generate_key/2, generate_key/3, compute_key/4]).
-export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]).
-export([cmac/3, cmac/4]).
@@ -45,6 +45,10 @@
-export([ec_curve/1, ec_curves/0]).
-export([rand_seed/1]).
+%% Private. For tests.
+-export([packed_openssl_version/4]).
+
+
-deprecated({rand_uniform, 2, next_major_release}).
%% This should correspond to the similar macro in crypto.c
@@ -87,11 +91,12 @@ stop() ->
application:stop(crypto).
supports()->
- {Hashs, PubKeys, Ciphers} = algorithms(),
+ {Hashs, PubKeys, Ciphers, Macs} = algorithms(),
[{hashs, Hashs},
{ciphers, Ciphers},
- {public_keys, PubKeys}
+ {public_keys, PubKeys},
+ {macs, Macs}
].
info_lib() -> ?nif_stub.
@@ -388,36 +393,31 @@ mod_pow(Base, Exponent, Prime) ->
<<0>> -> error;
R -> R
end.
-verify(dss, none, Data, Signature, Key) when is_binary(Data) ->
- verify(dss, sha, {digest, Data}, Signature, Key);
-verify(Alg, Type, Data, Signature, Key) when is_binary(Data) ->
- verify(Alg, Type, {digest, hash(Type, Data)}, Signature, Key);
-verify(dss, Type, {digest, Digest}, Signature, Key) ->
- dss_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key));
-verify(rsa, Type, {digest, Digest}, Signature, Key) ->
- notsup_to_error(
- rsa_verify_nif(Type, Digest, Signature, map_ensure_int_as_bin(Key)));
-verify(ecdsa, Type, {digest, Digest}, Signature, [Key, Curve]) ->
- notsup_to_error(
- ecdsa_verify_nif(Type, Digest, Signature, nif_curve_params(Curve), ensure_int_as_bin(Key))).
-sign(dss, none, Data, Key) when is_binary(Data) ->
- sign(dss, sha, {digest, Data}, Key);
-sign(Alg, Type, Data, Key) when is_binary(Data) ->
- sign(Alg, Type, {digest, hash(Type, Data)}, Key);
-sign(rsa, Type, {digest, Digest}, Key) ->
- case rsa_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [rsa, Type, {digest, Digest}, Key]);
- Sign -> Sign
- end;
-sign(dss, Type, {digest, Digest}, Key) ->
- case dss_sign_nif(Type, Digest, map_ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [dss, Type, {digest, Digest}, Key]);
- Sign -> Sign
- end;
-sign(ecdsa, Type, {digest, Digest}, [Key, Curve]) ->
- case ecdsa_sign_nif(Type, Digest, nif_curve_params(Curve), ensure_int_as_bin(Key)) of
- error -> erlang:error(badkey, [ecdsa, Type, {digest, Digest}, [Key, Curve]]);
- Sign -> Sign
+
+verify(Algorithm, Type, Data, Signature, Key) ->
+ verify(Algorithm, Type, Data, Signature, Key, []).
+
+%% Backwards compatible
+verify(Algorithm = dss, none, Digest, Signature, Key, Options) ->
+ verify(Algorithm, sha, {digest, Digest}, Signature, Key, Options);
+verify(Algorithm, Type, Data, Signature, Key, Options) ->
+ case pkey_verify_nif(Algorithm, Type, Data, Signature, format_pkey(Algorithm, Key), Options) of
+ notsup -> erlang:error(notsup);
+ Boolean -> Boolean
+ end.
+
+
+sign(Algorithm, Type, Data, Key) ->
+ sign(Algorithm, Type, Data, Key, []).
+
+%% Backwards compatible
+sign(Algorithm = dss, none, Digest, Key, Options) ->
+ sign(Algorithm, sha, {digest, Digest}, Key, Options);
+sign(Algorithm, Type, Data, Key, Options) ->
+ case pkey_sign_nif(Algorithm, Type, Data, format_pkey(Algorithm, Key), Options) of
+ error -> erlang:error(badkey, [Algorithm, Type, Data, Key, Options]);
+ notsup -> erlang:error(notsup);
+ Signature -> Signature
end.
-spec public_encrypt(rsa, binary(), [binary()], rsa_padding()) ->
@@ -838,13 +838,9 @@ srp_value_B_nif(_Multiplier, _Verifier, _Generator, _Exponent, _Prime) -> ?nif_s
%% Digital signatures --------------------------------------------------------------------
-rsa_sign_nif(_Type,_Digest,_Key) -> ?nif_stub.
-dss_sign_nif(_Type,_Digest,_Key) -> ?nif_stub.
-ecdsa_sign_nif(_Type, _Digest, _Curve, _Key) -> ?nif_stub.
-dss_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub.
-rsa_verify_nif(_Type, _Digest, _Signature, _Key) -> ?nif_stub.
-ecdsa_verify_nif(_Type, _Digest, _Signature, _Curve, _Key) -> ?nif_stub.
+pkey_sign_nif(_Algorithm, _Type, _Digest, _Key, _Options) -> ?nif_stub.
+pkey_verify_nif(_Algorithm, _Type, _Data, _Signature, _Key, _Options) -> ?nif_stub.
%% Public Keys --------------------------------------------------------------------
%% RSA Rivest-Shamir-Adleman functions
@@ -961,6 +957,15 @@ ensure_int_as_bin(Int) when is_integer(Int) ->
ensure_int_as_bin(Bin) ->
Bin.
+format_pkey(rsa, Key) ->
+ map_ensure_int_as_bin(Key);
+format_pkey(ecdsa, [Key, Curve]) ->
+ {nif_curve_params(Curve), ensure_int_as_bin(Key)};
+format_pkey(dss, Key) ->
+ map_ensure_int_as_bin(Key);
+format_pkey(_, Key) ->
+ Key.
+
%%--------------------------------------------------------------------
%%
-type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'.
@@ -1003,3 +1008,14 @@ erlint(<<MPIntSize:32/integer,MPIntValue/binary>>) ->
%%
mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub.
+
+%%%----------------------------------------------------------------
+%% 9470495 == V(0,9,8,zh).
+%% 268435615 == V(1,0,0,i).
+%% 268439663 == V(1,0,1,f).
+
+packed_openssl_version(MAJ, MIN, FIX, P0) ->
+ %% crypto.c
+ P1 = atom_to_list(P0),
+ P = lists:sum([C-$a||C<-P1]),
+ ((((((((MAJ bsl 8) bor MIN) bsl 8 ) bor FIX) bsl 8) bor (P+1)) bsl 4) bor 16#f).
diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl
index c2d0d2621b..c9033ac4f8 100644
--- a/lib/crypto/test/blowfish_SUITE.erl
+++ b/lib/crypto/test/blowfish_SUITE.erl
@@ -47,6 +47,11 @@
init_per_suite(Config) ->
case catch crypto:start() of
ok ->
+ catch ct:comment("~s",[element(3,hd(crypto:info_lib()))]),
+ catch ct:log("crypto:info_lib() -> ~p~n"
+ "crypto:supports() -> ~p~n"
+ "crypto:version() -> ~p~n"
+ ,[crypto:info_lib(), crypto:supports(), crypto:version()]),
Config;
_Else ->
{skip,"Could not start crypto!"}
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 30ee782fe9..88f13d766c 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -177,6 +177,12 @@ init_per_suite(Config) ->
try crypto:start() of
ok ->
+ catch ct:comment("~s",[element(3,hd(crypto:info_lib()))]),
+ catch ct:log("crypto:info_lib() -> ~p~n"
+ "crypto:supports() -> ~p~n"
+ "crypto:version() -> ~p~n"
+ ,[crypto:info_lib(), crypto:supports(), crypto:version()]),
+
try crypto:strong_rand_bytes(1) of
_ ->
Config
@@ -745,10 +751,44 @@ do_sign_verify({Type, Hash, Public, Private, Msg}) ->
Signature = crypto:sign(Type, Hash, Msg, Private),
case crypto:verify(Type, Hash, Msg, Signature, Public) of
true ->
+ ct:log("OK crypto:sign(~p, ~p, ..., ..., ...)", [Type,Hash]),
negative_verify(Type, Hash, Msg, <<10,20>>, Public);
false ->
+ ct:log("ERROR crypto:sign(~p, ~p, ..., ..., ...)", [Type,Hash]),
ct:fail({{crypto, verify, [Type, Hash, Msg, Signature, Public]}})
- end.
+ end;
+do_sign_verify({Type, Hash, Public, Private, Msg, Options}) ->
+ LibVer =
+ case crypto:info_lib() of
+ [{<<"OpenSSL">>,Ver,<<"OpenSSL",_/binary>>}] -> Ver;
+ _ -> infinity
+ end,
+ Pad = proplists:get_value(rsa_padding, Options),
+ NotSupLow = lists:member(Pad, [rsa_pkcs1_pss_padding]),
+ try
+ crypto:sign(Type, Hash, Msg, Private, Options)
+ of
+ Signature ->
+ case crypto:verify(Type, Hash, Msg, Signature, Public, Options) of
+ true ->
+ ct:log("OK crypto:sign(~p, ~p, ..., ..., ..., ~p)", [Type,Hash,Options]),
+ negative_verify(Type, Hash, Msg, <<10,20>>, Public, Options);
+ false ->
+ ct:log("ERROR crypto:sign(~p, ~p, ..., ..., ..., ~p)", [Type,Hash,Options]),
+ ct:fail({{crypto, verify, [Type, Hash, Msg, Signature, Public, Options]}})
+ end
+ catch
+ error:notsup when NotSupLow == true,
+ is_integer(LibVer),
+ LibVer < 16#10001000 ->
+ %% Thoose opts where introduced in 1.0.1
+ ct:log("notsup but OK in old cryptolib crypto:sign(~p, ~p, ..., ..., ..., ~p)",
+ [Type,Hash,Options]),
+ true;
+ C:E ->
+ ct:log("~p:~p crypto:sign(~p, ~p, ..., ..., ..., ~p)", [C,E,Type,Hash,Options]),
+ ct:fail({{crypto, sign_verify, [LibVer, Type, Hash, Msg, Public, Options]}})
+ end.
negative_verify(Type, Hash, Msg, Signature, Public) ->
case crypto:verify(Type, Hash, Msg, Signature, Public) of
@@ -758,6 +798,14 @@ negative_verify(Type, Hash, Msg, Signature, Public) ->
ok
end.
+negative_verify(Type, Hash, Msg, Signature, Public, Options) ->
+ case crypto:verify(Type, Hash, Msg, Signature, Public, Options) of
+ true ->
+ ct:fail({{crypto, verify, [Type, Hash, Msg, Signature, Public, Options]}, should_fail});
+ false ->
+ ok
+ end.
+
do_public_encrypt({Type, Public, Private, Msg, Padding}) ->
PublicEcn = (catch crypto:public_encrypt(Type, Msg, Public, Padding)),
case crypto:private_decrypt(Type, PublicEcn, Private, Padding) of
@@ -809,8 +857,15 @@ do_generate({ecdh = Type, Curve, Priv, Pub}) ->
ct:fail({{crypto, generate_key, [Type, Priv, Curve]}, {expected, Pub}, {got, Other}})
end;
do_generate({rsa = Type, Mod, Exp}) ->
- {Pub,Priv} = crypto:generate_key(Type, {Mod,Exp}),
- do_sign_verify({rsa, sha256, Pub, Priv, rsa_plain()}).
+ case crypto:info_fips() of
+ enabled when Mod < 3072 ->
+ ct:log("SKIP do_generate ~p FIPS=~p, Mod=~p Exp=~p", [Type, enabled, Mod, Exp]),
+ {skip, "FIPS violation"};
+ FIPS ->
+ ct:log("do_generate ~p FIPS=~p, Mod=~p Exp=~p", [Type, FIPS, Mod, Exp]),
+ {Pub,Priv} = crypto:generate_key(Type, {Mod,Exp}),
+ do_sign_verify({rsa, sha256, Pub, Priv, rsa_plain()})
+ end.
notsup(Fun, Args) ->
Result =
@@ -1159,19 +1214,35 @@ group_config(rsa = Type, Config) ->
rsa_oaep(),
no_padding()
],
- Generate = [{rsa, 2048, 17}, {rsa, 3072, 65537}],
+ Generate = [{rsa, 1024, 3}, {rsa, 2048, 17}, {rsa, 3072, 65537}],
[{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc}, {generate, Generate} | Config];
group_config(dss = Type, Config) ->
Msg = dss_plain(),
Public = dss_params() ++ [dss_public()],
Private = dss_params() ++ [dss_private()],
- SignVerify = [{Type, sha, Public, Private, Msg}],
+ SupportedHashs = proplists:get_value(hashs, crypto:supports(), []),
+ DssHashs =
+ case crypto:info_lib() of
+ [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer), LibVer > 16#10001000 ->
+ [sha, sha224, sha256, sha384, sha512];
+ [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer), LibVer > 16#10000000 ->
+ [sha, sha224, sha256];
+ _Else ->
+ [sha]
+ end,
+ SignVerify = [{Type, Hash, Public, Private, Msg}
+ || Hash <- DssHashs,
+ lists:member(Hash, SupportedHashs)],
[{sign_verify, SignVerify} | Config];
group_config(ecdsa = Type, Config) ->
{Private, Public} = ec_key_named(),
Msg = ec_msg(),
- SignVerify = [{Type, sha, Public, Private, Msg}],
+ SupportedHashs = proplists:get_value(hashs, crypto:supports(), []),
+ DssHashs = [sha, sha224, sha256, sha384, sha512],
+ SignVerify = [{Type, Hash, Public, Private, Msg}
+ || Hash <- DssHashs,
+ lists:member(Hash, SupportedHashs)],
[{sign_verify, SignVerify} | Config];
group_config(srp, Config) ->
GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()],
@@ -1255,18 +1326,38 @@ group_config(_, Config) ->
Config.
sign_verify_tests(Type, Msg, Public, Private, PublicS, PrivateS) ->
- sign_verify_tests(Type, [md5, sha, sha224, sha256], Msg, Public, Private) ++
- sign_verify_tests(Type, [sha384, sha512], Msg, PublicS, PrivateS).
-
-sign_verify_tests(Type, Hashs, Msg, Public, Private) ->
- lists:foldl(fun(Hash, Acc) ->
- case is_supported(Hash) of
- true ->
- [{Type, Hash, Public, Private, Msg}|Acc];
- false ->
- Acc
- end
- end, [], Hashs).
+ gen_sign_verify_tests(Type, [md5, ripemd160, sha, sha224, sha256], Msg, Public, Private,
+ [undefined,
+ [{rsa_padding, rsa_pkcs1_pss_padding}],
+ [{rsa_padding, rsa_pkcs1_pss_padding}, {rsa_pss_saltlen, 0}],
+ [{rsa_padding, rsa_x931_padding}]
+ ]) ++
+ gen_sign_verify_tests(Type, [sha384, sha512], Msg, PublicS, PrivateS,
+ [undefined,
+ [{rsa_padding, rsa_pkcs1_pss_padding}],
+ [{rsa_padding, rsa_pkcs1_pss_padding}, {rsa_pss_saltlen, 0}],
+ [{rsa_padding, rsa_x931_padding}]
+ ]).
+
+gen_sign_verify_tests(Type, Hashs, Msg, Public, Private, Opts) ->
+ lists:foldr(fun(Hash, Acc0) ->
+ case is_supported(Hash) of
+ true ->
+ lists:foldr(fun
+ (undefined, Acc1) ->
+ [{Type, Hash, Public, Private, Msg} | Acc1];
+ ([{rsa_padding, rsa_x931_padding} | _], Acc1)
+ when Hash =:= md5
+ orelse Hash =:= ripemd160
+ orelse Hash =:= sha224 ->
+ Acc1;
+ (Opt, Acc1) ->
+ [{Type, Hash, Public, Private, Msg, Opt} | Acc1]
+ end, Acc0, Opts);
+ false ->
+ Acc0
+ end
+ end, [], Hashs).
rfc_1321_msgs() ->
[<<"">>,
@@ -2287,7 +2378,7 @@ fmt_words(Words) ->
log_rsp_size(Label, Term) ->
S = erts_debug:size(Term),
- ct:pal("~s: ~w test(s), Memory used: ~s",
+ ct:log("~s: ~w test(s), Memory used: ~s",
[Label, length(Term), fmt_words(S)]).
read_rsp(Config, Type, Files) ->
diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk
index f3e0623ac9..796e3b6d84 100644
--- a/lib/crypto/vsn.mk
+++ b/lib/crypto/vsn.mk
@@ -1 +1 @@
-CRYPTO_VSN = 3.7.4
+CRYPTO_VSN = 4.0
diff --git a/lib/debugger/doc/src/notes.xml b/lib/debugger/doc/src/notes.xml
index 532a17bd81..fa85567a84 100644
--- a/lib/debugger/doc/src/notes.xml
+++ b/lib/debugger/doc/src/notes.xml
@@ -33,6 +33,42 @@
<p>This document describes the changes made to the Debugger
application.</p>
+<section><title>Debugger 4.2.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> The Erlang shell, <c>qlc:string_to_handle()</c>, and
+ the Debugger (the Evaluator area and Edit variable window
+ of the Bindings area) can parse pids, ports, references,
+ and external funs, as long as they can be created in the
+ running system. </p>
+ <p>
+ Own Id: OTP-14296</p>
+ </item>
+ <item>
+ <p> Fix editing of simple binary values in the Bindings
+ area of the Debugger's Attach Process Window. </p>
+ <p>
+ Own Id: OTP-14318</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Debugger 4.2.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/debugger/vsn.mk b/lib/debugger/vsn.mk
index f5440865ef..3534570ef5 100644
--- a/lib/debugger/vsn.mk
+++ b/lib/debugger/vsn.mk
@@ -1 +1 @@
-DEBUGGER_VSN = 4.2.1
+DEBUGGER_VSN = 4.2.2
diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml
index f7613b3145..0d2cb6c4df 100644
--- a/lib/dialyzer/doc/src/notes.xml
+++ b/lib/dialyzer/doc/src/notes.xml
@@ -32,6 +32,75 @@
<p>This document describes the changes made to the Dialyzer
application.</p>
+<section><title>Dialyzer 3.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> The check of bad type variables in type declarations
+ was mistakingly removed in Erlang/OTP 18, and is now
+ re-introduced. </p>
+ <p>
+ Own Id: OTP-14423 Aux Id: OTP-14323 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Analyzing modules with binary construction with huge
+ strings is now much faster. The compiler also compiles
+ such modules slightly faster.</p>
+ <p>
+ Own Id: OTP-14125 Aux Id: ERL-308 </p>
+ </item>
+ <item>
+ <p> The peak memory consumption is reduced. </p>
+ <p>
+ Own Id: OTP-14127</p>
+ </item>
+ <item>
+ <p> Warnings about unknown types are now also generated
+ for types not used by any function specification. </p>
+ <p>
+ Own Id: OTP-14218 Aux Id: OTP-14127 </p>
+ </item>
+ <item>
+ <p>TypEr has been removed as separate application and is
+ now a part of the Dialyzer application. Documentation for
+ TypEr has been added in the Dialyzer application.</p>
+ <p>
+ Own Id: OTP-14336</p>
+ </item>
+ <item>
+ <p>The format of debug information that is stored in BEAM
+ files (when <c>debug_info</c> is used) has been changed.
+ The purpose of the change is to better support other
+ BEAM-based languages such as Elixir or LFE.</p>
+ <p>All tools included in OTP (dialyzer, debugger, cover,
+ and so on) will handle both the new format and the
+ previous format. Tools that retrieve the debug
+ information using <c>beam_lib:chunk(Beam,
+ [abstract_code])</c> will continue to work with both the
+ new and old format. Tools that call
+ <c>beam_lib:chunk(Beam, ["Abst"])</c> will not work with
+ the new format.</p>
+ <p>For more information, see the description of
+ <c>debug_info</c> in the documentation for
+ <c>beam_lib</c> and the description of the
+ <c>{debug_info,{Backend,Data}}</c> option in the
+ documentation for <c>compile</c>.</p>
+ <p>
+ Own Id: OTP-14369 Aux Id: PR-1367 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Dialyzer 3.1.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl
index ab137bd170..c319acb2fb 100644
--- a/lib/dialyzer/src/dialyzer.erl
+++ b/lib/dialyzer/src/dialyzer.erl
@@ -111,13 +111,13 @@ get_plt_info([PLT|PLTs]) ->
String =
case dialyzer_plt:included_files(PLT) of
{ok, Files} ->
- io_lib:format("The PLT ~s includes the following files:\n~p\n\n",
+ io_lib:format("The PLT ~ts includes the following files:\n~tp\n\n",
[PLT, Files]);
{error, read_error} ->
- Msg = io_lib:format("Could not read the PLT file ~p\n\n", [PLT]),
+ Msg = io_lib:format("Could not read the PLT file ~tp\n\n", [PLT]),
throw({dialyzer_error, Msg});
{error, no_such_file} ->
- Msg = io_lib:format("The PLT file ~p does not exist\n\n", [PLT]),
+ Msg = io_lib:format("The PLT file ~tp does not exist\n\n", [PLT]),
throw({dialyzer_error, Msg})
end,
String ++ get_plt_info(PLTs);
@@ -126,16 +126,16 @@ get_plt_info([]) -> "".
do_print_plt_info(PLTInfo, OutputFile) ->
case OutputFile =:= none of
true ->
- io:format("~s", [PLTInfo]),
+ io:format("~ts", [PLTInfo]),
?RET_NOTHING_SUSPICIOUS;
false ->
case file:open(OutputFile, [write]) of
{ok, FileDesc} ->
- io:format(FileDesc, "~s", [PLTInfo]),
+ io:format(FileDesc, "~ts", [PLTInfo]),
ok = file:close(FileDesc),
?RET_NOTHING_SUSPICIOUS;
{error, Reason} ->
- Msg1 = io_lib:format("Could not open output file ~p, Reason: ~p\n",
+ Msg1 = io_lib:format("Could not open output file ~tp, Reason: ~p\n",
[OutputFile, Reason]),
throw({dialyzer_error, Msg1})
end
@@ -264,7 +264,7 @@ cl_halt({ok, R = ?RET_DISCREPANCIES}, #options{output_file = Output}) ->
halt(R);
cl_halt({error, Msg1}, #options{output_file = Output}) ->
%% Msg2 = "dialyzer: Internal problems were encountered in the analysis",
- io:format("\ndialyzer: ~s\n", [Msg1]),
+ io:format("\ndialyzer: ~ts\n", [Msg1]),
cl_check_log(Output),
halt(?RET_INTERNAL_ERROR).
@@ -273,7 +273,7 @@ cl_halt({error, Msg1}, #options{output_file = Output}) ->
cl_check_log(none) ->
ok;
cl_check_log(Output) ->
- io:format(" Check output file `~s' for details\n", [Output]).
+ io:format(" Check output file `~ts' for details\n", [Output]).
-spec format_warning(raw_warning() | dial_warning()) -> string().
@@ -291,7 +291,7 @@ format_warning({_Tag, {File, Line}, Msg}, FOpt) when is_list(File),
basename -> filename:basename(File)
end,
String = lists:flatten(message_to_string(Msg)),
- lists:flatten(io_lib:format("~s:~w: ~s", [F, Line, String])).
+ lists:flatten(io_lib:format("~ts:~w: ~ts", [F, Line, String])).
%%-----------------------------------------------------------------------------
@@ -302,54 +302,55 @@ format_warning({_Tag, {File, Line}, Msg}, FOpt) when is_list(File),
%%----- Warnings for general discrepancies ----------------
message_to_string({apply, [Args, ArgNs, FailReason,
SigArgs, SigRet, Contract]}) ->
- io_lib:format("Fun application with arguments ~s ", [Args]) ++
+ io_lib:format("Fun application with arguments ~ts ", [Args]) ++
call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, Contract);
message_to_string({app_call, [M, F, Args, Culprit, ExpectedType, FoundType]}) ->
- io_lib:format("The call ~s:~s~s requires that ~s is of type ~s not ~s\n",
+ io_lib:format("The call ~s:~ts~ts requires that ~ts is of type ~ts not ~ts\n",
[M, F, Args, Culprit, ExpectedType, FoundType]);
message_to_string({bin_construction, [Culprit, Size, Seg, Type]}) ->
io_lib:format("Binary construction will fail since the ~s field ~s in"
" segment ~s has type ~s\n", [Culprit, Size, Seg, Type]);
message_to_string({call, [M, F, Args, ArgNs, FailReason,
SigArgs, SigRet, Contract]}) ->
- io_lib:format("The call ~w:~w~s ", [M, F, Args]) ++
+ io_lib:format("The call ~w:~tw~ts ", [M, F, Args]) ++
call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, Contract);
message_to_string({call_to_missing, [M, F, A]}) ->
- io_lib:format("Call to missing or unexported function ~w:~w/~w\n", [M, F, A]);
+ io_lib:format("Call to missing or unexported function ~w:~tw/~w\n",
+ [M, F, A]);
message_to_string({exact_eq, [Type1, Op, Type2]}) ->
- io_lib:format("The test ~s ~s ~s can never evaluate to 'true'\n",
+ io_lib:format("The test ~ts ~s ~ts can never evaluate to 'true'\n",
[Type1, Op, Type2]);
message_to_string({fun_app_args, [Args, Type]}) ->
- io_lib:format("Fun application with arguments ~s will fail"
- " since the function has type ~s\n", [Args, Type]);
+ io_lib:format("Fun application with arguments ~ts will fail"
+ " since the function has type ~ts\n", [Args, Type]);
message_to_string({fun_app_no_fun, [Op, Type, Arity]}) ->
- io_lib:format("Fun application will fail since ~s :: ~s"
+ io_lib:format("Fun application will fail since ~ts :: ~ts"
" is not a function of arity ~w\n", [Op, Type, Arity]);
message_to_string({guard_fail, []}) ->
"Clause guard cannot succeed.\n";
message_to_string({guard_fail, [Arg1, Infix, Arg2]}) ->
- io_lib:format("Guard test ~s ~s ~s can never succeed\n", [Arg1, Infix, Arg2]);
+ io_lib:format("Guard test ~ts ~s ~ts can never succeed\n", [Arg1, Infix, Arg2]);
message_to_string({map_update, [Type, Key]}) ->
- io_lib:format("A key of type ~s cannot exist "
- "in a map of type ~s\n", [Key, Type]);
+ io_lib:format("A key of type ~ts cannot exist "
+ "in a map of type ~ts\n", [Key, Type]);
message_to_string({neg_guard_fail, [Arg1, Infix, Arg2]}) ->
- io_lib:format("Guard test not(~s ~s ~s) can never succeed\n",
+ io_lib:format("Guard test not(~ts ~s ~ts) can never succeed\n",
[Arg1, Infix, Arg2]);
message_to_string({guard_fail, [Guard, Args]}) ->
- io_lib:format("Guard test ~w~s can never succeed\n", [Guard, Args]);
+ io_lib:format("Guard test ~w~ts can never succeed\n", [Guard, Args]);
message_to_string({neg_guard_fail, [Guard, Args]}) ->
- io_lib:format("Guard test not(~w~s) can never succeed\n", [Guard, Args]);
+ io_lib:format("Guard test not(~w~ts) can never succeed\n", [Guard, Args]);
message_to_string({guard_fail_pat, [Pat, Type]}) ->
- io_lib:format("Clause guard cannot succeed. The ~s was matched"
- " against the type ~s\n", [Pat, Type]);
+ io_lib:format("Clause guard cannot succeed. The ~ts was matched"
+ " against the type ~ts\n", [Pat, Type]);
message_to_string({improper_list_constr, [TlType]}) ->
io_lib:format("Cons will produce an improper list"
- " since its 2nd argument is ~s\n", [TlType]);
+ " since its 2nd argument is ~ts\n", [TlType]);
message_to_string({no_return, [Type|Name]}) ->
NameString =
case Name of
[] -> "The created fun ";
- [F, A] -> io_lib:format("Function ~w/~w ", [F, A])
+ [F, A] -> io_lib:format("Function ~tw/~w ", [F, A])
end,
case Type of
no_match -> NameString ++ "has no clauses that will ever match\n";
@@ -358,129 +359,129 @@ message_to_string({no_return, [Type|Name]}) ->
both -> NameString ++ "has no local return\n"
end;
message_to_string({record_constr, [RecConstr, FieldDiffs]}) ->
- io_lib:format("Record construction ~s violates the"
- " declared type of field ~s\n", [RecConstr, FieldDiffs]);
+ io_lib:format("Record construction ~ts violates the"
+ " declared type of field ~ts\n", [RecConstr, FieldDiffs]);
message_to_string({record_constr, [Name, Field, Type]}) ->
- io_lib:format("Record construction violates the declared type for #~w{}"
- " since ~s cannot be of type ~s\n", [Name, Field, Type]);
+ io_lib:format("Record construction violates the declared type for #~tw{}"
+ " since ~ts cannot be of type ~ts\n", [Name, Field, Type]);
message_to_string({record_matching, [String, Name]}) ->
- io_lib:format("The ~s violates the"
- " declared type for #~w{}\n", [String, Name]);
+ io_lib:format("The ~ts violates the"
+ " declared type for #~tw{}\n", [String, Name]);
message_to_string({record_match, [Pat, Type]}) ->
- io_lib:format("Matching of ~s tagged with a record name violates the declared"
- " type of ~s\n", [Pat, Type]);
+ io_lib:format("Matching of ~ts tagged with a record name violates"
+ " the declared type of ~ts\n", [Pat, Type]);
message_to_string({pattern_match, [Pat, Type]}) ->
- io_lib:format("The ~s can never match the type ~s\n", [Pat, Type]);
+ io_lib:format("The ~ts can never match the type ~ts\n", [Pat, Type]);
message_to_string({pattern_match_cov, [Pat, Type]}) ->
- io_lib:format("The ~s can never match since previous"
- " clauses completely covered the type ~s\n",
+ io_lib:format("The ~ts can never match since previous"
+ " clauses completely covered the type ~ts\n",
[Pat, Type]);
message_to_string({unmatched_return, [Type]}) ->
- io_lib:format("Expression produces a value of type ~s,"
+ io_lib:format("Expression produces a value of type ~ts,"
" but this value is unmatched\n", [Type]);
message_to_string({unused_fun, [F, A]}) ->
- io_lib:format("Function ~w/~w will never be called\n", [F, A]);
+ io_lib:format("Function ~tw/~w will never be called\n", [F, A]);
%%----- Warnings for specs and contracts -------------------
message_to_string({contract_diff, [M, F, _A, Contract, Sig]}) ->
- io_lib:format("Type specification ~w:~w~s"
- " is not equal to the success typing: ~w:~w~s\n",
+ io_lib:format("Type specification ~w:~tw~ts"
+ " is not equal to the success typing: ~w:~tw~ts\n",
[M, F, Contract, M, F, Sig]);
message_to_string({contract_subtype, [M, F, _A, Contract, Sig]}) ->
- io_lib:format("Type specification ~w:~w~s"
- " is a subtype of the success typing: ~w:~w~s\n",
+ io_lib:format("Type specification ~w:~tw~ts"
+ " is a subtype of the success typing: ~w:~tw~ts\n",
[M, F, Contract, M, F, Sig]);
message_to_string({contract_supertype, [M, F, _A, Contract, Sig]}) ->
- io_lib:format("Type specification ~w:~w~s"
- " is a supertype of the success typing: ~w:~w~s\n",
+ io_lib:format("Type specification ~w:~tw~ts"
+ " is a supertype of the success typing: ~w:~tw~ts\n",
[M, F, Contract, M, F, Sig]);
message_to_string({contract_range, [Contract, M, F, ArgStrings, Line, CRet]}) ->
- io_lib:format("The contract ~w:~w~s cannot be right because the inferred"
- " return for ~w~s on line ~w is ~s\n",
+ io_lib:format("The contract ~w:~tw~ts cannot be right because the inferred"
+ " return for ~tw~ts on line ~w is ~ts\n",
[M, F, Contract, F, ArgStrings, Line, CRet]);
message_to_string({invalid_contract, [M, F, A, Sig]}) ->
- io_lib:format("Invalid type specification for function ~w:~w/~w."
- " The success typing is ~s\n", [M, F, A, Sig]);
+ io_lib:format("Invalid type specification for function ~w:~tw/~w."
+ " The success typing is ~ts\n", [M, F, A, Sig]);
message_to_string({contract_with_opaque, [M, F, A, OpaqueType, SigType]}) ->
- io_lib:format("The specification for ~w:~w/~w"
- " has an opaque subtype ~s which is violated by the"
- " success typing ~s\n", [M, F, A, OpaqueType, SigType]);
+ io_lib:format("The specification for ~w:~tw/~w"
+ " has an opaque subtype ~ts which is violated by the"
+ " success typing ~ts\n", [M, F, A, OpaqueType, SigType]);
message_to_string({extra_range, [M, F, A, ExtraRanges, SigRange]}) ->
- io_lib:format("The specification for ~w:~w/~w states that the function"
- " might also return ~s but the inferred return is ~s\n",
+ io_lib:format("The specification for ~w:~tw/~w states that the function"
+ " might also return ~ts but the inferred return is ~ts\n",
[M, F, A, ExtraRanges, SigRange]);
message_to_string({overlapping_contract, [M, F, A]}) ->
- io_lib:format("Overloaded contract for ~w:~w/~w has overlapping domains;"
+ io_lib:format("Overloaded contract for ~w:~tw/~w has overlapping domains;"
" such contracts are currently unsupported and are simply ignored\n",
[M, F, A]);
message_to_string({spec_missing_fun, [M, F, A]}) ->
- io_lib:format("Contract for function that does not exist: ~w:~w/~w\n",
+ io_lib:format("Contract for function that does not exist: ~w:~tw/~w\n",
[M, F, A]);
%%----- Warnings for opaque type violations -------------------
message_to_string({call_with_opaque, [M, F, Args, ArgNs, ExpArgs]}) ->
- io_lib:format("The call ~w:~w~s contains ~s when ~s\n",
+ io_lib:format("The call ~w:~tw~ts contains ~ts when ~ts\n",
[M, F, Args, form_positions(ArgNs), form_expected(ExpArgs)]);
message_to_string({call_without_opaque, [M, F, Args, ExpectedTriples]}) ->
- io_lib:format("The call ~w:~w~s does not have ~s\n",
+ io_lib:format("The call ~w:~tw~ts does not have ~ts\n",
[M, F, Args, form_expected_without_opaque(ExpectedTriples)]);
message_to_string({opaque_eq, [Type, _Op, OpaqueType]}) ->
- io_lib:format("Attempt to test for equality between a term of type ~s"
- " and a term of opaque type ~s\n", [Type, OpaqueType]);
+ io_lib:format("Attempt to test for equality between a term of type ~ts"
+ " and a term of opaque type ~ts\n", [Type, OpaqueType]);
message_to_string({opaque_guard, [Arg1, Infix, Arg2, ArgNs]}) ->
- io_lib:format("Guard test ~s ~s ~s contains ~s\n",
+ io_lib:format("Guard test ~ts ~s ~ts contains ~s\n",
[Arg1, Infix, Arg2, form_positions(ArgNs)]);
message_to_string({opaque_guard, [Guard, Args]}) ->
- io_lib:format("Guard test ~w~s breaks the opacity of its argument\n",
+ io_lib:format("Guard test ~w~ts breaks the opacity of its argument\n",
[Guard, Args]);
message_to_string({opaque_match, [Pat, OpaqueType, OpaqueTerm]}) ->
Term = if OpaqueType =:= OpaqueTerm -> "the term";
true -> OpaqueTerm
end,
- io_lib:format("The attempt to match a term of type ~s against the ~s"
- " breaks the opacity of ~s\n", [OpaqueType, Pat, Term]);
+ io_lib:format("The attempt to match a term of type ~s against the ~ts"
+ " breaks the opacity of ~ts\n", [OpaqueType, Pat, Term]);
message_to_string({opaque_neq, [Type, _Op, OpaqueType]}) ->
- io_lib:format("Attempt to test for inequality between a term of type ~s"
- " and a term of opaque type ~s\n", [Type, OpaqueType]);
+ io_lib:format("Attempt to test for inequality between a term of type ~ts"
+ " and a term of opaque type ~ts\n", [Type, OpaqueType]);
message_to_string({opaque_type_test, [Fun, Args, Arg, ArgType]}) ->
- io_lib:format("The type test ~s~s breaks the opacity of the term ~s~s\n",
+ io_lib:format("The type test ~ts~ts breaks the opacity of the term ~ts~ts\n",
[Fun, Args, Arg, ArgType]);
message_to_string({opaque_size, [SizeType, Size]}) ->
- io_lib:format("The size ~s breaks the opacity of ~s\n",
+ io_lib:format("The size ~ts breaks the opacity of ~ts\n",
[SizeType, Size]);
message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}) ->
- io_lib:format("The call ~s:~s~s breaks the opacity of the term ~s :: ~s\n",
+ io_lib:format("The call ~s:~ts~ts breaks the opacity of the term ~ts :: ~ts\n",
[M, F, Args, Culprit, OpaqueType]);
%%----- Warnings for concurrency errors --------------------
message_to_string({race_condition, [M, F, Args, Reason]}) ->
- io_lib:format("The call ~w:~w~s ~s\n", [M, F, Args, Reason]);
+ io_lib:format("The call ~w:~tw~ts ~ts\n", [M, F, Args, Reason]);
%%----- Warnings for behaviour errors --------------------
message_to_string({callback_type_mismatch, [B, F, A, ST, CT]}) ->
- io_lib:format("The inferred return type of ~w/~w (~s) has nothing in common"
- " with ~s, which is the expected return type for the callback of"
- " ~w behaviour\n", [F, A, ST, CT, B]);
+ io_lib:format("The inferred return type of ~tw/~w (~ts) has nothing in"
+ " common with ~ts, which is the expected return type for"
+ " the callback of the ~w behaviour\n", [F, A, ST, CT, B]);
message_to_string({callback_arg_type_mismatch, [B, F, A, N, ST, CT]}) ->
- io_lib:format("The inferred type for the ~s argument of ~w/~w (~s) is"
- " not a supertype of ~s, which is expected type for this"
+ io_lib:format("The inferred type for the ~s argument of ~tw/~w (~ts) is"
+ " not a supertype of ~ts, which is expected type for this"
" argument in the callback of the ~w behaviour\n",
[ordinal(N), F, A, ST, CT, B]);
message_to_string({callback_spec_type_mismatch, [B, F, A, ST, CT]}) ->
- io_lib:format("The return type ~s in the specification of ~w/~w is not a"
- " subtype of ~s, which is the expected return type for the"
- " callback of ~w behaviour\n", [ST, F, A, CT, B]);
+ io_lib:format("The return type ~ts in the specification of ~tw/~w is not a"
+ " subtype of ~ts, which is the expected return type for the"
+ " callback of the ~w behaviour\n", [ST, F, A, CT, B]);
message_to_string({callback_spec_arg_type_mismatch, [B, F, A, N, ST, CT]}) ->
- io_lib:format("The specified type for the ~s argument of ~w/~w (~s) is"
- " not a supertype of ~s, which is expected type for this"
+ io_lib:format("The specified type for the ~ts argument of ~tw/~w (~ts) is"
+ " not a supertype of ~ts, which is expected type for this"
" argument in the callback of the ~w behaviour\n",
[ordinal(N), F, A, ST, CT, B]);
message_to_string({callback_missing, [B, F, A]}) ->
- io_lib:format("Undefined callback function ~w/~w (behaviour '~w')\n",
+ io_lib:format("Undefined callback function ~tw/~w (behaviour ~w)\n",
[F, A, B]);
message_to_string({callback_info_missing, [B]}) ->
io_lib:format("Callback info about the ~w behaviour is not available\n", [B]);
%%----- Warnings for unknown functions, types, and behaviours -------------
message_to_string({unknown_type, {M, F, A}}) ->
- io_lib:format("Unknown type ~w:~w/~w", [M, F, A]);
+ io_lib:format("Unknown type ~w:~tw/~w", [M, F, A]);
message_to_string({unknown_function, {M, F, A}}) ->
- io_lib:format("Unknown function ~w:~w/~w", [M, F, A]);
+ io_lib:format("Unknown function ~w:~tw/~w", [M, F, A]);
message_to_string({unknown_behaviour, B}) ->
io_lib:format("Unknown behaviour ~w", [B]).
diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
index 29aa25b98e..a4b42c9367 100644
--- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
@@ -92,11 +92,12 @@ loop(#server_state{parent = Parent} = State,
send_warnings(Parent, Warnings),
loop(State, Analysis, ExtCalls);
{AnalPid, cserver, CServer, Plt} ->
+ skip_ets_transfer(AnalPid),
send_codeserver_plt(Parent, CServer, Plt),
loop(State, Analysis, ExtCalls);
- {AnalPid, done, MiniPlt, DocPlt} ->
+ {AnalPid, done, Plt, DocPlt} ->
send_ext_calls(Parent, ExtCalls),
- send_analysis_done(Parent, MiniPlt, DocPlt);
+ send_analysis_done(Parent, Plt, DocPlt);
{AnalPid, ext_calls, NewExtCalls} ->
loop(State, Analysis, NewExtCalls);
{AnalPid, ext_types, ExtTypes} ->
@@ -133,26 +134,8 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
Files = ordsets:from_list(Analysis#analysis.files),
{Callgraph, TmpCServer0} = compile_and_store(Files, State),
%% Remote type postprocessing
- NewCServer =
- try
- TmpCServer1 = dialyzer_utils:merge_types(TmpCServer0, Plt),
- NewExpTypes = dialyzer_codeserver:get_temp_exported_types(TmpCServer0),
- OldExpTypes0 = dialyzer_plt:get_exported_types(Plt),
- RemMods =
- [case Analysis#analysis.start_from of
- byte_code -> list_to_atom(filename:basename(F, ".beam"));
- src_code -> list_to_atom(filename:basename(F, ".erl"))
- end || F <- Files],
- OldExpTypes1 = dialyzer_utils:sets_filter(RemMods, OldExpTypes0),
- MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1),
- TmpCServer2 =
- dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1),
- erlang:garbage_collect(), % reduce heap size
- ?timing(State#analysis_state.timing_server, "remote",
- contracts_and_records(TmpCServer2, Parent))
- catch
- throw:{error, _ErrorMsg} = Error -> exit(Error)
- end,
+ Args = {Plt, Analysis, Parent},
+ NewCServer = remote_type_postprocessing(TmpCServer0, Args),
dump_callgraph(Callgraph, State, Analysis),
%% Remove all old versions of the files being analyzed
AllNodes = dialyzer_callgraph:all_nodes(Callgraph),
@@ -168,46 +151,80 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
false -> Callgraph
end,
State2 = analyze_callgraph(NewCallgraph, State1),
- #analysis_state{plt = MiniPlt2,
+ #analysis_state{plt = Plt2,
doc_plt = DocPlt,
codeserver = Codeserver0} = State2,
- {Codeserver, MiniPlt3} = move_data(Codeserver0, MiniPlt2),
+ {Codeserver, Plt3} = move_data(Codeserver0, Plt2),
dialyzer_callgraph:dispose_race_server(NewCallgraph),
%% Since the PLT is never used, a dummy is sent:
DummyPlt = dialyzer_plt:new(),
send_codeserver_plt(Parent, Codeserver, DummyPlt),
- MiniPlt4 = dialyzer_plt:delete_list(MiniPlt3, NonExportsList),
- send_analysis_done(Parent, MiniPlt4, DocPlt).
-
-contracts_and_records(CodeServer, Parent) ->
- Fun = contrs_and_recs(CodeServer, Parent),
+ dialyzer_plt:delete(DummyPlt),
+ Plt4 = dialyzer_plt:delete_list(Plt3, NonExportsList),
+ send_analysis_done(Parent, Plt4, DocPlt).
+
+remote_type_postprocessing(TmpCServer, Args) ->
+ Fun = fun() ->
+ exit(remote_type_postproc(TmpCServer, Args))
+ end,
{Pid, Ref} = erlang:spawn_monitor(Fun),
- dialyzer_codeserver:give_away(CodeServer, Pid),
+ dialyzer_codeserver:give_away(TmpCServer, Pid),
Pid ! {self(), go},
receive {'DOWN', Ref, process, Pid, Return} ->
- Return
+ skip_ets_transfer(Pid),
+ case Return of
+ {error, _ErrorMsg} = Error -> exit(Error);
+ _ -> Return
+ end
end.
--spec contrs_and_recs(dialyzer_codeserver:codeserver(), pid()) ->
- fun(() -> no_return()).
-
-contrs_and_recs(TmpCServer2, Parent) ->
+remote_type_postproc(TmpCServer0, Args) ->
+ {Plt, Analysis, Parent} = Args,
fun() ->
Caller = receive {Pid, go} -> Pid end,
- TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2),
+ TmpCServer1 = dialyzer_utils:merge_types(TmpCServer0, Plt),
+ NewExpTypes = dialyzer_codeserver:get_temp_exported_types(TmpCServer0),
+ OldExpTypes0 = dialyzer_plt:get_exported_types(Plt),
+ #analysis{start_from = StartFrom,
+ timing_server = TimingServer} = Analysis,
+ Files = ordsets:from_list(Analysis#analysis.files),
+ RemMods =
+ [case StartFrom of
+ byte_code -> list_to_atom(filename:basename(F, ".beam"));
+ src_code -> list_to_atom(filename:basename(F, ".erl"))
+ end || F <- Files],
+ OldExpTypes1 = dialyzer_utils:sets_filter(RemMods, OldExpTypes0),
+ MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1),
+ TmpCServer2 =
+ dialyzer_codeserver:finalize_exported_types(MergedExpTypes,
+ TmpCServer1),
TmpServer4 =
- dialyzer_contracts:process_contract_remote_types(TmpCServer3),
- dialyzer_codeserver:give_away(TmpServer4, Caller),
+ ?timing
+ (TimingServer, "remote",
+ begin
+ TmpCServer3 =
+ dialyzer_utils:process_record_remote_types(TmpCServer2),
+ dialyzer_contracts:process_contract_remote_types(TmpCServer3)
+ end),
rcv_and_send_ext_types(Caller, Parent),
- exit(TmpServer4)
+ dialyzer_codeserver:give_away(TmpServer4, Caller),
+ TmpServer4
+ end().
+
+skip_ets_transfer(Pid) ->
+ receive
+ {'ETS-TRANSFER', _Tid, Pid, _HeriData} ->
+ skip_ets_transfer(Pid)
+ after 0 ->
+ ok
end.
-move_data(CServer, MiniPlt) ->
+move_data(CServer, Plt) ->
{CServer1, Records} = dialyzer_codeserver:extract_records(CServer),
- MiniPlt1 = dialyzer_plt:insert_types(MiniPlt, Records),
+ Plt1 = dialyzer_plt:insert_types(Plt, Records),
{NewCServer, ExpTypes} = dialyzer_codeserver:extract_exported_types(CServer1),
- NewMiniPlt = dialyzer_plt:insert_exported_types(MiniPlt1, ExpTypes),
- {NewCServer, NewMiniPlt}.
+ NewPlt = dialyzer_plt:insert_exported_types(Plt1, ExpTypes),
+ {NewCServer, NewPlt}.
analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver,
doc_plt = DocPlt,
@@ -217,19 +234,19 @@ analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver,
solvers = Solvers} = State) ->
case State#analysis_state.analysis_type of
plt_build ->
- NewMiniPlt =
+ NewPlt =
dialyzer_succ_typings:analyze_callgraph(Callgraph, Plt, Codeserver,
TimingServer, Solvers, Parent),
dialyzer_callgraph:delete(Callgraph),
- State#analysis_state{plt = NewMiniPlt, doc_plt = DocPlt};
+ State#analysis_state{plt = NewPlt, doc_plt = DocPlt};
succ_typings ->
- {Warnings, NewMiniPlt, NewDocPlt} =
+ {Warnings, NewPlt, 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}
+ State#analysis_state{plt = NewPlt, doc_plt = NewDocPlt}
end.
%%--------------------------------------------------------------------
@@ -287,7 +304,7 @@ compile_and_store(Files, #analysis_state{codeserver = CServer,
dict:new(), Files),
check_for_duplicate_modules(ModDict);
false ->
- Msg = io_lib:format("Could not scan the following file(s):~n~s",
+ Msg = io_lib:format("Could not scan the following file(s):~n~ts",
[[Reason || {_Filename, Reason} <- Failed]]),
exit({error, Msg})
end,
@@ -565,9 +582,8 @@ 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, MiniPlt, DocPlt) ->
- ok = dialyzer_plt:give_away(MiniPlt, Parent),
- Parent ! {self(), done, MiniPlt, DocPlt},
+send_analysis_done(Parent, Plt, DocPlt) ->
+ Parent ! {self(), done, Plt, DocPlt},
ok.
send_ext_calls(_Parent, none) ->
@@ -683,12 +699,13 @@ dump_callgraph(CallGraph, _State, #analysis{callgraph_file = File}, ".ps") ->
Args = "-Gratio=compress -Gsize=\"100,100\"",
dialyzer_callgraph:to_ps(CallGraph, File, Args);
dump_callgraph(CallGraph, State, #analysis{callgraph_file = File}, _Ext) ->
+ %% TODO: write the graph, not the ETS table identifiers.
case file:open(File, [write]) of
{ok, Fd} ->
io:format(Fd, "~p", [CallGraph]),
ok = file:close(Fd);
{error, Reason} ->
- Msg = io_lib:format("Could not open output file ~p, Reason: ~p\n",
+ Msg = io_lib:format("Could not open output file ~tp, Reason: ~p\n",
[File, Reason]),
send_log(State#analysis_state.parent, Msg)
end.
diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl
index 6387f3d1e4..7411b1d28b 100644
--- a/lib/dialyzer/src/dialyzer_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_callgraph.erl
@@ -755,6 +755,7 @@ put_behaviour_api_calls(Calls,
-spec to_dot(callgraph(), file:filename()) -> 'ok'.
to_dot(#callgraph{digraph = DG, esc = Esc} = CG, File) ->
+ %% TODO: handle Unicode names.
Fun = fun(L) ->
case lookup_name(L, CG) of
error -> L;
@@ -769,14 +770,14 @@ to_dot(#callgraph{digraph = DG, esc = Esc} = CG, File) ->
-spec to_ps(callgraph(), file:filename(), string()) -> 'ok'.
to_ps(#callgraph{} = CG, File, Args) ->
+ %% TODO: handle Unicode names.
Dot_File = filename:rootname(File) ++ ".dot",
to_dot(CG, Dot_File),
- Command = io_lib:format("dot -Tps ~s -o ~s ~s", [Args, File, Dot_File]),
+ Command = io_lib:format("dot -Tps ~ts -o ~ts ~ts", [Args, File, Dot_File]),
_ = os:cmd(Command),
ok.
condensation(G) ->
- erlang:garbage_collect(), % reduce heap size
{Pid, Ref} = erlang:spawn_monitor(do_condensation(G, self())),
receive {'DOWN', Ref, process, Pid, Result} ->
{SCCInts, OutETS, InETS, MapsETS} = Result,
diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl
index 8500c59ebe..0617be6435 100644
--- a/lib/dialyzer/src/dialyzer_cl.erl
+++ b/lib/dialyzer/src/dialyzer_cl.erl
@@ -77,7 +77,7 @@ init_opts_for_build(Opts) ->
[] -> Opts#options{output_plt = get_default_output_plt()};
[Plt] -> Opts#options{init_plts = [], output_plt = Plt};
Plts ->
- Msg = io_lib:format("Could not build multiple PLT files: ~s\n",
+ Msg = io_lib:format("Could not build multiple PLT files: ~ts\n",
[format_plts(Plts)]),
cl_error(Msg)
end;
@@ -99,7 +99,7 @@ init_opts_for_add(Opts) ->
init_plts = get_default_init_plt()};
[Plt] -> Opts#options{output_plt = Plt};
Plts ->
- Msg = io_lib:format("Could not add to multiple PLT files: ~s\n",
+ Msg = io_lib:format("Could not add to multiple PLT files: ~ts\n",
[format_plts(Plts)]),
cl_error(Msg)
end;
@@ -165,7 +165,7 @@ init_opts_for_remove(Opts) ->
init_plts = get_default_init_plt()};
[Plt] -> Opts#options{output_plt = Plt};
Plts ->
- Msg = io_lib:format("Could not remove from multiple PLT files: ~s\n",
+ Msg = io_lib:format("Could not remove from multiple PLT files: ~ts\n",
[format_plts(Plts)]),
cl_error(Msg)
end;
@@ -212,19 +212,19 @@ plt_common(#options{init_plts = [InitPlt]} = Opts, RemoveFiles, AddFiles) ->
do_analysis(AnalFiles, Opts, Plt, {Md5, ModDeps1})
end;
{error, no_such_file} ->
- Msg = io_lib:format("Could not find the PLT: ~s\n~s",
+ Msg = io_lib:format("Could not find the PLT: ~ts\n~s",
[InitPlt, default_plt_error_msg()]),
cl_error(Msg);
{error, not_valid} ->
- Msg = io_lib:format("The file: ~s is not a valid PLT file\n~s",
+ Msg = io_lib:format("The file: ~ts is not a valid PLT file\n~s",
[InitPlt, default_plt_error_msg()]),
cl_error(Msg);
{error, read_error} ->
- Msg = io_lib:format("Could not read the PLT: ~s\n~s",
+ Msg = io_lib:format("Could not read the PLT: ~ts\n~s",
[InitPlt, default_plt_error_msg()]),
cl_error(Msg);
{error, {no_file_to_remove, F}} ->
- Msg = io_lib:format("Could not remove the file ~s from the PLT: ~s\n",
+ Msg = io_lib:format("Could not remove the file ~ts from the PLT: ~ts\n",
[F, InitPlt]),
cl_error(Msg)
end.
@@ -264,7 +264,7 @@ report_check(#options{report_mode = ReportMode, init_plts = [InitPlt]}) ->
case ReportMode of
quiet -> ok;
_ ->
- io:format(" Checking whether the PLT ~s is up-to-date...", [InitPlt])
+ io:format(" Checking whether the PLT ~ts is up-to-date...", [InitPlt])
end.
report_old_version(#options{report_mode = ReportMode, init_plts = [InitPlt]}) ->
@@ -272,7 +272,7 @@ report_old_version(#options{report_mode = ReportMode, init_plts = [InitPlt]}) ->
quiet -> ok;
_ ->
io:put_chars(" no\n"),
- io:format(" (the PLT ~s was built with an old version of Dialyzer)\n",
+ io:format(" (the PLT ~ts was built with an old version of Dialyzer)\n",
[InitPlt])
end.
@@ -300,19 +300,19 @@ report_analysis_start(#options{analysis_type = Type,
plt_add ->
[InitPlt] = InitPlts,
case InitPlt =:= OutputPlt of
- true -> io:format("Adding information to ~s...", [OutputPlt]);
- false -> io:format("Adding information from ~s to ~s...",
+ true -> io:format("Adding information to ~ts...", [OutputPlt]);
+ false -> io:format("Adding information from ~ts to ~ts...",
[InitPlt, OutputPlt])
end;
plt_build ->
- io:format("Creating PLT ~s ...", [OutputPlt]);
+ io:format("Creating PLT ~ts ...", [OutputPlt]);
plt_check ->
- io:format("Rebuilding the information in ~s...", [OutputPlt]);
+ io:format("Rebuilding the information in ~ts...", [OutputPlt]);
plt_remove ->
[InitPlt] = InitPlts,
case InitPlt =:= OutputPlt of
- true -> io:format("Removing information from ~s...", [OutputPlt]);
- false -> io:format("Removing information from ~s to ~s...",
+ true -> io:format("Removing information from ~ts...", [OutputPlt]);
+ false -> io:format("Removing information from ~ts to ~ts...",
[InitPlt, OutputPlt])
end;
succ_typings -> io:format("Proceeding with analysis...")
@@ -420,7 +420,7 @@ assert_writable(PltFile) ->
case check_if_writable(PltFile) of
true -> ok;
false ->
- Msg = io_lib:format(" The PLT file ~s is not writable", [PltFile]),
+ Msg = io_lib:format(" The PLT file ~ts is not writable", [PltFile]),
cl_error(Msg)
end.
@@ -596,9 +596,11 @@ init_output(State0, #options{output_file = OutFile,
false ->
case file:open(OutFile, [write]) of
{ok, File} ->
+ %% Warnings and errors can include Unicode characters.
+ ok = io:setopts(File, [{encoding, unicode}]),
State#cl_state{output = File};
{error, Reason} ->
- Msg = io_lib:format("Could not open output file ~p, Reason: ~p\n",
+ Msg = io_lib:format("Could not open output file ~tp, Reason: ~p\n",
[OutFile, Reason]),
cl_error(State, lists:flatten(Msg))
end
@@ -635,8 +637,8 @@ cl_loop(State, LogCache) ->
{BackendPid, cserver, CodeServer, _Plt} -> % Plt is ignored
NewState = State#cl_state{code_server = CodeServer},
cl_loop(NewState, LogCache);
- {BackendPid, done, NewMiniPlt, _NewDocPlt} ->
- return_value(State, NewMiniPlt);
+ {BackendPid, done, NewPlt, _NewDocPlt} ->
+ return_value(State, NewPlt);
{BackendPid, ext_calls, ExtCalls} ->
cl_loop(State#cl_state{external_calls = ExtCalls}, LogCache);
{BackendPid, ext_types, ExtTypes} ->
@@ -687,7 +689,7 @@ cl_error(Msg) ->
cl_error(State, Msg) ->
case State#cl_state.output of
standard_io -> ok;
- Outfile -> io:format(Outfile, "\n~s\n", [Msg])
+ Outfile -> io:format(Outfile, "\n~ts\n", [Msg])
end,
maybe_close_output_file(State),
throw({dialyzer_error, lists:flatten(Msg)}).
@@ -698,7 +700,7 @@ return_value(State = #cl_state{code_server = CodeServer,
output_plt = OutputPlt,
plt_info = PltInfo,
stored_warnings = StoredWarnings},
- MiniPlt) ->
+ Plt) ->
%% Just for now:
case CodeServer =:= none of
true ->
@@ -708,18 +710,9 @@ return_value(State = #cl_state{code_server = CodeServer,
end,
case OutputPlt =:= none of
true ->
- dialyzer_plt:delete(MiniPlt);
+ dialyzer_plt:delete(Plt);
false ->
- Fun = to_file_fun(OutputPlt, MiniPlt, ModDeps, PltInfo),
- {Pid, Ref} = erlang:spawn_monitor(Fun),
- dialyzer_plt:give_away(MiniPlt, Pid),
- Pid ! go,
- receive {'DOWN', Ref, process, Pid, Result} ->
- case Result of
- ok -> ok;
- Thrown -> throw(Thrown)
- end
- end
+ dialyzer_plt:to_file(OutputPlt, Plt, ModDeps, PltInfo)
end,
UnknownWarnings = unknown_warnings(State),
RetValue =
@@ -740,16 +733,6 @@ return_value(State = #cl_state{code_server = CodeServer,
{RetValue, set_warning_id(AllWarnings)}
end.
--spec to_file_fun(_, _, _, _) -> fun(() -> no_return()).
-
-to_file_fun(Filename, MiniPlt, ModDeps, PltInfo) ->
- fun() ->
- receive go -> ok end,
- Plt = dialyzer_plt:restore_full_plt(MiniPlt),
- dialyzer_plt:to_file(Filename, Plt, ModDeps, PltInfo),
- exit(ok)
- end.
-
unknown_warnings(State = #cl_state{legal_warnings = LegalWarnings}) ->
Unknown = case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of
true ->
@@ -792,7 +775,7 @@ print_ext_calls(#cl_state{output = Output,
end.
do_print_ext_calls(Output, [{M,F,A}|T], Before) ->
- io:format(Output, "~s~p:~p/~p\n", [Before,M,F,A]),
+ io:format(Output, "~s~tp:~tp/~p\n", [Before,M,F,A]),
do_print_ext_calls(Output, T, Before);
do_print_ext_calls(_, [], _) ->
ok.
@@ -825,7 +808,7 @@ print_ext_types(#cl_state{output = Output,
end.
do_print_ext_types(Output, [{M,F,A}|T], Before) ->
- io:format(Output, "~s~p:~p/~p\n", [Before,M,F,A]),
+ io:format(Output, "~s~tp:~tp/~p\n", [Before,M,F,A]),
do_print_ext_types(Output, T, Before);
do_print_ext_types(_, [], _) ->
ok.
@@ -844,10 +827,10 @@ print_warnings(#cl_state{output = Output,
formatted ->
[dialyzer:format_warning(W, FOpt) || W <- PrWarnings];
raw ->
- [io_lib:format("~p. \n",
+ [io_lib:format("~tp. \n",
[W]) || W <- set_warning_id(PrWarnings)]
end,
- io:format(Output, "\n~s", [S])
+ io:format(Output, "\n~ts", [S])
end.
-spec process_warnings([raw_warning()]) -> [raw_warning()].
diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl
index baeffe99d8..a456d38e64 100644
--- a/lib/dialyzer/src/dialyzer_cl_parse.erl
+++ b/lib/dialyzer/src/dialyzer_cl_parse.erl
@@ -37,11 +37,12 @@ start() ->
init(),
Args = init:get_plain_arguments(),
try
- cl(Args)
+ Ret = cl(Args),
+ Ret
catch
throw:{dialyzer_cl_parse_error, Msg} -> {error, Msg};
_:R ->
- Msg = io_lib:format("~p\n~p\n", [R, erlang:get_stacktrace()]),
+ Msg = io_lib:format("~tp\n~tp\n", [R, erlang:get_stacktrace()]),
{error, lists:flatten(Msg)}
end.
diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl
index a1a7370eff..5587cf2bdf 100644
--- a/lib/dialyzer/src/dialyzer_codeserver.erl
+++ b/lib/dialyzer/src/dialyzer_codeserver.erl
@@ -304,9 +304,29 @@ lookup_temp_mod_records(Mod, #codeserver{temp_records = TempRecDict}) ->
finalize_records(#codeserver{temp_records = TmpRecords,
records = Records} = CS) ->
- true = ets:delete(Records),
- ets:rename(TmpRecords, dialyzer_codeserver_records),
- CS#codeserver{temp_records = clean, records = TmpRecords}.
+ %% The annotations of the abstract code are reset as they are no
+ %% longer needed, which makes the ETS table compression better.
+ A0 = erl_anno:new(0),
+ AFun = fun(_) -> A0 end,
+ FFun = fun({F, Abs, Type}) ->
+ NewAbs = erl_parse:map_anno(AFun, Abs),
+ {F, NewAbs, Type}
+ end,
+ ArFun = fun({Arity, Fields}) -> {Arity, lists:map(FFun, Fields)} end,
+ List = dialyzer_utils:ets_tab2list(TmpRecords),
+ true = ets:delete(TmpRecords),
+ Fun = fun({Mod, Map}) ->
+ MFun =
+ fun({record, _}, {FileLine, ArityFields}) ->
+ {FileLine, lists:map(ArFun, ArityFields)};
+ (_, {{M, FileLine, Abs, Args}, Type}) ->
+ {{M, FileLine, erl_parse:map_anno(AFun, Abs), Args}, Type}
+ end,
+ {Mod, maps:map(MFun, Map)}
+ end,
+ NewList = lists:map(Fun, List),
+ true = ets:insert(Records, NewList),
+ CS#codeserver{temp_records = clean}.
-spec lookup_mod_contracts(atom(), codeserver()) -> contracts().
@@ -355,7 +375,7 @@ store_temp_contracts(Mod, SpecMap, CallbackMap,
#codeserver{temp_contracts = Cn,
temp_callbacks = Cb} = CS)
when is_atom(Mod) ->
- %% Make sure Mod is stored even if there are not callbacks or
+ %% Make sure Mod is stored even if there are no callbacks or
%% contracts.
CS1 = CS#codeserver{temp_contracts = ets_map_store(Mod, SpecMap, Cn)},
CS1#codeserver{temp_callbacks = ets_map_store(Mod, CallbackMap, Cb)}.
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 5f24b5a668..b554ebc2cc 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -18,7 +18,7 @@
check_contracts/4,
contracts_without_fun/3,
contract_to_string/1,
- get_invalid_contract_warnings/4,
+ get_invalid_contract_warnings/3,
get_contract_args/1,
get_contract_return/1,
get_contract_return/2,
@@ -173,22 +173,20 @@ process_contract_remote_types(CodeServer) ->
lists:foreach(ModuleFun, Mods),
dialyzer_codeserver:finalize_contracts(CodeServer).
--type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]).
+-type fun_types() :: orddict:orddict(label(), erl_types:type_table()).
--type fun_types() :: dict:dict(label(), erl_types:type_table()).
-
--spec check_contracts(orddict:orddict(mfa(), file_contract()),
+-spec check_contracts(orddict:orddict(mfa(), #contract{}),
dialyzer_callgraph:callgraph(), fun_types(),
- opaques_fun()) -> plt_contracts().
+ erl_types:opaques()) -> plt_contracts().
-check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) ->
+check_contracts(Contracts, Callgraph, FunTypes, ModOpaques) ->
FoldFun =
- fun(Label, Type, NewContracts) ->
+ fun({Label, Type}, NewContracts) ->
case dialyzer_callgraph:lookup_name(Label, Callgraph) of
{ok, {M,F,A} = MFA} ->
case orddict:find(MFA, Contracts) of
- {ok, {_FileLine, Contract, _Xtra}} ->
- Opaques = FindOpaques(M),
+ {ok, Contract} ->
+ {M, Opaques} = lists:keyfind(M, 1, ModOpaques),
case check_contract(Contract, Type, Opaques) of
ok ->
case erl_bif_types:is_known(M, F, A) of
@@ -206,7 +204,7 @@ check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) ->
error -> NewContracts
end
end,
- orddict:from_list(dict:fold(FoldFun, [], FunTypes)).
+ orddict:from_list(lists:foldl(FoldFun, [], orddict:to_list(FunTypes))).
%% Checks all components of a contract
-spec check_contract(#contract{}, erl_types:erl_type()) -> 'ok' | {'error', term()}.
@@ -214,6 +212,9 @@ check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) ->
check_contract(Contract, SuccType) ->
check_contract(Contract, SuccType, 'universe').
+-spec check_contract(#contract{}, erl_types:erl_type(), erl_types:opaques()) ->
+ 'ok' | {'error', term()}.
+
check_contract(#contract{contracts = Contracts}, SuccType, Opaques) ->
try
Contracts1 = [{Contract, insert_constraints(Constraints)}
@@ -293,7 +294,7 @@ check_extraneous_1(Contract, SuccType) ->
CRng = erl_types:t_fun_range(Contract),
CRngs = erl_types:t_elements(CRng),
STRng = erl_types:t_fun_range(SuccType),
- ?debug("CR = ~p\nSR = ~p\n", [CRngs, STRng]),
+ ?debug("CR = ~tp\nSR = ~tp\n", [CRngs, STRng]),
case [CR || CR <- CRngs,
erl_types:t_is_none(erl_types:t_inf(CR, STRng))] of
[] ->
@@ -360,7 +361,7 @@ process_contract({Contract, Constraints}, CallTypes0) ->
CallTypesFun = erl_types:t_fun(CallTypes0, erl_types:t_any()),
ContArgsFun = erl_types:t_fun(erl_types:t_fun_args(Contract),
erl_types:t_any()),
- ?debug("Instance: Contract: ~s\n Arguments: ~s\n",
+ ?debug("Instance: Contract: ~ts\n Arguments: ~ts\n",
[erl_types:t_to_string(ContArgsFun),
erl_types:t_to_string(CallTypesFun)]),
case solve_constraints(ContArgsFun, CallTypesFun, Constraints) of
@@ -427,7 +428,7 @@ insert_constraints([{subtype, Type1, Type2}|Left], Map) ->
false ->
%% A lot of things should change to add supertypes
throw({error, io_lib:format("First argument of is_subtype constraint "
- "must be a type variable: ~p\n", [Type1])})
+ "must be a type variable: ~tp\n", [Type1])})
end;
insert_constraints([], Map) -> Map.
@@ -439,9 +440,9 @@ insert_constraints([], Map) -> Map.
contracts().
store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecMap, RecordsDict) ->
- %% io:format("contract from form: ~p\n", [TypeSpec]),
+ %% io:format("contract from form: ~tp\n", [TypeSpec]),
TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine),
- %% io:format("contract: ~p\n", [TmpContract]),
+ %% io:format("contract: ~tp\n", [TmpContract]),
maps:put(MFA, {FileLine, TmpContract, Xtra}, SpecMap).
contract_from_form(Forms, MFA, RecDict, FileLine) ->
@@ -458,8 +459,8 @@ contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], MFA, RecDict,
catch
throw:{error, Msg} ->
{File, Line} = FileLine,
- NewMsg = io_lib:format("~s:~p: ~s", [filename:basename(File),
- Line, Msg]),
+ NewMsg = io_lib:format("~ts:~p: ~ts", [filename:basename(File),
+ Line, Msg]),
throw({error, NewMsg})
end,
NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType),
@@ -514,7 +515,7 @@ initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, RecordTable,
{type, _, constraint, [{atom,_,Name}, List]} ->
N = length(List),
throw({error,
- io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])})
+ io_lib:format("Unsupported type guard ~tw/~w\n", [Name, N])})
end.
constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, RecordTable, Cache) ->
@@ -662,32 +663,37 @@ general_domain([], AccSig) ->
-spec get_invalid_contract_warnings([module()],
dialyzer_codeserver:codeserver(),
- dialyzer_plt:plt(),
- opaques_fun()) -> [raw_warning()].
+ dialyzer_plt:plt()) -> [raw_warning()].
-get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) ->
- get_invalid_contract_warnings_modules(Modules, CodeServer, Plt, FindOpaques, []).
+get_invalid_contract_warnings(Modules, CodeServer, Plt) ->
+ get_invalid_contract_warnings_modules(Modules, CodeServer, Plt, []).
-get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques, Acc) ->
+get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, Acc) ->
Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer),
- 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);
-get_invalid_contract_warnings_modules([], _CodeServer, _Plt, _FindOpaques, Acc) ->
+ NewAcc =
+ case maps:size(Contracts1) =:= 0 of
+ true -> Acc;
+ false ->
+ Contracts2 = maps:to_list(Contracts1),
+ Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer),
+ Opaques = erl_types:t_opaque_from_records(Records),
+ get_invalid_contract_warnings_funs(Contracts2, Plt, Records,
+ Opaques, Acc)
+ end,
+ get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, NewAcc);
+get_invalid_contract_warnings_modules([], _CodeServer, _Plt, Acc) ->
Acc.
get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left],
- Plt, RecDict, FindOpaques, Acc) ->
+ Plt, RecDict, Opaques, Acc) ->
case dialyzer_plt:lookup(Plt, MFA) of
none ->
%% This must be a contract for a non-available function. Just accept it.
- get_invalid_contract_warnings_funs(Left, Plt, RecDict, FindOpaques, Acc);
+ get_invalid_contract_warnings_funs(Left, Plt, RecDict, Opaques, Acc);
{value, {Ret, Args}} ->
Sig = erl_types:t_fun(Args, Ret),
{M, _F, _A} = MFA,
- %% io:format("MFA ~p~n", [MFA]),
- Opaques = FindOpaques(M),
+ %% io:format("MFA ~tp~n", [MFA]),
{File, Line} = FileLine,
WarningInfo = {File, Line, MFA},
NewAcc =
@@ -741,9 +747,9 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left],
RecDict, Acc)
end
end,
- get_invalid_contract_warnings_funs(Left, Plt, RecDict, FindOpaques, NewAcc)
+ get_invalid_contract_warnings_funs(Left, Plt, RecDict, Opaques, NewAcc)
end;
-get_invalid_contract_warnings_funs([], _Plt, _RecDict, _FindOpaques, Acc) ->
+get_invalid_contract_warnings_funs([], _Plt, _RecDict, _Opaques, Acc) ->
Acc.
invalid_contract_warning({M, F, A}, WarningInfo, SuccType, RecDict) ->
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 4c29b4f1eb..8367432ac5 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -138,7 +138,7 @@
%%--------------------------------------------------------------------
--type fun_types() :: dict:dict(label(), type()).
+-type fun_types() :: orddict:orddict(label(), type()).
-spec get_warnings(cerl:c_module(), dialyzer_plt:plt(),
dialyzer_callgraph:callgraph(),
@@ -191,19 +191,19 @@ analyze_loop(State) ->
{ArgTypes, IsCalled} = state__get_args_and_status(Fun, NewState1),
case not IsCalled of
true ->
- ?debug("Not handling (not called) ~w: ~s\n",
+ ?debug("Not handling (not called) ~w: ~ts\n",
[NewState1#state.curr_fun,
t_to_string(t_product(ArgTypes))]),
analyze_loop(NewState1);
false ->
case state__fun_env(Fun, NewState1) of
none ->
- ?debug("Not handling (no env) ~w: ~s\n",
+ ?debug("Not handling (no env) ~w: ~ts\n",
[NewState1#state.curr_fun,
t_to_string(t_product(ArgTypes))]),
analyze_loop(NewState1);
Map ->
- ?debug("Handling fun ~p: ~s\n",
+ ?debug("Handling fun ~p: ~ts\n",
[NewState1#state.curr_fun,
t_to_string(state__fun_type(Fun, NewState1))]),
Vars = cerl:fun_vars(Fun),
@@ -222,7 +222,7 @@ analyze_loop(State) ->
end,
{NewState4, _Map2, BodyType} =
traverse(Body, Map1, NewState3),
- ?debug("Done analyzing: ~w:~s\n",
+ ?debug("Done analyzing: ~w:~ts\n",
[NewState1#state.curr_fun,
t_to_string(t_fun(ArgTypes, BodyType))]),
NewState5 =
@@ -232,7 +232,7 @@ analyze_loop(State) ->
end,
NewState6 =
state__update_fun_entry(Fun, ArgTypes, BodyType, NewState5),
- ?debug("done adding stuff for ~w\n",
+ ?debug("done adding stuff for ~tw\n",
[state__lookup_name(get_label(Fun), State)]),
analyze_loop(NewState6)
end
@@ -487,23 +487,23 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
end,
?debug("--------------------------------------------------------\n", []),
- ?debug("Fun: ~p\n", [state__lookup_name(Fun, State)]),
+ ?debug("Fun: ~tp\n", [state__lookup_name(Fun, State)]),
?debug("Module ~p\n", [State#state.module]),
- ?debug("CArgs ~s\n", [erl_types:t_to_string(t_product(CArgs))]),
- ?debug("ArgTypes ~s\n", [erl_types:t_to_string(t_product(ArgTypes))]),
- ?debug("BifArgs ~p\n", [erl_types:t_to_string(t_product(BifArgs))]),
+ ?debug("CArgs ~ts\n", [erl_types:t_to_string(t_product(CArgs))]),
+ ?debug("ArgTypes ~ts\n", [erl_types:t_to_string(t_product(ArgTypes))]),
+ ?debug("BifArgs ~tp\n", [erl_types:t_to_string(t_product(BifArgs))]),
NewArgsSig = t_inf_lists(SigArgs, ArgTypes, Opaques),
- ?debug("SigArgs ~s\n", [erl_types:t_to_string(t_product(SigArgs))]),
- ?debug("NewArgsSig: ~s\n", [erl_types:t_to_string(t_product(NewArgsSig))]),
+ ?debug("SigArgs ~ts\n", [erl_types:t_to_string(t_product(SigArgs))]),
+ ?debug("NewArgsSig: ~ts\n", [erl_types:t_to_string(t_product(NewArgsSig))]),
NewArgsContract = t_inf_lists(CArgs, ArgTypes, Opaques),
- ?debug("NewArgsContract: ~s\n",
+ ?debug("NewArgsContract: ~ts\n",
[erl_types:t_to_string(t_product(NewArgsContract))]),
NewArgsBif = t_inf_lists(BifArgs, ArgTypes, Opaques),
- ?debug("NewArgsBif: ~s\n", [erl_types:t_to_string(t_product(NewArgsBif))]),
+ ?debug("NewArgsBif: ~ts\n", [erl_types:t_to_string(t_product(NewArgsBif))]),
NewArgTypes0 = t_inf_lists(NewArgsSig, NewArgsContract),
NewArgTypes = t_inf_lists(NewArgTypes0, NewArgsBif, Opaques),
- ?debug("NewArgTypes ~s\n", [erl_types:t_to_string(t_product(NewArgTypes))]),
+ ?debug("NewArgTypes ~ts\n", [erl_types:t_to_string(t_product(NewArgTypes))]),
?debug("\n", []),
BifRet = BifRange(NewArgTypes),
@@ -511,12 +511,12 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
RetWithoutContr = t_inf(SigRange, BifRet),
RetWithoutLocal = t_inf(ContrRet, RetWithoutContr),
- ?debug("RetWithoutContr: ~s\n",[erl_types:t_to_string(RetWithoutContr)]),
- ?debug("RetWithoutLocal: ~s\n", [erl_types:t_to_string(RetWithoutLocal)]),
- ?debug("BifRet: ~s\n", [erl_types:t_to_string(BifRange(NewArgTypes))]),
- ?debug("SigRange: ~s\n", [erl_types:t_to_string(SigRange)]),
- ?debug("ContrRet: ~s\n", [erl_types:t_to_string(ContrRet)]),
- ?debug("LocalRet: ~s\n", [erl_types:t_to_string(LocalRet)]),
+ ?debug("RetWithoutContr: ~ts\n",[erl_types:t_to_string(RetWithoutContr)]),
+ ?debug("RetWithoutLocal: ~ts\n", [erl_types:t_to_string(RetWithoutLocal)]),
+ ?debug("BifRet: ~ts\n", [erl_types:t_to_string(BifRange(NewArgTypes))]),
+ ?debug("SigRange: ~ts\n", [erl_types:t_to_string(SigRange)]),
+ ?debug("ContrRet: ~ts\n", [erl_types:t_to_string(ContrRet)]),
+ ?debug("LocalRet: ~ts\n", [erl_types:t_to_string(LocalRet)]),
State1 =
case is_race_analysis_enabled(State) of
@@ -596,7 +596,7 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left],
false -> t_inf(RetWithoutLocal, LocalRet)
end,
NewAccRet = t_sup(AccRet, TotalRet),
- ?debug("NewAccRet: ~s\n", [t_to_string(NewAccRet)]),
+ ?debug("NewAccRet: ~ts\n", [t_to_string(NewAccRet)]),
{NewWarnings, State4} = state__remove_added_warnings(State, State3),
{HowMany, OldWarnings} = Warns,
NewWarns =
@@ -1335,7 +1335,7 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) ->
end,
case BindRes of
{error, ErrorType, NewPats, Type, OpaqueTerm} ->
- ?debug("Failed binding pattern: ~s\nto ~s\n",
+ ?debug("Failed binding pattern: ~ts\nto ~ts\n",
[cerl_prettypr:format(C), format_type(ArgType0, State1)]),
case state__warning_mode(State1) of
false ->
@@ -1451,7 +1451,7 @@ do_clause(C, Arg, ArgType0, OrigArgType, Map, State, Warns) ->
end,
case bind_guard(Guard, Map3, State1) of
{error, Reason} ->
- ?debug("Failed guard: ~s\n",
+ ?debug("Failed guard: ~ts\n",
[cerl_prettypr:format(C, [{hook, cerl_typean:pp_hook()}])]),
PatString = format_patterns(Pats),
DefaultMsg =
@@ -1532,7 +1532,7 @@ bind_pat_vars_reverse(Pats, Types, Acc, Map, State) ->
end.
bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
- ?debug("Binding pat: ~w to ~s\n", [cerl:type(Pat), format_type(Type, State)]
+ ?debug("Binding pat: ~tw to ~ts\n", [cerl:type(Pat), format_type(Type, State)]
),
Opaques = State#state.opaques,
{NewMap, TypeOut} =
@@ -1830,7 +1830,7 @@ bind_guard(Guard, Map, State) ->
end.
bind_guard(Guard, Map, Env, Eval, State) ->
- ?debug("Handling ~w guard: ~s\n",
+ ?debug("Handling ~tw guard: ~ts\n",
[Eval, cerl_prettypr:format(Guard, [{noann, true}])]),
case cerl:type(Guard) of
binary ->
@@ -2009,7 +2009,7 @@ handle_guard_type_test(Guard, F, Map, Env, Eval, State) ->
?debug("Type test: ~w failed\n", [F]),
signal_guard_fail(Eval, Guard, [ArgType], State);
{ok, NewArgType, Ret} ->
- ?debug("Type test: ~w succeeded, NewType: ~s, Ret: ~s\n",
+ ?debug("Type test: ~w succeeded, NewType: ~ts, Ret: ~ts\n",
[F, t_to_string(NewArgType), t_to_string(Ret)]),
{enter_type(Arg, NewArgType, Map1), Ret}
end.
@@ -2295,8 +2295,8 @@ handle_guard_eqeq(Guard, Map, Env, Eval, State) ->
bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) ->
{Map1, Type1} = bind_guard(Arg1, Map, Env, dont_know, State),
{Map2, Type2} = bind_guard(Arg2, Map1, Env, dont_know, State),
- ?debug("Types are:~s =:= ~s\n", [t_to_string(Type1),
- t_to_string(Type2)]),
+ ?debug("Types are:~ts =:= ~ts\n", [t_to_string(Type1),
+ t_to_string(Type2)]),
Opaques = State#state.opaques,
Inf = t_inf(Type1, Type2, Opaques),
case t_is_none(Inf) of
@@ -2840,7 +2840,7 @@ enter_type(Key, Val, MS) ->
?debug("Binding ~p to ~p\n", [KeyLabel, NewKey]),
enter_type(NewKey, Val, MS);
error ->
- ?debug("Entering ~p :: ~s\n", [KeyLabel, t_to_string(Val)]),
+ ?debug("Entering ~p :: ~ts\n", [KeyLabel, t_to_string(Val)]),
case maps:find(KeyLabel, Map) of
{ok, Value} ->
case erl_types:t_is_equal(Val, Value) of
@@ -2940,7 +2940,7 @@ debug_pp_map(#map{map = Map}=MapRec) ->
Keys = maps:keys(Map),
io:format("Map:\n", []),
lists:foreach(fun (Key) ->
- io:format("\t~w :: ~s\n",
+ io:format("\t~w :: ~ts\n",
[Key, t_to_string(lookup_type(Key, MapRec))])
end, Keys),
ok.
@@ -3095,7 +3095,7 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State,
abs(get_line(Ann)),
State#state.curr_fun},
Warn = {Tag, WarningInfo, Msg},
- ?debug("MSG ~s\n", [dialyzer:format_warning(Warn)]),
+ ?debug("MSG ~ts\n", [dialyzer:format_warning(Warn)]),
State#state{warnings = [Warn|Warnings]};
false ->
case is_compiler_generated(Ann) of
@@ -3107,7 +3107,7 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State,
Warn = {Tag, WarningInfo, Msg},
case Tag of
?WARN_CONTRACT_RANGE -> ok;
- _ -> ?debug("MSG ~s\n", [dialyzer:format_warning(Warn)])
+ _ -> ?debug("MSG ~ts\n", [dialyzer:format_warning(Warn)])
end,
State#state{warnings = [Warn|Warnings]}
end
@@ -3317,7 +3317,9 @@ state__clean_not_called(#state{fun_tab = FunTab} = State) ->
state__all_fun_types(State) ->
#state{fun_tab = FunTab} = state__clean_not_called(State),
Tab1 = dict:erase(top, FunTab),
- dict:map(fun(_Fun, {Args, Ret}) -> t_fun(Args, Ret)end, Tab1).
+ List = [{Fun, t_fun(Args, Ret)} ||
+ {Fun, {Args, Ret}} <- dict:to_list(Tab1)],
+ orddict:from_list(List).
state__fun_type(Fun, #state{fun_tab = FunTab}) ->
Label =
@@ -3351,14 +3353,14 @@ state__update_fun_entry(Tree, ArgTypes, Out0,
SameOut = t_is_equal(OldOut, Out),
if
SameArgs, SameOut ->
- ?debug("Fixpoint for ~w: ~s\n",
+ ?debug("Fixpoint for ~tw: ~ts\n",
[state__lookup_name(Fun, State),
t_to_string(t_fun(ArgTypes, Out))]),
State;
true ->
%% Can only happen in self-recursive functions.
NewEntry = {OldArgTypes, Out},
- ?debug("New Entry for ~w: ~s\n",
+ ?debug("New Entry for ~tw: ~ts\n",
[state__lookup_name(Fun, State),
t_to_string(t_fun(OldArgTypes, Out))]),
NewFunTab = dict:store(Fun, NewEntry, FunTab),
@@ -3380,7 +3382,7 @@ state__add_work_from_fun(Tree, #state{callgraph = Callgraph,
|| MFA <- MFAList],
%% Must filter the result for results in this module.
FilteredList = [L || {ok, L} <- LabelList, dict:is_key(L, TreeMap)],
- ?debug("~w: Will try to add:~w\n",
+ ?debug("~tw: Will try to add:~tw\n",
[state__lookup_name(Label, State), MFAList]),
lists:foldl(fun(L, AccState) ->
state__add_work(L, AccState)
@@ -3427,7 +3429,7 @@ state__fun_info(Fun, #state{callgraph = CG, fun_tab = FunTab, plt = PLT}) ->
{not_handled, {_Args, Ret}} -> Ret;
{_Args, Ret} -> Ret
end,
- ?debug("LocalRet: ~s\n", [t_to_string(LocalRet)]),
+ ?debug("LocalRet: ~ts\n", [t_to_string(LocalRet)]),
{Fun, Sig, Contract, LocalRet}.
forward_args(Fun, ArgTypes, #state{work = Work, fun_tab = FunTab} = State) ->
@@ -3445,7 +3447,7 @@ forward_args(Fun, ArgTypes, #state{work = Work, fun_tab = FunTab} = State) ->
NewArgTypes = [t_sup(X, Y) ||
{X, Y} <- lists:zip(ArgTypes, OldArgTypes)],
NewWork = add_work(Fun, Work),
- ?debug("~w: forwarding args ~s\n",
+ ?debug("~tw: forwarding args ~ts\n",
[state__lookup_name(Fun, State),
t_to_string(t_product(NewArgTypes))]),
NewFunTab = dict:store(Fun, {NewArgTypes, OldOut}, FunTab),
diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl
index d1b955044b..538327d4d1 100644
--- a/lib/dialyzer/src/dialyzer_gui_wx.erl
+++ b/lib/dialyzer/src/dialyzer_gui_wx.erl
@@ -469,18 +469,18 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt,
Msg = io_lib:format("The following functions are called "
"but type information about them is not available.\n"
"The analysis might get more precise by including "
- "the modules containing these functions:\n\n\t~p\n",
+ "the modules containing these functions:\n\n\t~tp\n",
[ExtCalls]),
free_editor(State,"Analysis Done", Msg),
gui_loop(State);
{BackendPid, ext_types, ExtTypes} ->
- Map = fun({M,F,A}) -> io_lib:format("~p:~p/~p",[M,F,A]) end,
+ Map = fun({M,F,A}) -> io_lib:format("~tp:~tp/~p",[M,F,A]) end,
ExtTypeString = string:join(lists:map(Map, ExtTypes), "\n"),
Msg = io_lib:format("The following remote types are being used "
"but information about them is not available.\n"
"The analysis might get more precise by including "
"the modules containing these types and making sure "
- "that they are exported:\n~s\n", [ExtTypeString]),
+ "that they are exported:\n~ts\n", [ExtTypeString]),
free_editor(State, "Analysis done", Msg),
gui_loop(State);
{BackendPid, log, LogMsg} ->
@@ -498,9 +498,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, NewMiniPlt, NewDocPlt} ->
+ {BackendPid, done, NewPlt, NewDocPlt} ->
message(State, "Analysis done"),
- dialyzer_plt:delete(NewMiniPlt),
+ dialyzer_plt:delete(NewPlt),
config_gui_stop(State),
gui_loop(State#gui_state{doc_plt = NewDocPlt});
{'EXIT', BackendPid, {error, Reason}} ->
@@ -508,7 +508,7 @@ gui_loop(#gui_state{backend_pid = BackendPid, doc_plt = DocPlt,
config_gui_stop(State),
gui_loop(State);
{'EXIT', BackendPid, Reason} when Reason =/= 'normal' ->
- free_editor(State, ?DIALYZER_ERROR_TITLE, io_lib:format("~p", [Reason])),
+ free_editor(State, ?DIALYZER_ERROR_TITLE, io_lib:format("~tp", [Reason])),
config_gui_stop(State),
gui_loop(State)
end.
@@ -926,7 +926,7 @@ include_dialog(#gui_state{gui = Wx, frame = Frame, options = Options}) ->
wxButton:connect(DeleteAllButton, command_button_clicked),
wxButton:connect(Ok, command_button_clicked),
wxButton:connect(Cancel, command_button_clicked),
- Dirs = [io_lib:format("~s", [X]) || X <- Options#options.include_dirs],
+ Dirs = [io_lib:format("~ts", [X]) || X <- Options#options.include_dirs],
wxListBox:set(Box, Dirs),
Layout = wxBoxSizer:new(?wxVERTICAL),
Buttons = wxBoxSizer:new(?wxHORIZONTAL),
@@ -1118,13 +1118,13 @@ handle_help(State, Title, Txt) ->
case file:open(FileName, [read]) of
{error, Reason} ->
error_sms(State,
- io_lib:format("Could not find doc/~s file!\n\n ~p",
+ io_lib:format("Could not find doc/~ts file!\n\n ~tp",
[Txt, Reason]));
{ok, _Handle} ->
case file:read_file(FileName) of
{error, Reason} ->
error_sms(State,
- io_lib:format("Could not read doc/~s file!\n\n ~p",
+ io_lib:format("Could not read doc/~ts file!\n\n ~tp",
[Txt, Reason]));
{ok, Binary} ->
Contents = binary_to_list(Binary),
@@ -1223,7 +1223,7 @@ update_explanation(#gui_state{explanation_box = Box}, Explanation) ->
wxTextCtrl:appendText(Box, ExplString).
format_explanation({function_return, {M, F, A}, NewList}) ->
- io_lib:format("The function ~p: ~p/~p returns ~p\n",
+ io_lib:format("The function ~w:~tw/~w returns ~ts\n",
[M, F, A, erl_types:t_to_string(NewList)]);
format_explanation(Explanation) ->
io_lib:format("~p\n", [Explanation]).
diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl
index ec3f41311d..03040f8e38 100644
--- a/lib/dialyzer/src/dialyzer_options.erl
+++ b/lib/dialyzer/src/dialyzer_options.erl
@@ -112,7 +112,7 @@ adapt_get_warnings(Opts = #options{analysis_type = Mode,
-spec bad_option(string(), term()) -> no_return().
bad_option(String, Term) ->
- Msg = io_lib:format("~s: ~P", [String, Term, 25]),
+ Msg = io_lib:format("~ts: ~tP", [String, Term, 25]),
throw({dialyzer_options_error, lists:flatten(Msg)}).
build_options([{OptName, undefined}|Rest], Options) when is_atom(OptName) ->
diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl
index 847faab2f4..47994fc35b 100644
--- a/lib/dialyzer/src/dialyzer_plt.erl
+++ b/lib/dialyzer/src/dialyzer_plt.erl
@@ -39,6 +39,7 @@
insert_types/2,
insert_exported_types/2,
lookup/2,
+ is_contract/2,
lookup_contract/2,
lookup_callbacks/2,
lookup_module/2,
@@ -49,10 +50,7 @@
get_specs/1,
get_specs/4,
to_file/4,
- get_mini_plt/1,
- restore_full_plt/1,
- delete/1,
- give_away/2
+ delete/1
]).
%% Debug utilities
@@ -60,6 +58,8 @@
-export_type([plt/0, plt_info/0]).
+-include_lib("stdlib/include/ms_transform.hrl").
+
%%----------------------------------------------------------------------
-type mod_deps() :: dialyzer_callgraph:mod_deps().
@@ -75,20 +75,16 @@
%%----------------------------------------------------------------------
--record(plt, {info = 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(),
- exported_types :: ets:tid()
- }).
+-record(plt, {info :: ets:tid(), %% {mfa() | integer(), ret_args_types()}
+ types :: ets:tid(), %% {module(), erl_types:type_table()}
+ contracts :: ets:tid(), %% {mfa(), #contract{}}
+ callbacks :: ets:tid(), %% {module(),
+ %% [{mfa(),
+ %% dialyzer_contracts:file_contract()}]
+ exported_types :: ets:tid() %% {module(), sets:set()}
+ }).
--opaque plt() :: #plt{} | #mini_plt{}.
+-opaque plt() :: #plt{}.
-include("dialyzer.hrl").
@@ -110,7 +106,17 @@
-spec new() -> plt().
new() ->
- #plt{}.
+ [ETSInfo, ETSContracts] =
+ [ets:new(Name, [public]) ||
+ Name <- [plt_info, plt_contracts]],
+ [ETSTypes, ETSCallbacks, ETSExpTypes] =
+ [ets:new(Name, [compressed, public]) ||
+ Name <- [plt_types, plt_callbacks, plt_exported_types]],
+ #plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes}.
-spec delete_module(plt(), atom()) -> plt().
@@ -121,58 +127,55 @@ delete_module(#plt{info = Info, types = Types,
#plt{info = table_delete_module(Info, Mod),
types = table_delete_module2(Types, Mod),
contracts = table_delete_module(Contracts, Mod),
- callbacks = table_delete_module(Callbacks, Mod),
+ callbacks = table_delete_module2(Callbacks, Mod),
exported_types = table_delete_module1(ExpTypes, Mod)}.
-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,
- exported_types = ExpTypes}, List) ->
- #plt{info = table_delete_list(Info, List),
- types = Types,
- contracts = table_delete_list(Contracts, List),
- callbacks = Callbacks,
- exported_types = ExpTypes}.
+delete_list(#plt{info = Info,
+ contracts = Contracts}=Plt, List) ->
+ Plt#plt{info = ets_table_delete_list(Info, List),
+ contracts = ets_table_delete_list(Contracts, List)}.
-spec insert_contract_list(plt(), dialyzer_contracts:plt_contracts()) -> plt().
insert_contract_list(#plt{contracts = Contracts} = PLT, List) ->
- NewContracts = dict:merge(fun(_MFA, _Old, New) -> New end,
- Contracts, dict:from_list(List)),
- PLT#plt{contracts = NewContracts};
-insert_contract_list(#mini_plt{contracts = Contracts} = PLT, List) ->
true = ets:insert(Contracts, List),
PLT.
-spec insert_callbacks(plt(), dialyzer_codeserver:codeserver()) -> plt().
insert_callbacks(#plt{callbacks = Callbacks} = Plt, Codeserver) ->
- List = dialyzer_codeserver:get_callbacks(Codeserver),
- Plt#plt{callbacks = table_insert_list(Callbacks, List)}.
+ CallbacksList = dialyzer_codeserver:get_callbacks(Codeserver),
+ CallbacksByModule =
+ [{M, [Cb || {{M1,_,_},_} = Cb <- CallbacksList, M1 =:= M]} ||
+ M <- lists:usort([M || {{M,_,_},_} <- CallbacksList])],
+ true = ets:insert(Callbacks, CallbacksByModule),
+ Plt.
+
+-spec is_contract(plt(), mfa()) -> boolean().
+
+is_contract(#plt{contracts = ETSContracts},
+ {M, F, _} = MFA) when is_atom(M), is_atom(F) ->
+ ets:member(ETSContracts, MFA).
-spec lookup_contract(plt(), mfa_patt()) -> 'none' | {'value', #contract{}}.
-lookup_contract(#mini_plt{contracts = ETSContracts},
+lookup_contract(#plt{contracts = ETSContracts},
{M, F, _} = MFA) when is_atom(M), is_atom(F) ->
ets_table_lookup(ETSContracts, MFA).
-spec lookup_callbacks(plt(), module()) ->
'none' | {'value', [{mfa(), dialyzer_contracts:file_contract()}]}.
-lookup_callbacks(#mini_plt{callbacks = ETSCallbacks}, Mod) when is_atom(Mod) ->
+lookup_callbacks(#plt{callbacks = ETSCallbacks}, Mod) when is_atom(Mod) ->
ets_table_lookup(ETSCallbacks, Mod).
-type ret_args_types() :: {erl_types:erl_type(), [erl_types:erl_type()]}.
-spec insert_list(plt(), [{mfa() | integer(), ret_args_types()}]) -> plt().
-insert_list(#mini_plt{info = Info} = PLT, List) ->
+insert_list(#plt{info = Info} = PLT, List) ->
true = ets:insert(Info, List),
PLT.
@@ -184,31 +187,31 @@ lookup(Plt, {M, F, _} = MFA) when is_atom(M), is_atom(F) ->
lookup(Plt, Label) when is_integer(Label) ->
lookup_1(Plt, Label).
-lookup_1(#mini_plt{info = Info}, MFAorLabel) ->
+lookup_1(#plt{info = Info}, MFAorLabel) ->
ets_table_lookup(Info, MFAorLabel).
-spec insert_types(plt(), ets:tid()) -> plt().
-insert_types(MiniPLT, Records) ->
- ets:rename(Records, plt_types),
- MiniPLT#mini_plt{types = Records}.
+insert_types(PLT, Records) ->
+ ok = dialyzer_utils:ets_move(Records, PLT#plt.types),
+ PLT.
-spec insert_exported_types(plt(), ets:tid()) -> plt().
-insert_exported_types(MiniPLT, ExpTypes) ->
- ets:rename(ExpTypes, plt_exported_types),
- MiniPLT#mini_plt{exported_types = ExpTypes}.
+insert_exported_types(PLT, ExpTypes) ->
+ ok = dialyzer_utils:ets_move(ExpTypes, PLT#plt.exported_types),
+ PLT.
-spec get_module_types(plt(), atom()) ->
'none' | {'value', erl_types:type_table()}.
get_module_types(#plt{types = Types}, M) when is_atom(M) ->
- table_lookup(Types, M).
+ ets_table_lookup(Types, M).
-spec get_exported_types(plt()) -> sets:set().
-get_exported_types(#plt{exported_types = ExpTypes}) ->
- ExpTypes.
+get_exported_types(#plt{exported_types = ETSExpTypes}) ->
+ sets:from_list([E || {E} <- table_to_list(ETSExpTypes)]).
-type mfa_types() :: {mfa(), erl_types:erl_type(), [erl_types:erl_type()]}.
@@ -225,8 +228,7 @@ all_modules(#plt{info = Info, contracts = Cs}) ->
-spec contains_mfa(plt(), mfa()) -> boolean().
contains_mfa(#plt{info = Info, contracts = Contracts}, MFA) ->
- (table_lookup(Info, MFA) =/= none)
- orelse (table_lookup(Contracts, MFA) =/= none).
+ ets:member(Info, MFA) orelse ets:member(Contracts, MFA).
-spec get_default_plt() -> file:filename().
@@ -249,32 +251,60 @@ from_file(FileName) ->
from_file(FileName, false).
from_file(FileName, ReturnInfo) ->
+ Plt = new(),
+ Fun = fun() -> from_file1(Plt, FileName, ReturnInfo) end,
+ case subproc(Fun) of
+ {ok, Return} ->
+ Return;
+ {error, Msg} ->
+ delete(Plt),
+ plt_error(Msg)
+ end.
+
+from_file1(Plt, FileName, ReturnInfo) ->
case get_record_from_file(FileName) of
{ok, Rec} ->
case check_version(Rec) of
error ->
- Msg = io_lib:format("Old PLT file ~s\n", [FileName]),
- plt_error(Msg);
+ Msg = io_lib:format("Old PLT file ~ts\n", [FileName]),
+ {error, Msg};
ok ->
+ #file_plt{info = FileInfo,
+ contracts = FileContracts,
+ callbacks = FileCallbacks,
+ types = FileTypes,
+ exported_types = FileExpTypes} = Rec,
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 = dict:from_list(Types),
- contracts = Rec#file_plt.contracts,
- callbacks = Rec#file_plt.callbacks,
- exported_types = Rec#file_plt.exported_types},
+ {Mod, Types} <- dict:to_list(FileTypes)],
+ CallbacksList = dict:to_list(FileCallbacks),
+ CallbacksByModule =
+ [{M, [Cb || {{M1,_,_},_} = Cb <- CallbacksList, M1 =:= M]} ||
+ M <- lists:usort([M || {{M,_,_},_} <- CallbacksList])],
+ #plt{info = ETSInfo,
+ types = ETSTypes,
+ contracts = ETSContracts,
+ callbacks = ETSCallbacks,
+ exported_types = ETSExpTypes} = Plt,
+ [true, true, true] =
+ [ets:insert(ETS, Data) ||
+ {ETS, Data} <- [{ETSInfo, dict:to_list(FileInfo)},
+ {ETSTypes, Types},
+ {ETSContracts, dict:to_list(FileContracts)}]],
+ true = ets:insert(ETSCallbacks, CallbacksByModule),
+ true = ets:insert(ETSExpTypes, [{ET} ||
+ ET <- sets:to_list(FileExpTypes)]),
case ReturnInfo of
- false -> Plt;
+ false -> {ok, Plt};
true ->
PltInfo = {Rec#file_plt.file_md5_list,
Rec#file_plt.mod_deps},
- {Plt, PltInfo}
+ {ok, {Plt, PltInfo}}
end
end;
{error, Reason} ->
- Msg = io_lib:format("Could not read PLT file ~s: ~p\n",
+ Msg = io_lib:format("Could not read PLT file ~ts: ~p\n",
[FileName, Reason]),
- plt_error(Msg)
+ {error, Msg}
end.
-type err_rsn() :: 'not_valid' | 'no_such_file' | 'read_error'.
@@ -283,6 +313,10 @@ from_file(FileName, ReturnInfo) ->
| {'error', err_rsn()}.
included_files(FileName) ->
+ Fun = fun() -> included_files1(FileName) end,
+ subproc(Fun).
+
+included_files1(FileName) ->
case get_record_from_file(FileName) of
{ok, #file_plt{file_md5_list = Md5}} ->
{ok, [File || {File, _} <- Md5]};
@@ -315,6 +349,9 @@ get_record_from_file(FileName) ->
-spec merge_plts([plt()]) -> plt().
+%% One of the PLTs of the list is augmented with the contents of the
+%% other PLTs, and returned. The other PLTs are deleted.
+
merge_plts(List) ->
{InfoList, TypesList, ExpTypesList, ContractsList, CallbacksList} =
group_fields(List),
@@ -327,6 +364,12 @@ merge_plts(List) ->
-spec merge_disj_plts([plt()]) -> plt().
+%% One of the PLTs of the list is augmented with the contents of the
+%% other PLTs, and returned. The other PLTs are deleted.
+%%
+%% The keys are compared when checking for disjointness. Sometimes the
+%% key is a module(), sometimes an mfa(). It boils down to checking if
+%% any module occurs more than once.
merge_disj_plts(List) ->
{InfoList, TypesList, ExpTypesList, ContractsList, CallbacksList} =
group_fields(List),
@@ -356,7 +399,7 @@ merge_plts_or_report_conflicts(PltFiles, Plts) ->
ConfFiles = find_duplicates(IncFiles),
Msg = io_lib:format("Could not merge PLTs since they are not disjoint\n"
"The following files are included in more than one "
- "PLTs:\n~p\n", [ConfFiles]),
+ "PLTs:\n~tp\n", [ConfFiles]),
plt_error(Msg)
end.
@@ -367,17 +410,36 @@ find_duplicates(List) ->
-spec to_file(file:filename(), plt(), mod_deps(), {[file_md5()], mod_deps()}) -> 'ok'.
-to_file(FileName,
- #plt{info = Info, types = Types, contracts = Contracts,
- callbacks = Callbacks, exported_types = ExpTypes},
+%% Write the PLT to file, and deletes the PLT.
+to_file(FileName, Plt, ModDeps, MD5_OldModDeps) ->
+ Fun = fun() -> to_file1(FileName, Plt, ModDeps, MD5_OldModDeps) end,
+ Return = subproc(Fun),
+ delete(Plt),
+ case Return of
+ ok -> ok;
+ Thrown -> throw(Thrown)
+ end.
+
+to_file1(FileName,
+ #plt{info = ETSInfo, types = ETSTypes, contracts = ETSContracts,
+ callbacks = ETSCallbacks, exported_types = ETSExpTypes},
ModDeps, {MD5, OldModDeps}) ->
NewModDeps = dict:merge(fun(_Key, OldVal, NewVal) ->
ordsets:union(OldVal, NewVal)
end,
OldModDeps, ModDeps),
ImplMd5 = compute_implementation_md5(),
+ CallbacksList =
+ [Cb ||
+ {_M, Cbs} <- tab2list(ETSCallbacks),
+ Cb <- Cbs],
+ Callbacks = dict:from_list(CallbacksList),
+ Info = dict:from_list(tab2list(ETSInfo)),
+ Types = tab2list(ETSTypes),
+ Contracts = dict:from_list(tab2list(ETSContracts)),
+ ExpTypes = sets:from_list([E || {E} <- tab2list(ETSExpTypes)]),
FileTypes = dict:from_list([{Mod, dict:from_list(maps:to_list(MTypes))} ||
- {Mod, MTypes} <- dict:to_list(Types)]),
+ {Mod, MTypes} <- Types]),
Record = #file_plt{version = ?VSN,
file_md5_list = MD5,
info = Info,
@@ -391,9 +453,9 @@ to_file(FileName,
case file:write_file(FileName, Bin) of
ok -> ok;
{error, Reason} ->
- Msg = io_lib:format("Could not write PLT file ~s: ~w\n",
+ Msg = io_lib:format("Could not write PLT file ~ts: ~w\n",
[FileName, Reason]),
- throw({dialyzer_error, Msg})
+ {dialyzer_error, Msg}
end.
-type md5_diff() :: [{'differ', atom()} | {'removed', atom()}].
@@ -406,6 +468,10 @@ to_file(FileName,
| {'old_version', [file_md5()]}.
check_plt(FileName, RemoveFiles, AddFiles) ->
+ Fun = fun() -> check_plt1(FileName, RemoveFiles, AddFiles) end,
+ subproc(Fun).
+
+check_plt1(FileName, RemoveFiles, AddFiles) ->
case get_record_from_file(FileName) of
{ok, #file_plt{file_md5_list = Md5, mod_deps = ModDeps} = Rec} ->
case check_version(Rec) of
@@ -467,7 +533,7 @@ compute_md5_from_files(Files) ->
compute_md5_from_file(File) ->
case filelib:is_regular(File) of
false ->
- Msg = io_lib:format("Not a regular file: ~s\n", [File]),
+ Msg = io_lib:format("Not a regular file: ~ts\n", [File]),
throw({dialyzer_error, Msg});
true ->
case dialyzer_utils:get_core_from_beam(File) of
@@ -514,67 +580,13 @@ init_md5_list_1([], DiffList, Acc) ->
init_md5_list_1(Md5List, [], Acc) ->
{ok, lists:reverse(Acc, Md5List)}.
--spec get_mini_plt(plt()) -> plt().
+-spec delete(plt()) -> 'ok'.
-get_mini_plt(#plt{info = Info,
- types = Types,
- contracts = Contracts,
- callbacks = Callbacks,
- exported_types = ExpTypes}) ->
- [ETSInfo, ETSContracts] =
- [ets:new(Name, [public]) ||
- Name <- [plt_info, plt_contracts]],
- [ETSTypes, ETSCallbacks, ETSExpTypes] =
- [ets:new(Name, [compressed, public]) ||
- Name <- [plt_types, 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] =
- [ets:insert(ETS, dict:to_list(Data)) ||
- {ETS, Data} <- [{ETSInfo, Info},
- {ETSTypes, Types},
- {ETSContracts, Contracts}]],
- true = ets:insert(ETSCallbacks, CallbacksByModule),
- true = ets:insert(ETSExpTypes, [{ET} || ET <- sets:to_list(ExpTypes)]),
- #mini_plt{info = ETSInfo,
+delete(#plt{info = ETSInfo,
types = ETSTypes,
contracts = ETSContracts,
callbacks = ETSCallbacks,
- exported_types = ETSExpTypes};
-get_mini_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}) ->
+ exported_types = ETSExpTypes}) ->
true = ets:delete(ETSContracts),
true = ets:delete(ETSTypes),
true = ets:delete(ETSInfo),
@@ -582,35 +594,15 @@ delete(#mini_plt{info = ETSInfo,
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(Tab) ->
+ dialyzer_utils:ets_tab2list(Tab).
-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).
+subproc(Fun) ->
+ F = fun() -> exit(Fun()) end,
+ {Pid, Ref} = erlang:spawn_monitor(F),
+ receive {'DOWN', Ref, process, Pid, Return} ->
+ Return
+ end.
%%---------------------------------------------------------------------------
%% Edoc
@@ -619,7 +611,8 @@ tab2list(Key, T, A) ->
get_specs(#plt{info = Info}) ->
%% TODO: Should print contracts as well.
- L = lists:sort([{MFA, Val} || {{_,_,_} = MFA, Val} <- table_to_list(Info)]),
+ L = lists:sort([{MFA, Val} ||
+ {{_,_,_} = MFA, Val} <- table_to_list(Info)]),
lists:flatten(create_specs(L, [])).
beam_file_to_module(Filename) ->
@@ -629,13 +622,13 @@ beam_file_to_module(Filename) ->
get_specs(#plt{info = Info}, M, F, A) when is_atom(M), is_atom(F) ->
MFA = {M, F, A},
- case table_lookup(Info, MFA) of
+ case ets_table_lookup(Info, MFA) of
none -> none;
{value, Val} -> lists:flatten(create_specs([{MFA, Val}], []))
end.
create_specs([{{M, F, _A}, {Ret, Args}}|Left], M) ->
- [io_lib:format("-spec ~w(~s) -> ~s\n",
+ [io_lib:format("-spec ~tw(~ts) -> ~ts\n",
[F, expand_args(Args), erl_types:t_to_string(Ret)])
| create_specs(Left, M)];
create_specs(List = [{{M, _F, _A}, {_Ret, _Args}}| _], _M) ->
@@ -666,22 +659,24 @@ plt_error(Msg) ->
%%---------------------------------------------------------------------------
%% Ets table
-table_new() ->
- dict:new().
-
table_to_list(Plt) ->
- dict:to_list(Plt).
+ ets:tab2list(Plt).
-table_delete_module(Plt, Mod) ->
- dict:filter(fun({M, _F, _A}, _Val) -> M =/= Mod;
- (_, _) -> true
- end, Plt).
+table_delete_module(Tab, Mod) ->
+ MS = ets:fun2ms(fun({{M, _F, _A}, _Val}) -> M =:= Mod;
+ ({_, _}) -> false
+ end),
+ _NumDeleted = ets:select_delete(Tab, MS),
+ Tab.
-table_delete_module1(Plt, Mod) ->
- sets:filter(fun({M, _F, _A}) -> M =/= Mod end, Plt).
+table_delete_module1(Tab, Mod) ->
+ MS = ets:fun2ms(fun({{M, _F, _A}}) -> M =:= Mod end),
+ _NumDeleted = ets:select_delete(Tab, MS),
+ Tab.
-table_delete_module2(Plt, Mod) ->
- dict:filter(fun(M, _Val) -> M =/= Mod end, Plt).
+table_delete_module2(Tab, Mod) ->
+ true = ets:delete(Tab, Mod),
+ Tab.
ets_table_delete_list(Tab, [H|T]) ->
ets:delete(Tab, H),
@@ -689,25 +684,6 @@ ets_table_delete_list(Tab, [H|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, []) ->
- Plt.
-
-table_insert_list(Plt, [{Key, Val}|Left]) ->
- table_insert_list(table_insert(Plt, Key, Val), Left);
-table_insert_list(Plt, []) ->
- Plt.
-
-table_insert(Plt, Key, {_File, #contract{}, _Xtra} = C) ->
- dict:store(Key, C, Plt).
-
-table_lookup(Plt, Obj) ->
- case dict:find(Obj, Plt) of
- error -> none;
- {ok, Val} -> {value, Val}
- end.
-
ets_table_lookup(Plt, Obj) ->
try ets:lookup_element(Plt, Obj, 2) of
Val -> {value, Val}
@@ -715,25 +691,28 @@ ets_table_lookup(Plt, Obj) ->
_:_ -> none
end.
-table_lookup_module(Plt, Mod) ->
- List = dict:fold(fun(Key, Val, Acc) ->
- case Key of
- {Mod, _F, _A} -> [{Key, element(1, Val),
- element(2, Val)}|Acc];
- _ -> Acc
- end
- end, [], Plt),
+table_lookup_module(Tab, Mod) ->
+ MS = ets:fun2ms(fun({{M, F, A}, V}) when M =:= Mod ->
+ {{M, F, A}, V} end),
+ List = [begin
+ {V1, V2} = V,
+ {MFA, V1, V2}
+ end || {MFA, V} <- ets:select(Tab, MS)],
case List =:= [] of
true -> none;
false -> {value, List}
end.
-table_all_modules(Plt) ->
- Fold =
- fun({M, _F, _A}, _Val, Acc) -> sets:add_element(M, Acc);
- (_, _, Acc) -> Acc
- end,
- dict:fold(Fold, sets:new(), Plt).
+table_all_modules(Tab) ->
+ Ks = ets:match(Tab, {'$1', '_'}, 100),
+ all_mods(Ks, sets:new()).
+
+all_mods('$end_of_table', S) ->
+ S;
+all_mods({ListsOfKeys, Cont}, S) ->
+ S1 = lists:foldl(fun([{M, _F, _A}], S0) -> sets:add_element(M, S0)
+ end, S, ListsOfKeys),
+ all_mods(ets:match(Cont), S1).
table_merge([H|T]) ->
table_merge(T, H).
@@ -741,7 +720,7 @@ table_merge([H|T]) ->
table_merge([], Acc) ->
Acc;
table_merge([Plt|Plts], Acc) ->
- NewAcc = dict:merge(fun(_Key, Val, Val) -> Val end, Plt, Acc),
+ NewAcc = merge_tables(Plt, Acc),
table_merge(Plts, NewAcc).
table_disj_merge([H|T]) ->
@@ -752,24 +731,18 @@ table_disj_merge([], Acc) ->
table_disj_merge([Plt|Plts], Acc) ->
case table_is_disjoint(Plt, Acc) of
true ->
- NewAcc = dict:merge(fun(_Key, _Val1, _Val2) -> gazonk end,
- Plt, Acc),
+ NewAcc = merge_tables(Plt, Acc),
table_disj_merge(Plts, NewAcc);
false -> throw({dialyzer_error, not_disjoint_plts})
end.
-table_is_disjoint(T1, T2) ->
- K1 = dict:fetch_keys(T1),
- K2 = dict:fetch_keys(T2),
- lists:all(fun(E) -> not lists:member(E, K2) end, K1).
-
sets_merge([H|T]) ->
sets_merge(T, H).
sets_merge([], Acc) ->
Acc;
sets_merge([Plt|Plts], Acc) ->
- NewAcc = sets:union(Plt, Acc),
+ NewAcc = merge_tables(Plt, Acc),
sets_merge(Plts, NewAcc).
sets_disj_merge([H|T]) ->
@@ -778,13 +751,39 @@ sets_disj_merge([H|T]) ->
sets_disj_merge([], Acc) ->
Acc;
sets_disj_merge([Plt|Plts], Acc) ->
- case sets:is_disjoint(Plt, Acc) of
+ case table_is_disjoint(Plt, Acc) of
true ->
- NewAcc = sets:union(Plt, Acc),
+ NewAcc = merge_tables(Plt, Acc),
sets_disj_merge(Plts, NewAcc);
false -> throw({dialyzer_error, not_disjoint_plts})
end.
+table_is_disjoint(T1, T2) ->
+ tab_is_disj(ets:first(T1), T1, T2).
+
+tab_is_disj('$end_of_table', _T1, _T2) ->
+ true;
+tab_is_disj(K1, T1, T2) ->
+ case ets:member(T2, K1) of
+ false ->
+ tab_is_disj(ets:next(T1, K1), T1, T2);
+ true ->
+ false
+ end.
+
+merge_tables(T1, T2) ->
+ tab_merge(ets:first(T1), T1, T2).
+
+tab_merge('$end_of_table', T1, T2) ->
+ true = ets:delete(T1),
+ T2;
+tab_merge(K1, T1, T2) ->
+ Vs = ets:lookup(T1, K1),
+ NextK1 = ets:next(T1, K1),
+ true = ets:delete(T1, K1),
+ true = ets:insert(T2, Vs),
+ tab_merge(NextK1, T1, T2).
+
%%---------------------------------------------------------------------------
%% Debug utilities.
@@ -802,7 +801,7 @@ pp_non_returning() ->
io:format("= Loops =\n"),
io:format("=========================================\n\n"),
lists:foreach(fun({{M, F, _}, Type}) ->
- io:format("~w:~w~s.\n",
+ io:format("~w:~tw~ts.\n",
[M, F, dialyzer_utils:format_sig(Type)])
end, lists:sort(Unit)),
io:format("\n"),
@@ -812,7 +811,8 @@ pp_non_returning() ->
lists:foreach(fun({{M, F, _}, Type}) ->
io:format("~w:~w~s.\n",
[M, F, dialyzer_utils:format_sig(Type)])
- end, lists:sort(None)).
+ end, lists:sort(None)),
+ delete(Plt).
-spec pp_mod(atom()) -> 'ok'.
@@ -824,8 +824,9 @@ pp_mod(Mod) when is_atom(Mod) ->
lists:foreach(fun({{_, F, _}, Ret, Args}) ->
T = erl_types:t_fun(Args, Ret),
S = dialyzer_utils:format_sig(T),
- io:format("-spec ~w~s.\n", [F, S])
+ io:format("-spec ~tw~ts.\n", [F, S])
end, lists:sort(List));
none ->
io:format("dialyzer: Found no module named '~s' in the PLT\n", [Mod])
- end.
+ end,
+ delete(Plt).
diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl
index be685baf22..48115bb683 100644
--- a/lib/dialyzer/src/dialyzer_succ_typings.erl
+++ b/lib/dialyzer/src/dialyzer_succ_typings.erl
@@ -97,14 +97,13 @@ init_state_and_get_success_typings(Callgraph, Plt, Codeserver,
TimingServer, Solvers, Parent) ->
{SCCs, Callgraph1} =
?timing(TimingServer, "order", dialyzer_callgraph:finalize(Callgraph)),
- State = #st{callgraph = Callgraph1, plt = dialyzer_plt:get_mini_plt(Plt),
+ State = #st{callgraph = Callgraph1, plt = Plt,
codeserver = Codeserver, parent = Parent,
timing_server = TimingServer, solvers = Solvers},
get_refined_success_typings(SCCs, State).
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} ->
@@ -139,18 +138,15 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver,
init_state_and_get_success_typings(Callgraph, Plt, Codeserver,
TimingServer, Solvers, Parent),
Mods = dialyzer_callgraph:modules(InitState#st.callgraph),
- MiniPlt = InitState#st.plt,
- FindOpaques = lookup_and_find_opaques_fun(Codeserver),
+ Plt = InitState#st.plt,
CWarns =
- dialyzer_contracts:get_invalid_contract_warnings(Mods, Codeserver,
- MiniPlt, FindOpaques),
- MiniDocPlt = dialyzer_plt:get_mini_plt(DocPlt),
+ dialyzer_contracts:get_invalid_contract_warnings(Mods, Codeserver, Plt),
ModWarns =
?timing(TimingServer, "warning",
- get_warnings_from_modules(Mods, InitState, MiniDocPlt)),
+ get_warnings_from_modules(Mods, InitState, DocPlt)),
{postprocess_warnings(CWarns ++ ModWarns, Codeserver),
- MiniPlt,
- dialyzer_plt:restore_full_plt(MiniDocPlt)}.
+ Plt,
+ DocPlt}.
get_warnings_from_modules(Mods, State, DocPlt) ->
#st{callgraph = Callgraph, codeserver = Codeserver,
@@ -162,13 +158,13 @@ get_warnings_from_modules(Mods, State, DocPlt) ->
collect_warnings(M, {Codeserver, Callgraph, Plt, DocPlt}) ->
ModCode = dialyzer_codeserver:lookup_mod_code(M, Codeserver),
- Records = dialyzer_codeserver:lookup_mod_records(M, Codeserver),
Contracts = dialyzer_codeserver:lookup_mod_contracts(M, Codeserver),
AllFuns = collect_fun_info([ModCode]),
%% 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),
+ Records = dialyzer_codeserver:lookup_mod_records(M, Codeserver),
{Warnings2, FunTypes} =
dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, Codeserver,
Records),
@@ -251,24 +247,22 @@ lookup_names(Labels, {_Codeserver, Callgraph, _Plt, _Solvers}) ->
refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) ->
ModCode = dialyzer_codeserver:lookup_mod_code(M, CodeServer),
AllFuns = collect_fun_info([ModCode]),
- Records = dialyzer_codeserver:lookup_mod_records(M, CodeServer),
FunTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt),
+ Records = dialyzer_codeserver:lookup_mod_records(M, CodeServer),
NewFunTypes =
dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, CodeServer, Records),
- Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer),
- Contracts = orddict:from_list(maps:to_list(Contracts1)),
- FindOpaques = find_opaques_fun(Records),
- DecoratedFunTypes =
- decorate_succ_typings(Contracts, Callgraph, NewFunTypes, FindOpaques),
- %% ?debug("NewFunTypes ~p\n ~n", [dict:to_list(NewFunTypes)]),
- %% ?debug("refine DecoratedFunTypes ~p\n ~n", [dict:to_list(DecoratedFunTypes)]),
+ {FunMFAContracts, ModOpaques} =
+ prepare_decoration(NewFunTypes, Callgraph, CodeServer),
+ DecoratedFunTypes = decorate_succ_typings(FunMFAContracts, ModOpaques),
+ %% ?Debug("NewFunTypes ~tp\n ~n", [NewFunTypes]),
+ %% ?debug("refine DecoratedFunTypes ~tp\n ~n", [DecoratedFunTypes]),
debug_pp_functions("Refine", NewFunTypes, DecoratedFunTypes, Callgraph),
case reached_fixpoint(FunTypes, DecoratedFunTypes) of
true -> [];
{false, NotFixpoint} ->
?debug("Not fixpoint\n", []),
- Plt = insert_into_plt(dict:from_list(NotFixpoint), Callgraph, Plt),
+ Plt = insert_into_plt(orddict:from_list(NotFixpoint), Callgraph, Plt),
[FunLbl || {FunLbl,_Type} <- NotFixpoint]
end.
@@ -282,22 +276,20 @@ reached_fixpoint_strict(OldTypes, NewTypes) ->
end.
reached_fixpoint(OldTypes0, NewTypes0, Strict) ->
- MapFun = fun(_Key, Type) ->
+ MapFun = fun({Key, Type}) ->
case is_failed_or_not_called_fun(Type) of
- true -> failed_fun;
- false -> erl_types:t_limit(Type, ?TYPE_LIMIT)
+ true -> {Key, failed_fun};
+ false -> {Key, erl_types:t_limit(Type, ?TYPE_LIMIT)}
end
end,
- OldTypes = dict:map(MapFun, OldTypes0),
- NewTypes = dict:map(MapFun, NewTypes0),
+ OldTypes = lists:map(MapFun, orddict:to_list(OldTypes0)),
+ NewTypes = lists:map(MapFun, orddict:to_list(NewTypes0)),
compare_types(OldTypes, NewTypes, Strict).
is_failed_or_not_called_fun(Type) ->
erl_types:any_none([erl_types:t_fun_range(Type)|erl_types:t_fun_args(Type)]).
-compare_types(Dict1, Dict2, Strict) ->
- List1 = lists:keysort(1, dict:to_list(Dict1)),
- List2 = lists:keysort(1, dict:to_list(Dict2)),
+compare_types(List1, List2, Strict) ->
compare_types_1(List1, List2, Strict, []).
compare_types_1([{X, _Type1}|Left1], [{X, failed_fun}|Left2],
@@ -314,7 +306,7 @@ compare_types_1([{X, Type1}|Left1], [{X, Type2}|Left2], Strict, NotFixpoint) ->
case Res of
true -> compare_types_1(Left1, Left2, Strict, NotFixpoint);
false ->
- ?debug("Failed fixpoint for ~w: ~s =/= ~s\n",
+ ?debug("Failed fixpoint for ~w: ~ts =/= ~ts\n",
[X, erl_types:t_to_string(Type1), erl_types:t_to_string(Type2)]),
compare_types_1(Left1, Left2, Strict, [{X, Type2}|NotFixpoint])
end;
@@ -344,10 +336,6 @@ find_succ_typings(SCCs, #st{codeserver = Codeserver, callgraph = Callgraph,
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],
- Contracts2 = [{MFA, Contract} || {MFA, {ok, Contract}} <- Contracts1],
- Contracts3 = orddict:from_list(Contracts2),
Label = dialyzer_codeserver:get_next_core_label(Codeserver),
AllFuns = lists:append(
[begin
@@ -355,7 +343,6 @@ find_succ_types_for_scc(SCC0, {Codeserver, Callgraph, Plt, Solvers}) ->
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, Label, Callgraph,
@@ -363,71 +350,79 @@ find_succ_types_for_scc(SCC0, {Codeserver, Callgraph, Plt, Solvers}) ->
Solvers),
AllFunSet = sets:from_list([X || {X, _} <- AllFuns]),
FilteredFunTypes =
- dict:filter(fun(X, _) -> sets:is_element(X, AllFunSet) end, FunTypes),
- FindOpaques = lookup_and_find_opaques_fun(Codeserver),
- DecoratedFunTypes =
- decorate_succ_typings(Contracts3, Callgraph, FilteredFunTypes, FindOpaques),
+ orddict:filter(fun(F, _T) -> sets:is_element(F, AllFunSet)
+ end, FunTypes),
+ {FunMFAContracts, ModOpaques} =
+ prepare_decoration(FilteredFunTypes, Callgraph, Codeserver),
+ DecoratedFunTypes = decorate_succ_typings(FunMFAContracts, ModOpaques),
%% Check contracts
+ Contracts = orddict:from_list([{MFA, Contract} ||
+ {_, {MFA, Contract}} <- FunMFAContracts]),
PltContracts =
- dialyzer_contracts:check_contracts(Contracts3, Callgraph,
- DecoratedFunTypes, FindOpaques),
- %% ?debug("FilteredFunTypes ~p\n ~n", [dict:to_list(FilteredFunTypes)]),
- %% ?debug("SCC DecoratedFunTypes ~p\n ~n", [dict:to_list(DecoratedFunTypes)]),
+ dialyzer_contracts:check_contracts(Contracts, Callgraph,
+ DecoratedFunTypes,
+ ModOpaques),
+ %% ?debug("FilteredFunTypes ~tp\n ~n", [FilteredFunTypes]),
+ %% ?debug("SCC DecoratedFunTypes ~tp\n ~n", [DecoratedFunTypes]),
debug_pp_functions("SCC", FilteredFunTypes, DecoratedFunTypes, Callgraph),
- ContractFixpoint =
- lists:all(fun({MFA, _C}) ->
- %% Check the non-deleted PLT
- case dialyzer_plt:lookup_contract(Plt, MFA) of
- none -> false;
- {value, _} -> true
- end
- end, PltContracts),
+ NewPltContracts = [MC ||
+ {MFA, _C}=MC <- PltContracts,
+ %% Check the non-deleted PLT
+ not dialyzer_plt:is_contract(Plt, MFA)],
+ ContractFixpoint = NewPltContracts =:= [],
Plt = insert_into_plt(DecoratedFunTypes, Callgraph, Plt),
- Plt = dialyzer_plt:insert_contract_list(Plt, PltContracts),
+ Plt = dialyzer_plt:insert_contract_list(Plt, NewPltContracts),
case (ContractFixpoint andalso
reached_fixpoint_strict(PropTypes, DecoratedFunTypes)) of
true -> [];
false ->
- ?debug("Not fixpoint for: ~w\n", [AllFuns]),
+ ?debug("Not fixpoint for: ~tw\n", [AllFuns]),
[Fun || {Fun, _Arity} <- AllFuns]
end.
-decorate_succ_typings(Contracts, Callgraph, FunTypes, FindOpaques) ->
- F = fun(Label, Type) ->
+prepare_decoration(FunTypes, Callgraph, Codeserver) ->
+ F = fun({Label, _Type}=LabelType, Acc) ->
case dialyzer_callgraph:lookup_name(Label, Callgraph) of
{ok, MFA} ->
- case orddict:find(MFA, Contracts) of
+ case dialyzer_codeserver:lookup_mfa_contract(MFA, Codeserver) of
{ok, {_FileLine, Contract, _Xtra}} ->
- Args = dialyzer_contracts:get_contract_args(Contract),
- Ret = dialyzer_contracts:get_contract_return(Contract),
- C = erl_types:t_fun(Args, Ret),
- {M, _, _} = MFA,
- Opaques = FindOpaques(M),
- erl_types:t_decorate_with_opaque(Type, C, Opaques);
- error -> Type
+ [{LabelType, {MFA, Contract}}|Acc];
+ error -> [{LabelType, no}|Acc]
end;
- error -> Type
+ error -> [{LabelType, no}|Acc]
end
end,
- dict:map(F, FunTypes).
-
-lookup_and_find_opaques_fun(Codeserver) ->
- fun(Module) ->
- Records = dialyzer_codeserver:lookup_mod_records(Module, Codeserver),
- (find_opaques_fun(Records))(Module)
- end.
+ Contracts = lists:foldl(F, [], orddict:to_list(FunTypes)),
+ ModOpaques =
+ [{M, lookup_opaques(M, Codeserver)} ||
+ M <- lists:usort([M || {_LabelType, {{M, _, _}, _Con}} <- Contracts])],
+ {Contracts, orddict:from_list(ModOpaques)}.
+
+decorate_succ_typings(FunTypesContracts, ModOpaques) ->
+ F = fun({{Label, Type}, {{M, _, _}, Contract}}) ->
+ Args = dialyzer_contracts:get_contract_args(Contract),
+ Ret = dialyzer_contracts:get_contract_return(Contract),
+ C = erl_types:t_fun(Args, Ret),
+ {M, Opaques} = lists:keyfind(M, 1, ModOpaques),
+ R = erl_types:t_decorate_with_opaque(Type, C, Opaques),
+ {Label, R};
+ ({LabelType, no}) ->
+ LabelType
+ end,
+ orddict:from_list(lists:map(F, FunTypesContracts)).
-find_opaques_fun(Records) ->
- fun(_Module) -> erl_types:t_opaque_from_records(Records) end.
+lookup_opaques(Module, Codeserver) ->
+ Records = dialyzer_codeserver:lookup_mod_records(Module, Codeserver),
+ erl_types:t_opaque_from_records(Records).
get_fun_types_from_plt(FunList, Callgraph, Plt) ->
- get_fun_types_from_plt(FunList, Callgraph, Plt, dict:new()).
+ get_fun_types_from_plt(FunList, Callgraph, Plt, []).
get_fun_types_from_plt([{FunLabel, Arity}|Left], Callgraph, Plt, Map) ->
Type = lookup_fun_type(FunLabel, Arity, Callgraph, Plt),
- get_fun_types_from_plt(Left, Callgraph, Plt, dict:store(FunLabel, Type, Map));
+ get_fun_types_from_plt(Left, Callgraph, Plt, [{FunLabel, Type}|Map]);
get_fun_types_from_plt([], _Callgraph, _Plt, Map) ->
- Map.
+ orddict:from_list(Map).
collect_fun_info(Trees) ->
collect_fun_info(Trees, []).
@@ -463,7 +458,7 @@ insert_into_plt(SuccTypes0, Callgraph, Plt) ->
dialyzer_plt:insert_list(Plt, SuccTypes).
format_succ_types(SuccTypes, Callgraph) ->
- format_succ_types(dict:to_list(SuccTypes), Callgraph, []).
+ format_succ_types(SuccTypes, Callgraph, []).
format_succ_types([{Label, Type0}|Left], Callgraph, Acc) ->
Type = erl_types:t_limit(Type0, ?TYPE_LIMIT+1),
@@ -476,28 +471,26 @@ format_succ_types([], _Callgraph, Acc) ->
-ifdef(DEBUG).
debug_pp_succ_typings(SuccTypes) ->
?debug("Succ typings:\n", []),
- [?debug(" ~w :: ~s\n",
+ [?debug(" ~tw :: ~ts\n",
[MFA, erl_types:t_to_string(erl_types:t_fun(ArgT, RetT))])
|| {MFA, {RetT, ArgT}} <- SuccTypes],
?debug("Contracts:\n", []),
- [?debug(" ~w :: ~s\n",
+ [?debug(" ~tw :: ~ts\n",
[MFA, erl_types:t_to_string(erl_types:t_fun(ArgT, RetFun(ArgT)))])
|| {MFA, {contract, RetFun, ArgT}} <- SuccTypes],
?debug("\n", []),
ok.
-debug_pp_functions(Header, FunTypes, DecoratedFunTypes, Callgraph) ->
+debug_pp_functions(Header, FTypes, DTypes, Callgraph) ->
?debug("FunTypes (~s)\n", [Header]),
- FTypes = lists:keysort(1, dict:to_list(FunTypes)),
- DTypes = lists:keysort(1, dict:to_list(DecoratedFunTypes)),
Fun = fun({{Label, Type},{Label, DecoratedType}}) ->
Name = lookup_name(Label, Callgraph),
- ?debug("~w (~w): ~s\n",
+ ?debug("~tw (~w): ~ts\n",
[Name, Label, erl_types:t_to_string(Type)]),
case erl_types:t_is_equal(Type, DecoratedType) of
true -> ok;
false ->
- ?debug(" With opaque types: ~s\n",
+ ?debug(" With opaque types: ~ts\n",
[erl_types:t_to_string(DecoratedType)])
end
end,
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index c3ba44fde7..c4d8f45447 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -96,10 +96,12 @@
-type typesig_funmap() :: #{type_var() => type_var()}.
--type prop_types() :: dict:dict(label(), erl_types:erl_type()).
+-type prop_types() :: orddict:orddict(label(), erl_types:erl_type()).
+-type dict_prop_types() :: dict:dict(label(), erl_types:erl_type()).
-record(state, {callgraph :: dialyzer_callgraph:callgraph()
| 'undefined',
+ cserver :: dialyzer_codeserver:codeserver(),
cs = [] :: [constr()],
cmap = maps:new() :: #{type_var() => constr()},
fun_map = maps:new() :: typesig_funmap(),
@@ -112,8 +114,8 @@
self_rec :: 'false' | erl_types:erl_type(),
plt :: dialyzer_plt:plt()
| 'undefined',
- prop_types = dict:new() :: prop_types(),
- records = maps:new() :: types(),
+ prop_types = dict:new() :: dict_prop_types(),
+ mod_records = [] :: [{module(), types()}],
scc = [] :: ordsets:ordset(type_var()),
mfas :: [mfa()],
solvers = [] :: [solver()]
@@ -138,9 +140,11 @@
-ifdef(DEBUG).
-define(debug(__String, __Args), io:format(__String, __Args)).
-define(mk_fun_var(Fun, Vars), mk_fun_var(?LINE, Fun, Vars)).
+-define(pp_map(S, M), pp_map(S, M)).
-else.
-define(debug(__String, __Args), ok).
-define(mk_fun_var(Fun, Vars), mk_fun_var(Fun, Vars)).
+-define(pp_map(S, M), ok).
-endif.
%% ============================================================================
@@ -177,15 +181,13 @@ analyze_scc(SCC, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers0) ->
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),
+ State2 = traverse_scc(SCC, CServer, DefSet, State1),
State3 = state__finalize(State2),
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)).
+ orddict:from_list(maps:to_list(T)).
solvers([]) -> [v2];
solvers(Solvers) -> Solvers.
@@ -196,15 +198,14 @@ solvers(Solvers) -> Solvers.
%%
%% ============================================================================
-traverse_scc([{M,_,_}=MFA|Left], Codeserver, DefSet, ModRecs, AccState) ->
+traverse_scc([{M,_,_}=MFA|Left], Codeserver, DefSet, AccState) ->
+ TmpState1 = state__set_module(AccState, M),
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)),
TmpState2 = state__new_constraint_context(TmpState1),
{NewAccState, _} = traverse(DummyLetrec, DefSet, TmpState2),
- traverse_scc(Left, Codeserver, DefSet, ModRecs, NewAccState);
-traverse_scc([], _Codeserver, _DefSet, _ModRecs, AccState) ->
+ traverse_scc(Left, Codeserver, DefSet, NewAccState);
+traverse_scc([], _Codeserver, _DefSet, AccState) ->
AccState.
traverse(Tree, DefinedVars, State) ->
@@ -470,12 +471,11 @@ traverse(Tree, DefinedVars, State) ->
true ->
%% Check if a record is constructed.
Arity = length(Fields),
- Records = State2#state.records,
- case lookup_record(Records, cerl:atom_val(Tag), Arity) of
- error -> {State2, TupleType};
- {ok, RecType} ->
- State3 = state__store_conj(TupleType, sub, RecType, State2),
- {State3, TupleType}
+ case lookup_record(State2, cerl:atom_val(Tag), Arity) of
+ {error, State3} -> {State3, TupleType};
+ {ok, RecType, State3} ->
+ State4 = state__store_conj(TupleType, sub, RecType, State3),
+ {State4, TupleType}
end;
false -> {State2, TupleType}
end;
@@ -771,7 +771,7 @@ handle_call(Call, DefinedVars, State) ->
{ok, Var} ->
%% This is part of the SCC currently analyzed.
%% Intercept and change this to an apply instead.
- ?debug("Found the call to ~w\n", [MFA]),
+ ?debug("Found the call to ~tw\n", [MFA]),
Label = cerl_trees:get_label(Call),
Apply = cerl:ann_c_apply([{label, Label}], Var, Args),
traverse(Apply, DefinedVars, State)
@@ -1440,7 +1440,6 @@ get_bif_constr({erlang, is_record, 2}, Dst, [Var, Tag] = Args, _State) ->
mk_constraint(Var, sub, ArgV)]);
get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) ->
%% TODO: Revise this to make it precise for Tag and Arity.
- Records = State#state.records,
ArgFun =
fun(Map) ->
case t_is_any_atom(true, lookup_type(Dst, Map)) of
@@ -1457,10 +1456,10 @@ get_bif_constr({erlang, is_record, 3}, Dst, [Var, Tag, Arity] = Args, State) ->
GenRecord = t_tuple([TagType|AnyElems]),
case t_atom_vals(TagType) of
[TagVal] ->
- case lookup_record(Records, TagVal, ArityVal - 1) of
- {ok, Type} ->
+ case lookup_record(State, TagVal, ArityVal - 1) of
+ {ok, Type, _NewState} ->
Type;
- error -> GenRecord
+ {error, _NewState} -> GenRecord
end;
_ -> GenRecord
end;
@@ -1789,11 +1788,11 @@ get_bif_test_constr(Dst, Arg, Type, _State) ->
%%=============================================================================
solve([Fun], State) ->
- ?debug("============ Analyzing Fun: ~w ===========\n",
+ ?debug("============ Analyzing Fun: ~tw ===========\n",
[debug_lookup_name(Fun)]),
solve_fun(Fun, map_new(), State);
solve([_|_] = SCC, State) ->
- ?debug("============ Analyzing SCC: ~w ===========\n",
+ ?debug("============ Analyzing SCC: ~tw ===========\n",
[[debug_lookup_name(F) || F <- SCC]]),
Users = comp_users(SCC, State),
solve_scc(SCC, map_new(), State, Users, _ToSolve=SCC, false).
@@ -1829,13 +1828,13 @@ solve_scc(SCC, Map, State, Users, ToSolve, TryingUnit) ->
erase_type(t_var_name(Fun), AccFunMap)
end, Map, ToSolve),
Map1 = enter_type_lists(Vars, RecTypes, CleanMap),
- ?debug("Checking SCC: ~w\n", [[debug_lookup_name(F) || F <- SCC]]),
+ ?debug("Checking SCC: ~tw\n", [[debug_lookup_name(F) || F <- SCC]]),
SolveFun = fun(X, Y) -> scc_fold_fun(X, Y, State) end,
Map2 = lists:foldl(SolveFun, Map1, ToSolve),
Updated = updated_vars_only(Vars, Map, Map2),
case Updated =:= [] of
true ->
- ?debug("SCC ~w reached fixpoint\n", [SCC]),
+ ?debug("SCC ~tw reached fixpoint\n", [SCC]),
NewTypes = unsafe_lookup_type_list(Funs, Map2),
case erl_types:any_none([t_fun_range(T) || T <- NewTypes])
andalso TryingUnit =:= false of
@@ -1851,7 +1850,7 @@ solve_scc(SCC, Map, State, Users, ToSolve, TryingUnit) ->
Map2
end;
false ->
- ?debug("SCC ~w did not reach fixpoint\n", [SCC]),
+ ?debug("SCC ~tw did not reach fixpoint\n", [SCC]),
ToSolve1 = affected(Updated, Users),
solve_scc(SCC, Map2, State, Users, ToSolve1, TryingUnit)
end.
@@ -1875,8 +1874,8 @@ scc_fold_fun(F, FunMap, State) ->
error ->
enter_type(F, NewType, FunMap)
end,
- ?debug("Done solving for function ~w :: ~s\n", [debug_lookup_name(F),
- format_type(NewType)]),
+ ?debug("Done solving for function ~tw :: ~ts\n", [debug_lookup_name(F),
+ format_type(NewType)]),
NewFunMap.
solve(Fun, Cs, FunMap, State) ->
@@ -1895,7 +1894,7 @@ solver(Solver, SolveFun) ->
[Solver, _R, 60]),
throw(error)
catch E:R ->
- io:format("Solver ~w failed: ~w:~p\n ~p\n",
+ io:format("Solver ~w failed: ~w:~p\n ~tp\n",
[Solver, E, R, erlang:get_stacktrace()]),
throw(error)
end.
@@ -1917,8 +1916,8 @@ check_solutions([{S1,Map1,_Time1}|Maps], Fun, S, Map) ->
check_solutions(Maps, Fun, S1, Map1);
false ->
?debug("Constraint solvers do not agree on ~w\n", [Fun]),
- pp_map(atom_to_list(S), Map),
- pp_map(atom_to_list(S1), Map1),
+ ?pp_map(atom_to_list(S), Map),
+ ?pp_map(atom_to_list(S1), Map1),
io:format("A bug was found. Please report it, and use the option "
"`--solver v1' until the bug has been fixed.\n"),
throw(error)
@@ -1932,9 +1931,9 @@ sane_maps(Map1, Map2, Keys, _S1, _S2) ->
true -> true;
false ->
?debug("Constraint solvers do not agree on ~w\n", [Key]),
- ?debug("~w: ~s\n",
+ ?debug("~w: ~ts\n",
[_S1, format_type(unsafe_lookup_type(Key, Map1))]),
- ?debug("~w: ~s\n",
+ ?debug("~w: ~ts\n",
[_S2, format_type(unsafe_lookup_type(Key, Map2))]),
false
end
@@ -1966,8 +1965,8 @@ v2_solve(#constraint_ref{id = Id}, Map, V2State) ->
v2_solve_reference(Id, Map, V2State).
v2_solve_reference(Id, Map, V2State0) ->
- ?debug("Checking ref to fun: ~w\n", [debug_lookup_name(Id)]),
- pp_map("Map", Map),
+ ?debug("Checking ref to fun: ~tw\n", [debug_lookup_name(Id)]),
+ ?pp_map("Map", Map),
pp_constr_data("solve_ref", V2State0),
Map1 = restore_local_map(V2State0, Id, Map),
State = V2State0#v2_state.state,
@@ -1980,7 +1979,7 @@ v2_solve_reference(Id, Map, V2State0) ->
{FunType, V2State} =
case Res of
{error, V2State1} ->
- ?debug("Error solving for function ~p\n", [debug_lookup_name(Id)]),
+ ?debug("Error solving for function ~tp\n", [debug_lookup_name(Id)]),
Arity = state__fun_arity(Id, State),
FunType0 =
case state__prop_domain(t_var_name(Id), State) of
@@ -1989,12 +1988,12 @@ v2_solve_reference(Id, Map, V2State0) ->
end,
{FunType0, V2State1};
{ok, NewMap, V2State1, U} ->
- ?debug("Done solving fun: ~p\n", [debug_lookup_name(Id)]),
+ ?debug("Done solving fun: ~tp\n", [debug_lookup_name(Id)]),
FunType0 = lookup_type(Id, NewMap),
V2State2 = save_local_map(V2State1, Id, U, NewMap),
{FunType0, V2State2}
end,
- ?debug("ref Id=~w Assigned ~s\n", [Id, format_type(FunType)]),
+ ?debug("ref Id=~w Assigned ~ts\n", [Id, format_type(FunType)]),
{NewMap1, U1} = enter_var_type(Id, FunType, Map),
{NewMap2, U2} =
case state__get_rec_var(Id, State) of
@@ -2004,10 +2003,10 @@ v2_solve_reference(Id, Map, V2State0) ->
{ok, NewMap2, V2State, lists:umerge(U1, U2)}.
v2_solve_self_recursive(Cs, Map, Id, RecType0, V2State0) ->
- ?debug("Solving self recursive ~w\n", [debug_lookup_name(Id)]),
+ ?debug("Solving self recursive ~tw\n", [debug_lookup_name(Id)]),
State = V2State0#v2_state.state,
{ok, RecVar} = state__get_rec_var(Id, State),
- ?debug("OldRecType ~s\n", [format_type(RecType0)]),
+ ?debug("OldRecType ~ts\n", [format_type(RecType0)]),
RecType = t_limit(RecType0, ?TYPE_LIMIT),
{Map1, U0} = enter_var_type(RecVar, RecType, Map),
V2State1 = save_updated_vars1(V2State0, Cs, U0), % Probably not necessary
@@ -2023,7 +2022,7 @@ v2_solve_self_recursive(Cs, Map, Id, RecType0, V2State0) ->
Error
end;
{ok, NewMap, V2State, U} ->
- pp_map("recursive finished", NewMap),
+ ?pp_map("recursive finished", NewMap),
NewRecType = unsafe_lookup_type(Id, NewMap),
case is_equal(NewRecType, RecType0) of
true ->
@@ -2041,7 +2040,7 @@ enter_var_type(Var, Type, Map0) ->
v2_solve_disjunct(Disj, Map, V2State0) ->
#constraint_list{type = disj, id = _Id, list = Cs, masks = Masks} = Disj,
?debug("disjunct Id=~w~n", [_Id]),
- pp_map("Map", Map),
+ ?pp_map("Map", Map),
pp_constr_data("disjunct", V2State0),
case get_flags(V2State0, Disj) of
{V2State1, failed_list} -> {error, V2State1}; % cannot happen
@@ -2069,7 +2068,7 @@ v2_solve_disjunct(Disj, Map, V2State0) ->
U1 = [V || V <- U0,
var_occurs_everywhere(V, Masks, NotFailed)],
NewMap = join_maps(U1, MapL, Map),
- pp_map("NewMap", NewMap),
+ ?pp_map("NewMap", NewMap),
U = updated_vars_only(U1, Map, NewMap),
?debug("disjunct finished _Id=~w\n", [_Id]),
{ok, NewMap, V2State, U}
@@ -2092,7 +2091,7 @@ v2_solve_disj([I|Is], [C|Cs], I, Map0, V2State0, UL, MapL, Eval, Uneval,
{ok, Map, V2State1, U} ->
?debug("disj I=~w U=~w~n", [I, U]),
V2State = save_local_map(V2State1, Id, U, Map),
- pp_map("DMap", Map),
+ ?pp_map("DMap", Map),
v2_solve_disj(Is, Cs, I+1, Map0, V2State, [U|UL], [Map|MapL],
[I|Eval], Uneval, Failed0)
end;
@@ -2118,9 +2117,9 @@ save_local_map(#v2_state{constr_data = ConData}=V2State, Id, U, Map) ->
end,
?debug("save local map Id=~w:\n", [Id]),
Part = lists:ukeymerge(1, lists:keysort(1, Part0), Part1),
- pp_map("New Part", maps:from_list(Part0)),
- pp_map("Old Part", maps:from_list(Part1)),
- pp_map(" => Part", maps:from_list(Part)),
+ ?pp_map("New Part", maps:from_list(Part0)),
+ ?pp_map("Old Part", maps:from_list(Part1)),
+ ?pp_map(" => Part", maps:from_list(Part)),
V2State#v2_state{constr_data = maps:put(Id, {Part,[]}, ConData)}.
restore_local_map(#v2_state{constr_data = ConData}, Id, Map0) ->
@@ -2131,10 +2130,10 @@ restore_local_map(#v2_state{constr_data = ConData}, Id, Map0) ->
{ok, {Part0,U}} ->
Part = [KV || {K,_V} = KV <- Part0, not lists:member(K, U)],
?debug("restore local map Id=~w U=~w\n", [Id, U]),
- pp_map("Part", maps:from_list(Part)),
- pp_map("Map0", Map0),
+ ?pp_map("Part", maps:from_list(Part)),
+ ?pp_map("Map0", Map0),
Map = lists:foldl(fun({K,V}, D) -> maps:put(K, V, D) end, Map0, Part),
- pp_map("Map", Map),
+ ?pp_map("Map", Map),
Map
end.
@@ -2290,7 +2289,7 @@ pp_constr_data(_Tag, #v2_state{constr_data = D}) ->
case _PartU of
{_Part, _U} ->
io:format("Id: ~w Vars: ~w\n", [_Id, _U]),
- [pp_map("Part", maps:from_list(_Part)) || _Part =/= []];
+ [?pp_map("Part", maps:from_list(_Part)) || _Part =/= []];
failed ->
io:format("Id: ~w failed list\n", [_Id])
end
@@ -2319,7 +2318,7 @@ solve_ref_or_list(#constraint_ref{id = Id, deps = Deps},
error -> {map_new(), false};
{ok, M} -> {M, true}
end,
- ?debug("Checking ref to fun: ~w\n", [debug_lookup_name(Id)]),
+ ?debug("Checking ref to fun: ~tw\n", [debug_lookup_name(Id)]),
%% Note: mk_constraint_ref() has already removed Id from Deps. The
%% reason for doing it there is that it makes it easy for
%% calculate_masks() to make the corresponding adjustment for
@@ -2341,7 +2340,7 @@ solve_ref_or_list(#constraint_ref{id = Id, deps = Deps},
{NewMapDict, FunType} =
case Res of
{error, NewMapDict0} ->
- ?debug("Error solving for function ~p\n", [debug_lookup_name(Id)]),
+ ?debug("Error solving for function ~tp\n", [debug_lookup_name(Id)]),
Arity = state__fun_arity(Id, State),
FunType0 =
case state__prop_domain(t_var_name(Id), State) of
@@ -2350,11 +2349,11 @@ solve_ref_or_list(#constraint_ref{id = Id, deps = Deps},
end,
{NewMapDict0, FunType0};
{ok, NewMapDict0, NewMap} ->
- ?debug("Done solving fun: ~p\n", [debug_lookup_name(Id)]),
+ ?debug("Done solving fun: ~tp\n", [debug_lookup_name(Id)]),
FunType0 = lookup_type(Id, NewMap),
{NewMapDict0, FunType0}
end,
- ?debug(" Id=~w Assigned ~s\n", [Id, format_type(FunType)]),
+ ?debug(" Id=~w Assigned ~ts\n", [Id, format_type(FunType)]),
NewMap1 = enter_type(Id, FunType, Map),
NewMap2 =
case state__get_rec_var(Id, State) of
@@ -2376,21 +2375,21 @@ solve_ref_or_list(#constraint_list{type=Type, list = Cs, deps = Deps, id = Id},
true ->
case Check andalso maps_are_equal(OldLocalMap, Map, Deps) of
true ->
- ?debug("~w equal ~w\n", [Type, Id]),
+ ?debug("~tw equal ~w\n", [Type, Id]),
{ok, MapDict, Map};
false ->
- ?debug("~w not equal: ~w. Solving\n", [Type, Id]),
+ ?debug("~tw not equal: ~w. Solving\n", [Type, Id]),
solve_clist(Cs, Type, Id, Deps, MapDict, Map, State)
end
end.
solve_self_recursive(Cs, Map, MapDict, Id, RecType0, State) ->
- ?debug("Solving self recursive ~w\n", [debug_lookup_name(Id)]),
+ ?debug("Solving self recursive ~tw\n", [debug_lookup_name(Id)]),
{ok, RecVar} = state__get_rec_var(Id, State),
- ?debug("OldRecType ~s\n", [format_type(RecType0)]),
+ ?debug("OldRecType ~ts\n", [format_type(RecType0)]),
RecType = t_limit(RecType0, ?TYPE_LIMIT),
Map1 = enter_type(RecVar, RecType, erase_type(t_var_name(Id), Map)),
- pp_map("Map1", Map1),
+ ?pp_map("Map1", Map1),
case solve_ref_or_list(Cs, Map1, MapDict, State) of
{error, _} = Error ->
case t_is_none(RecType0) of
@@ -2403,7 +2402,7 @@ solve_self_recursive(Cs, Map, MapDict, Id, RecType0, State) ->
Error
end;
{ok, NewMapDict, NewMap} ->
- pp_map("NewMap", NewMap),
+ ?pp_map("NewMap", NewMap),
NewRecType = unsafe_lookup_type(Id, NewMap),
case is_equal(NewRecType, RecType0) of
true ->
@@ -2469,7 +2468,7 @@ solve_one_c(#constraint{lhs = Lhs, rhs = Rhs, op = Op}, Map) ->
LhsType = lookup_type(Lhs, Map),
RhsType = lookup_type(Rhs, Map),
Inf = t_inf(LhsType, RhsType),
- ?debug("Solving: ~s :: ~s ~w ~s :: ~s\n\tInf: ~s\n",
+ ?debug("Solving: ~ts :: ~ts ~w ~ts :: ~ts\n\tInf: ~ts\n",
[format_type(Lhs), format_type(LhsType), Op,
format_type(Rhs), format_type(RhsType), format_type(Inf)]),
case t_is_none(Inf) of
@@ -2501,14 +2500,14 @@ solve_subtype(Type, Inf, Map) ->
{_, List} -> {ok, enter_type_list(List, Map)}
catch
throw:{mismatch, _T1, _T2} ->
- ?debug("Mismatch between ~s and ~s\n",
+ ?debug("Mismatch between ~ts and ~ts\n",
[format_type(_T1), format_type(_T2)]),
error
end.
%% end.
report_failed_constraint(_C, _Map) ->
- ?debug("+++++++++++\nFailed: ~s :: ~s ~w ~s :: ~s\n+++++++++++\n",
+ ?debug("+++++++++++\nFailed: ~ts :: ~ts ~w ~ts :: ~ts\n+++++++++++\n",
[format_type(_C#constraint.lhs),
format_type(lookup_type(_C#constraint.lhs, _Map)),
_C#constraint.op,
@@ -2566,7 +2565,7 @@ maps_are_equal_1(Map1, Map2, [H|Tail]) ->
case is_equal(T1, T2) of
true -> maps_are_equal_1(Map1, Map2, Tail);
false ->
- ?debug("~w: ~s =/= ~s\n", [H, format_type(T1), format_type(T2)]),
+ ?debug("~w: ~ts =/= ~ts\n", [H, format_type(T1), format_type(T2)]),
false
end;
maps_are_equal_1(_Map1, _Map2, []) ->
@@ -2594,7 +2593,7 @@ prune_keys(Map1, Map2, Deps) ->
end.
enter_type(Key, Val, Map) when is_integer(Key) ->
- ?debug("Entering ~s :: ~s\n", [format_type(t_var(Key)), format_type(Val)]),
+ ?debug("Entering ~ts :: ~ts\n", [format_type(t_var(Key)), format_type(Val)]),
%% Keep any() in the map if it is opaque:
case is_equal(Val, t_any()) of
true ->
@@ -2603,7 +2602,7 @@ enter_type(Key, Val, Map) when is_integer(Key) ->
LimitedVal = t_limit(Val, ?INTERNAL_TYPE_LIMIT),
case is_equal(LimitedVal, Val) of
true -> ok;
- false -> ?debug("LimitedVal ~s\n", [format_type(LimitedVal)])
+ false -> ?debug("LimitedVal ~ts\n", [format_type(LimitedVal)])
end,
case maps:find(Key, Map) of
{ok, Value} ->
@@ -2638,7 +2637,7 @@ enter_type2(Key, Val, Map) ->
{Map1, [Key || not is_same(Key, Map, Map1)]}.
map_store(Key, Val, Map) ->
- ?debug("Storing ~w :: ~s\n", [Key, format_type(Val)]),
+ ?debug("Storing ~tw :: ~ts\n", [Key, format_type(Val)]),
maps:put(Key, Val, Map).
erase_type(Key, Map) ->
@@ -2702,18 +2701,13 @@ is_same(Key, Map1, Map2) ->
is_equal(Type1, Type2) ->
t_is_equal(Type1, Type2).
-pp_map(_S, _Map) ->
- ?debug("\t~s: ~p\n",
- [_S, [{X, lists:flatten(format_type(Y))} ||
- {X, Y} <- lists:keysort(1, maps:to_list(_Map))]]).
-
%% ============================================================================
%%
%% The State.
%%
%% ============================================================================
-new_state(MFAs, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers) ->
+new_state(MFAs, NextLabel, CallGraph, CServer, Plt, PropTypes0, Solvers) ->
List_SCC =
[begin
{Var, Label} = dialyzer_codeserver:lookup_mfa_var_label(MFA, CServer),
@@ -2731,12 +2725,14 @@ new_state(MFAs, NextLabel, CallGraph, CServer, Plt, PropTypes, Solvers) ->
end;
_Many -> false
end,
+ PropTypes = dict:from_list(PropTypes0),
#state{callgraph = CallGraph, name_map = NameMap, next_label = NextLabel,
prop_types = PropTypes, plt = Plt, scc = ordsets:from_list(SCC),
- mfas = MFAs, self_rec = SelfRec, solvers = Solvers}.
+ mfas = MFAs, self_rec = SelfRec, solvers = Solvers,
+ cserver = CServer}.
-state__set_rec_dict(State, RecDict) ->
- State#state{records = RecDict}.
+state__set_module(State, Module) ->
+ State#state{module = Module}.
state__set_in_match(State, Bool) ->
State#state{in_match = Bool}.
@@ -2846,7 +2842,7 @@ state__add_prop_constrs(Tree, #state{prop_types = PropTypes} = State) ->
case erl_types:any_none(ArgTypes) of
true -> not_called;
false ->
- ?debug("Adding propagated constr: ~s for function ~w\n",
+ ?debug("Adding propagated constr: ~ts for function ~tw\n",
[format_type(FunType), debug_lookup_name(mk_var(Tree))]),
FunVar = mk_var(Tree),
state__store_conj(FunVar, sub, FunType, State)
@@ -2975,6 +2971,11 @@ mk_fun_var(Line, Fun, Types) ->
Deps = [t_var_name(Var) || Var <- t_collect_vars(t_product(Types))],
#fun_var{'fun' = Fun, deps = ordsets:from_list(Deps), origin = Line}.
+pp_map(S, Map) ->
+ ?debug("\t~s: ~p\n",
+ [S, [{X, lists:flatten(format_type(Y))} ||
+ {X, Y} <- lists:keysort(1, maps:to_list(Map))]]).
+
-else.
-spec mk_fun_var(fun((_) -> erl_types:erl_type()), [erl_types:erl_type()]) -> #fun_var{}.
@@ -3348,15 +3349,25 @@ fold_literal_maybe_match(Tree0, State) ->
true -> dialyzer_utils:refold_pattern(Tree1)
end.
-lookup_record(Records, Tag, Arity) ->
- case erl_types:lookup_record(Tag, Arity, Records) of
+lookup_record(State, Tag, Arity) ->
+ #state{module = M, mod_records = ModRecs, cserver = CServer} = State,
+ {State1, Rec} =
+ case lists:keyfind(M, 1, ModRecs) of
+ {M, Rec0} ->
+ {State, Rec0};
+ false ->
+ Rec0 = dialyzer_codeserver:lookup_mod_records(M, CServer),
+ NewModRecs = [{M, Rec0}|ModRecs],
+ {State#state{mod_records = NewModRecs}, Rec0}
+ end,
+ case erl_types:lookup_record(Tag, Arity, Rec) of
{ok, Fields} ->
RecType =
t_tuple([t_from_term(Tag)|
[FieldType || {_FieldName, _Abstr, FieldType} <- Fields]]),
- {ok, RecType};
+ {ok, RecType, State1};
error ->
- error
+ {error, State1}
end.
is_literal_record(Tree) ->
@@ -3381,10 +3392,10 @@ family(L) ->
-ifdef(DEBUG).
format_type(#fun_var{deps = Deps, origin = Origin}) ->
L = [format_type(t_var(X)) || X <- Deps],
- io_lib:format("Fun@L~p(~s)", [Origin, join_chars(L, ",")]);
+ io_lib:format("Fun@L~p(~ts)", [Origin, join_chars(L, ",")]);
format_type(Type) ->
case cerl:is_literal(Type) of
- true -> io_lib:format("~w", [cerl:concrete(Type)]);
+ true -> io_lib:format("~tw", [cerl:concrete(Type)]);
false -> erl_types:t_to_string(Type)
end.
@@ -3426,7 +3437,7 @@ pp_constrs_scc(SCC, State) ->
[pp_constrs(Fun, state__get_cs(Fun, State), State) || Fun <- SCC].
pp_constrs(Fun, Cs, State) ->
- io:format("Constraints for fun: ~w", [debug_lookup_name(Fun)]),
+ io:format("Constraints for fun: ~tw", [debug_lookup_name(Fun)]),
MaxDepth = pp_constraints(Cs, State),
io:format("Depth: ~w\n", [MaxDepth]).
@@ -3464,7 +3475,7 @@ pp_constraints([#constraint_list{type = Type, list = List, id = Id}|Tail],
pp_op(#constraint{lhs = Lhs, op = Op, rhs = Rhs}, Level) ->
pp_indent(Level),
- io:format("~s ~w ~s", [format_type(Lhs), Op, format_type(Rhs)]).
+ io:format("~ts ~w ~ts", [format_type(Lhs), Op, format_type(Rhs)]).
pp_indent(Level) ->
io:format("\n~*s", [Level*2, ""]).
@@ -3476,19 +3487,25 @@ pp_constrs_scc(_SCC, _State) ->
-ifdef(TO_DOT).
constraints_to_dot_scc(SCC, State) ->
- io:format("SCC: ~p\n", [SCC]),
- Name = lists:flatten([io_lib:format("'~w'", [debug_lookup_name(Fun)])
- || Fun <- SCC]),
+ %% TODO: handle Unicode names.
+ io:format("SCC: ~tp\n", [SCC]),
+ Name = lists:flatten([format_lookup_name(debug_lookup_name(Fun))
+ || Fun <- SCC]),
Cs = [state__get_cs(Fun, State) || Fun <- SCC],
constraints_to_dot(Cs, Name, State).
+format_lookup_name({FunName, Arity}) ->
+ TupleS = io_lib:format("{~ts,~w}", [atom_to_list(FunName), Arity]),
+ io_lib:format("~tw", [list_to_atom(lists:flatten(TupleS))]).
+
constraints_to_dot(Cs0, Name, State) ->
NofCs = length(Cs0),
Cs = lists:zip(lists:seq(1, NofCs), Cs0),
{Graph, Opts, _N} = constraints_to_nodes(Cs, NofCs + 1, 1, [], [], State),
hipe_dot:translate_list(Graph, "/tmp/cs.dot", "foo", Opts),
+ %% "-T ps" works for Latin-1. hipe_dot cannot handle UTF-8 either.
Res = os:cmd("dot -o /tmp/"++ Name ++ ".ps -T ps /tmp/cs.dot"),
- io:format("Res: ~p~n", [Res]),
+ io:format("Res: ~ts~n", [Res]),
ok.
constraints_to_nodes([{Name, #constraint_list{type = Type, list = List, id=Id}}
@@ -3507,7 +3524,7 @@ constraints_to_nodes([{Name, #constraint_list{type = Type, list = List, id=Id}}
constraints_to_nodes(Left, N2, Level, NewGraph, NewOpts, State);
constraints_to_nodes([{Name, #constraint{lhs = Lhs, op = Op, rhs = Rhs}}|Left],
N, Level, Graph, Opts, State) ->
- Label = lists:flatten(io_lib:format("~s ~w ~s",
+ Label = lists:flatten(io_lib:format("~ts ~w ~ts",
[format_type(Lhs), Op,
format_type(Rhs)])),
ThisNode = [{Name, Opt} || Opt <- [{label, Label}, {level, Level}]],
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 75d6e3bc65..511a6d66bf 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -39,6 +39,8 @@
sets_filter/2,
src_compiler_opts/0,
refold_pattern/1,
+ ets_tab2list/1,
+ ets_move/2,
parallelism/0,
family/1
]).
@@ -56,15 +58,15 @@ print_types1([], _) ->
ok;
print_types1([{type, _Name, _NArgs} = Key|T], RecDict) ->
{ok, {{_Mod, _FileLine, _Form, _Args}, Type}} = dict:find(Key, RecDict),
- io:format("\n~w: ~w\n", [Key, Type]),
+ io:format("\n~tw: ~tw\n", [Key, Type]),
print_types1(T, RecDict);
print_types1([{opaque, _Name, _NArgs} = Key|T], RecDict) ->
{ok, {{_Mod, _FileLine, _Form, _Args}, Type}} = dict:find(Key, RecDict),
- io:format("\n~w: ~w\n", [Key, Type]),
+ io:format("\n~tw: ~tw\n", [Key, Type]),
print_types1(T, RecDict);
print_types1([{record, _Name} = Key|T], RecDict) ->
{ok, {_FileLine, [{_Arity, _Fields} = AF]}} = dict:find(Key, RecDict),
- io:format("~w: ~w\n\n", [Key, AF]),
+ io:format("~tw: ~tw\n\n", [Key, AF]),
print_types1(T, RecDict).
-define(debug(D_), print_types(D_)).
-else.
@@ -268,7 +270,7 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN,
Arity = length(ArgForms),
case erl_types:type_is_defined(TypeOrOpaque, Name, Arity, RecDict) of
true ->
- Msg = flat_format("Type ~s/~w already defined\n", [Name, Arity]),
+ Msg = flat_format("Type ~ts/~w already defined\n", [Name, Arity]),
throw({error, Msg});
false ->
try erl_types:t_var_names(ArgForms) of
@@ -278,7 +280,7 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN,
erl_types:t_any()}, RecDict)
catch
_:_ ->
- throw({error, flat_format("Type declaration for ~w does not "
+ throw({error, flat_format("Type declaration for ~tw does not "
"have variables as parameters", [Name])})
end
end.
@@ -340,7 +342,19 @@ process_record_remote_types(CServer) ->
{FieldsList, C3} =
lists:mapfoldl(FieldFun, C2, orddict:to_list(Fields)),
{{Key, {FileLine, orddict:from_list(FieldsList)}}, C3};
- _Other -> {{Key, Value}, C2}
+ {type, Name, NArgs} ->
+ %% Make sure warnings about unknown types are output
+ %% also for types unused by specs.
+ Site = {type, {Module, Name, NArgs}},
+ L = erl_anno:new(0),
+ Args = lists:duplicate(NArgs, {var, L, '_'}),
+ UserType = {user_type, L, Name, Args},
+ {_NewType, C3} =
+ erl_types:t_from_form(UserType, ExpTypes, Site,
+ RecordTable, VarTable, C2),
+ {{Key, Value}, C3};
+ {opaque, _Name, _NArgs} ->
+ {{Key, Value}, C2}
end
end,
Cache = erl_types:cache__new(),
@@ -378,7 +392,10 @@ process_opaque_types(AllModules, CServer, TempExpTypes) ->
erl_types:t_from_form(Form, TempExpTypes, Site,
RecordTable, VarTable, C2),
{{Key, {F, Type}}, C3};
- _Other -> {{Key, Value}, C2}
+ {type, _Name, _NArgs} ->
+ {{Key, Value}, C2};
+ {record, _RecName} ->
+ {{Key, Value}, C2}
end
end,
C0 = erl_types:cache__new(),
@@ -433,7 +450,7 @@ msg_with_position(Fun, FileLine) ->
throw:{error, Msg} ->
{File, Line} = FileLine,
BaseName = filename:basename(File),
- NewMsg = io_lib:format("~s:~p: ~s", [BaseName, Line, Msg]),
+ NewMsg = io_lib:format("~ts:~p: ~ts", [BaseName, Line, Msg]),
throw({error, NewMsg})
end.
@@ -526,13 +543,13 @@ get_spec_info([{Contract, Ln, [{Id, TypeSpec}]}|Left],
RecordsMap, ModName, OptCb, File);
{ok, {{OtherFile, L}, _D}} ->
{Mod, Fun, Arity} = MFA,
- Msg = flat_format(" Contract/callback for function ~w:~w/~w "
- "already defined in ~s:~w\n",
+ Msg = flat_format(" Contract/callback for function ~w:~tw/~w "
+ "already defined in ~ts:~w\n",
[Mod, Fun, Arity, OtherFile, L]),
throw({error, Msg})
catch
throw:{error, Error} ->
- {error, flat_format(" Error while parsing contract in line ~w: ~s\n",
+ {error, flat_format(" Error while parsing contract in line ~w: ~ts\n",
[Ln, Error])}
end;
get_spec_info([{file, _, [{IncludeFile, _}]}|Left],
@@ -635,7 +652,7 @@ get_options1([{Args, L, File}|Left], Warnings) ->
get_options1(Left, NewWarnings)
catch
throw:{dialyzer_options_error, Msg} ->
- Msg1 = flat_format(" ~s:~w: ~s", [File, L, Msg]),
+ Msg1 = flat_format(" ~ts:~w: ~ts", [File, L, Msg]),
throw({error, Msg1})
end;
get_options1([], Warnings) ->
@@ -714,7 +731,7 @@ src_compiler_opts() ->
format_errors([{Mod, Errors}|Left]) ->
FormatedError =
- [io_lib:format("~s:~w: ~s\n", [Mod, Line, M:format_error(Desc)])
+ [io_lib:format("~ts:~w: ~ts\n", [Mod, Line, M:format_error(Desc)])
|| {Line, M, Desc} <- Errors],
[lists:flatten(FormatedError) | format_errors(Left)];
format_errors([]) ->
@@ -759,14 +776,14 @@ check_fa_list1([{Args, L, File}|Left], Tag, Funcs) ->
case lists:dropwhile(fun({_, T}) -> is_fa(T) end, TermsL) of
[] -> ok;
[{_, Bad}|_] ->
- Msg1 = flat_format(" Bad function ~w in line ~s:~w",
+ Msg1 = flat_format(" Bad function ~tw in line ~ts:~w",
[Bad, File, L]),
throw({error, Msg1})
end,
case lists:dropwhile(fun({_, FA}) -> is_known(FA, Funcs) end, TermsL) of
[] -> ok;
[{_, {F, A}}|_] ->
- Msg2 = flat_format(" Unknown function ~w/~w in line ~s:~w",
+ Msg2 = flat_format(" Unknown function ~tw/~w in line ~ts:~w",
[F, A, File, L]),
throw({error, Msg2})
end,
@@ -974,6 +991,35 @@ label(Tree) ->
%%------------------------------------------------------------------------------
+-spec ets_tab2list(ets:tid()) -> list().
+
+%% Deletes the contents of the table. Use:
+%% ets_tab2list(T), ets:delete(T)
+%% instead of:
+%% ets:tab2list(T), ets:delete(T)
+%% to save some memory at the expense of somewhat longer execution time.
+ets_tab2list(T) ->
+ F = fun(Vs, A) -> Vs ++ A end,
+ ets_take(ets:first(T), T, F, []).
+
+-spec ets_move(From :: ets:tid(), To :: ets:tid()) -> 'ok'.
+
+ets_move(T1, T2) ->
+ F = fun(Es, A) -> true = ets:insert(T2, Es), A end,
+ [] = ets_take(ets:first(T1), T1, F, []),
+ ok.
+
+ets_take('$end_of_table', T, F, A) ->
+ case ets:first(T) of % no safe_fixtable()...
+ '$end_of_table' -> A;
+ Key -> ets_take(Key, T, F, A)
+ end;
+ets_take(Key, T, F, A) ->
+ Vs = ets:lookup(T, Key),
+ Key1 = ets:next(T, Key),
+ true = ets:delete(T, Key),
+ ets_take(Key1, T, F, F(Vs, A)).
+
-spec parallelism() -> integer().
parallelism() ->
diff --git a/lib/dialyzer/src/typer.erl b/lib/dialyzer/src/typer.erl
index 86c7c62f98..bf5484e5f6 100644
--- a/lib/dialyzer/src/typer.erl
+++ b/lib/dialyzer/src/typer.erl
@@ -74,6 +74,7 @@
-spec start() -> no_return().
start() ->
+_ = io:setopts(standard_error, [{encoding,unicode}]),
{Args, Analysis} = process_cl_args(),
%% io:format("Args: ~p\n", [Args]),
%% io:format("Analysis: ~p\n", [Analysis]),
@@ -81,7 +82,7 @@ start() ->
TrustedFiles = filter_fd(Args#args.trusted, [], fun is_erl_file/1),
Analysis2 = extract(Analysis, TrustedFiles),
All_Files = get_all_files(Args),
- %% io:format("All_Files: ~p\n", [All_Files]),
+ %% io:format("All_Files: ~tp\n", [All_Files]),
Analysis3 = Analysis2#analysis{files = All_Files},
Analysis4 = collect_info(Analysis3),
%% io:format("Final: ~p\n", [Analysis4#analysis.fms]),
@@ -157,17 +158,16 @@ get_type_info(#analysis{callgraph = CallGraph,
StrippedCallGraph = remove_external(CallGraph, TrustPLT),
%% io:format("--- Analyzing callgraph... "),
try
- NewMiniPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph,
- TrustPLT,
- CodeServer),
- NewPlt = dialyzer_plt:restore_full_plt(NewMiniPlt),
+ NewPlt = dialyzer_succ_typings:analyze_callgraph(StrippedCallGraph,
+ TrustPLT,
+ CodeServer),
Analysis#analysis{callgraph = StrippedCallGraph, trust_plt = NewPlt}
catch
error:What ->
- fatal_error(io_lib:format("Analysis failed with message: ~p",
+ fatal_error(io_lib:format("Analysis failed with message: ~tp",
[{What, erlang:get_stacktrace()}]));
throw:{dialyzer_succ_typing_error, Msg} ->
- fatal_error(io_lib:format("Analysis failed with message: ~s", [Msg]))
+ fatal_error(io_lib:format("Analysis failed with message: ~ts", [Msg]))
end.
-spec remove_external(callgraph(), plt()) -> callgraph().
@@ -177,11 +177,11 @@ remove_external(CallGraph, PLT) ->
case get_external(Ext, PLT) of
[] -> ok;
Externals ->
- msg(io_lib:format(" Unknown functions: ~p\n", [lists:usort(Externals)])),
+ msg(io_lib:format(" Unknown functions: ~tp\n", [lists:usort(Externals)])),
ExtTypes = rcv_ext_types(),
case ExtTypes of
[] -> ok;
- _ -> msg(io_lib:format(" Unknown types: ~p\n", [ExtTypes]))
+ _ -> msg(io_lib:format(" Unknown types: ~tp\n", [ExtTypes]))
end
end,
StrippedCG0.
@@ -257,9 +257,9 @@ write_inc_files(Inc) ->
records = maps:new(),
%% Note we need to sort functions here!
functions = lists:keysort(1, Functions)},
- %% io:format("Types ~p\n", [Info#info.types]),
- %% io:format("Functions ~p\n", [Info#info.functions]),
- %% io:format("Records ~p\n", [Info#info.records]),
+ %% io:format("Types ~tp\n", [Info#info.types]),
+ %% io:format("Functions ~tp\n", [Info#info.functions]),
+ %% io:format("Records ~tp\n", [Info#info.records]),
write_typed_file(File, Info)
end,
lists:foreach(Fun, dict:fetch_keys(Inc#inc.map)).
@@ -349,8 +349,8 @@ check_imported_functions({File, {Line, F, A}}, Inc, Types) ->
end.
inc_warning({F, A}, File) ->
- io:format(" ***Warning: Skip function ~p/~p ", [F, A]),
- io:format("in file ~p because of inconsistent type\n", [File]).
+ io:format(" ***Warning: Skip function ~tp/~p ", [F, A]),
+ io:format("in file ~tp because of inconsistent type\n", [File]).
clean_inc(Inc) ->
Inc1 = remove_yecc_generated_file(Inc),
@@ -407,13 +407,13 @@ get_type({{M, F, A} = MFA, Range, Arg}, CodeServer, Records) ->
{error, invalid_contract} ->
CString = dialyzer_contracts:contract_to_string(Contract),
SigString = dialyzer_utils:format_sig(Sig, Records),
- Msg = io_lib:format("Error in contract of function ~w:~w/~w\n"
+ Msg = io_lib:format("Error in contract of function ~w:~tw/~w\n"
"\t The contract is: " ++ CString ++ "\n" ++
- "\t but the inferred signature is: ~s",
+ "\t but the inferred signature is: ~ts",
[M, F, A, SigString]),
fatal_error(Msg);
{error, ErrorStr} when is_list(ErrorStr) -> % ErrorStr is a string()
- Msg = io_lib:format("Error in contract of function ~w:~w/~w: ~s",
+ Msg = io_lib:format("Error in contract of function ~w:~tw/~w: ~ts",
[M, F, A, ErrorStr]),
fatal_error(Msg)
end
@@ -448,7 +448,7 @@ remove_module_info(FunInfoList) ->
lists:filter(F, FunInfoList).
write_typed_file(File, Info) ->
- io:format(" Processing file: ~p\n", [File]),
+ io:format(" Processing file: ~tp\n", [File]),
Dir = filename:dirname(File),
RootName = filename:basename(filename:rootname(File)),
Ext = filename:extension(File),
@@ -463,18 +463,18 @@ write_typed_file(File, Info) ->
ok -> ok;
{error, enoent} -> ok;
{error, _} ->
- Msg = io_lib:format("Error in deleting file ~s\n", [NewFileName]),
+ Msg = io_lib:format("Error in deleting file ~ts\n", [NewFileName]),
fatal_error(Msg)
end,
write_typed_file(File, Info, NewFileName);
enospc ->
- Msg = io_lib:format("Not enough space in ~p\n", [Dir]),
+ Msg = io_lib:format("Not enough space in ~tp\n", [Dir]),
fatal_error(Msg);
eacces ->
- Msg = io_lib:format("No write permission in ~p\n", [Dir]),
+ Msg = io_lib:format("No write permission in ~tp\n", [Dir]),
fatal_error(Msg);
_ ->
- Msg = io_lib:format("Unhandled error ~s when writing ~p\n",
+ Msg = io_lib:format("Unhandled error ~ts when writing ~tp\n",
[Reason, Dir]),
fatal_error(Msg)
end;
@@ -486,7 +486,7 @@ write_typed_file(File, Info, NewFileName) ->
{ok, Binary} = file:read_file(File),
Chars = binary_to_list(Binary),
write_typed_file(Chars, NewFileName, Info, 1, []),
- io:format(" Saved as: ~p\n", [NewFileName]).
+ io:format(" Saved as: ~tp\n", [NewFileName]).
write_typed_file(Chars, File, #info{functions = []}, _LNo, _Acc) ->
ok = file:write_file(File, list_to_binary(Chars), [append]);
@@ -546,12 +546,12 @@ get_type_string(F, A, Info, Mode) ->
end.
show_type_info(File, Info) ->
- io:format("\n%% File: ~p\n%% ", [File]),
+ io:format("\n%% File: ~tp\n%% ", [File]),
OutputString = lists:concat(["~.", length(File)+8, "c~n"]),
io:fwrite(OutputString, [$-]),
Fun = fun ({_LineNo, F, A}) ->
TypeInfo = get_type_string(F, A, Info, show),
- io:format("~s\n", [TypeInfo])
+ io:format("~ts\n", [TypeInfo])
end,
lists:foreach(Fun, Info#info.functions).
@@ -561,7 +561,7 @@ get_type_info(Func, Types) ->
%% Note: Typeinfo of any function should exist in
%% the result offered by dialyzer, otherwise there
%% *must* be something wrong with the analysis
- Msg = io_lib:format("No type info for function: ~p\n", [Func]),
+ Msg = io_lib:format("No type info for function: ~tp\n", [Func]),
fatal_error(Msg);
{contract, _Fun} = C -> C;
{_RetType, _ArgType} = RA -> RA
@@ -575,7 +575,7 @@ get_type_info(Func, Types) ->
process_cl_args() ->
ArgList = init:get_plain_arguments(),
- %% io:format("Args is ~p\n", [ArgList]),
+ %% io:format("Args is ~tp\n", [ArgList]),
{Args, Analysis} = analyze_args(ArgList, #args{}, #analysis{}),
%% if the mode has not been set, set it to the default mode (show)
{Args, case Analysis#analysis.mode of
@@ -848,7 +848,7 @@ collect_one_file_info(File, Analysis) ->
Options = dialyzer_utils:src_compiler_opts() ++ Is ++ Ds,
case dialyzer_utils:get_core_from_src(File, Options) of
{error, Reason} ->
- %% io:format("File=~p\n,Options=~p\n,Error=~p\n", [File,Options,Reason]),
+ %% io:format("File=~tp\n,Options=~p\n,Error=~p\n", [File,Options,Reason]),
compile_error(Reason);
{ok, Core} ->
case dialyzer_utils:get_record_and_type_info(Core) of
@@ -922,7 +922,7 @@ analyze_one_function({Var, FunBody} = Function, Acc) ->
{FuncAcc, IncFuncAcc} =
case (FileName =:= OriginalName) orelse (BaseName =:= OriginalName) of
true -> %% Coming from original file
- %% io:format("Added function ~p\n", [{LineNo, F, A}]),
+ %% io:format("Added function ~tp\n", [{LineNo, F, A}]),
{Acc#tmpAcc.funcAcc ++ [FuncInfo], Acc#tmpAcc.incFuncAcc};
false ->
%% Coming from other sourses, including:
@@ -972,7 +972,7 @@ get_exported_types_from_core(Core) ->
-spec fatal_error(string()) -> no_return().
fatal_error(Slogan) ->
- msg(io_lib:format("typer: ~s\n", [Slogan])),
+ msg(io_lib:format("typer: ~ts\n", [Slogan])),
erlang:halt(1).
-spec mode_error(mode(), mode()) -> no_return().
@@ -993,7 +993,7 @@ compile_error(Reason) ->
-spec msg(string()) -> 'ok'.
msg(Msg) ->
- io:format(standard_error, "~s", [Msg]).
+ io:format(standard_error, "~ts", [Msg]).
%%--------------------------------------------------------------------
%% Version and help messages.
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs
index 38999e8919..843d26ee59 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/callbacks_and_specs
@@ -1,5 +1,5 @@
-my_callbacks_wrong.erl:26: The return type #state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour
-my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of my_behaviour behaviour
-my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of my_behaviour behaviour
+my_callbacks_wrong.erl:26: The return type #state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()} in the specification of callback_init/1 is not a subtype of {'ok',_}, which is the expected return type for the callback of the my_behaviour behaviour
+my_callbacks_wrong.erl:28: The inferred return type of callback_init/1 (#state{parent::pid(),status::'init',subscribe::[],counter::1}) has nothing in common with {'ok',_}, which is the expected return type for the callback of the my_behaviour behaviour
+my_callbacks_wrong.erl:30: The return type {'reply',#state{parent::pid(),status::'closed' | 'init' | 'open',subscribe::[{pid(),integer()}],counter::integer()}} in the specification of callback_cast/3 is not a subtype of {'noreply',_}, which is the expected return type for the callback of the my_behaviour behaviour
my_callbacks_wrong.erl:39: The specified type for the 2nd argument of callback_call/3 (atom()) is not a supertype of pid(), which is expected type for this argument in the callback of the my_behaviour behaviour
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_event_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_event_incorrect_return
index e646eea383..c3ebee05da 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_event_incorrect_return
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_event_incorrect_return
@@ -1,2 +1,2 @@
-gen_event_incorrect_return.erl:16: The inferred return type of init/1 ('error') has nothing in common with {'error',_} | {'ok',_} | {'ok',_,'hibernate'}, which is the expected return type for the callback of gen_event behaviour
+gen_event_incorrect_return.erl:16: The inferred return type of init/1 ('error') has nothing in common with {'error',_} | {'ok',_} | {'ok',_,'hibernate'}, which is the expected return type for the callback of the gen_event behaviour
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
index 2f504d3c72..1eb8cd455b 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_incorrect_args
@@ -1,5 +1,5 @@
-gen_server_incorrect_args.erl:3: Undefined callback function handle_cast/2 (behaviour 'gen_server')
-gen_server_incorrect_args.erl:3: Undefined callback function init/1 (behaviour 'gen_server')
-gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer()} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer()} | {'stop',_,_,_}, which is the expected return type for the callback of gen_server behaviour
+gen_server_incorrect_args.erl:3: Undefined callback function handle_cast/2 (behaviour gen_server)
+gen_server_incorrect_args.erl:3: Undefined callback function init/1 (behaviour gen_server)
+gen_server_incorrect_args.erl:7: The inferred return type of handle_call/3 ({'no'} | {'ok'}) has nothing in common with {'noreply',_} | {'noreply',_,'hibernate' | 'infinity' | non_neg_integer()} | {'reply',_,_} | {'stop',_,_} | {'reply',_,_,'hibernate' | 'infinity' | non_neg_integer()} | {'stop',_,_,_}, which is the expected return type for the callback of the gen_server behaviour
gen_server_incorrect_args.erl:7: The inferred type for the 2nd argument of handle_call/3 ('boo' | 'foo') is not a supertype of {pid(),_}, which is expected type for this argument in the callback of the gen_server behaviour
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks
index 0a7642a9b5..188f7822fa 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/gen_server_missing_callbacks
@@ -1,2 +1,2 @@
-gen_server_missing_callbacks.erl:3: Undefined callback function handle_cast/2 (behaviour 'gen_server')
+gen_server_missing_callbacks.erl:3: Undefined callback function handle_cast/2 (behaviour gen_server)
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour b/lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour
index 8cecabccaa..68adf4cfa0 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour
@@ -1,9 +1,9 @@
-sample_callback_wrong.erl:16: The inferred return type of sample_callback_2/0 (42) has nothing in common with atom(), which is the expected return type for the callback of sample_behaviour behaviour
-sample_callback_wrong.erl:17: The inferred return type of sample_callback_3/0 ('fair') has nothing in common with 'fail' | {'ok',1..255}, which is the expected return type for the callback of sample_behaviour behaviour
-sample_callback_wrong.erl:18: The inferred return type of sample_callback_4/1 ('fail') has nothing in common with 'ok', which is the expected return type for the callback of sample_behaviour behaviour
-sample_callback_wrong.erl:20: The inferred return type of sample_callback_5/1 (string()) has nothing in common with 'fail' | 'ok', which is the expected return type for the callback of sample_behaviour behaviour
+sample_callback_wrong.erl:16: The inferred return type of sample_callback_2/0 (42) has nothing in common with atom(), which is the expected return type for the callback of the sample_behaviour behaviour
+sample_callback_wrong.erl:17: The inferred return type of sample_callback_3/0 ('fair') has nothing in common with 'fail' | {'ok',1..255}, which is the expected return type for the callback of the sample_behaviour behaviour
+sample_callback_wrong.erl:18: The inferred return type of sample_callback_4/1 ('fail') has nothing in common with 'ok', which is the expected return type for the callback of the sample_behaviour behaviour
+sample_callback_wrong.erl:20: The inferred return type of sample_callback_5/1 (string()) has nothing in common with 'fail' | 'ok', which is the expected return type for the callback of the sample_behaviour behaviour
sample_callback_wrong.erl:20: The inferred type for the 1st argument of sample_callback_5/1 (atom()) is not a supertype of 1..255, which is expected type for this argument in the callback of the sample_behaviour behaviour
-sample_callback_wrong.erl:22: The inferred return type of sample_callback_6/3 ({'okk',number()}) has nothing in common with 'fail' | {'ok',1..255}, which is the expected return type for the callback of sample_behaviour behaviour
+sample_callback_wrong.erl:22: The inferred return type of sample_callback_6/3 ({'okk',number()}) has nothing in common with 'fail' | {'ok',1..255}, which is the expected return type for the callback of the sample_behaviour behaviour
sample_callback_wrong.erl:22: The inferred type for the 3rd argument of sample_callback_6/3 (atom()) is not a supertype of string(), which is expected type for this argument in the callback of the sample_behaviour behaviour
-sample_callback_wrong.erl:4: Undefined callback function sample_callback_1/0 (behaviour 'sample_behaviour')
+sample_callback_wrong.erl:4: Undefined callback function sample_callback_1/0 (behaviour sample_behaviour)
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour_old b/lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour_old
index f0181bb59c..67aa872984 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour_old
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/sample_behaviour_old
@@ -1,4 +1,4 @@
incorrect_args_callback.erl:12: The inferred type for the 2nd argument of bar/2 ('yes') is not a supertype of [any()], which is expected type for this argument in the callback of the correct_behaviour behaviour
-incorrect_return_callback.erl:9: The inferred return type of foo/0 ('error') has nothing in common with 'no' | 'yes', which is the expected return type for the callback of correct_behaviour behaviour
-missing_callback.erl:5: Undefined callback function foo/0 (behaviour 'correct_behaviour')
+incorrect_return_callback.erl:9: The inferred return type of foo/0 ('error') has nothing in common with 'no' | 'yes', which is the expected return type for the callback of the correct_behaviour behaviour
+missing_callback.erl:5: Undefined callback function foo/0 (behaviour correct_behaviour)
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
index 638d031923..5a063a12b8 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return
@@ -1,2 +1,2 @@
-supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{'intensity'=>non_neg_integer(), 'period'=>pos_integer(), 'strategy'=>'one_for_all' | 'one_for_one' | 'rest_for_one' | 'simple_one_for_one'},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{'id':=_, 'start':={atom(),atom(),'undefined' | [any()]}, 'modules'=>'dynamic' | [atom()], 'restart'=>'permanent' | 'temporary' | 'transient', 'shutdown'=>'brutal_kill' | 'infinity' | non_neg_integer(), 'type'=>'supervisor' | 'worker'}]}}, which is the expected return type for the callback of supervisor behaviour
+supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{'intensity'=>non_neg_integer(), 'period'=>pos_integer(), 'strategy'=>'one_for_all' | 'one_for_one' | 'rest_for_one' | 'simple_one_for_one'},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{'id':=_, 'start':={atom(),atom(),'undefined' | [any()]}, 'modules'=>'dynamic' | [atom()], 'restart'=>'permanent' | 'temporary' | 'transient', 'shutdown'=>'brutal_kill' | 'infinity' | non_neg_integer(), 'type'=>'supervisor' | 'worker'}]}}, which is the expected return type for the callback of the supervisor behaviour
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec b/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec
index 512dcdd758..f313c24420 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec
+++ b/lib/dialyzer/test/behaviour_SUITE_data/results/vars_in_beh_spec
@@ -1,4 +1,4 @@
-vars_in_beh_spec.erl:3: Undefined callback function handle_call/3 (behaviour 'gen_server')
-vars_in_beh_spec.erl:3: Undefined callback function handle_cast/2 (behaviour 'gen_server')
-vars_in_beh_spec.erl:3: Undefined callback function init/1 (behaviour 'gen_server')
+vars_in_beh_spec.erl:3: Undefined callback function handle_call/3 (behaviour gen_server)
+vars_in_beh_spec.erl:3: Undefined callback function handle_cast/2 (behaviour gen_server)
+vars_in_beh_spec.erl:3: Undefined callback function init/1 (behaviour gen_server)
diff --git a/lib/dialyzer/test/options2_SUITE_data/results/unused_unknown_type b/lib/dialyzer/test/options2_SUITE_data/results/unused_unknown_type
new file mode 100644
index 0000000000..110d896c76
--- /dev/null
+++ b/lib/dialyzer/test/options2_SUITE_data/results/unused_unknown_type
@@ -0,0 +1,2 @@
+
+:0: Unknown type unknown:type1/0:0: Unknown type unknown:type2/0:0: Unknown type unknown:type3/0 \ No newline at end of file
diff --git a/lib/dialyzer/test/options2_SUITE_data/src/unused_unknown_type.erl b/lib/dialyzer/test/options2_SUITE_data/src/unused_unknown_type.erl
new file mode 100644
index 0000000000..90df7d528a
--- /dev/null
+++ b/lib/dialyzer/test/options2_SUITE_data/src/unused_unknown_type.erl
@@ -0,0 +1,10 @@
+-module(unused_unknown_type).
+
+-export_type([unused/0]).
+
+-type unused() :: unknown:type1().
+
+-record(unused_rec, {a :: unknown:type2()}).
+
+-record(rec, {a}).
+-type unused_rec() :: #rec{a :: unknown:type3()}.
diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl
index 92c63bdb0c..ebe79b2a6d 100644
--- a/lib/dialyzer/test/plt_SUITE.erl
+++ b/lib/dialyzer/test/plt_SUITE.erl
@@ -9,14 +9,14 @@
-export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1,
local_fun_same_as_callback/1,
remove_plt/1, run_plt_check/1, run_succ_typings/1,
- bad_dialyzer_attr/1]).
+ bad_dialyzer_attr/1, merge_plts/1]).
suite() ->
[{timetrap, ?plt_timeout}].
all() -> [build_plt, beam_tests, update_plt, run_plt_check,
remove_plt, run_succ_typings, local_fun_same_as_callback,
- bad_dialyzer_attr].
+ bad_dialyzer_attr, merge_plts].
build_plt(Config) ->
OutDir = ?config(priv_dir, Config),
@@ -170,6 +170,7 @@ update_plt(Config) ->
{init_plt, Plt}] ++ Opts),
ok.
+
%%% If a behaviour module contains an non-exported function with the same name
%%% as one of the behaviour's callbacks, the callback info was inadvertently
%%% deleted from the PLT as the dialyzer_plt:delete_list/2 function was cleaning
@@ -297,6 +298,87 @@ bad_dialyzer_attr(Config) ->
ok.
+merge_plts(Config) ->
+ %% A few checks of merging PLTs.
+ fun() ->
+ {Mod1, Mod2} = types(),
+ {BeamFiles, Plt1, Plt2} = create_plts(Mod1, Mod2, Config),
+
+ {dialyzer_error,
+ "Could not merge PLTs since they are not disjoint"++_} =
+ (catch run_dialyzer(succ_typings, BeamFiles,
+ [{plts, [Plt1, Plt1]}])),
+ [{warn_contract_types,_,_}] =
+ run_dialyzer(succ_typings, BeamFiles,
+ [{warnings, [unknown]},
+ {plts, [Plt1, Plt2]}])
+ end(),
+
+ fun() ->
+ {Mod1, Mod2} = callbacks(),
+ {BeamFiles, Plt1, Plt2} = create_plts(Mod1, Mod2, Config),
+
+ {dialyzer_error,
+ "Could not merge PLTs since they are not disjoint"++_} =
+ (catch run_dialyzer(succ_typings, BeamFiles,
+ [{plts, [Plt1, Plt1]}])),
+ [] =
+ run_dialyzer(succ_typings, BeamFiles,
+ [{warnings, [unknown]},
+ {plts, [Plt1, Plt2]}])
+ end(),
+
+ ok.
+
+types() ->
+ Mod1 = <<"-module(merge_plts_1).
+ -export([f/0]).
+ -export_type([t/0]).
+ -type t() :: merge_plts_2:t().
+ -spec f() -> t().
+ f() -> 1. % Not an atom().
+ ">>,
+ Mod2 = <<"-module(merge_plts_2).
+ -export_type([t/0]).
+ -type t() :: atom().
+ ">>,
+ {Mod1, Mod2}.
+
+callbacks() -> % A very shallow test.
+ Mod1 = <<"-module(merge_plts_1).
+ -callback t() -> merge_plts_2:t().
+ ">>,
+ Mod2 = <<"-module(merge_plts_2).
+ -export_type([t/0]).
+ -type t() :: atom().
+ ">>,
+ {Mod1, Mod2}.
+
+create_plts(Mod1, Mod2, Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Plt1 = filename:join(PrivDir, "merge_plts_1.plt"),
+ Plt2 = filename:join(PrivDir, "merge_plts_2.plt"),
+ ErlangBeam = erlang_beam(),
+
+ {ok, BeamFile1} = compile(Config, Mod1, merge_plts_1, []),
+ [] = run_dialyzer(plt_build, [ErlangBeam,BeamFile1], [{output_plt,Plt1}]),
+
+ {ok, BeamFile2} = compile(Config, Mod2, merge_plts_2, []),
+ [] = run_dialyzer(plt_build, [BeamFile2], [{output_plt, Plt2}]),
+ {[BeamFile1, BeamFile2], Plt1, Plt2}.
+
+%% End of merge_plts().
+
+erlang_beam() ->
+ case code:where_is_file("erlang.beam") of
+ non_existing ->
+ filename:join([code:root_dir(),
+ "erts", "preloaded", "ebin",
+ "erlang.beam"]);
+ EBeam ->
+ EBeam
+ end.
+
compile(Config, Prog, Module, CompileOpts) ->
Source = lists:concat([Module, ".erl"]),
PrivDir = ?config(priv_dir,Config),
diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk
index 0919fba834..4a1a7c25a0 100644
--- a/lib/dialyzer/vsn.mk
+++ b/lib/dialyzer/vsn.mk
@@ -1 +1 @@
-DIALYZER_VSN = 3.1
+DIALYZER_VSN = 3.2
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 72181a42b0..2cbe48ecce 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -21,7 +21,7 @@
<copyright>
<year>2011</year>
-<year>2016</year>
+<year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -300,6 +300,17 @@ corresponding list of filters.
Defaults to <c>none</c>.</p>
</item>
+<tag><c>{peer, &app_peer_ref;}</c></tag>
+<item>
+<p>
+Peer to which the request in question can be sent, preempting the
+selection of peers having advertised support for the Diameter
+application in question.
+Multiple options can be specified, and their order is
+respected in the candidate lists passed to a subsequent
+&app_pick_peer; callback.</p>
+</item>
+
<tag><c>{timeout, &dict_Unsigned32;}</c></tag>
<item>
<p>
diff --git a/lib/diameter/doc/src/diameter_codec.xml b/lib/diameter/doc/src/diameter_codec.xml
index 91e96058dd..0117c1c88a 100644
--- a/lib/diameter/doc/src/diameter_codec.xml
+++ b/lib/diameter/doc/src/diameter_codec.xml
@@ -13,7 +13,8 @@
<erlref>
<header>
<copyright>
-<year>2012</year><year>2016</year>
+<year>2012</year>
+<year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -53,17 +54,17 @@ communicated to &man_app; callbacks.
Similarly, outgoing Diameter messages are encoded into binary() before
being passed to the appropriate &man_transport; module for
transmission.
-The functions in this module implement this encode/decode.</p>
+The functions documented here implement the default encode/decode.</p>
-<note>
+<warning>
<p>
-Calls to this module are made by diameter itself as a consequence of
-configuration passed to &mod_start_service;.
-The encode/decode functions may also be useful for other purposes (eg.
-test) but the diameter user does not need to call them explicitly when
+The diameter user does not need to call functions here explicitly when
sending and receiving messages using &mod_call; and the callback
-interface documented in &man_app;.</p>
-</note>
+interface documented in &man_app;: diameter itself provides encode/decode
+as a consequence of configuration passed to &mod_start_service;, and
+the results may differ from those returned by the functions documented
+here, depending on configuration.</p>
+</warning>
<p>
The &header; and &packet; records below
diff --git a/lib/diameter/doc/src/diameter_dict.xml b/lib/diameter/doc/src/diameter_dict.xml
index 9584d682c2..94016d9466 100644
--- a/lib/diameter/doc/src/diameter_dict.xml
+++ b/lib/diameter/doc/src/diameter_dict.xml
@@ -16,7 +16,8 @@
<header>
<copyright>
-<year>2011</year><year>2016</year>
+<year>2011</year>
+<year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -307,11 +308,11 @@ The P flag has been deprecated by &the_rfc;.</p>
<p>
Specifies AVPs for which module Mod provides encode/decode functions.
The section contents consists of AVP names.
-For each such name, <c>Mod:Name(encode|decode, Type, Data)</c> is
+For each such name, <c>Mod:Name(encode|decode, Type, Data, Opts)</c> is
expected to provide encode/decode for values of the AVP, where Name is
the name of the AVP, Type is it's type as declared in the
-<c>@avp_types</c> section of the dictionary and Data is the value to
-encode/decode.</p>
+<c>@avp_types</c> section of the dictionary, Data is the value to
+encode/decode, and Opts is a term that is passed through encode/decode.</p>
<p>
Example:</p>
@@ -328,8 +329,8 @@ Framed-IP-Address
<item>
<p>
Like <c>@custom_types</c> but requires the specified module to export
-<c>Mod:Type(encode|decode, Name, Data)</c> rather than
-<c>Mod:Name(encode|decode, Type, Data)</c>.</p>
+<c>Mod:Type(encode|decode, Name, Data, Opts)</c> rather than
+<c>Mod:Name(encode|decode, Type, Data, Opts)</c>.</p>
<p>
Example:</p>
diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml
index 50f568abaa..60478606ad 100644
--- a/lib/diameter/doc/src/notes.xml
+++ b/lib/diameter/doc/src/notes.xml
@@ -43,6 +43,76 @@ first.</p>
<!-- ===================================================================== -->
+<section><title>diameter 2.0</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Let candidate peers be passed to diameter:call/4</p>
+ <p>
+ With call option peer, to allow a request to be sent to a
+ peer that hasn't advertised support for the application
+ in question.</p>
+ <p>
+ RFC 6733 2.4 requires a node to send the application
+ identifiers of all locally supported applications at
+ capabilities exchange, but not all nodes respect this for
+ the common application, and diameter itself will send
+ D[WP][RA] without the common application having been
+ explicitly advertised. Regarding the common application
+ as implicit renders Result-Code 5010
+ (DIAMETER_NO_COMMON_APPLICATION) meaningless however, so
+ allow any request to be sent as long as there is a
+ configured dictionary to support it.</p>
+ <p>
+ Own Id: OTP-14338</p>
+ </item>
+ <item>
+ <p>
+ Improve performance of message encode/decode and related
+ handling.</p>
+ <p>
+ Dictionaries using @custom_types or @codecs will need to
+ adapt the corresponding functions to accept an additional
+ argument that is now passed through encode/decode, which
+ was required to remove various process dictionary-based
+ workarounds that have been used to solve problems in the
+ past.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14343</p>
+ </item>
+ <item>
+ <p>
+ Add transport options to avoid deadlock and allow for
+ load regulation.</p>
+ <p>
+ Both diameter_tcp and diameter_sctp now accept two new
+ configuration options: sender and message_cb. The former
+ causes outgoing sends to take place in a dedicated
+ process, to avoid the possibility of deadlock when both
+ the transport process and its peer block in send. The
+ latter allows a callback to control the reading of
+ messages on the socket, to allow for backpressure towards
+ peers when the rate of incoming traffic is greater than
+ can otherwise be handled.</p>
+ <p>
+ Neither of these options are yet documented, but are
+ unlikely to change unless problems are discovered. The
+ sender option is not the default since it should probably
+ always be used in combination with message_cb, to prevent
+ incoming requests from being read at a higher rate than a
+ peer allows outgoing answers to be sent.</p>
+ <p>
+ Own Id: OTP-14455 Aux Id: ERL-332 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>diameter 1.12.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/diameter/examples/code/node.erl b/lib/diameter/examples/code/node.erl
index 246be4194b..fc5830f8e2 100644
--- a/lib/diameter/examples/code/node.erl
+++ b/lib/diameter/examples/code/node.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,6 +30,8 @@
connect/2,
stop/1]).
+-export([message/3]).
+
-type protocol()
:: tcp | sctp.
@@ -128,6 +130,8 @@ stop(Name) ->
server_opts({T, Addr, Port}) ->
[{transport_module, tmod(T)},
{transport_config, [{reuseaddr, true},
+ {sender, true},
+ {message_cb, [fun ?MODULE:message/3, 0]},
{ip, addr(Addr)},
{port, Port}]}];
@@ -173,3 +177,26 @@ addr(loopback) ->
{127,0,0,1};
addr(A) ->
A.
+
+%% ---------------------------------------------------------------------------
+
+%% message/3
+%%
+%% Simple message callback that limits the number of concurrent
+%% requests on the peer connection in question.
+
+%% Incoming request.
+message(recv, <<_:32, 1:1, _/bits>> = Bin, N) ->
+ [Bin, N < 32, fun ?MODULE:message/3, N+1];
+
+%% Outgoing request.
+message(ack, <<_:32, 1:1, _/bits>>, _) ->
+ [];
+
+%% Incoming answer or request discarded.
+message(ack, _, N) ->
+ [N =< 32, fun ?MODULE:message/3, N-1];
+
+%% Outgoing message or incoming answer.
+message(_, Bin, _) ->
+ [Bin].
diff --git a/lib/diameter/include/diameter_gen.hrl b/lib/diameter/include/diameter_gen.hrl
index 6531e9528c..fb6370fe54 100644
--- a/lib/diameter/include/diameter_gen.hrl
+++ b/lib/diameter/include/diameter_gen.hrl
@@ -20,716 +20,36 @@
%%
%% This file contains code that's included by encode/decode modules
-%% generated by diameter_codegen.erl. This code does most of the work, the
-%% generated code being kept simple.
+%% generated by diameter_codegen.erl. This code used to do most of the
+%% work, but now passes it off to module diameter_gen.
%%
--define(THROW(T), throw({?MODULE, T})).
+%% encode_avps/3
-%% Tag common to generated dictionaries.
--define(TAG, diameter_gen).
+encode_avps(Name, Vals, Opts) ->
+ diameter_gen:encode_avps(Name, Vals, Opts#{module => ?MODULE}).
-%% Key to a value in the process dictionary that determines whether or
-%% not an unrecognized AVP setting the M-bit should be regarded as an
-%% error or not. See is_strict/0. This is only used to relax M-bit
-%% interpretation inside Grouped AVPs not setting the M-bit. The
-%% service_opt() strict_mbit can be used to disable the check
-%% globally.
--define(STRICT_KEY, strict).
+%% decode_avps/2
-%% Key that says whether or not we should do a best-effort decode
-%% within Failed-AVP.
--define(FAILED_KEY, failed).
+decode_avps(Name, Recs, Opts) ->
+ diameter_gen:decode_avps(Name, Recs, Opts#{module => ?MODULE}).
--type parent_name() :: atom(). %% parent = Message or AVP
--type parent_record() :: tuple(). %%
--type avp_name() :: atom().
--type avp_record() :: tuple().
--type avp_values() :: [{avp_name(), term()}].
+%% avp/5
--type non_grouped_avp() :: #diameter_avp{}.
--type grouped_avp() :: nonempty_improper_list(#diameter_avp{}, [avp()]).
--type avp() :: non_grouped_avp() | grouped_avp().
+avp(T, Data, Name, Opts, Mod) ->
+ Mod:avp(T, Data, Name, Opts#{module := Mod}).
-%% Use a (hopefully) unique key when manipulating the process
-%% dictionary.
+%% grouped_avp/4
-putr(K,V) ->
- put({?TAG, K}, V).
+grouped_avp(T, Name, Data, Opts) ->
+ diameter_gen:grouped_avp(T, Name, Data, Opts).
-getr(K) ->
- case get({?TAG, K}) of
- undefined ->
- V = erase({?MODULE, K}), %% written in old code
- V == undefined orelse putr(K,V),
- V;
- V ->
- V
- end.
+%% empty_group/2
-eraser(K) ->
- erase({?TAG, K}).
+empty_group(Name, Opts) ->
+ diameter_gen:empty_group(Name, Opts).
-%% ---------------------------------------------------------------------------
-%% # encode_avps/2
-%% ---------------------------------------------------------------------------
+%% empty/2
--spec encode_avps(parent_name(), parent_record() | avp_values())
- -> binary()
- | no_return().
-
-encode_avps(Name, Vals)
- when is_list(Vals) ->
- encode_avps(Name, '#set-'(Vals, newrec(Name)));
-
-encode_avps(Name, Rec) ->
- try
- list_to_binary(encode(Name, Rec))
- catch
- throw: {?MODULE, Reason} ->
- diameter_lib:log({encode, error},
- ?MODULE,
- ?LINE,
- {Reason, Name, Rec}),
- erlang:error(list_to_tuple(Reason ++ [Name]));
- error: Reason ->
- Stack = erlang:get_stacktrace(),
- diameter_lib:log({encode, failure},
- ?MODULE,
- ?LINE,
- {Reason, Name, Rec, Stack}),
- erlang:error({encode_failure, Reason, Name, Stack})
- end.
-
-%% encode/2
-
-encode(Name, Rec) ->
- lists:flatmap(fun(A) -> encode(Name, A, '#get-'(A, Rec)) end,
- '#info-'(element(1, Rec), fields)).
-
-%% encode/3
-
-encode(Name, AvpName, Values) ->
- e(Name, AvpName, avp_arity(Name, AvpName), Values).
-
-%% e/4
-
-e(_, AvpName, 1, undefined) ->
- ?THROW([mandatory_avp_missing, AvpName]);
-
-e(Name, AvpName, 1, Value) ->
- e(Name, AvpName, [Value]);
-
-e(_, _, {0,_}, []) ->
- [];
-
-e(_, AvpName, _, T)
- when not is_list(T) ->
- ?THROW([repeated_avp_as_non_list, AvpName, T]);
-
-e(_, AvpName, {Min, _}, L)
- when length(L) < Min ->
- ?THROW([repeated_avp_insufficient_arity, AvpName, Min, L]);
-
-e(_, AvpName, {_, Max}, L)
- when Max < length(L) ->
- ?THROW([repeated_avp_excessive_arity, AvpName, Max, L]);
-
-e(Name, AvpName, _, Values) ->
- e(Name, AvpName, Values).
-
-%% e/3
-
-e(Name, 'AVP', Values) ->
- [pack_AVP(Name, A) || A <- Values];
-
-e(_, AvpName, Values) ->
- e(AvpName, Values).
-
-%% e/2
-
-e(AvpName, Values) ->
- H = avp_header(AvpName),
- [diameter_codec:pack_avp(H, avp(encode, V, AvpName)) || V <- Values].
-
-%% pack_AVP/2
-
-%% No value: assume AVP data is already encoded. The normal case will
-%% be when this is passed back from #diameter_packet.errors as a
-%% consequence of a failed decode. Any AVP can be encoded this way
-%% however, which side-steps any arity checks for known AVP's and
-%% could potentially encode something unfortunate.
-pack_AVP(_, #diameter_avp{value = undefined} = A) ->
- diameter_codec:pack_avp(A);
-
-%% Missing name for value encode.
-pack_AVP(_, #diameter_avp{name = N, value = V})
- when N == undefined;
- N == 'AVP' ->
- ?THROW([value_with_nameless_avp, N, V]);
-
-%% Or not. Ensure that 'AVP' is the appropriate field. Note that if we
-%% don't know this AVP at all then the encode will fail.
-pack_AVP(Name, #diameter_avp{name = AvpName,
- value = Data}) ->
- 0 == avp_arity(Name, AvpName)
- orelse ?THROW([known_avp_as_AVP, Name, AvpName, Data]),
- e(AvpName, [Data]).
-
-%% ---------------------------------------------------------------------------
-%% # decode_avps/2
-%% ---------------------------------------------------------------------------
-
--spec decode_avps(parent_name(), [#diameter_avp{}])
- -> {parent_record(), [avp()], Failed}
- when Failed :: [{5000..5999, #diameter_avp{}}].
-
-decode_avps(Name, Recs) ->
- {Avps, {Rec, Failed}}
- = lists:foldl(fun(T,A) -> decode(Name, T, A) end,
- {[], {newrec(Name), []}},
- Recs),
- {Rec, Avps, Failed ++ missing(Rec, Name, Failed)}.
-%% Append 5005 errors so that errors are reported in the order
-%% encountered. Failed-AVP should typically contain the first
-%% encountered error accordg to the RFC.
-
-newrec(Name) ->
- '#new-'(name2rec(Name)).
-
-%% 3588:
-%%
-%% DIAMETER_MISSING_AVP 5005
-%% The request did not contain an AVP that is required by the Command
-%% Code definition. If this value is sent in the Result-Code AVP, a
-%% Failed-AVP AVP SHOULD be included in the message. The Failed-AVP
-%% AVP MUST contain an example of the missing AVP complete with the
-%% Vendor-Id if applicable. The value field of the missing AVP
-%% should be of correct minimum length and contain zeros.
-
-missing(Rec, Name, Failed) ->
- Avps = lists:foldl(fun({_, #diameter_avp{code = C, vendor_id = V}}, A) ->
- sets:add_element({C,V}, A)
- end,
- sets:new(),
- Failed),
- [{5005, A} || F <- '#info-'(element(1, Rec), fields),
- not has_arity(avp_arity(Name, F), '#get-'(F, Rec)),
- #diameter_avp{code = C, vendor_id = V}
- = A <- [empty_avp(F)],
- not sets:is_element({C,V}, Avps)].
-
-%% Maximum arities have already been checked in building the record.
-
-has_arity({Min, _}, L) ->
- has_prefix(Min, L);
-has_arity(N, V) ->
- N /= 1 orelse V /= undefined.
-
-%% Compare a non-negative integer and the length of a list without
-%% computing the length.
-has_prefix(0, _) ->
- true;
-has_prefix(_, []) ->
- false;
-has_prefix(N, L) ->
- has_prefix(N-1, tl(L)).
-
-%% empty_avp/1
-
-empty_avp(Name) ->
- {Code, Flags, VId} = avp_header(Name),
- {Name, Type} = avp_name(Code, VId),
- #diameter_avp{name = Name,
- code = Code,
- vendor_id = VId,
- is_mandatory = 0 /= (Flags band 2#01000000),
- need_encryption = 0 /= (Flags band 2#00100000),
- data = empty_value(Name),
- type = Type}.
-
-%% 3588, ch 7:
-%%
-%% The Result-Code AVP describes the error that the Diameter node
-%% encountered in its processing. In case there are multiple errors,
-%% the Diameter node MUST report only the first error it encountered
-%% (detected possibly in some implementation dependent order). The
-%% specific errors that can be described by this AVP are described in
-%% the following section.
-
-%% decode/3
-
-decode(Name, #diameter_avp{code = Code, vendor_id = Vid} = Avp, Acc) ->
- decode(Name, avp_name(Code, Vid), Avp, Acc).
-
-%% decode/4
-
-%% AVP is defined in the dictionary ...
-decode(Name, {AvpName, Type}, Avp, Acc) ->
- d(Name, Avp#diameter_avp{name = AvpName, type = Type}, Acc);
-
-%% ... or not.
-decode(Name, 'AVP', Avp, Acc) ->
- decode_AVP(Name, Avp, Acc).
-
-%% 6733, 4.4:
-%%
-%% Receivers of a Grouped AVP that does not have the 'M' (mandatory)
-%% bit set and one or more of the encapsulated AVPs within the group
-%% has the 'M' (mandatory) bit set MAY simply be ignored if the
-%% Grouped AVP itself is unrecognized. The rule applies even if the
-%% encapsulated AVP with its 'M' (mandatory) bit set is further
-%% encapsulated within other sub-groups, i.e., other Grouped AVPs
-%% embedded within the Grouped AVP.
-%%
-%% The first sentence is slightly mangled, but take it to mean this:
-%%
-%% An unrecognized AVP of type Grouped that does not set the 'M' bit
-%% MAY be ignored even if one of its encapsulated AVPs sets the 'M'
-%% bit.
-%%
-%% The text above is a change from RFC 3588, which instead says this:
-%%
-%% Further, if any of the AVPs encapsulated within a Grouped AVP has
-%% the 'M' (mandatory) bit set, the Grouped AVP itself MUST also
-%% include the 'M' bit set.
-%%
-%% Both of these texts have problems. If the AVP is unknown then its
-%% type is unknown since the type isn't sent over the wire, so the
-%% 6733 text becomes a non-statement: don't know that the AVP not
-%% setting the M-bit is of type Grouped, therefore can't know that its
-%% data consists of encapsulated AVPs, therefore can't but ignore that
-%% one of these might set the M-bit. It should be no worse if we know
-%% the AVP to have type Grouped.
-%%
-%% Similarly, for the 3588 text: if we receive an AVP that doesn't set
-%% the M-bit and don't know that the AVP has type Grouped then we
-%% can't realize that its data contains an AVP that sets the M-bit, so
-%% can't regard the AVP as erroneous on this account. Again, it should
-%% be no worse if the type is known to be Grouped, but in this case
-%% the RFC forces us to regard the AVP as erroneous. This is
-%% inconsistent, and the 3588 text has never been enforced.
-%%
-%% So, if an AVP doesn't set the M-bit then we're free to ignore it,
-%% regardless of the AVP's type. If we know the type to be Grouped
-%% then we must ignore the M-bit on an encapsulated AVP. That means
-%% packing such an encapsulated AVP into an 'AVP' field if need be,
-%% not regarding the lack of a specific field as an error as is
-%% otherwise the case. (The lack of an AVP-specific field being how we
-%% defined the RFC's "unrecognized", which is slightly stronger than
-%% "not defined".)
-
-%% d/3
-
-d(Name, Avp, Acc) ->
- #diameter_avp{name = AvpName,
- data = Data,
- type = Type,
- is_mandatory = M}
- = Avp,
-
- %% Use the process dictionary is to keep track of whether or not
- %% to ignore an M-bit on an encapsulated AVP. Not ideal, but the
- %% alternative requires widespread changes to be able to pass the
- %% value around through the entire decode. The solution here is
- %% simple in comparison, both to implement and to understand.
-
- Strict = relax(Type, M),
-
- %% Use the process dictionary again to keep track of whether we're
- %% decoding within Failed-AVP and should ignore decode errors
- %% altogether.
-
- Failed = relax(Name), %% Not AvpName or else a failed Failed-AVP
- %% decode is packed into 'AVP'.
- Mod = dict(Failed), %% Dictionary to decode in.
-
- %% On decode, a Grouped AVP is represented as a #diameter_avp{}
- %% list with AVP as head and component AVPs as tail. On encode,
- %% data can be a list of component AVPs.
-
- try Mod:avp(decode, Data, AvpName) of
- V ->
- {Avps, T} = Acc,
- {H, A} = ungroup(V, Avp),
- {[H | Avps], pack_avp(Name, A, T)}
- catch
- throw: {?TAG, {grouped, Error, ComponentAvps}} ->
- g(is_failed(), Error, Name, trim(Avp), Acc, ComponentAvps);
- error: Reason ->
- d(is_failed(), Reason, Name, trim(Avp), Acc)
- after
- reset(?STRICT_KEY, Strict),
- reset(?FAILED_KEY, Failed)
- end.
-
-%% trim/1
-%%
-%% Remove any extra bit that was added in diameter_codec to induce a
-%% 5014 error.
-
-trim(#diameter_avp{data = <<0:1, Bin/binary>>} = Avp) ->
- Avp#diameter_avp{data = Bin};
-
-trim(Avps)
- when is_list(Avps) ->
- lists:map(fun trim/1, Avps);
-
-trim(Avp) ->
- Avp.
-
-%% dict/1
-%%
-%% Retrieve the dictionary for the best-effort decode of Failed-AVP,
-%% as put by diameter_codec:decode/2. See that function for the
-%% explanation.
-
-dict(true) ->
- case get({diameter_codec, dictionary}) of
- undefined ->
- ?MODULE;
- Mod ->
- Mod
- end;
-
-dict(_) ->
- ?MODULE.
-
-%% g/5
-
-%% Ignore decode errors within Failed-AVP (best-effort) ...
-g(true, [_Error | Rec], Name, Avp, Acc, _ComponentAvps) ->
- decode_AVP(Name, Avp#diameter_avp{value = Rec}, Acc);
-g(true, _Error, Name, Avp, Acc, _ComponentAvps) ->
- decode_AVP(Name, Avp, Acc);
-
-%% ... or not.
-g(false, [Error | _Rec], _Name, Avp, Acc, ComponentAvps) ->
- g(Error, Avp, Acc, ComponentAvps);
-g(false, Error, _Name, Avp, Acc, ComponentAvps) ->
- g(Error, Avp, Acc, ComponentAvps).
-
-%% g/4
-
-g({RC, ErrorData}, Avp, Acc, ComponentAvps) ->
- {Avps, {Rec, Errors}} = Acc,
- E = Avp#diameter_avp{data = [ErrorData]},
- {[[Avp | trim(ComponentAvps)] | Avps], {Rec, [{RC, E} | Errors]}}.
-
-%% d/5
-
-%% Ignore a decode error within Failed-AVP ...
-d(true, _, Name, Avp, Acc) ->
- decode_AVP(Name, Avp, Acc);
-
-%% ... or not. Failures here won't be visible since they're a "normal"
-%% occurrence if the peer sends a faulty AVP that we need to respond
-%% sensibly to. Log the occurrence for traceability, but the peer will
-%% also receive info in the resulting answer message.
-d(false, Reason, Name, Avp, {Avps, Acc}) ->
- Stack = diameter_lib:get_stacktrace(),
- diameter_lib:log(decode_error,
- ?MODULE,
- ?LINE,
- {Name, Avp#diameter_avp.name, Stack}),
- {Rec, Failed} = Acc,
- {[Avp|Avps], {Rec, [rc(Reason, Avp) | Failed]}}.
-
-%% relax/2
-
-%% Set false in the process dictionary as soon as we see a Grouped AVP
-%% that doesn't set the M-bit, so that is_strict() can say whether or
-%% not to ignore the M-bit on an encapsulated AVP.
-relax('Grouped', M) ->
- case getr(?STRICT_KEY) of
- undefined when not M ->
- putr(?STRICT_KEY, M);
- _ ->
- false
- end;
-relax(_, _) ->
- false.
-
-is_strict() ->
- diameter_codec:getopt(strict_mbit)
- andalso false /= getr(?STRICT_KEY).
-
-%% relax/1
-%%
-%% Set true in the process dictionary as soon as we see Failed-AVP.
-%% Matching on 'Failed-AVP' assumes that this is the RFC AVP.
-%% Strictly, this doesn't need to be the case.
-
-relax('Failed-AVP') ->
- putr(?FAILED_KEY, true);
-
-relax(_) ->
- is_failed().
-
-%% is_failed/0
-%%
-%% Is the AVP currently being decoded nested within Failed-AVP? Note
-%% that this is only true when Failed-AVP is the parent. In
-%% particular, it's not true when Failed-AVP itself is being decoded
-%% (unless nested).
-
-is_failed() ->
- true == getr(?FAILED_KEY).
-
-%% is_failed/1
-
-is_failed(Name) ->
- 'Failed-AVP' == Name orelse is_failed().
-
-%% reset/2
-
-reset(Key, undefined) ->
- eraser(Key);
-reset(_, _) ->
- ok.
-
-%% decode_AVP/3
-%%
-%% Don't know this AVP: see if it can be packed in an 'AVP' field
-%% undecoded. Note that the type field is 'undefined' in this case.
-
-decode_AVP(Name, Avp, {Avps, Acc}) ->
- {[trim(Avp) | Avps], pack_AVP(Name, Avp, Acc)}.
-
-%% rc/1
-
-%% diameter_types will raise an error of this form to communicate
-%% DIAMETER_INVALID_AVP_LENGTH (5014). A module specified to a
-%% @custom_types tag in a dictionary file can also raise an error of
-%% this form.
-rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = Avp) ->
- {RC, Avp#diameter_avp{data = empty_value(AvpName)}};
-
-%% 3588:
-%%
-%% DIAMETER_INVALID_AVP_VALUE 5004
-%% The request contained an AVP with an invalid value in its data
-%% portion. A Diameter message indicating this error MUST include
-%% the offending AVPs within a Failed-AVP AVP.
-rc(_, Avp) ->
- {5004, Avp}.
-
-%% ungroup/2
-
--spec ungroup(term(), #diameter_avp{})
- -> {avp(), #diameter_avp{}}.
-
-%% The decoded value in the Grouped case is as returned by grouped_avp/3:
-%% a record and a list of component AVP's.
-ungroup(V, #diameter_avp{type = 'Grouped'} = Avp) ->
- {Rec, As} = V,
- A = Avp#diameter_avp{value = Rec},
- {[A|As], A};
-
-%% Otherwise it's just a plain value.
-ungroup(V, #diameter_avp{} = Avp) ->
- A = Avp#diameter_avp{value = V},
- {A, A}.
-
-%% pack_avp/3
-
-pack_avp(Name, #diameter_avp{name = AvpName} = Avp, Acc) ->
- pack_avp(Name, avp_arity(Name, AvpName), Avp, Acc).
-
-%% pack_avp/4
-
-pack_avp(Name, 0, Avp, Acc) ->
- pack_AVP(Name, Avp, Acc);
-
-pack_avp(_, Arity, Avp, Acc) ->
- pack(Arity, Avp#diameter_avp.name, Avp, Acc).
-
-%% pack_AVP/3
-
-%% Length failure was induced because of a header/payload length
-%% mismatch. The AVP Length is reset to match the received data if
-%% this AVP is encoded in an answer message, since the length is
-%% computed.
-%%
-%% Data is a truncated header if command_code = undefined, otherwise
-%% payload bytes. The former is padded to the length of a header if
-%% the AVP reaches an outgoing encode in diameter_codec.
-%%
-%% RFC 6733 says that an AVP returned with 5014 can contain a minimal
-%% payload for the AVP's type, but in this case we don't know the
-%% type.
-
-pack_AVP(_, #diameter_avp{data = <<0:1, Data/binary>>} = Avp, Acc) ->
- {Rec, Failed} = Acc,
- {Rec, [{5014, Avp#diameter_avp{data = Data}} | Failed]};
-
-pack_AVP(Name, #diameter_avp{is_mandatory = M, name = AvpName} = Avp, Acc) ->
- case pack_arity(Name, AvpName, M) of
- 0 ->
- {Rec, Failed} = Acc,
- {Rec, [{if M -> 5001; true -> 5008 end, Avp} | Failed]};
- Arity ->
- pack(Arity, 'AVP', Avp, Acc)
- end.
-
-%% Give Failed-AVP special treatment since (1) it'll contain any
-%% unrecognized mandatory AVP's and (2) the RFC 3588 grammar failed to
-%% allow for Failed-AVP in an answer-message.
-
-pack_arity(Name, AvpName, M) ->
-
- %% Not testing just Name /= 'Failed-AVP' means we're changing the
- %% packing of AVPs nested within Failed-AVP, but the point of
- %% ignoring errors within Failed-AVP is to decode as much as
- %% possible, and failing because a mandatory AVP couldn't be
- %% packed into a dedicated field defeats that point. Note
- %% is_failed/1 since is_failed/0 will return false when packing
- %% 'AVP' within Failed-AVP.
-
- pack_arity(is_failed(Name)
- orelse {Name, AvpName} == {'answer-message', 'Failed-AVP'}
- orelse not M
- orelse not is_strict(),
- Name).
-
-pack_arity(true, Name) ->
- avp_arity(Name, 'AVP');
-
-pack_arity(false, _) ->
- 0.
-
-%% 3588:
-%%
-%% DIAMETER_AVP_UNSUPPORTED 5001
-%% The peer received a message that contained an AVP that is not
-%% recognized or supported and was marked with the Mandatory bit. A
-%% Diameter message with this error MUST contain one or more Failed-
-%% AVP AVP containing the AVPs that caused the failure.
-%%
-%% DIAMETER_AVP_NOT_ALLOWED 5008
-%% A message was received with an AVP that MUST NOT be present. The
-%% Failed-AVP AVP MUST be included and contain a copy of the
-%% offending AVP.
-
-%% pack/4
-
-pack(Arity, FieldName, Avp, {Rec, _} = Acc) ->
- pack('#get-'(FieldName, Rec), Arity, FieldName, Avp, Acc).
-
-%% pack/5
-
-pack(undefined, 1, FieldName, Avp, Acc) ->
- p(FieldName, fun(V) -> V end, Avp, Acc);
-
-%% 3588:
-%%
-%% DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009
-%% A message was received that included an AVP that appeared more
-%% often than permitted in the message definition. The Failed-AVP
-%% AVP MUST be included and contain a copy of the first instance of
-%% the offending AVP that exceeded the maximum number of occurrences
-%%
-
-pack(_, 1, _, Avp, {Rec, Failed}) ->
- {Rec, [{5009, Avp} | Failed]};
-pack(L, {_, Max}, FieldName, Avp, Acc) ->
- case '*' /= Max andalso has_prefix(Max, L) of
- true ->
- {Rec, Failed} = Acc,
- {Rec, [{5009, Avp} | Failed]};
- false ->
- p(FieldName, fun(V) -> [V|L] end, Avp, Acc)
- end.
-
-%% p/4
-
-p(F, Fun, Avp, {Rec, Failed}) ->
- {'#set-'({F, Fun(value(F, Avp))}, Rec), Failed}.
-
-value('AVP', Avp) ->
- Avp;
-value(_, Avp) ->
- Avp#diameter_avp.value.
-
-%% ---------------------------------------------------------------------------
-%% # grouped_avp/3
-%% ---------------------------------------------------------------------------
-
--spec grouped_avp(decode, avp_name(), bitstring())
- -> {avp_record(), [avp()]};
- (encode, avp_name(), avp_record() | avp_values())
- -> binary()
- | no_return().
-
-%% Length error induced by diameter_codec:collect_avps/1: the AVP
-%% length in the header was too short (insufficient for the extracted
-%% header) or too long (past the end of the message). An empty payload
-%% is sufficient according to the RFC text for 5014.
-grouped_avp(decode, _Name, <<0:1, _/binary>>) ->
- throw({?TAG, {grouped, {5014, []}, []}});
-
-grouped_avp(decode, Name, Data) ->
- grouped_decode(Name, diameter_codec:collect_avps(Data));
-
-grouped_avp(encode, Name, Data) ->
- encode_avps(Name, Data).
-
-%% grouped_decode/2
-%%
-%% Note that Grouped is the only AVP type that doesn't just return a
-%% decoded value, also returning the list of component diameter_avp
-%% records.
-
-%% Length error in trailing component AVP.
-grouped_decode(_Name, {Error, Acc}) ->
- {5014, Avp} = Error,
- throw({?TAG, {grouped, Error, [Avp | Acc]}});
-
-%% 7.5. Failed-AVP AVP
-
-%% In the case where the offending AVP is embedded within a Grouped AVP,
-%% the Failed-AVP MAY contain the grouped AVP, which in turn contains
-%% the single offending AVP. The same method MAY be employed if the
-%% grouped AVP itself is embedded in yet another grouped AVP and so on.
-%% In this case, the Failed-AVP MAY contain the grouped AVP hierarchy up
-%% to the single offending AVP. This enables the recipient to detect
-%% the location of the offending AVP when embedded in a group.
-
-%% An error in decoding a component AVP throws the first fauly
-%% component, which the catch in d/3 wraps in the Grouped AVP in
-%% question. A partially decoded record is only used when ignoring
-%% errors in Failed-AVP.
-grouped_decode(Name, ComponentAvps) ->
- {Rec, Avps, Es} = decode_avps(Name, ComponentAvps),
- [] == Es orelse throw({?TAG, {grouped, [{_,_} = hd(Es) | Rec], Avps}}),
- {Rec, Avps}.
-
-%% ---------------------------------------------------------------------------
-%% # empty_group/1
-%% ---------------------------------------------------------------------------
-
-empty_group(Name) ->
- list_to_binary(empty_body(Name)).
-
-empty_body(Name) ->
- [z(F, avp_arity(Name, F)) || F <- '#info-'(name2rec(Name), fields)].
-
-z(Name, 1) ->
- z(Name);
-z(_, {0,_}) ->
- [];
-z(Name, {Min, _}) ->
- lists:duplicate(Min, z(Name)).
-
-z('AVP') ->
- <<0:64/integer>>; %% minimal header
-z(Name) ->
- Bin = diameter_codec:pack_avp(avp_header(Name), empty_value(Name)),
- << <<0>> || <<_>> <= Bin >>.
-
-%% ---------------------------------------------------------------------------
-%% # empty/1
-%% ---------------------------------------------------------------------------
-
-empty(AvpName) ->
- avp(encode, zero, AvpName).
+empty(Name, Opts) ->
+ diameter_gen:empty(Name, Opts).
diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
index 253f64133c..bd92e16fba 100644
--- a/lib/diameter/src/base/diameter.erl
+++ b/lib/diameter/src/base/diameter.erl
@@ -406,4 +406,5 @@ call(SvcName, App, Message) ->
:: {extra, list()}
| {filter, peer_filter()}
| {timeout, 'Unsigned32'()}
+ | {peer, peer_ref()}
| detach.
diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl
index 07a678c617..62b05644b2 100644
--- a/lib/diameter/src/base/diameter_capx.erl
+++ b/lib/diameter/src/base/diameter_capx.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2015. 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.
@@ -94,6 +94,9 @@ recv_CER(CER, Svc, Dict) ->
recv_CEA(CEA, Svc, Dict) ->
try_it([fun rCEA/3, CEA, Svc, Dict]).
+-spec make_caps(#diameter_caps{}, [{atom(), term()}])
+ -> tried(#diameter_caps{}).
+
make_caps(Caps, Opts) ->
try_it([fun mk_caps/2, Caps, Opts]).
@@ -110,31 +113,20 @@ try_it([Fun | Args]) ->
%% mk_caps/2
mk_caps(Caps0, Opts) ->
- {Caps, _} = lists:foldl(fun set_cap/2,
- {Caps0, #diameter_caps{_ = false}},
- Opts),
- Caps.
-
--define(SC(K,F),
- set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) ->
- {Caps#diameter_caps{F = cap(K, copy(Val))},
- C#diameter_caps{F = true}}).
-
-?SC('Origin-Host', origin_host);
-?SC('Origin-Realm', origin_realm);
-?SC('Host-IP-Address', host_ip_address);
-?SC('Vendor-Id', vendor_id);
-?SC('Product-Name', product_name);
-?SC('Origin-State-Id', origin_state_id);
-?SC('Supported-Vendor-Id', supported_vendor_id);
-?SC('Auth-Application-Id', auth_application_id);
-?SC('Inband-Security-Id', inband_security_id);
-?SC('Acct-Application-Id', acct_application_id);
-?SC('Vendor-Specific-Application-Id', vendor_specific_application_id);
-?SC('Firmware-Revision', firmware_revision);
-
-set_cap({Key, _}, _) ->
- ?THROW({duplicate, Key}).
+ Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER, fields),
+ Defs = lists:zip(Fields, tl(tuple_to_list(Caps0))),
+ Unset = maps:from_list([{F, true} || F <- lists:droplast(Fields)]), %% no 'AVP'
+ {Caps, _} = lists:foldl(fun set_cap/2, {Defs, Unset}, Opts),
+ #diameter_caps{} = list_to_tuple([diameter_caps | [V || {_,V} <- Caps]]).
+
+set_cap({F,V}, {Caps, Unset}) ->
+ case Unset of
+ #{F := true} ->
+ {lists:keyreplace(F, 1, Caps, {F, cap(F, copy(V))}),
+ maps:remove(F, Unset)};
+ _ ->
+ ?THROW({duplicate, F})
+ end.
cap(K, V)
when K == 'Origin-Host';
@@ -349,7 +341,7 @@ cs(LS, RS) ->
cea_from_cer(CER, Dict) ->
RecName = Dict:msg2rec('CEA'),
[_ | Values] = Dict:'#get-'(CER),
- Dict:'#set-'(Values, Dict:'#new-'(RecName)).
+ Dict:'#new-'([RecName | Values]).
%% rCEA/3
@@ -424,7 +416,48 @@ bcaps(N, Caps) ->
%% common_applications/3
%%
%% Identify the (local) applications to be supported on the connection
-%% in question.
+%% in question. The RFC says this:
+%%
+%% 2.4 Application Identifiers
+%%
+%% Relay and redirect agents MUST advertise the Relay Application ID,
+%% while all other Diameter nodes MUST advertise locally supported
+%% applications.
+%%
+%% Taken literally, every Diameter node should then advertise support
+%% for the Diameter common messages application, with id 0, since no
+%% node can perform capabilities exchange without it. Expecting this,
+%% or regarding the support as implicit, renders the Result-Code 5010
+%% (DIAMETER_NO_COMMON_APPLICATION) meaningless however, since every
+%% node would regard the common application as being in common with
+%% the peer. In practice, nodes may or may not advertise support for
+%% Diameter common messages.
+%%
+%% That only explicitly advertised applications should be considered
+%% when computing the intersection with the peer is supported here:
+%%
+%% 5.3. Capabilities Exchange
+%%
+%% The receiver of the Capabilities-Exchange-Request (CER) MUST
+%% determine common applications by computing the intersection of its
+%% own set of supported Application Ids against all of the
+%% Application-Id AVPs (Auth-Application-Id, Acct-Application-Id, and
+%% Vendor-Specific-Application-Id) present in the CER.
+%%
+%% The same section also has the following about capabilities exchange
+%% messages.
+%%
+%% The receiver only issues commands to its peers that have advertised
+%% support for the Diameter application that defines the command.
+%%
+%% This statement is also difficult to interpret literally since it
+%% would disallow D[WP]R and more when Diameter common messages isn't
+%% advertised. In practice, diameter lets requests be sent as long as
+%% there's a dictionary configured to support it, peer selection by
+%% advertised application being possible to preempt by passing
+%% candidate peers directly to diameter:call/4. The peer can always
+%% answer 3001 (DIAMETER_COMMAND_UNSUPPORTED) or 3007
+%% (DIAMETER_APPLICATION_UNSUPPORTED) if this is objectionable.
common_applications(LCaps, RCaps, #diameter_service{applications = Apps}) ->
LA = app_union(LCaps),
diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl
index 1ea5357924..82fa796e69 100644
--- a/lib/diameter/src/base/diameter_codec.erl
+++ b/lib/diameter/src/base/diameter_codec.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2015. 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.
@@ -20,11 +20,8 @@
-module(diameter_codec).
--export([encode/2,
- decode/2,
- decode/3,
- setopts/1,
- getopt/1,
+-export([encode/2, encode/3,
+ decode/2, decode/3, decode/4,
collect_avps/1,
decode_header/1,
sequence_numbers/1,
@@ -33,13 +30,17 @@
msg_id/1]).
%% Towards generated encoders (from diameter_gen.hrl).
--export([pack_avp/1,
+-export([pack_data/2,
pack_avp/2]).
-include_lib("diameter/include/diameter.hrl").
-include("diameter_internal.hrl").
--define(MASK(N,I), ((I) band (1 bsl (N)))).
+-define(PAD(Len), ((4 - (Len rem 4)) rem 4)).
+-define(BIT(B,I), (if B -> I; true -> 0 end)).
+-define(BIT(B), ?BIT(B,1)).
+-define(FLAGS(R,P,E,T), ?BIT(R):1, ?BIT(P):1, ?BIT(E):1, ?BIT(T):1, 0:4).
+-define(FLAG(B,D), (if is_boolean(B) -> B; true -> 0 /= (D) end)).
-type u32() :: 0..16#FFFFFFFF.
-type u24() :: 0..16#FFFFFF.
@@ -62,62 +63,29 @@
%% +-+-+-+-+-+-+-+-+-+-+-+-+-
%%% ---------------------------------------------------------------------------
-%%% # setopts/1
-%%% # getopt/1
+%%% # encode/2
%%% ---------------------------------------------------------------------------
-%% These functions are a compromise in the same vein as the use of the
-%% process dictionary in diameter_gen.hrl in generated codec modules.
-%% Instead of rewriting the entire dictionary generation to pass
-%% encode/decode options around, the calling process sets them by
-%% calling setopts/1. At current, the only option is whether or not to
-%% decode binaries as strings, which is used by diameter_types.
-
-setopts(Opts)
- when is_list(Opts) ->
- lists:foreach(fun setopt/1, Opts).
-
-%% The default string_decode true is for backwards compatibility.
-setopt({K, false = B})
- when K == string_decode;
- K == strict_mbit ->
- setopt(K, B);
-
-%% Regard anything but the generated RFC 3588 dictionary as modern.
-%% This affects the interpretation of defaults during the decode
-%% of values of type DiameterURI, this having changed from RFC 3588.
-%% (So much for backwards compatibility.)
-setopt({common_dictionary, diameter_gen_base_rfc3588}) ->
- setopt(rfc, 3588);
-
-setopt(_) ->
- ok.
-
-setopt(Key, Value) ->
- put({diameter, Key}, Value).
-
-getopt(Key) ->
- case get({diameter, Key}) of
- undefined when Key == string_decode;
- Key == strict_mbit ->
- true;
- undefined when Key == rfc ->
- 6733;
- V ->
- V
- end.
+%% The representative encode documented in diameter_codec(3). As of
+%% the options that affect encode (eg. ordered_encode), it's no longer
+%% *the* encode.
+
+encode(Mod, Msg) ->
+ encode(Mod, #{ordered_encode => true}, Msg).
%%% ---------------------------------------------------------------------------
-%%% # encode/2
+%%% # encode/3
%%% ---------------------------------------------------------------------------
--spec encode(module(), Msg :: term())
+-spec encode(module(),
+ map(),
+ Msg :: term())
-> #diameter_packet{}
| no_return().
-encode(Mod, #diameter_packet{} = Pkt) ->
+encode(Mod, Opts, #diameter_packet{} = Pkt) ->
try
- e(Mod, Pkt)
+ enc(Mod, Opts, Pkt)
catch
exit: {Reason, Stack, #diameter_header{} = H} = T ->
%% Exit with a header in the reason to let the caller
@@ -130,91 +98,97 @@ encode(Mod, #diameter_packet{} = Pkt) ->
exit({?MODULE, encode, T})
end;
-encode(Mod, Msg) ->
+encode(Mod, Opts, Msg) ->
Seq = diameter_session:sequence(),
Hdr = #diameter_header{version = ?DIAMETER_VERSION,
end_to_end_id = Seq,
hop_by_hop_id = Seq},
- encode(Mod, #diameter_packet{header = Hdr,
- msg = Msg}).
+ encode(Mod, Opts, #diameter_packet{header = Hdr,
+ msg = Msg}).
+
+%% enc/3
-e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) ->
- try encode_avps(reorder(As)) of
+enc(_, Opts, #diameter_packet{msg = [#diameter_header{} = Hdr | As]}
+ = Pkt) ->
+ try encode_avps(reorder(As), Opts) of
Avps ->
- Length = size(Avps) + 20,
+ Bin = list_to_binary(Avps),
+ Len = 20 + size(Bin),
#diameter_header{version = Vsn,
+ is_request = R,
+ is_proxiable = P,
+ is_error = E,
+ is_retransmitted = T,
cmd_code = Code,
application_id = Aid,
hop_by_hop_id = Hid,
end_to_end_id = Eid}
= Hdr,
- Flags = make_flags(0, Hdr),
-
Pkt#diameter_packet{header = Hdr,
- bin = <<Vsn:8, Length:24,
- Flags:8, Code:24,
+ bin = <<Vsn:8, Len:24,
+ ?FLAGS(R,P,E,T), Code:24,
Aid:32,
Hid:32,
Eid:32,
- Avps/binary>>}
+ Bin/binary>>}
catch
error: Reason ->
exit({Reason, diameter_lib:get_stacktrace(), Hdr})
end;
-e(Mod, #diameter_packet{header = Hdr0, msg = Msg} = Pkt) ->
+enc(Mod, Opts, #diameter_packet{header = Hdr0, msg = Msg} = Pkt) ->
+ MsgName = rec2msg(Mod, Msg),
+ {Code, Flags, Aid} = msg_header(Mod, MsgName, Hdr0),
+
#diameter_header{version = Vsn,
+ is_request = R,
+ is_proxiable = P,
+ is_error = E,
+ is_retransmitted = T,
hop_by_hop_id = Hid,
end_to_end_id = Eid}
= Hdr0,
- MsgName = rec2msg(Mod, Msg),
- {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr0),
- Flags = make_flags(Flags0, Hdr0),
- Hdr = Hdr0#diameter_header{cmd_code = Code,
- application_id = Aid,
- is_request = 0 /= ?MASK(7, Flags),
- is_proxiable = 0 /= ?MASK(6, Flags),
- is_error = 0 /= ?MASK(5, Flags),
- is_retransmitted = 0 /= ?MASK(4, Flags)},
+ RB = ?FLAG(R, Flags band 2#10000000),
+ PB = ?FLAG(P, Flags band 2#01000000),
+ EB = ?FLAG(E, Flags band 2#00100000),
+ TB = ?FLAG(T, Flags band 2#00010000),
+
Values = values(Msg),
- try encode_avps(Mod, MsgName, Values) of
+ try encode_avps(Mod, MsgName, Values, Opts) of
Avps ->
- Length = size(Avps) + 20,
- Pkt#diameter_packet{header = Hdr#diameter_header{length = Length},
- bin = <<Vsn:8, Length:24,
- Flags:8, Code:24,
+ Bin = list_to_binary(Avps),
+ Len = 20 + size(Bin),
+
+ Hdr = Hdr0#diameter_header{length = Len,
+ cmd_code = Code,
+ application_id = Aid,
+ is_request = RB,
+ is_proxiable = PB,
+ is_error = EB,
+ is_retransmitted = TB},
+
+ Pkt#diameter_packet{header = Hdr,
+ bin = <<Vsn:8, Len:24,
+ ?FLAGS(RB, PB, EB, TB), Code:24,
Aid:32,
Hid:32,
Eid:32,
- Avps/binary>>}
+ Bin/binary>>}
catch
error: Reason ->
+ Hdr = Hdr0#diameter_header{cmd_code = Code,
+ application_id = Aid,
+ is_request = RB,
+ is_proxiable = PB,
+ is_error = EB,
+ is_retransmitted = TB},
exit({Reason, diameter_lib:get_stacktrace(), Hdr})
end.
-%% make_flags/2
-
-make_flags(Flags0, #diameter_header{is_request = R,
- is_proxiable = P,
- is_error = E,
- is_retransmitted = T}) ->
- {Flags, 3} = lists:foldl(fun(B,{F,N}) -> {mf(B,F,N), N-1} end,
- {Flags0, 7},
- [R,P,E,T]),
- Flags.
-
-mf(undefined, F, _) ->
- F;
-mf(B, F, N) -> %% reset the affected bit
- (F bxor (F band (1 bsl N))) bor bit(B, N).
-
-bit(true, N) -> 1 bsl N;
-bit(false, _) -> 0.
-
%% values/1
values([H|T])
@@ -223,7 +197,7 @@ values([H|T])
values(Avps) ->
Avps.
-%% encode_avps/3
+%% encode_avps/4
%% Specifying values as a #diameter_avp list bypasses arity and other
%% checks: the values are expected to be already encoded and the AVP's
@@ -231,12 +205,12 @@ values(Avps) ->
%% these have to be able to resend whatever comes.
%% Message as a list of #diameter_avp{} ...
-encode_avps(_, _, [#diameter_avp{} | _] = Avps) ->
- encode_avps(reorder(Avps));
+encode_avps(_, _, [#diameter_avp{} | _] = Avps, Opts) ->
+ encode_avps(reorder(Avps), Opts);
%% ... or as a tuple list or record.
-encode_avps(Mod, MsgName, Values) ->
- Mod:encode_avps(MsgName, Values).
+encode_avps(Mod, MsgName, Values, Opts) ->
+ Mod:encode_avps(MsgName, Values, Opts).
%% reorder/1
%%
@@ -277,10 +251,10 @@ reorder([H | T], Acc) ->
reorder([], _) ->
false.
-%% encode_avps/1
+%% encode_avps/2
-encode_avps(Avps) ->
- list_to_binary(lists:map(fun pack_avp/1, Avps)).
+encode_avps(Avps, Opts) ->
+ [pack_avp(A, Opts) || A <- Avps].
%% msg_header/3
@@ -308,38 +282,50 @@ rec2msg(Mod, Rec) ->
%%% # decode/2
%%% ---------------------------------------------------------------------------
+%% The representative default decode documented in diameter_codec(3).
+%% As of the options that affect decode (eg. string_decode), it's no
+%% longer *the* decode.
+
+decode(Mod, Pkt) ->
+ Opts = #{string_decode => true,
+ strict_mbit => true,
+ rfc => 6733},
+ decode(Mod, Opts, Pkt).
+
+%%% ---------------------------------------------------------------------------
+%%% # decode/3
+%%% ---------------------------------------------------------------------------
+
%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors.
--spec decode(module() | {module(), module()}, #diameter_packet{} | binary())
+-spec decode(module() | {module(), module()},
+ map(),
+ #diameter_packet{} | binary())
-> #diameter_packet{}.
%% An Answer setting the E-bit. The application dictionary is needed
-%% for the best-effort decode of Failed-AVP, and the best way to make
-%% this available to the AVP decode in diameter_gen.hrl, without
-%% having to rewrite the entire codec generation, is to place it in
-%% the process dictionary. It's the code in diameter_gen.hrl (that's
-%% included by every generated codec module) that looks for the entry.
-%% Not ideal, but it solves the problem relatively simply.
-decode({Mod, Mod}, Pkt) ->
- decode(Mod, Pkt);
-decode({Mod, AppMod}, Pkt) ->
- Key = {?MODULE, dictionary},
- put(Key, AppMod),
- try
- decode(Mod, Pkt)
- after
- erase(Key)
- end;
+%% for the best-effort decode of Failed-AVP.
+decode({Mod, AppMod}, Opts, Pkt) ->
+ decode(Mod, AppMod, Opts, Pkt);
%% Or not: a request, or an answer not setting the E-bit.
-decode(Mod, Pkt) ->
- decode(Mod:id(), Mod, Pkt).
+decode(Mod, Opts, Pkt) ->
+ decode(Mod, Mod, Opts, Pkt).
+
+%% decode/4
+
+decode(Id, Mod, Opts, Pkt)
+ when is_integer(Id) ->
+ decode(Id, Mod, Mod, Opts, Pkt);
-%% decode/3
+decode(Mod, AppMod, Opts, Pkt) ->
+ decode(Mod:id(), Mod, AppMod, Opts, Pkt).
+
+%% decode/5
%% Relay application: just extract the avp's without any decoding of
%% their data since we don't know the application in question.
-decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) ->
+decode(?APP_ID_RELAY, _, _, _, #diameter_packet{} = Pkt) ->
case collect_avps(Pkt) of
{E, As} ->
Pkt#diameter_packet{avps = As,
@@ -349,7 +335,7 @@ decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) ->
end;
%% Otherwise decode using the dictionary.
-decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) ->
+decode(_, Mod, AppMod, Opts, #diameter_packet{header = Hdr} = Pkt) ->
#diameter_header{cmd_code = CmdCode,
is_request = IsRequest,
is_error = IsError}
@@ -361,29 +347,33 @@ decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) ->
Mod:msg_name(CmdCode, IsRequest)
end,
- decode_avps(MsgName, Mod, Pkt, collect_avps(Pkt));
+ decode_avps(MsgName, Mod, AppMod, Opts, Pkt, collect_avps(Pkt));
-decode(Id, Mod, Bin)
+decode(Id, Mod, AppMod, Opts, Bin)
when is_binary(Bin) ->
- decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}).
+ decode(Id, Mod, AppMod, Opts, #diameter_packet{header = decode_header(Bin),
+ bin = Bin}).
-%% decode_avps/4
+%% decode_avps/6
-decode_avps(MsgName, Mod, Pkt, {E, Avps}) ->
+decode_avps(MsgName, Mod, AppMod, Opts, Pkt, {E, Avps}) ->
?LOG(invalid_avp_length, Pkt#diameter_packet.header),
#diameter_packet{errors = Failed}
= P
- = decode_avps(MsgName, Mod, Pkt, Avps),
+ = decode_avps(MsgName, Mod, AppMod, Opts, Pkt, Avps),
P#diameter_packet{errors = [E | Failed]};
-decode_avps('', _, Pkt, Avps) -> %% unknown message ...
+decode_avps('', _, _, _, Pkt, Avps) -> %% unknown message ...
?LOG(unknown_message, Pkt#diameter_packet.header),
Pkt#diameter_packet{avps = lists:reverse(Avps),
errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED
%% msg = undefined identifies this case.
-decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not
- {Rec, As, Errors} = Mod:decode_avps(MsgName, Avps),
+decode_avps(MsgName, Mod, AppMod, Opts, Pkt, Avps) -> %% ... or not
+ {Rec, As, Errors} = Mod:decode_avps(MsgName,
+ Avps,
+ Opts#{dictionary => AppMod,
+ failed_avp => false}),
?LOGC([] /= Errors, decode_errors, Pkt#diameter_packet.header),
Pkt#diameter_packet{msg = Rec,
errors = Errors,
@@ -399,14 +389,12 @@ decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not
decode_header(<<Version:8,
MsgLength:24,
- CmdFlags:1/binary,
+ R:1, P:1, E:1, T:1, _:4,
CmdCode:24,
ApplicationId:32,
HopByHopId:32,
EndToEndId:32,
_/binary>>) ->
- <<R:1, P:1, E:1, T:1, _:4>>
- = CmdFlags,
%% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored
%% by the receiver.
@@ -518,7 +506,7 @@ msg_id(#diameter_packet{header = #diameter_header{} = Hdr}) ->
msg_id(#diameter_header{application_id = A,
cmd_code = C,
is_request = R}) ->
- {A, C, if R -> 1; true -> 0 end};
+ {A, C, ?BIT(R)};
msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/binary>>) ->
{ApplId, CmdCode, Rbit}.
@@ -537,24 +525,14 @@ msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/binary>>) ->
when Avp :: #diameter_avp{},
Error :: {5014, #diameter_avp{}}.
-collect_avps(#diameter_packet{bin = Bin}) ->
- <<_:20/binary, Avps/binary>> = Bin,
- collect_avps(Avps);
+collect_avps(#diameter_packet{bin = <<_:20/binary, Avps/binary>>}) ->
+ collect_avps(Avps, 0, []);
collect_avps(Bin)
when is_binary(Bin) ->
collect_avps(Bin, 0, []).
-collect_avps(<<>>, _, Acc) ->
- Acc;
-collect_avps(Bin, N, Acc) ->
- try split_avp(Bin) of
- {Rest, AVP} ->
- collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc])
- catch
- ?FAILURE(Error) ->
- {Error, Acc}
- end.
+%% collect_avps/3
%% 0 1 2 3
%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
@@ -568,32 +546,65 @@ collect_avps(Bin, N, Acc) ->
%% | Data ...
%% +-+-+-+-+-+-+-+-+
-%% split_avp/1
+collect_avps(<<Code:32, V:1, M:1, P:1, _:5, Len:24, I:V/unit:32, Rest/binary>>,
+ N,
+ Acc) ->
+ collect_avps(Code,
+ if 1 == V -> I; 0 == V -> undefined end,
+ 1 == M,
+ 1 == P,
+ Len - 8 - V*4, %% Might be negative, which ensures
+ ?PAD(Len), %% failure of the Data match below.
+ Rest,
+ N,
+ Acc);
-split_avp(Bin) ->
- {Code, V, M, P, Len, HdrLen} = split_head(Bin),
-
- <<_:HdrLen/binary, Rest/binary>> = Bin,
- {Data, B} = split_data(Rest, Len - HdrLen),
-
- {B, #diameter_avp{code = Code,
- vendor_id = V,
- is_mandatory = 1 == M,
- need_encryption = 1 == P,
- data = Data}}.
-
-%% split_head/1
-
-split_head(<<Code:32, 1:1, M:1, P:1, _:5, Len:24, V:32, _/binary>>) ->
- {Code, V, M, P, Len, 12};
+collect_avps(<<>>, _, Acc) ->
+ Acc;
-split_head(<<Code:32, 0:1, M:1, P:1, _:5, Len:24, _/binary>>) ->
- {Code, undefined, M, P, Len, 8};
+%% Header is truncated. pack_avp/1 will pad this at encode if sent in
+%% a Failed-AVP.
+collect_avps(Bin, _, Acc) ->
+ {{5014, #diameter_avp{data = Bin}}, Acc}.
+
+%% collect_avps/9
+
+%% Duplicate the diameter_avp creation in each branch below to avoid
+%% modifying the record, which profiling has shown to be a relatively
+%% costly part of building the list.
+
+collect_avps(Code, VendorId, M, P, Len, Pad, Rest, N, Acc) ->
+ case Rest of
+ <<Data:Len/binary, _:Pad/binary, T/binary>> ->
+ Avp = #diameter_avp{code = Code,
+ vendor_id = VendorId,
+ is_mandatory = M,
+ need_encryption = P,
+ data = Data,
+ index = N},
+ collect_avps(T, N+1, [Avp | Acc]);
+ _ ->
+ %% Length in header points past the end of the message, or
+ %% doesn't span the header. As stated in the 6733 text
+ %% above, it's sufficient to return a zero-filled minimal
+ %% payload if this is a request. Do this (in cases that we
+ %% know the type) by inducing a decode failure and letting
+ %% the dictionary's decode (in diameter_gen) deal with it.
+ %%
+ %% Note that the extra bit can only occur in the trailing
+ %% AVP of a message or Grouped AVP, since a faulty AVP
+ %% Length is otherwise indistinguishable from a correct
+ %% one here, as we don't know the types of the AVPs being
+ %% extracted.
+ Avp = #diameter_avp{code = Code,
+ vendor_id = VendorId,
+ is_mandatory = M,
+ need_encryption = P,
+ data = {5014, Rest},
+ index = N},
+ [Avp | Acc]
+ end.
-%% Header is truncated.
-split_head(Bin) ->
- ?THROW({5014, #diameter_avp{data = Bin}}).
-%% Note that pack_avp/1 will pad this at encode if sent in a Failed-AVP.
%% 3588:
%%
@@ -626,35 +637,8 @@ split_head(Bin) ->
%% the minimum value mean we might not know the identity of the AVP and
%% (2) the last sentence covers this case.
-%% split_data/3
-
-split_data(Bin, Len) ->
- Pad = (4 - (Len rem 4)) rem 4,
-
- %% Len might be negative here, but that ensures the failure of the
- %% binary match.
-
- case Bin of
- <<Data:Len/binary, _:Pad/binary, Rest/binary>> ->
- {Data, Rest};
- _ ->
- %% Header length points past the end of the message, or
- %% doesn't span the header. As stated in the 6733 text
- %% above, it's sufficient to return a zero-filled minimal
- %% payload if this is a request. Do this (in cases that we
- %% know the type) by inducing a decode failure and letting
- %% the dictionary's decode (in diameter_gen) deal with it.
- %%
- %% Note that the extra bit can only occur in the trailing
- %% AVP of a message or Grouped AVP, since a faulty AVP
- %% Length is otherwise indistinguishable from a correct
- %% one here, since we don't know the types of the AVPs
- %% being extracted.
- {<<0:1, Bin/binary>>, <<>>}
- end.
-
%%% ---------------------------------------------------------------------------
-%%% # pack_avp/1
+%%% # pack_avp/2
%%% ---------------------------------------------------------------------------
%% The normal case here is data as an #diameter_avp{} list or an
@@ -664,104 +648,96 @@ split_data(Bin, Len) ->
%% Decoded Grouped AVP with decoded components: ignore components
%% since they're already encoded in the Grouped AVP.
-pack_avp([#diameter_avp{} = Grouped | _Components]) ->
- pack_avp(Grouped);
+pack_avp([#diameter_avp{} = Grouped | _Components], Opts) ->
+ pack_avp(Grouped, Opts);
%% Grouped AVP whose components need packing. It's intentional that
%% this isn't equivalent to [Grouped | Components]: here the
%% components need to be encoded before wrapping with the Grouped AVP,
%% and the list is flat, nesting being accomplished in the data
%% fields.
-pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Components} = Grouped) ->
- pack_avp(Grouped#diameter_avp{data = encode_avps(Components)});
+pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Components}
+ = Grouped,
+ Opts) ->
+ pack_data(Grouped, encode_avps(Components, Opts));
%% Data as a type/value tuple ...
-pack_avp(#diameter_avp{data = {Type, Value}} = A)
+pack_avp(#diameter_avp{data = {Type, Value}} = A, Opts)
when is_atom(Type) ->
- pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)});
+ pack_data(A, diameter_types:Type(encode, Value, Opts));
%% ... with a header in various forms ...
-pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) ->
- pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value)));
+pack_avp(#diameter_avp{data = {T, {Type, Value}}}, Opts) ->
+ pack_data(T, diameter_types:Type(encode, Value, Opts));
-pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}})
- when is_binary(Bin) ->
- pack_avp(T, Bin);
+pack_avp(#diameter_avp{data = {T, Data}}, _) ->
+ pack_data(T, Data);
-pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) ->
- {Code, _Flags, Vid} = Hdr = Dict:avp_header(Name),
- {Name, Type} = Dict:avp_name(Code, Vid),
- pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}});
+pack_avp(#diameter_avp{data = {Dict, Name, Data}}, Opts) ->
+ pack_data(Dict:avp_header(Name), Dict:avp(encode, Data, Name, Opts));
%% ... with a truncated header ...
-pack_avp(#diameter_avp{code = undefined, data = B})
+pack_avp(#diameter_avp{code = undefined, data = B}, _)
when is_binary(B) ->
%% Reset the AVP Length of an AVP Header resulting from a 5014
%% error. The RFC doesn't explicitly say to do this but the
%% receiver can't correctly extract this and following AVP's
%% without a correct length. On the downside, the header doesn't
- %% reveal if the received header has been padded.
- Pad = 8*header_length(B) - bit_size(B),
- Len = size(<<H:5/binary, _:24, T/binary>> = <<B/binary, 0:Pad>>),
- <<H/binary, Len:24, T/binary>>;
-
-%% ... when ignoring errors in Failed-AVP ...
-%% ... during a relay encode ...
-pack_avp(#diameter_avp{data = <<0:1, B/binary>>} = A) ->
- pack_avp(A#diameter_avp{data = B});
-
-%% ... or as an iolist.
-pack_avp(#diameter_avp{code = Code,
- vendor_id = V,
- is_mandatory = M,
- need_encryption = P,
- data = Data}) ->
- Flags = lists:foldl(fun flag_avp/2, 0, [{V /= undefined, 2#10000000},
- {M, 2#01000000},
- {P, 2#00100000}]),
- pack_avp({Code, Flags, V}, iolist_to_binary(Data)).
-
-header_length(<<_:32, 1:1, _/bitstring>>) ->
+ %% reveal if the received header has been padded. Discard bytes
+ %% from the length header for this reason, to avoid creating a sub
+ %% binary for no useful reason.
+ Len = header_length(B),
+ Sz = min(5, size(B)),
+ <<B:Sz/binary, 0:(5-Sz)/unit:8, Len:24, 0:(Len-8)/unit:8>>;
+
+%% Ignoring errors in Failed-AVP or during a relay encode.
+pack_avp(#diameter_avp{data = {5014, Data}} = A, _) ->
+ pack_data(A, Data);
+
+pack_avp(#diameter_avp{data = Data} = A, _) ->
+ pack_data(A, Data).
+
+header_length(<<_:32, 1:1, _/bits>>) ->
12;
header_length(_) ->
8.
-flag_avp({true, B}, F) ->
- F bor B;
-flag_avp({false, _}, F) ->
- F.
-
%%% ---------------------------------------------------------------------------
-%%% # pack_avp/2
+%%% # pack_data/2
%%% ---------------------------------------------------------------------------
-pack_avp({Code, Flags, VendorId}, Bin)
- when is_binary(Bin) ->
- Sz = size(Bin),
- pack_avp(Code, Flags, VendorId, Sz, pad(Sz rem 4, Bin)).
-
-pad(0, Bin) ->
- Bin;
-pad(N, Bin) ->
- P = 8*(4-N),
- <<Bin/binary, 0:P>>.
-%% Note that padding is not included in the length field as mandated by
-%% the RFC.
-
-%% pack_avp/5
+pack_data(#diameter_avp{code = Code,
+ vendor_id = V,
+ is_mandatory = M,
+ need_encryption = P},
+ Data) ->
+ Flags = ?BIT(V /= undefined, 2#10000000)
+ bor ?BIT(M, 2#01000000)
+ bor ?BIT(P, 2#00100000),
+ pack(Code, Flags, V, Data);
+
+pack_data({Code, Flags, VendorId}, Data) ->
+ pack(Code, Flags, VendorId, Data).
+
+%% pack/4
+
+pack(Code, Flags, VendorId, Data) ->
+ Sz = iolist_size(Data),
+ pack(Code, Flags, Sz, VendorId, Data, ?PAD(Sz)).
+%% Padding is not included in the length field, as mandated by the RFC.
+
+%% pack/6
%%
%% Prepend the vendor id as required.
-pack_avp(Code, Flags, Vid, Sz, Bin)
+pack(Code, Flags, Sz, _Vid, Data, Pad)
when 0 == Flags band 2#10000000 ->
- undefined = Vid, %% sanity check
- pack_avp(Code, Flags, Sz, Bin);
+ pack(Code, Flags, Sz, 0, 0, Data, Pad);
-pack_avp(Code, Flags, Vid, Sz, Bin) ->
- pack_avp(Code, Flags, Sz+4, <<Vid:32, Bin/binary>>).
+pack(Code, Flags, Sz, Vid, Data, Pad) ->
+ pack(Code, Flags, Sz+4, Vid, 1, Data, Pad).
-%% pack_avp/4
+%% pack/7
-pack_avp(Code, Flags, Sz, Bin) ->
- Length = Sz + 8,
- <<Code:32, Flags:8, Length:24, Bin/binary>>.
+pack(Code, Flags, Sz, VId, V, Data, Pad) ->
+ [<<Code:32, Flags:8, (8+Sz):24, VId:V/unit:32>>, Data, <<0:Pad/unit:8>>].
diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl
index e10804c931..34018ae6d3 100644
--- a/lib/diameter/src/base/diameter_config.erl
+++ b/lib/diameter/src/base/diameter_config.erl
@@ -277,7 +277,7 @@ start_link() ->
start_link(T) ->
proc_lib:start_link(?MODULE, init, [T], infinity, []).
-
+
state() ->
call(state).
@@ -535,12 +535,12 @@ stop(SvcName) ->
%% restrict applications so that that there's one while the service
%% has many.
-add(SvcName, Type, Opts) ->
+add(SvcName, Type, Opts0) ->
%% Ensure acceptable transport options. This won't catch all
%% possible errors (faulty callbacks for example) but it catches
%% many. diameter_service:merge_service/2 depends on usable
%% capabilities for example.
- ok = transport_opts(Opts),
+ Opts = transport_opts(Opts0),
Ref = make_ref(),
true = diameter_reg:add_new(?TRANSPORT_KEY(Ref)),
@@ -560,7 +560,17 @@ add(SvcName, Type, Opts) ->
end.
transport_opts(Opts) ->
- lists:foreach(fun(T) -> opt(T) orelse ?THROW({invalid, T}) end, Opts).
+ lists:map(fun topt/1, Opts).
+
+topt(T) ->
+ case opt(T) of
+ {value, X} ->
+ X;
+ true ->
+ T;
+ false ->
+ ?THROW({invalid, T})
+ end.
opt({transport_module, M}) ->
is_atom(M);
@@ -600,8 +610,15 @@ opt({watchdog_timer, Tmo}) ->
opt({watchdog_config, L}) ->
is_list(L) andalso lists:all(fun wdopt/1, L);
-opt({spawn_opt, Opts}) ->
- is_list(Opts);
+opt({spawn_opt, {M,F,A}})
+ when is_atom(M), is_atom(F), is_list(A) ->
+ true;
+opt({spawn_opt = K, Opts}) ->
+ if is_list(Opts) ->
+ {value, {K, spawn_opts(Opts)}};
+ true ->
+ false
+ end;
opt({pool_size, N}) ->
is_integer(N) andalso 0 < N;
@@ -676,7 +693,7 @@ stop_transport(SvcName, Refs) ->
make_config(SvcName, Opts) ->
AppOpts = [T || {application, _} = T <- Opts],
- Apps = init_apps(AppOpts),
+ Apps = [init_app(T) || T <- AppOpts],
[] == Apps andalso ?THROW(no_apps),
@@ -725,9 +742,13 @@ opt(incoming_maxlen, N)
when 0 =< N, N < 1 bsl 24 ->
N;
+opt(spawn_opt, {M,F,A} = T)
+ when is_atom(M), is_atom(F), is_list(A) ->
+ T;
+
opt(spawn_opt, L)
when is_list(L) ->
- L;
+ spawn_opts(L);
opt(K, false = B)
when K == share_peers;
@@ -789,6 +810,9 @@ opt(sequence = K, F) ->
opt(K, _) ->
?THROW({value, K}).
+spawn_opts(L) ->
+ [T || T <- L, T /= link, T /= monitor].
+
sequence({H,N} = T)
when 0 =< N, N =< 32, 0 =< H, 0 == H bsr (32-N) ->
T;
@@ -822,10 +846,7 @@ encode_CER(Opts) ->
?THROW(Reason)
end.
-init_apps(Opts) ->
- lists:foldl(fun app_acc/2, [], lists:reverse(Opts)).
-
-app_acc({application, Opts} = T, Acc) ->
+init_app({application, Opts} = T) ->
is_list(Opts) orelse ?THROW(T),
[Dict, Mod] = get_opt([dictionary, module], Opts),
@@ -834,15 +855,14 @@ app_acc({application, Opts} = T, Acc) ->
M = get_opt(call_mutates_state, Opts, false, [true]),
A = get_opt(answer_errors, Opts, discard, [callback, report]),
P = get_opt(request_errors, Opts, answer_3xxx, [answer, callback]),
- [#diameter_app{alias = Alias,
- dictionary = Dict,
- id = cb(Dict, id),
- module = init_mod(Mod),
- init_state = ModS,
- mutable = M,
- options = [{answer_errors, A},
- {request_errors, P}]}
- | Acc].
+ #diameter_app{alias = Alias,
+ dictionary = Dict,
+ id = cb(Dict, id),
+ module = init_mod(Mod),
+ init_state = ModS,
+ mutable = M,
+ options = [{answer_errors, A},
+ {request_errors, P}]}.
init_mod(#diameter_callback{} = R) ->
init_mod([diameter_callback, R]);
diff --git a/lib/diameter/src/base/diameter_dict.erl b/lib/diameter/src/base/diameter_dict.erl
deleted file mode 100644
index 7db294a1b1..0000000000
--- a/lib/diameter/src/base/diameter_dict.erl
+++ /dev/null
@@ -1,154 +0,0 @@
-%%
-%% %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%
-%%
-
-%%
-%% This module provide OTP's dict interface built on top of ets.
-%%
-%% Note that while the interface is the same as dict the semantics
-%% aren't quite. A Dict here is just a table identifier (although
-%% this fact can't be used if you want dict/ets-based implementations
-%% to be interchangeable) so changes made to the Dict modify the
-%% underlying table. For merge/3, the first argument table is modified.
-%%
-%% The underlying ets table implementing a dict is deleted when the
-%% process from which new() was invoked exits and the dict is only
-%% writable from this process.
-%%
-%% The reason for this is to be able to swap dict/ets-based
-%% implementations: the former is easier to debug, the latter is
-%% faster for larger tables. It's also just a nice interface even
-%% when there's no need for swapability.
-%%
-
--module(diameter_dict).
-
--export([append/3,
- append_list/3,
- erase/2,
- fetch/2,
- fetch_keys/1,
- filter/2,
- find/2,
- fold/3,
- from_list/1,
- is_key/2,
- map/2,
- merge/3,
- new/0,
- store/3,
- to_list/1,
- update/3,
- update/4,
- update_counter/3]).
-
-%%% ----------------------------------------------------------
-%%% EXPORTED INTERNAL FUNCTIONS
-%%% ----------------------------------------------------------
-
-append(Key, Value, Dict) ->
- append_list(Key, [Value], Dict).
-
-append_list(Key, ValueList, Dict)
- when is_list(ValueList) ->
- update(Key, fun(V) -> V ++ ValueList end, ValueList, Dict).
-
-erase(Key, Dict) ->
- ets:delete(Dict, Key),
- Dict.
-
-fetch(Key, Dict) ->
- {ok, V} = find(Key, Dict),
- V.
-
-fetch_keys(Dict) ->
- ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict).
-
-filter(Pred, Dict) ->
- lists:foreach(fun({K,V}) -> filter(Pred(K,V), K, Dict) end, to_list(Dict)),
- Dict.
-
-find(Key, Dict) ->
- case ets:lookup(Dict, Key) of
- [{Key, V}] ->
- {ok, V};
- [] ->
- error
- end.
-
-fold(Fun, Acc0, Dict) ->
- ets:foldl(fun({K,V}, Acc) -> Fun(K, V, Acc) end, Acc0, Dict).
-
-from_list(List) ->
- lists:foldl(fun store/2, new(), List).
-
-is_key(Key, Dict) ->
- ets:member(Dict, Key).
-
-map(Fun, Dict) ->
- lists:foreach(fun({K,V}) -> store(K, Fun(K,V), Dict) end, to_list(Dict)),
- Dict.
-
-merge(Fun, Dict1, Dict2) ->
- fold(fun(K2,V2,_) ->
- update(K2, fun(V1) -> Fun(K2, V1, V2) end, V2, Dict1)
- end,
- Dict1,
- Dict2).
-
-new() ->
- ets:new(?MODULE, [set]).
-
-store(Key, Value, Dict) ->
- store({Key, Value}, Dict).
-
-to_list(Dict) ->
- ets:tab2list(Dict).
-
-update(Key, Fun, Dict) ->
- store(Key, Fun(fetch(Key, Dict)), Dict).
-
-update(Key, Fun, Initial, Dict) ->
- store(Key, map(Key, Fun, Dict, Initial), Dict).
-
-update_counter(Key, Increment, Dict)
- when is_integer(Increment) ->
- update(Key, fun(V) -> V + Increment end, Increment, Dict).
-
-%%% ---------------------------------------------------------
-%%% INTERNAL FUNCTIONS
-%%% ---------------------------------------------------------
-
-store({_,_} = T, Dict) ->
- ets:insert(Dict, T),
- Dict.
-
-filter(true, _, _) ->
- ok;
-filter(false, K, Dict) ->
- erase(K, Dict).
-
-map(Key, Fun, Dict, Error) ->
- case find(Key, Dict) of
- {ok, V} ->
- Fun(V);
- error ->
- Error
- end.
-
diff --git a/lib/diameter/src/base/diameter_gen.erl b/lib/diameter/src/base/diameter_gen.erl
new file mode 100644
index 0000000000..e832832876
--- /dev/null
+++ b/lib/diameter/src/base/diameter_gen.erl
@@ -0,0 +1,709 @@
+%%
+%% %CopyrightBegin%
+%%
+%% 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.
+%% 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%
+%%
+
+%%
+%% This file contains code that encode/decode modules generated by
+%% diameter_codegen.erl calls to implement the functionality. This
+%% code does most of the work, the generated code being kept simple.
+%%
+
+-module(diameter_gen).
+
+-export([encode_avps/3,
+ decode_avps/3,
+ grouped_avp/4,
+ empty_group/2,
+ empty/2]).
+
+-include_lib("diameter/include/diameter.hrl").
+
+-define(THROW(T), throw({?MODULE, T})).
+
+-type parent_name() :: atom(). %% parent = Message or AVP
+-type parent_record() :: tuple(). %%
+-type avp_name() :: atom().
+-type avp_record() :: tuple().
+-type avp_values() :: [{avp_name(), term()}].
+
+-type non_grouped_avp() :: #diameter_avp{}.
+-type grouped_avp() :: nonempty_improper_list(#diameter_avp{}, [avp()]).
+-type avp() :: non_grouped_avp() | grouped_avp().
+
+%% ---------------------------------------------------------------------------
+%% # encode_avps/3
+%% ---------------------------------------------------------------------------
+
+-spec encode_avps(parent_name(), parent_record() | avp_values(), map())
+ -> iolist()
+ | no_return().
+
+encode_avps(Name, Vals, #{module := Mod} = Opts) ->
+ try
+ encode(Name, Vals, Opts, Mod)
+ catch
+ throw: {?MODULE, Reason} ->
+ diameter_lib:log({encode, error},
+ ?MODULE,
+ ?LINE,
+ {Reason, Name, Vals, Mod}),
+ erlang:error(list_to_tuple(Reason ++ [Name]));
+ error: Reason ->
+ Stack = erlang:get_stacktrace(),
+ diameter_lib:log({encode, failure},
+ ?MODULE,
+ ?LINE,
+ {Reason, Name, Vals, Mod, Stack}),
+ erlang:error({encode_failure, Reason, Name, Stack})
+ end.
+
+%% encode/4
+
+encode(Name, Vals, #{ordered_encode := false} = Opts, Mod)
+ when is_list(Vals) ->
+ lists:map(fun({F,V}) -> encode(Name, F, V, Opts, Mod) end, Vals);
+
+encode(Name, Vals, Opts, Mod)
+ when is_list(Vals) ->
+ encode(Name, Mod:'#set-'(Vals, newrec(Mod, Name)), Opts, Mod);
+
+encode(Name, Rec, Opts, Mod) ->
+ [encode(Name, F, V, Opts, Mod) || {F,V} <- Mod:'#get-'(Rec)].
+
+%% encode/5
+
+encode(Name, AvpName, Values, Opts, Mod) ->
+ enc(Name, AvpName, Mod:avp_arity(Name, AvpName), Values, Opts, Mod).
+
+%% enc/6
+
+enc(_, AvpName, 1, undefined, _, _) ->
+ ?THROW([mandatory_avp_missing, AvpName]);
+
+enc(Name, AvpName, 1, Value, Opts, Mod) ->
+ enc(Name, AvpName, [Value], Opts, Mod);
+
+enc(_, _, {0,_}, [], _, _) ->
+ [];
+
+enc(_, AvpName, _, T, _, _)
+ when not is_list(T) ->
+ ?THROW([repeated_avp_as_non_list, AvpName, T]);
+
+enc(_, AvpName, {Min, _}, L, _, _)
+ when length(L) < Min ->
+ ?THROW([repeated_avp_insufficient_arity, AvpName, Min, L]);
+
+enc(_, AvpName, {_, Max}, L, _, _)
+ when Max < length(L) ->
+ ?THROW([repeated_avp_excessive_arity, AvpName, Max, L]);
+
+enc(Name, AvpName, _, Values, Opts, Mod) ->
+ enc(Name, AvpName, Values, Opts, Mod).
+
+%% enc/5
+
+enc(Name, 'AVP', Values, Opts, Mod) ->
+ [enc_AVP(Name, A, Opts, Mod) || A <- Values];
+
+enc(_, AvpName, Values, Opts, Mod) ->
+ enc(AvpName, Values, Opts, Mod).
+
+%% enc/4
+
+enc(AvpName, Values, Opts, Mod) ->
+ H = Mod:avp_header(AvpName),
+ [diameter_codec:pack_data(H, Mod:avp(encode, V, AvpName, Opts))
+ || V <- Values].
+
+%% enc_AVP/4
+
+%% No value: assume AVP data is already encoded. The normal case will
+%% be when this is passed back from #diameter_packet.errors as a
+%% consequence of a failed decode. Any AVP can be encoded this way
+%% however, which side-steps any arity checks for known AVP's and
+%% could potentially encode something unfortunate.
+enc_AVP(_, #diameter_avp{value = undefined} = A, Opts, _) ->
+ diameter_codec:pack_avp(A, Opts);
+
+%% Missing name for value encode.
+enc_AVP(_, #diameter_avp{name = N, value = V}, _, _)
+ when N == undefined;
+ N == 'AVP' ->
+ ?THROW([value_with_nameless_avp, N, V]);
+
+%% Or not. Ensure that 'AVP' is the appropriate field. Note that if we
+%% don't know this AVP at all then the encode will fail.
+enc_AVP(Name, #diameter_avp{name = AvpName, value = Data}, Opts, Mod) ->
+ 0 == Mod:avp_arity(Name, AvpName)
+ orelse ?THROW([known_avp_as_AVP, Name, AvpName, Data]),
+ enc(AvpName, [Data], Opts, Mod);
+
+%% The backdoor ...
+enc_AVP(_, {AvpName, Value}, Opts, Mod) ->
+ enc(AvpName, [Value], Opts, Mod);
+
+%% ... and the side door.
+enc_AVP(_Name, {_Dict, _AvpName, _Data} = T, Opts, _) ->
+ diameter_codec:pack_avp(#diameter_avp{data = T}, Opts).
+
+%% ---------------------------------------------------------------------------
+%% # decode_avps/3
+%% ---------------------------------------------------------------------------
+
+-spec decode_avps(parent_name(), [#diameter_avp{}], map())
+ -> {parent_record(), [avp()], Failed}
+ when Failed :: [{5000..5999, #diameter_avp{}}].
+
+decode_avps(Name, Recs, #{module := Mod} = Opts) ->
+ {Avps, {Rec, Failed}}
+ = mapfoldl(fun(T,A) -> decode(Name, Opts, Mod, T, A) end,
+ {newrec(Mod, Name), []},
+ Recs),
+ {Rec, Avps, Failed ++ missing(Rec, Name, Failed, Opts, Mod)}.
+%% Append 5005 errors so that errors are reported in the order
+%% encountered. Failed-AVP should typically contain the first
+%% encountered error accordg to the RFC.
+
+%% mapfoldl/3
+%%
+%% Like lists:mapfoldl/3, but don't reverse the list.
+
+mapfoldl(F, Acc, List) ->
+ mapfoldl(F, Acc, List, []).
+
+mapfoldl(F, Acc0, [T|Rest], List) ->
+ {B, Acc} = F(T, Acc0),
+ mapfoldl(F, Acc, Rest, [B|List]);
+mapfoldl(_, Acc, [], List) ->
+ {List, Acc}.
+
+%% 3588:
+%%
+%% DIAMETER_MISSING_AVP 5005
+%% The request did not contain an AVP that is required by the Command
+%% Code definition. If this value is sent in the Result-Code AVP, a
+%% Failed-AVP AVP SHOULD be included in the message. The Failed-AVP
+%% AVP MUST contain an example of the missing AVP complete with the
+%% Vendor-Id if applicable. The value field of the missing AVP
+%% should be of correct minimum length and contain zeros.
+
+missing(Rec, Name, Failed, Opts, Mod) ->
+ Avps = lists:foldl(fun({_, #diameter_avp{code = C, vendor_id = V}}, A) ->
+ maps:put({C,V}, true, A)
+ end,
+ maps:new(),
+ Failed),
+ missing(Mod:avp_arity(Name), tl(tuple_to_list(Rec)), Avps, Opts, Mod, []).
+
+missing([{Name, Arity} | As], [Value | Vs], Avps, Opts, Mod, Acc) ->
+ missing(As,
+ Vs,
+ Avps,
+ Opts,
+ Mod,
+ case
+ [H || missing_arity(Arity, Value),
+ {C,_,V} = H <- [Mod:avp_header(Name)],
+ not maps:is_key({C,V}, Avps)]
+ of
+ [H] ->
+ [{5005, empty_avp(Name, H, Opts, Mod)} | Acc];
+ [] ->
+ Acc
+ end);
+
+missing([], [], _, _, _, Acc) ->
+ Acc.
+
+%% Maximum arities have already been checked in building the record.
+
+missing_arity(1, V) ->
+ V == undefined;
+missing_arity({0, _}, _) ->
+ false;
+missing_arity({1, _}, L) ->
+ [] == L;
+missing_arity({Min, _}, L) ->
+ not has_prefix(Min, L).
+
+%% Compare a non-negative integer and the length of a list without
+%% computing the length.
+has_prefix(0, _) ->
+ true;
+has_prefix(_, []) ->
+ false;
+has_prefix(N, [_|L]) ->
+ has_prefix(N-1, L).
+
+%% empty_avp/4
+
+empty_avp(Name, {Code, Flags, VId}, Opts, Mod) ->
+ {Name, Type} = Mod:avp_name(Code, VId),
+ #diameter_avp{name = Name,
+ code = Code,
+ vendor_id = VId,
+ is_mandatory = 0 /= (Flags band 2#01000000),
+ need_encryption = 0 /= (Flags band 2#00100000),
+ data = Mod:empty_value(Name, Opts),
+ type = Type}.
+
+%% 3588, ch 7:
+%%
+%% The Result-Code AVP describes the error that the Diameter node
+%% encountered in its processing. In case there are multiple errors,
+%% the Diameter node MUST report only the first error it encountered
+%% (detected possibly in some implementation dependent order). The
+%% specific errors that can be described by this AVP are described in
+%% the following section.
+
+%% decode/5
+
+decode(Name,
+ Opts,
+ Mod,
+ #diameter_avp{code = Code, vendor_id = Vid}
+ = Avp,
+ Acc) ->
+ decode(Name, Opts, Mod, Mod:avp_name(Code, Vid), Avp, Acc).
+
+%% decode/6
+
+%% AVP not in dictionary.
+decode(Name, Opts, Mod, 'AVP', Avp, Acc) ->
+ decode_AVP(Name, Avp, Opts, Mod, Acc);
+
+%% 6733, 4.4:
+%%
+%% Receivers of a Grouped AVP that does not have the 'M' (mandatory)
+%% bit set and one or more of the encapsulated AVPs within the group
+%% has the 'M' (mandatory) bit set MAY simply be ignored if the
+%% Grouped AVP itself is unrecognized. The rule applies even if the
+%% encapsulated AVP with its 'M' (mandatory) bit set is further
+%% encapsulated within other sub-groups, i.e., other Grouped AVPs
+%% embedded within the Grouped AVP.
+%%
+%% The first sentence is slightly mangled, but take it to mean this:
+%%
+%% An unrecognized AVP of type Grouped that does not set the 'M' bit
+%% MAY be ignored even if one of its encapsulated AVPs sets the 'M'
+%% bit.
+%%
+%% The text above is a change from RFC 3588, which instead says this:
+%%
+%% Further, if any of the AVPs encapsulated within a Grouped AVP has
+%% the 'M' (mandatory) bit set, the Grouped AVP itself MUST also
+%% include the 'M' bit set.
+%%
+%% Both of these texts have problems. If the AVP is unknown then its
+%% type is unknown since the type isn't sent over the wire, so the
+%% 6733 text becomes a non-statement: don't know that the AVP not
+%% setting the M-bit is of type Grouped, therefore can't know that its
+%% data consists of encapsulated AVPs, therefore can't but ignore that
+%% one of these might set the M-bit. It should be no worse if we know
+%% the AVP to have type Grouped.
+%%
+%% Similarly, for the 3588 text: if we receive an AVP that doesn't set
+%% the M-bit and don't know that the AVP has type Grouped then we
+%% can't realize that its data contains an AVP that sets the M-bit, so
+%% can't regard the AVP as erroneous on this account. Again, it should
+%% be no worse if the type is known to be Grouped, but in this case
+%% the RFC forces us to regard the AVP as erroneous. This is
+%% inconsistent, and the 3588 text has never been enforced.
+%%
+%% So, if an AVP doesn't set the M-bit then we're free to ignore it,
+%% regardless of the AVP's type. If we know the type to be Grouped
+%% then we must ignore the M-bit on an encapsulated AVP. That means
+%% packing such an encapsulated AVP into an 'AVP' field if need be,
+%% not regarding the lack of a specific field as an error as is
+%% otherwise the case. (The lack of an AVP-specific field being how we
+%% defined the RFC's "unrecognized", which is slightly stronger than
+%% "not defined".)
+
+decode(Name, Opts0, Mod, {AvpName, Type}, Avp, Acc) ->
+ #diameter_avp{data = Data, is_mandatory = M}
+ = Avp,
+
+ %% Whether or not to ignore an M-bit on an encapsulated AVP, or on
+ %% all AVPs with the service_opt() strict_mbit.
+ Opts1 = set_strict(Type, M, Opts0),
+
+ %% Whether or not we're decoding within Failed-AVP and should
+ %% ignore decode errors.
+ #{dictionary := AppMod, failed_avp := Failed}
+ = Opts
+ = set_failed(Name, Opts1), %% Not AvpName or else a failed Failed-AVP
+ %% decode is packed into 'AVP'.
+
+ %% Reset the dictionary for best-effort decode of Failed-AVP.
+ DecMod = if Failed ->
+ AppMod;
+ true ->
+ Mod
+ end,
+
+ %% On decode, a Grouped AVP is represented as a #diameter_avp{}
+ %% list with AVP as head and component AVPs as tail. On encode,
+ %% data can be a list of component AVPs.
+
+ try avp_decode(Data, AvpName, Opts, DecMod, Mod) of
+ {Rec, As} when Type == 'Grouped' ->
+ A = Avp#diameter_avp{name = AvpName,
+ value = Rec,
+ type = Type},
+ {[A|As], pack_avp(Name, A, Opts, Mod, Acc)};
+
+ V when Type /= 'Grouped' ->
+ A = Avp#diameter_avp{name = AvpName,
+ value = V,
+ type = Type},
+ {A, pack_avp(Name, A, Opts, Mod, Acc)}
+ catch
+ throw: {?MODULE, {grouped, Error, ComponentAvps}} ->
+ decode_error(Name,
+ Error,
+ ComponentAvps,
+ Opts,
+ Mod,
+ Avp#diameter_avp{name = AvpName,
+ data = trim(Avp#diameter_avp.data),
+ type = Type},
+ Acc);
+
+ error: Reason ->
+ decode_error(Name,
+ Reason,
+ Opts,
+ Mod,
+ Avp#diameter_avp{name = AvpName,
+ data = trim(Avp#diameter_avp.data),
+ type = Type},
+ Acc)
+ end.
+
+%% avp_decode/5
+
+avp_decode(Data, AvpName, Opts, Mod, Mod) ->
+ Mod:avp(decode, Data, AvpName, Opts);
+
+avp_decode(Data, AvpName, Opts, Mod, _) ->
+ Mod:avp(decode, Data, AvpName, Opts, Mod).
+
+%% trim/1
+%%
+%% Remove any extra bit that was added in diameter_codec to induce a
+%% 5014 error.
+
+trim(#diameter_avp{data = Data} = Avp) ->
+ Avp#diameter_avp{data = trim(Data)};
+
+trim({5014, Bin}) ->
+ Bin;
+
+trim(Avps)
+ when is_list(Avps) ->
+ lists:map(fun trim/1, Avps);
+
+trim(Avp) ->
+ Avp.
+
+%% decode_error/7
+
+decode_error(Name, [_ | Rec], _, #{failed_avp := true} = Opts, Mod, Avp, Acc) ->
+ decode_AVP(Name, Avp#diameter_avp{value = Rec}, Opts, Mod, Acc);
+
+decode_error(Name, _, _, #{failed_avp := true} = Opts, Mod, Avp, Acc) ->
+ decode_AVP(Name, Avp, Opts, Mod, Acc);
+
+decode_error(_, [Error | _], ComponentAvps, _, _, Avp, Acc) ->
+ decode_error(Error, Avp, Acc, ComponentAvps);
+
+decode_error(_, Error, ComponentAvps, _, _, Avp, Acc) ->
+ decode_error(Error, Avp, Acc, ComponentAvps).
+
+%% decode_error/5
+
+decode_error(Name, _Reason, #{failed_avp := true} = Opts, Mod, Avp, Acc) ->
+ decode_AVP(Name, Avp, Opts, Mod, Acc);
+
+decode_error(Name, Reason, Opts, Mod, Avp, {Rec, Failed}) ->
+ Stack = diameter_lib:get_stacktrace(),
+ diameter_lib:log(decode_error,
+ ?MODULE,
+ ?LINE,
+ {Reason, Name, Avp#diameter_avp.name, Mod, Stack}),
+ {Avp, {Rec, [rc(Reason, Avp, Opts, Mod) | Failed]}}.
+
+%% decode_error/4
+
+decode_error({RC, ErrorData}, Avp, {Rec, Failed}, ComponentAvps) ->
+ E = Avp#diameter_avp{data = [ErrorData]},
+ {[Avp | trim(ComponentAvps)], {Rec, [{RC, E} | Failed]}}.
+
+%% set_strict/3
+
+%% Set false as soon as we see a Grouped AVP that doesn't set the
+%% M-bit, to ignore the M-bit on an encapsulated AVP.
+set_strict('Grouped', false = M, #{strict_mbit := true} = Opts) ->
+ Opts#{strict_mbit := M};
+set_strict(_, _, Opts) ->
+ Opts.
+
+%% set_failed/2
+%%
+%% Set true as soon as we see Failed-AVP. Matching on 'Failed-AVP'
+%% assumes that this is the RFC AVP. Strictly, this doesn't need to be
+%% the case.
+
+set_failed('Failed-AVP', #{failed_avp := false} = Opts) ->
+ Opts#{failed_avp := true};
+set_failed(_, Opts) ->
+ Opts.
+
+%% decode_AVP/5
+%%
+%% Don't know this AVP: see if it can be packed in an 'AVP' field
+%% undecoded. Note that the type field is 'undefined' in this case.
+
+decode_AVP(Name, Avp, Opts, Mod, Acc) ->
+ {trim(Avp), pack_AVP(Name, Avp, Opts, Mod, Acc)}.
+
+%% rc/2
+
+%% diameter_types will raise an error of this form to communicate
+%% DIAMETER_INVALID_AVP_LENGTH (5014). A module specified to a
+%% @custom_types tag in a dictionary file can also raise an error of
+%% this form.
+rc({'DIAMETER', 5014 = RC, _}, #diameter_avp{name = AvpName} = Avp, Opts, Mod) ->
+ {RC, Avp#diameter_avp{data = Mod:empty_value(AvpName, Opts)}};
+
+%% 3588:
+%%
+%% DIAMETER_INVALID_AVP_VALUE 5004
+%% The request contained an AVP with an invalid value in its data
+%% portion. A Diameter message indicating this error MUST include
+%% the offending AVPs within a Failed-AVP AVP.
+rc(_, Avp, _, _) ->
+ {5004, Avp}.
+
+%% pack_avp/5
+
+pack_avp(Name, #diameter_avp{name = AvpName} = Avp, Opts, Mod, Acc) ->
+ pack_avp(Name, Mod:avp_arity(Name, AvpName), Avp, Opts, Mod, Acc).
+
+%% pack_avp/6
+
+pack_avp(Name, 0, Avp, Opts, Mod, Acc) ->
+ pack_AVP(Name, Avp, Opts, Mod, Acc);
+
+pack_avp(_, Arity, #diameter_avp{name = AvpName} = Avp, _Opts, Mod, Acc) ->
+ pack(Arity, AvpName, Avp, Mod, Acc).
+
+%% pack_AVP/5
+
+%% Length failure was induced because of a header/payload length
+%% mismatch. The AVP Length is reset to match the received data if
+%% this AVP is encoded in an answer message, since the length is
+%% computed.
+%%
+%% Data is a truncated header if command_code = undefined, otherwise
+%% payload bytes. The former is padded to the length of a header if
+%% the AVP reaches an outgoing encode in diameter_codec.
+%%
+%% RFC 6733 says that an AVP returned with 5014 can contain a minimal
+%% payload for the AVP's type, but in this case we don't know the
+%% type.
+
+pack_AVP(_, #diameter_avp{data = {5014 = RC, Data}} = Avp, _, _, Acc) ->
+ {Rec, Failed} = Acc,
+ {Rec, [{RC, Avp#diameter_avp{data = Data}} | Failed]};
+
+pack_AVP(Name, Avp, Opts, Mod, Acc) ->
+ pack_arity(Name, pack_arity(Name, Opts, Mod, Avp), Avp, Mod, Acc).
+
+%% pack_arity/5
+
+pack_arity(_, 0, #diameter_avp{is_mandatory = M} = Avp, _, Acc) ->
+ {Rec, Failed} = Acc,
+ {Rec, [{if M -> 5001; true -> 5008 end, Avp} | Failed]};
+
+pack_arity(_, Arity, Avp, Mod, Acc) ->
+ pack(Arity, 'AVP', Avp, Mod, Acc).
+
+%% Give Failed-AVP special treatment since (1) it'll contain any
+%% unrecognized mandatory AVP's and (2) the RFC 3588 grammar failed to
+%% allow for Failed-AVP in an answer-message.
+
+pack_arity(Name,
+ #{strict_mbit := Strict,
+ failed_avp := Failed},
+ Mod,
+ #diameter_avp{is_mandatory = M,
+ name = AvpName}) ->
+
+ %% Not testing just Name /= 'Failed-AVP' means we're changing the
+ %% packing of AVPs nested within Failed-AVP, but the point of
+ %% ignoring errors within Failed-AVP is to decode as much as
+ %% possible, and failing because a mandatory AVP couldn't be
+ %% packed into a dedicated field defeats that point.
+
+ if Failed == true;
+ Name == 'Failed-AVP';
+ Name == 'answer-message', AvpName == 'Failed-AVP';
+ not M;
+ not Strict ->
+ Mod:avp_arity(Name, 'AVP');
+ true ->
+ 0
+ end.
+
+%% 3588:
+%%
+%% DIAMETER_AVP_UNSUPPORTED 5001
+%% The peer received a message that contained an AVP that is not
+%% recognized or supported and was marked with the Mandatory bit. A
+%% Diameter message with this error MUST contain one or more Failed-
+%% AVP AVP containing the AVPs that caused the failure.
+%%
+%% DIAMETER_AVP_NOT_ALLOWED 5008
+%% A message was received with an AVP that MUST NOT be present. The
+%% Failed-AVP AVP MUST be included and contain a copy of the
+%% offending AVP.
+
+%% pack/5
+
+pack(Arity, FieldName, Avp, Mod, {Rec, _} = Acc) ->
+ pack(Mod:'#get-'(FieldName, Rec), Arity, FieldName, Avp, Mod, Acc).
+
+%% pack/6
+
+pack(undefined, 1, 'AVP' = F, Avp, Mod, {Rec, Failed}) -> %% unlikely
+ {Mod:'#set-'({F, Avp}, Rec), Failed};
+
+pack(undefined, 1, F, #diameter_avp{value = V}, Mod, {Rec, Failed}) ->
+ {Mod:'#set-'({F, V}, Rec), Failed};
+
+%% 3588:
+%%
+%% DIAMETER_AVP_OCCURS_TOO_MANY_TIMES 5009
+%% A message was received that included an AVP that appeared more
+%% often than permitted in the message definition. The Failed-AVP
+%% AVP MUST be included and contain a copy of the first instance of
+%% the offending AVP that exceeded the maximum number of occurrences
+%%
+
+pack(_, 1, _, Avp, _, {Rec, Failed}) ->
+ {Rec, [{5009, Avp} | Failed]};
+
+pack(L, {_, Max}, F, Avp, Mod, {Rec, Failed}) ->
+ case '*' /= Max andalso has_prefix(Max+1, L) of
+ true ->
+ {Rec, [{5009, Avp} | Failed]};
+ false when F == 'AVP' ->
+ {Mod:'#set-'({F, [Avp | L]}, Rec), Failed};
+ false ->
+ {Mod:'#set-'({F, [Avp#diameter_avp.value | L]}, Rec), Failed}
+ end.
+
+%% ---------------------------------------------------------------------------
+%% # grouped_avp/3
+%% ---------------------------------------------------------------------------
+
+-spec grouped_avp(decode, avp_name(), binary() | {5014, binary()}, term())
+ -> {avp_record(), [avp()]};
+ (encode, avp_name(), avp_record() | avp_values(), term())
+ -> iolist()
+ | no_return().
+
+%% Length error induced by diameter_codec:collect_avps/1: the AVP
+%% length in the header was too short (insufficient for the extracted
+%% header) or too long (past the end of the message). An empty payload
+%% is sufficient according to the RFC text for 5014.
+grouped_avp(decode, _Name, {5014 = RC, _Bin}, _) ->
+ ?THROW({grouped, {RC, []}, []});
+
+grouped_avp(decode, Name, Data, Opts) ->
+ grouped_decode(Name, diameter_codec:collect_avps(Data), Opts);
+
+grouped_avp(encode, Name, Data, Opts) ->
+ encode_avps(Name, Data, Opts).
+
+%% grouped_decode/2
+%%
+%% Note that Grouped is the only AVP type that doesn't just return a
+%% decoded value, also returning the list of component diameter_avp
+%% records.
+
+%% Length error in trailing component AVP.
+grouped_decode(_Name, {Error, Acc}, _) ->
+ {5014, Avp} = Error,
+ ?THROW({grouped, Error, [Avp | Acc]});
+
+%% 7.5. Failed-AVP AVP
+
+%% In the case where the offending AVP is embedded within a Grouped AVP,
+%% the Failed-AVP MAY contain the grouped AVP, which in turn contains
+%% the single offending AVP. The same method MAY be employed if the
+%% grouped AVP itself is embedded in yet another grouped AVP and so on.
+%% In this case, the Failed-AVP MAY contain the grouped AVP hierarchy up
+%% to the single offending AVP. This enables the recipient to detect
+%% the location of the offending AVP when embedded in a group.
+
+%% An error in decoding a component AVP throws the first faulty
+%% component, which the catch in d/3 wraps in the Grouped AVP in
+%% question. A partially decoded record is only used when ignoring
+%% errors in Failed-AVP.
+grouped_decode(Name, ComponentAvps, Opts) ->
+ {Rec, Avps, Es} = decode_avps(Name, ComponentAvps, Opts),
+ [] == Es orelse ?THROW({grouped, [{_,_} = hd(Es) | Rec], Avps}),
+ {Rec, Avps}.
+
+%% ---------------------------------------------------------------------------
+%% # empty_group/2
+%% ---------------------------------------------------------------------------
+
+empty_group(Name, #{module := Mod} = Opts) ->
+ list_to_binary([z(F, A, Opts, Mod) || {F,A} <- Mod:avp_arity(Name)]).
+
+z(Name, 1, Opts, Mod) ->
+ z(Name, Opts, Mod);
+z(_, {0,_}, _, _) ->
+ [];
+z(Name, {Min, _}, Opts, Mod) ->
+ binary:copy(z(Name, Opts, Mod), Min).
+
+z('AVP', _, _) ->
+ <<0:64>>; %% minimal header
+z(Name, Opts, Mod) ->
+ Bin = diameter_codec:pack_data(Mod:avp_header(Name),
+ Mod:empty_value(Name, Opts)),
+ Sz = iolist_size(Bin),
+ <<0:Sz/unit:8>>.
+
+%% ---------------------------------------------------------------------------
+%% # empty/2
+%% ---------------------------------------------------------------------------
+
+empty(Name, #{module := Mod} = Opts) ->
+ Mod:avp(encode, zero, Name, Opts).
+
+%% ------------------------------------------------------------------------------
+
+newrec(Mod, Name) ->
+ Mod:'#new-'(Mod:name2rec(Name)).
diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl
index 3928769b5e..8792e97621 100644
--- a/lib/diameter/src/base/diameter_lib.erl
+++ b/lib/diameter/src/base/diameter_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-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.
@@ -37,7 +37,6 @@
ipaddr/1,
spawn_opts/2,
wait/1,
- fold_tuple/3,
fold_n/3,
for_n/2,
log/4]).
@@ -341,36 +340,6 @@ down(MRef)
receive {'DOWN', MRef, process, _, _} = T -> T end.
%% ---------------------------------------------------------------------------
-%% # fold_tuple/3
-%% ---------------------------------------------------------------------------
-
--spec fold_tuple(N, T0, T)
- -> tuple()
- when N :: pos_integer(),
- T0 :: tuple(),
- T :: tuple()
- | undefined.
-
-%% Replace fields in T0 by those of T starting at index N, unless the
-%% new value is 'undefined'.
-%%
-%% eg. fold_tuple(2, Hdr, #diameter_header{end_to_end_id = 42})
-
-fold_tuple(_, T, undefined) ->
- T;
-
-fold_tuple(N, T0, T1) ->
- {_, T} = lists:foldl(fun(V, {I,_} = IT) -> {I+1, ft(V, IT)} end,
- {N, T0},
- lists:nthtail(N-1, tuple_to_list(T1))),
- T.
-
-ft(undefined, {_, T}) ->
- T;
-ft(Value, {Idx, T}) ->
- setelement(Idx, T, Value).
-
-%% ---------------------------------------------------------------------------
%% # fold_n/3
%% ---------------------------------------------------------------------------
diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl
index 46d231da74..e43b3f54cf 100644
--- a/lib/diameter/src/base/diameter_peer_fsm.erl
+++ b/lib/diameter/src/base/diameter_peer_fsm.erl
@@ -128,7 +128,12 @@
%% outgoing DPR; boolean says whether or not
%% the request was sent explicitly with
%% diameter:call/4.
+ codec :: #{string_decode := boolean(),
+ strict_mbit := boolean(),
+ rfc := 3588 | 6733,
+ ordered_encode := false},
strict :: boolean(),
+ ack = false :: boolean(),
length_errors :: exit | handle | discard,
incoming_maxlen :: integer() | infinity}).
@@ -159,10 +164,7 @@
%% # start/3
%% ---------------------------------------------------------------------------
--spec start(T, [Opt], {[diameter:service_opt()],
- [node()],
- module(),
- #diameter_service{}})
+-spec start(T, [Opt], {map(), [node()], module(), #diameter_service{}})
-> {reference(), pid()}
when T :: {connect|accept, diameter:transport_ref()},
Opt :: diameter:transport_opt().
@@ -221,9 +223,10 @@ i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) ->
erlang:monitor(process, WPid),
wait(Ack, WPid),
diameter_stats:reg(Ref),
- diameter_codec:setopts([{common_dictionary, Dict0} | SvcOpts]),
- {_,_} = Mask = proplists:get_value(sequence, SvcOpts),
- Maxlen = proplists:get_value(incoming_maxlen, SvcOpts, 16#FFFFFF),
+
+ #{sequence := Mask, incoming_maxlen := Maxlen}
+ = SvcOpts,
+
{[Cs,Ds], Rest} = proplists:split(Opts, [capabilities_cb, disconnect_cb]),
putr(?CB_KEY, {Ref, [F || {_,F} <- Cs]}),
putr(?DPR_KEY, [F || {_, F} <- Ds]),
@@ -235,7 +238,7 @@ i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) ->
Tmo = proplists:get_value(capx_timeout, Opts, ?CAPX_TIMEOUT),
Strictness = proplists:get_value(capx_strictness, Opts, true),
- OnLengthErr = proplists:get_value(length_errors, Opts, exit),
+ LengthErr = proplists:get_value(length_errors, Opts, exit),
{TPid, Addrs} = start_transport(T, Rest, Svc),
@@ -247,9 +250,14 @@ i({Ack, WPid, {M, Ref} = T, Opts, {SvcOpts, Nodes, Dict0, Svc}}) ->
dictionary = Dict0,
mode = M,
service = svc(Svc, Addrs),
- length_errors = OnLengthErr,
+ length_errors = LengthErr,
strict = Strictness,
- incoming_maxlen = Maxlen}.
+ incoming_maxlen = Maxlen,
+ codec = maps:with([string_decode,
+ strict_mbit,
+ rfc,
+ ordered_encode],
+ SvcOpts#{ordered_encode => false})}.
%% The transport returns its local ip addresses so that different
%% transports on the same service can use different local addresses.
%% The local addresses are put into Host-IP-Address avps here when
@@ -442,9 +450,18 @@ transition({connection_timeout = T, TPid},
transition({connection_timeout, _}, _) ->
ok;
+%% Requests for acknowledgements to the transport.
+transition({diameter, ack}, S) ->
+ S#state{ack = true};
+
%% Incoming message from the transport.
-transition({diameter, {recv, MsgT}}, S) ->
- incoming(MsgT, S);
+transition({diameter, {recv, Msg}}, S) ->
+ incoming(recv(Msg, S), S);
+
+%% Handler of an incoming request is telling of its existence.
+transition({handler, Pid}, _) ->
+ put_route(Pid),
+ ok;
%% Timeout when still in the same state ...
transition({timeout = T, PS}, #state{state = PS}) ->
@@ -458,7 +475,7 @@ transition({timeout, _}, _) ->
transition({send, Msg}, S) ->
outgoing(Msg, S);
transition({send, Msg, Route}, S) ->
- put_route(Route),
+ route_outgoing(Route),
outgoing(Msg, S);
%% Request for graceful shutdown at remove_transport, stop_service of
@@ -487,12 +504,13 @@ transition({'DOWN', _, process, WPid, _},
transition({'DOWN', _, process, TPid, _},
#state{transport = TPid}
= S) ->
- start_next(S);
+ start_next(S#state{ack = false});
%% Transport has died after connection timeout, or handler process has
%% died.
-transition({'DOWN', _, process, Pid, _}, _) ->
- erase_route(Pid),
+transition({'DOWN', _, process, Pid, _}, #state{transport = TPid}) ->
+ is_reference(erase_route(Pid))
+ andalso send(TPid, false), %% answer not forthcoming
ok;
%% State query.
@@ -502,37 +520,62 @@ transition({state, Pid}, #state{state = S, transport = TPid}) ->
%% Crash on anything unexpected.
-%% put_route/1
-%%
+%% route_outgoing/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}) ->
+route_outgoing({Pid, Ref, Seqs}) -> %% request
MRef = monitor(process, Pid),
put(Pid, Seqs),
- put(Seqs, {Pid, Ref, MRef}).
+ put(Seqs, {Pid, Ref, MRef});
+
+%% Remove a mapping made for an incoming request.
+route_outgoing(Pid)
+ when is_pid(Pid) -> %% answer
+ MRef = erase_route(Pid),
+ undefined == MRef orelse demonitor(MRef).
+
+%% put_route/1
+
+%% Monitor on a handler process for an incoming request.
+put_route(Pid) ->
+ MRef = monitor(process, Pid),
+ put(Pid, MRef).
-%% get_route/1
+%% get_route/3
-get_route(#diameter_packet{header = #diameter_header{is_request = false}}
- = Pkt) ->
+%% Incoming answer.
+get_route(_, _, #diameter_packet{header = #diameter_header{is_request = false}}
+ = Pkt) ->
Seqs = diameter_codec:sequence_numbers(Pkt),
case erase(Seqs) of
{Pid, Ref, MRef} ->
demonitor(MRef),
erase(Pid),
{Pid, Ref, self()};
- undefined ->
+ undefined -> %% request unknown
false
end;
-get_route(_) ->
- false.
+%% Requests answered here ...
+get_route(_, N, _)
+ when N == 'CER';
+ N == 'DPR' ->
+ false;
+
+%% ... or not.
+get_route(Ack, _, _) ->
+ Ack.
%% erase_route/1
erase_route(Pid) ->
- erase(erase(Pid)).
+ case erase(Pid) of
+ {_,_} = Seqs ->
+ erase(Seqs);
+ T ->
+ T
+ end.
%% capx/1
@@ -560,7 +603,8 @@ send_CER(#state{state = {'Wait-Conn-Ack', Tmo},
mode = {connect, Remote},
service = #diameter_service{capabilities = LCaps},
transport = TPid,
- dictionary = Dict}
+ dictionary = Dict,
+ codec = Opts}
= S) ->
OH = LCaps#diameter_caps.origin_host,
req_send_CER(OH, Remote)
@@ -570,7 +614,7 @@ send_CER(#state{state = {'Wait-Conn-Ack', Tmo},
#diameter_packet{header = #diameter_header{end_to_end_id = Eid,
hop_by_hop_id = Hid}}
= Pkt
- = encode(CER, Dict),
+ = encode(CER, Opts, Dict),
incr(send, Pkt, Dict),
send(TPid, Pkt),
?LOG(send, 'CER'),
@@ -599,41 +643,36 @@ build_CER(#state{service = #diameter_service{capabilities = LCaps},
{ok, CER} = diameter_capx:build_CER(LCaps, Dict),
CER.
-%% encode/2
+%% encode/3
-encode(Rec, Dict) ->
+encode(Rec, Opts, Dict) ->
Seq = diameter_session:sequence({_,_} = getr(?SEQUENCE_KEY)),
Hdr = #diameter_header{version = ?DIAMETER_VERSION,
end_to_end_id = Seq,
hop_by_hop_id = Seq},
- diameter_codec:encode(Dict, #diameter_packet{header = Hdr,
- msg = Rec}).
+ diameter_codec:encode(Dict, Opts, #diameter_packet{header = Hdr,
+ msg = Rec}).
%% incoming/2
-incoming({Msg, NPid}, S) ->
- try recv(Msg, S) of
- T ->
- NPid ! {diameter, discard},
- T
- catch
- {?MODULE, Name, Pkt} ->
- incoming(Name, Pkt, NPid, S)
- end;
+incoming({recv = T, Name, Pkt}, #state{parent = Pid, ack = Ack} = S) ->
+ Pid ! {T, self(), get_route(Ack, Name, Pkt), Name, Pkt},
+ rcv(Name, Pkt, S);
-incoming(Msg, S) ->
- try
- recv(Msg, S)
- catch
- {?MODULE, Name, Pkt} ->
- incoming(Name, Pkt, false, S)
- end.
+incoming(#diameter_header{is_request = R}, #state{transport = TPid,
+ ack = Ack}) ->
+ R andalso Ack andalso send(TPid, false),
+ ok;
+
+incoming(<<_:32, 1:1, _/bits>>, #state{ack = true} = S) ->
+ send(S#state.transport, false),
+ ok;
-%% incoming/4
+incoming(<<_/bits>>, _) ->
+ ok;
-incoming(Name, Pkt, NPid, #state{parent = Pid} = S) ->
- Pid ! {recv, self(), get_route(Pkt), Name, Pkt, NPid},
- rcv(Name, Pkt, S).
+incoming(T, _) ->
+ T.
%% recv/2
@@ -658,18 +697,19 @@ recv1(_,
#diameter_packet{header = H, bin = Bin},
#state{incoming_maxlen = M})
when M < size(Bin) ->
- invalid(false, incoming_maxlen_exceeded, {size(Bin), H});
+ invalid(false, incoming_maxlen_exceeded, {size(Bin), H}),
+ H;
%% Ignore anything but an expected CER/CEA if so configured. This is
%% non-standard behaviour.
-recv1(Name, _, #state{state = {'Wait-CEA', _, _},
- strict = false})
+recv1(Name, #diameter_packet{header = H}, #state{state = {'Wait-CEA', _, _},
+ strict = false})
when Name /= 'CEA' ->
- ok;
-recv1(Name, _, #state{state = recv_CER,
- strict = false})
+ H;
+recv1(Name, #diameter_packet{header = H}, #state{state = recv_CER,
+ strict = false})
when Name /= 'CER' ->
- ok;
+ H;
%% Incoming request after outgoing DPR: discard. Don't discard DPR, so
%% both ends don't do so when sending simultaneously.
@@ -677,13 +717,15 @@ recv1(Name,
#diameter_packet{header = #diameter_header{is_request = true} = H},
#state{dpr = {_,_,_}})
when Name /= 'DPR' ->
- invalid(false, recv_after_outgoing_dpr, H);
+ invalid(false, recv_after_outgoing_dpr, H),
+ H;
%% Incoming request after incoming DPR: discard.
recv1(_,
#diameter_packet{header = #diameter_header{is_request = true} = H},
#state{dpr = true}) ->
- invalid(false, recv_after_incoming_dpr, H);
+ invalid(false, recv_after_incoming_dpr, H),
+ H;
%% DPA with identifier mismatch, or in response to a DPR initiated by
%% the service.
@@ -701,7 +743,7 @@ recv1('DPA' = N,
%% Any other message with a header and no length errors: send to the
%% parent.
recv1(Name, Pkt, #state{}) ->
- throw({?MODULE, Name, Pkt}).
+ {recv, Name, Pkt}.
%% recv/3
@@ -720,10 +762,12 @@ recv(#diameter_header{}
#diameter_packet{bin = Bin},
#state{length_errors = E}) ->
T = {size(Bin), bit_size(Bin) rem 8, H},
- invalid(E, message_length_mismatch, T);
+ invalid(E, message_length_mismatch, T),
+ Bin;
recv(false, #diameter_packet{bin = Bin}, #state{length_errors = E}) ->
- invalid(E, truncated_header, Bin).
+ invalid(E, truncated_header, Bin),
+ Bin.
%% Note that counters here only count discarded messages.
invalid(E, Reason, T) ->
@@ -767,26 +811,23 @@ rcv('DPA' = N,
= Pkt,
#state{dictionary = Dict0,
transport = TPid,
- dpr = {X, Hid, Eid}}) ->
+ dpr = {X, Hid, Eid},
+ codec = Opts}) ->
?LOG(recv, N),
X orelse begin
%% Only count DPA in response to a DPR sent by the
%% service: explicit DPR is counted in the same way
%% as other explicitly sent requests.
incr(recv, H, Dict0),
- incr_rc(recv, diameter_codec:decode(Dict0, Pkt), Dict0)
+ incr_rc(recv, diameter_codec:decode(Dict0, Opts, Pkt), Dict0)
end,
diameter_peer:close(TPid),
{stop, N};
-%% Ignore anything else, an unsolicited DPA in particular. Note that
-%% dpa_timeout deals with the case in which the peer sends the wrong
-%% identifiers in DPA.
-rcv(N, #diameter_packet{header = H}, _)
- when N == 'CER';
- N == 'CEA';
- N == 'DPR';
- N == 'DPA' ->
+%% Ignore an unsolicited DPA in particular. Note that dpa_timeout
+%% deals with the case in which the peer sends the wrong identifiers
+%% in DPA.
+rcv('DPA' = N, #diameter_packet{header = H}, _) ->
?LOG(ignored, N),
%% Note that these aren't counted in the normal recv counter.
diameter_stats:incr({diameter_codec:msg_id(H), recv, ignored}),
@@ -839,7 +880,7 @@ outgoing(#diameter_packet{header = #diameter_header{application_id = 0,
invalid(false, dpr_after_dpr, H) %% DPR sent: discard
end;
-%% Explict CER or DWR: discard. These are sent by us.
+%% Explicit CER or DWR: discard. These are sent by us.
outgoing(#diameter_packet{header = #diameter_header{application_id = 0,
cmd_code = C,
is_request = true}
@@ -875,15 +916,21 @@ header(Bin) -> %% DWR
%% Incoming CER or DPR.
handle_request(Name,
- #diameter_packet{header = H} = Pkt,
- #state{dictionary = Dict0} = S) ->
+ #diameter_packet{header = H}
+ = Pkt,
+ #state{dictionary = Dict0,
+ codec = Opts}
+ = S) ->
?LOG(recv, Name),
incr(recv, H, Dict0),
- send_answer(Name, diameter_codec:decode(Dict0, Pkt), S).
+ send_answer(Name, diameter_codec:decode(Dict0, Opts, Pkt), S).
%% send_answer/3
-send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) ->
+send_answer(Type, ReqPkt, #state{transport = TPid,
+ dictionary = Dict,
+ codec = Opts}
+ = S) ->
incr_error(recv, ReqPkt, Dict),
#diameter_packet{header = H,
@@ -902,7 +949,7 @@ send_answer(Type, ReqPkt, #state{transport = TPid, dictionary = Dict} = S) ->
msg = Msg,
transport_data = TD},
- AnsPkt = diameter_codec:encode(Dict, Pkt),
+ AnsPkt = diameter_codec:encode(Dict, Opts, Pkt),
incr(send, AnsPkt, Dict),
incr_rc(send, AnsPkt, Dict),
@@ -929,8 +976,6 @@ build_answer('CER',
= Pkt,
#state{dictionary = Dict0}
= S) ->
- diameter_codec:setopts([{string_decode, false}]),
-
{SupportedApps, RCaps, CEA} = recv_CER(CER, S),
[RC, IS] = Dict0:'#get-'(['Result-Code', 'Inband-Security-Id'], CEA),
@@ -1131,18 +1176,16 @@ recv_CER(CER, #state{service = Svc, dictionary = Dict}) ->
handle_CEA(#diameter_packet{header = H}
= Pkt,
#state{dictionary = Dict0,
- service = #diameter_service{capabilities = LCaps}}
+ service = #diameter_service{capabilities = LCaps},
+ codec = Opts}
= S) ->
incr(recv, H, Dict0),
#diameter_packet{}
= DPkt
- = diameter_codec:decode(Dict0, Pkt),
-
- diameter_codec:setopts([{string_decode, false}]),
+ = diameter_codec:decode(Dict0, Opts, Pkt),
RC = result_code(incr_rc(recv, DPkt, Dict0)),
-
{SApps, IS, RCaps} = recv_CEA(DPkt, S),
#diameter_caps{origin_host = {OH, DH}}
@@ -1330,8 +1373,9 @@ dpr([], [Reason | _], S) ->
-record(opts, {cause, timeout}).
-send_dpr(Reason, Opts, #state{dictionary = Dict,
- service = #diameter_service{capabilities = Caps}}
+send_dpr(Reason, DprOpts, #state{dictionary = Dict,
+ service = #diameter_service{capabilities = Caps},
+ codec = Opts}
= S) ->
#opts{cause = Cause, timeout = Tmo}
= lists:foldl(fun opt/2,
@@ -1340,7 +1384,7 @@ send_dpr(Reason, Opts, #state{dictionary = Dict,
_ -> ?REBOOT
end,
timeout = dpa_timeout()},
- Opts),
+ DprOpts),
#diameter_caps{origin_host = {OH, _},
origin_realm = {OR, _}}
= Caps,
@@ -1348,6 +1392,7 @@ send_dpr(Reason, Opts, #state{dictionary = Dict,
Pkt = encode(['DPR', {'Origin-Host', OH},
{'Origin-Realm', OR},
{'Disconnect-Cause', Cause}],
+ Opts,
Dict),
send_dpr(false, Pkt, Tmo, S).
diff --git a/lib/diameter/src/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl
index 9027130063..97e74657bd 100644
--- a/lib/diameter/src/base/diameter_reg.erl
+++ b/lib/diameter/src/base/diameter_reg.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.
@@ -137,7 +137,7 @@ match(Pat) ->
match(Pat, Pid) ->
ets:match_object(?TABLE, {Pat, Pid}).
-
+
%% ===========================================================================
%% # wait(Pat)
%%
diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl
index e4f77e3a24..788f697627 100644
--- a/lib/diameter/src/base/diameter_service.erl
+++ b/lib/diameter/src/base/diameter_service.erl
@@ -88,12 +88,6 @@
%% outside of the service process.
-define(STATE_TABLE, ?MODULE).
-%% The default sequence mask.
--define(NOMASK, {0,32}).
-
-%% The default restrict_connections.
--define(RESTRICT, nodes).
-
%% Workaround for dialyzer's lack of understanding of match specs.
-type match(T)
:: T | '_' | '$1' | '$2'.
@@ -110,21 +104,17 @@
service :: #diameter_service{},
watchdogT = ets_new(watchdogs) %% #watchdog{} at start
:: ets:tid(),
- peerT, %% undefined in new code, but remain for upgrade
- shared_peers, %% reasons. Replaced by local/remote.
- local_peers, %%
local :: {ets:tid(), ets:tid(), ets:tid()},
remote :: {ets:tid(), ets:tid(), ets:tid()},
monitor = false :: false | pid(), %% process to die with
- options
- :: [{sequence, diameter:sequence()} %% sequence mask
- | {share_peers, diameter:remotes()} %% broadcast to
- | {use_shared_peers, diameter:remotes()} %% use from
- | {restrict_connections, diameter:restriction()}
- | {strict_mbit, boolean()}
- | {string_decode, boolean()}
- | {incoming_maxlen, diameter:message_length()}]}).
-%% shared_peers reflects the peers broadcast from remote nodes.
+ options :: #{sequence := diameter:sequence(), %% sequence mask
+ share_peers := diameter:remotes(),%% broadcast to
+ use_shared_peers := diameter:remotes(),%% use from
+ restrict_connections := diameter:restriction(),
+ incoming_maxlen := diameter:message_length(),
+ strict_mbit := boolean(),
+ string_decode := boolean(),
+ spawn_opt := list() | {module(), atom(), list()}}}).
%% Record representing an RFC 3539 watchdog process implemented by
%% diameter_watchdog.
@@ -284,7 +274,7 @@ whois(SvcName) ->
%% ---------------------------------------------------------------------------
-spec pick_peer(SvcName, AppOrAlias, Opts)
- -> {{TPid, Caps, App}, Mask, SvcOpts}
+ -> {{{TPid, Caps}, App}, SvcOpts}
| false %% no selection
| {error, no_service}
when SvcName :: diameter:service_name(),
@@ -292,14 +282,12 @@ whois(SvcName) ->
| {alias, diameter:app_alias()},
Opts :: {fun((Dict :: module()) -> [term()]),
diameter:peer_filter(),
- Xtra :: list()},
+ Xtra :: list(),
+ [diameter:peer_ref()]},
TPid :: pid(),
Caps :: #diameter_caps{},
App :: #diameter_app{},
- Mask :: diameter:sequence(),
- SvcOpts :: [diameter:service_opt()].
-%% Extract Mask in the returned tuple so that diameter_traffic doesn't
-%% need to know about the ordering of SvcOpts used here.
+ SvcOpts :: map().
pick_peer(SvcName, App, Opts) ->
pick(lookup_state(SvcName), App, Opts).
@@ -319,16 +307,16 @@ pick(#state{service = #diameter_service{applications = Apps}}
pick(_, false = No, _) ->
No;
-pick(#state{options = [{_, Mask} | SvcOpts]}
+pick(#state{options = SvcOpts}
= S,
#diameter_app{module = ModX, dictionary = Dict}
= App0,
- {DestF, Filter, Xtra}) ->
+ {DestF, Filter, Xtra, TPids}) ->
App = App0#diameter_app{module = ModX ++ Xtra},
[_,_] = RealmAndHost = diameter_lib:eval([DestF, Dict]),
- case pick_peer(App, RealmAndHost, Filter, S) of
- {TPid, Caps} ->
- {{TPid, Caps, App}, Mask, SvcOpts};
+ case pick_peer(App, RealmAndHost, [Filter | TPids], S) of
+ {_TPid, _Caps} = TC ->
+ {{TC, App}, SvcOpts};
false = No ->
No
end.
@@ -526,6 +514,13 @@ transition({tc_timeout, T}, S) ->
tc_timeout(T, S),
ok;
+transition({nodeup, Node, _}, S) ->
+ nodeup(Node, S),
+ ok;
+
+transition({nodedown, _Node, _}, _) ->
+ ok;
+
transition(Req, S) ->
unexpected(handle_info, [Req], S),
ok.
@@ -556,81 +551,9 @@ terminate(Reason, #state{service_name = Name, local = {PeerT, _, _}} = S) ->
%% # code_change/3
%% ---------------------------------------------------------------------------
-code_change(_FromVsn, #state{} = S, _Extra) ->
- {ok, S};
-
-%% Don't support downgrade since we won't in appup.
-code_change({down = T, _}, _, _Extra) ->
- {error, T};
-
-%% Upgrade local/shared peers dicts populated in old code. Don't
-code_change(_FromVsn, S0, _Extra) ->
- {state, Id, SvcName, Svc, WT, PeerT, SDict, LDict, Monitor, Opts}
- = S0,
-
- init_peers(LT = setelement(1, {PT, _, _} = init_peers(), PeerT),
- fun({_,A}) -> A end),
- init_peers(init_peers(RT = init_peers(), SDict),
- fun(A) -> A end),
-
- S = #state{id = Id,
- service_name = SvcName,
- service = Svc,
- watchdogT = WT,
- peerT = PT, %% empty
- shared_peers = SDict,
- local_peers = LDict,
- local = LT,
- remote = RT,
- monitor = Monitor,
- options = Opts},
-
- %% Replacing the table entry and deleting the old shared tables
- %% can make outgoing requests return {error, no_connection} until
- %% everyone is running new code. Don't delete the tables to avoid
- %% crashing request processes.
- ets:delete_all_objects(SDict),
- ets:delete_all_objects(LDict),
- ets:insert(?STATE_TABLE, S),
+code_change(_FromVsn, S, _Extra) ->
{ok, S}.
-%% init_peers/2
-
-%% Populate app and identity bags from a new-style #peer{} sets.
-init_peers({PeerT, _, _} = T, F)
- when is_function(F) ->
- ets:foldl(fun(#peer{pid = P, apps = As, caps = C}, N) ->
- insert_peer(P, lists:map(F, As), C, T),
- N+1
- end,
- 0,
- PeerT);
-
-%% Populate #peer{} table given a shared peers dict.
-init_peers({PeerT, _, _}, SDict) ->
- dict:fold(fun(P, As, N) ->
- ets:update_element(PeerT, P, {#peer.apps, As}),
- N+1
- end,
- 0,
- diameter_dict:fold(fun(A, Ps, D) ->
- init_peers(A, Ps, PeerT, D)
- end,
- dict:new(),
- SDict)).
-
-%% init_peers/4
-
-init_peers(App, TCs, PeerT, Dict) ->
- lists:foldl(fun({P,C}, D) ->
- ets:insert(PeerT, #peer{pid = P,
- apps = [],
- caps = C}),
- dict:append(P, App, D)
- end,
- Dict,
- TCs).
-
%% ===========================================================================
%% ===========================================================================
@@ -768,7 +691,7 @@ cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts},
local = init_peers(),
remote = init_peers(),
monitor = mref(get_value(monitor, Opts)),
- options = service_options(Opts)},
+ options = service_options(lists:keydelete(monitor, 1, Opts))},
{S, Acc};
cfg_acc({_Ref, Type, _Opts} = T, {S, Acc})
@@ -784,25 +707,17 @@ init_peers() ->
%% TPid}
service_options(Opts) ->
- [{sequence, proplists:get_value(sequence, Opts, ?NOMASK)},
- {share_peers, get_value(share_peers, Opts)},
- {use_shared_peers, get_value(use_shared_peers, Opts)},
- {restrict_connections, proplists:get_value(restrict_connections,
- Opts,
- ?RESTRICT)},
- {spawn_opt, proplists:get_value(spawn_opt, Opts, [])},
- {string_decode, proplists:get_value(string_decode, Opts, true)},
- {incoming_maxlen, proplists:get_value(incoming_maxlen, Opts, 16#FFFFFF)},
- {strict_mbit, proplists:get_value(strict_mbit, Opts, true)}].
-%% The order of options is significant since we match against the list.
+ maps:from_list(Opts).
mref(false = No) ->
No;
mref(P) ->
monitor(process, P).
-init_shared(#state{options = [_, _, {_,T} | _],
+init_shared(#state{options = #{use_shared_peers := T},
service_name = Svc}) ->
+ T == false orelse net_kernel:monitor_nodes(true, [{node_type, visible},
+ nodedown_reason]),
notify(T, Svc, {service, self()}).
init_mod(#diameter_app{alias = Alias,
@@ -822,6 +737,11 @@ notify(Share, SvcName, T) ->
%% Test for the empty list for upgrade reasons: there's no
%% diameter_peer:notify/3 in old code.
+nodeup(Node, #state{options = #{share_peers := SP},
+ service_name = SvcName}) ->
+ lists:member(Node, remotes(SP))
+ andalso diameter_peer:notify([Node], SvcName, {service, self()}).
+
remotes(false) ->
[];
@@ -899,7 +819,8 @@ start(Ref, Type, Opts, State) ->
start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT,
local = {PeerT, _, _},
- options = SvcOpts,
+ options = #{string_decode := SD}
+ = SvcOpts0,
service_name = SvcName,
service = Svc0})
when Type == connect;
@@ -907,21 +828,25 @@ start(Ref, Type, Opts, N, #state{watchdogT = WatchdogT,
#diameter_service{applications = Apps}
= Svc1
= merge_service(Opts, Svc0),
- Svc = binary_caps(Svc1, proplists:get_value(string_decode, SvcOpts, true)),
- RecvData = diameter_traffic:make_recvdata([SvcName,
- PeerT,
- Apps,
- SvcOpts]),
- T = {{spawn_opts([Opts, SvcOpts]), RecvData}, Opts, SvcOpts, Svc},
+ Svc = binary_caps(Svc1, SD),
+ SvcOpts = merge_options(Opts, SvcOpts0),
+ RecvData = diameter_traffic:make_recvdata([SvcName, PeerT, Apps, SvcOpts]),
+ T = {Opts, SvcOpts, RecvData, Svc},
Rec = #watchdog{type = Type,
ref = Ref,
options = Opts},
+
diameter_lib:fold_n(fun(_,A) ->
[wd(Type, Ref, T, WatchdogT, Rec) | A]
end,
[],
N).
+merge_options(Opts, SvcOpts) ->
+ Keys = maps:keys(SvcOpts),
+ Map = maps:from_list([KV || {K,_} = KV <- Opts, lists:member(K, Keys)]),
+ maps:merge(SvcOpts, Map).
+
binary_caps(Svc, true) ->
Svc;
binary_caps(#diameter_service{capabilities = Caps} = Svc, false) ->
@@ -936,12 +861,6 @@ wd(Type, Ref, T, WatchdogT, Rec) ->
%% record so that each watchdog may get a different record. This
%% record is what is passed back into application callbacks.
-spawn_opts(Optss) ->
- SpawnOpts = get_value(spawn_opt, Optss, []),
- [T || T <- SpawnOpts,
- T /= link,
- T /= monitor].
-
start_watchdog(Type, Ref, T) ->
{_MRef, Pid} = diameter_watchdog:start({Type, Ref}, T),
Pid.
@@ -1154,18 +1073,6 @@ keyfind([Key | Rest], Pos, L) ->
T
end.
-%% get_value/3
-
-get_value(_, [], Def) ->
- Def;
-get_value(Key, [L | Rest], Def) ->
- case lists:keyfind(Key, 1, L) of
- {_,V} ->
- V;
- _ ->
- get_value(Key, Rest, Def)
- end.
-
%% find_outgoing_app/2
find_outgoing_app(Alias, Apps) ->
@@ -1463,19 +1370,19 @@ send_event(#diameter_event{service = SvcName} = E) ->
%% # share_peer/5
%% ---------------------------------------------------------------------------
-share_peer(up, Caps, Apps, TPid, #state{options = [_, {_,T} | _],
+share_peer(up, Caps, Apps, TPid, #state{options = #{share_peers := SP},
service_name = Svc}) ->
- notify(T, Svc, {peer, TPid, [A || {_,A} <- Apps], Caps});
+ notify(SP, Svc, {peer, TPid, [A || {_,A} <- Apps], Caps});
-share_peer(down, _Caps, _Apps, TPid, #state{options = [_, {_,T} | _],
+share_peer(down, _Caps, _Apps, TPid, #state{options = #{share_peers := SP},
service_name = Svc}) ->
- notify(T, Svc, {peer, TPid}).
+ notify(SP, Svc, {peer, TPid}).
%% ---------------------------------------------------------------------------
%% # share_peers/2
%% ---------------------------------------------------------------------------
-share_peers(Pid, #state{options = [_, {_,SP} | _],
+share_peers(Pid, #state{options = #{share_peers := SP},
local = {PeerT, AppT, _}}) ->
is_remote(Pid, SP)
andalso ets:foldl(fun(T, N) -> N + sp(Pid, AppT, T) end,
@@ -1507,8 +1414,15 @@ is_remote(Pid, T) ->
%% # remote_peer_up/4
%% ---------------------------------------------------------------------------
-remote_peer_up(TPid, Aliases, Caps, #state{options = [_, _, {_,T} | _]} = S) ->
- is_remote(TPid, T) andalso rpu(TPid, Aliases, Caps, S).
+remote_peer_up(TPid, Aliases, Caps, #state{options = #{use_shared_peers := T},
+ remote = {PeerT, _, _}}
+ = S) ->
+ is_remote(TPid, T)
+ andalso not ets:member(PeerT, TPid)
+ andalso rpu(TPid, Aliases, Caps, S).
+
+%% Notification can be duplicate since remote nodes push and the local
+%% node pulls.
rpu(TPid, Aliases, Caps, #state{service = Svc, remote = RT}) ->
#diameter_service{applications = Apps} = Svc,
@@ -1518,6 +1432,7 @@ rpu(TPid, Aliases, Caps, #state{service = Svc, remote = RT}) ->
rpu(_, [] = No, _, _) ->
No;
+
rpu(TPid, Aliases, Caps, {PeerT, _, _} = RT) ->
monitor(process, TPid),
ets:insert(PeerT, #peer{pid = TPid,
@@ -1629,8 +1544,14 @@ pick_peer(Local,
%% peers/4
-peers(Alias, RH, Filter, T) ->
- filter(Alias, RH, Filter, T, true).
+%% No peer options pointing at specific peers: search for them.
+peers(Alias, RH, [Filter], T) ->
+ filter(Alias, RH, Filter, T, true);
+
+%% Or just lookup.
+peers(_Alias, RH, [Filter | TPids], {PeerT, _AppT, _IdentT}) ->
+ {Ts, _} = filter(caps(PeerT, TPids), RH, Filter),
+ Ts.
%% filter/5
%%
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index bc1ccf4feb..85378babea 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -30,7 +30,7 @@
-export([send_request/4]).
%% towards diameter_watchdog
--export([receive_message/6]).
+-export([receive_message/5]).
%% towards diameter_peer_fsm and diameter_watchdog
-export([incr/4,
@@ -54,8 +54,7 @@
-define(RELAY, ?DIAMETER_DICT_RELAY).
-define(BASE, ?DIAMETER_DICT_COMMON). %% Note: the RFC 3588 dictionary
--define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests
--define(DEFAULT_SPAWN_OPTS, []).
+-define(DEFAULT(V, Def), if V == undefined -> Def; true -> V end).
%% Table containing outgoing entries that live and die with
%% peer_up/down. The name is historic, since the table used to contain
@@ -65,9 +64,10 @@
%% Record diameter:call/4 options are parsed into.
-record(options,
- {filter = none :: diameter:peer_filter(),
+ {peers = [] :: [diameter:peer_ref()],
+ filter = none :: diameter:peer_filter(),
extra = [] :: list(),
- timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF,
+ timeout = 5000 :: 0..16#FFFFFFFF, %% for outgoing requests
detach = false :: boolean()}).
%% Term passed back to receive_message/6 with every incoming message.
@@ -76,9 +76,9 @@
service_name :: diameter:service_name(),
apps :: [#diameter_app{}],
sequence :: diameter:sequence(),
- codec :: [{string_decode, boolean()}
- | {strict_mbit, boolean()}
- | {incoming_maxlen, diameter:message_length()}]}).
+ codec :: #{string_decode := boolean(),
+ strict_mbit := boolean(),
+ incoming_maxlen := diameter:message_length()}}).
%% Note that incoming_maxlen is currently handled in diameter_peer_fsm,
%% so that any message exceeding the maximum is discarded. Retain the
%% option in case we want to extend the values and semantics.
@@ -88,24 +88,25 @@
{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
+ peer :: undefined | {pid(), #diameter_caps{}},
packet :: #diameter_packet{} | undefined}). %% of request
%% ---------------------------------------------------------------------------
-%% # make_recvdata/1
+%% make_recvdata/1
%% ---------------------------------------------------------------------------
make_recvdata([SvcName, PeerT, Apps, SvcOpts | _]) ->
- {_,_} = Mask = proplists:get_value(sequence, SvcOpts),
- #recvdata{service_name = SvcName,
- peerT = PeerT,
- apps = Apps,
- sequence = Mask,
- codec = [T || {K,_} = T <- SvcOpts,
- lists:member(K, [string_decode,
- incoming_maxlen,
- strict_mbit])]}.
+ #{sequence := {_,_} = Mask, spawn_opt := Opts}
+ = SvcOpts,
+ {Opts, #recvdata{service_name = SvcName,
+ peerT = PeerT,
+ apps = Apps,
+ sequence = Mask,
+ codec = maps:with([string_decode,
+ strict_mbit,
+ ordered_encode,
+ incoming_maxlen],
+ SvcOpts)}}.
%% ---------------------------------------------------------------------------
%% peer_up/1
@@ -206,42 +207,40 @@ incr_rc(Dir, Pkt, TPid, Dict0) ->
incr_rc(Dir, Pkt, TPid, {Dict0, Dict0, Dict0}).
%% ---------------------------------------------------------------------------
-%% # receive_message/6
+%% receive_message/5
%%
-%% Handle an incoming Diameter message.
+%% Handle an incoming Diameter message in a watchdog process.
%% ---------------------------------------------------------------------------
-%% Handle an incoming Diameter message in the watchdog process.
-
-receive_message(TPid, Route, Pkt, false, Dict0, RecvData) ->
- incoming(TPid, Route, Pkt, Dict0, RecvData);
-
-receive_message(TPid, Route, Pkt, NPid, Dict0, RecvData) ->
- NPid ! {diameter, incoming(TPid, Route, Pkt, Dict0, RecvData)}.
-
-%% incoming/4
-
-incoming(TPid, Route, Pkt, Dict0, RecvData)
- when is_pid(TPid) ->
+-spec receive_message(pid(), Route, #diameter_packet{}, module(), RecvData)
+ -> pid() %% request handler
+ | boolean() %% answer, known request or not
+ | discard %% request discarded by MFA
+ when Route :: {Handler, RequestRef, Seqs}
+ | Ack,
+ RecvData :: {[SpawnOpt], #recvdata{}},
+ SpawnOpt :: term(),
+ Handler :: pid(),
+ RequestRef :: reference(),
+ Seqs :: {0..16#FFFFFFFF, 0..16#FFFFFFFF},
+ Ack :: boolean().
+
+receive_message(TPid, Route, Pkt, Dict0, RecvData) ->
#diameter_packet{header = #diameter_header{is_request = R}} = Pkt,
recv(R, Route, TPid, Pkt, Dict0, RecvData).
%% recv/6
%% Incoming request ...
-recv(true, false, TPid, Pkt, Dict0, T) ->
- try
- {request, spawn_request(TPid, Pkt, Dict0, T)}
- catch
- error: system_limit = E -> %% discard
- ?LOG(error, E),
- discard
- end;
+recv(true, Ack, TPid, Pkt, Dict0, T)
+ when is_boolean(Ack) ->
+ {Opts, RecvData} = T,
+ spawn_request(Ack, TPid, Pkt, Dict0, RecvData, Opts);
%% ... answer to known request ...
recv(false, {Pid, Ref, TPid}, _, Pkt, Dict0, _) ->
Pid ! {answer, Ref, TPid, Dict0, Pkt},
- {answer, Pid};
+ true;
%% Note that failover could have happened prior to this message being
%% received and triggering failback. That is, both a failover message
@@ -256,69 +255,91 @@ recv(false, {Pid, Ref, TPid}, _, Pkt, Dict0, _) ->
recv(false, false, TPid, Pkt, _, _) ->
?LOG(discarded, Pkt#diameter_packet.header),
incr(TPid, {{unknown, 0}, recv, discarded}),
- discard.
+ false.
-%% spawn_request/4
+%% spawn_request/6
+
+%% An MFA should return a pid() or the atom 'discard'. The latter
+%% results in an acknowledgment back to the transport process when
+%% appropriate, to ensure that send/recv callbacks can count
+%% outstanding requests. Acknowledgement is implicit if the
+%% handler process dies (in a handle_request callback for example).
+spawn_request(Ack, TPid, Pkt, Dict0, RecvData, {M,F,A}) ->
+ ReqF = fun() ->
+ ack(Ack, TPid, recv_request(Ack, TPid, Pkt, Dict0, RecvData))
+ end,
+ ack(Ack, TPid, apply(M, F, [ReqF | A]));
-spawn_request(TPid, Pkt, Dict0, {Opts, RecvData}) ->
- spawn_request(TPid, Pkt, Dict0, Opts, RecvData);
-spawn_request(TPid, Pkt, Dict0, RecvData) ->
- spawn_request(TPid, Pkt, Dict0, ?DEFAULT_SPAWN_OPTS, RecvData).
+%% A spawned process acks implicitly when it dies, so there's no need
+%% to handle 'discard'.
+spawn_request(Ack, TPid, Pkt, Dict0, RecvData, Opts) ->
+ spawn_opt(fun() ->
+ recv_request(Ack, TPid, Pkt, Dict0, RecvData)
+ end,
+ Opts).
-spawn_request(TPid, Pkt, Dict0, Opts, RecvData) ->
- spawn_opt(fun() -> recv_request(TPid, Pkt, Dict0, RecvData) end, Opts).
+%% ack/3
+
+ack(Ack, TPid, RC) ->
+ RC == discard andalso Ack andalso (TPid ! {send, false}),
+ RC.
%% ---------------------------------------------------------------------------
-%% recv_request/4
+%% recv_request/5
%% ---------------------------------------------------------------------------
-recv_request(TPid,
+-spec recv_request(Ack :: boolean(),
+ TPid :: pid(),
+ #diameter_packet{},
+ Dict0 :: module(),
+ #recvdata{})
+ -> ok %% answer was sent
+ | discard %% or not
+ | false. %% no transport
+
+recv_request(Ack,
+ TPid,
#diameter_packet{header = #diameter_header{application_id = Id}}
= Pkt,
Dict0,
#recvdata{peerT = PeerT,
- apps = Apps,
- codec = Opts}
+ apps = Apps}
= RecvData) ->
- diameter_codec:setopts([{common_dictionary, Dict0} | Opts]),
- send_A(recv_R(diameter_service:find_incoming_app(PeerT, TPid, Id, Apps),
- TPid,
- Pkt,
- Dict0,
- RecvData),
- TPid,
- Dict0,
- RecvData).
-
-%% recv_R/5
-
-recv_R({#diameter_app{id = Id, dictionary = AppDict} = App, Caps},
- TPid,
- Pkt0,
- Dict0,
- RecvData) ->
- incr(recv, Pkt0, TPid, AppDict),
- Pkt = errors(Id, diameter_codec:decode(Id, AppDict, Pkt0)),
- incr_error(recv, Pkt, TPid, AppDict),
- {Caps, Pkt, App, recv_R(App, TPid, Dict0, Caps, RecvData, Pkt)};
-%% Note that the decode is different depending on whether or not Id is
-%% ?APP_ID_RELAY.
-
-%% DIAMETER_APPLICATION_UNSUPPORTED 3007
-%% A request was sent for an application that is not supported.
-
-recv_R(#diameter_caps{}
- = Caps,
- _TPid,
- #diameter_packet{errors = Es}
- = Pkt,
- _Dict0,
- _RecvData) ->
- {Caps, Pkt#diameter_packet{avps = collect_avps(Pkt),
- errors = [3007 | Es]}};
+ Ack andalso (TPid ! {handler, self()}),
+ case diameter_service:find_incoming_app(PeerT, TPid, Id, Apps) of
+ {#diameter_app{id = Aid, dictionary = AppDict} = App, Caps} ->
+ incr(recv, Pkt, TPid, AppDict),
+ DecPkt = decode(Aid, AppDict, RecvData, Pkt),
+ incr_error(recv, DecPkt, TPid, AppDict),
+ send_A(recv_R(App, TPid, Dict0, Caps, RecvData, DecPkt),
+ TPid,
+ App,
+ Dict0,
+ RecvData,
+ DecPkt,
+ Caps);
+ #diameter_caps{} = Caps ->
+ %% DIAMETER_APPLICATION_UNSUPPORTED 3007
+ %% A request was sent for an application that is not
+ %% supported.
+ RC = 3007,
+ Es = Pkt#diameter_packet.errors,
+ DecPkt = Pkt#diameter_packet{avps = collect_avps(Pkt),
+ errors = [RC | Es]},
+ send_answer(answer_message(RC, Dict0, Caps, DecPkt),
+ TPid,
+ Dict0,
+ Dict0,
+ Dict0,
+ RecvData,
+ DecPkt,
+ [[]]);
+ false = No -> %% transport has gone down
+ No
+ end.
-recv_R(false = No, _, _, _, _) -> %% transport has gone down
- No.
+decode(Id, Dict, #recvdata{codec = Opts}, Pkt) ->
+ errors(Id, diameter_codec:decode(Id, Dict, Opts, Pkt)).
collect_avps(Pkt) ->
case diameter_codec:collect_avps(Pkt) of
@@ -328,6 +349,14 @@ collect_avps(Pkt) ->
Avps
end.
+%% send_A/7
+
+send_A([T | Fs], TPid, App, Dict0, RecvData, DecPkt, Caps) ->
+ send_A(T, TPid, App, Dict0, RecvData, DecPkt, Caps, Fs);
+
+send_A(discard = No, _, _, _, _, _, _) ->
+ No.
+
%% recv_R/6
%% Answer errors ourselves ...
@@ -337,9 +366,9 @@ recv_R(#diameter_app{options = [_, {request_errors, E} | _]},
_Caps,
_RecvData,
#diameter_packet{errors = [RC|_]}) %% a detected 3xxx is hd
- when E == answer, (Dict0 /= ?BASE orelse 3 == RC div 1000);
+ when E == answer, Dict0 /= ?BASE orelse 3 == RC div 1000;
E == answer_3xxx, 3 == RC div 1000 ->
- {{answer_message, rc(RC)}, [], []};
+ [{answer_message, rc(RC)}, []];
%% ... or make a handle_request callback. Note that
%% Pkt#diameter_packet.msg = undefined in the 3001 case.
@@ -431,24 +460,24 @@ errors(_, Pkt) ->
%% command code in this case. It will also then ignore Dict and use
%% the base encoder.
request_cb({reply, _Ans} = T, _App, EvalPktFs, EvalFs) ->
- {T, EvalPktFs, EvalFs};
+ [T, EvalPktFs | EvalFs];
%% An 3xxx result code, for which the E-bit is set in the header.
request_cb({protocol_error, RC}, _App, EvalPktFs, EvalFs)
when 3 == RC div 1000 ->
- {{answer_message, RC}, EvalPktFs, EvalFs};
+ [{answer_message, RC}, EvalPktFs | EvalFs];
request_cb({answer_message, RC} = T, _App, EvalPktFs, EvalFs)
when 3 == RC div 1000;
5 == RC div 1000 ->
- {T, EvalPktFs, EvalFs};
+ [T, EvalPktFs | EvalFs];
%% RFC 3588 says we must reply 3001 to anything unrecognized or
%% unsupported. 'noreply' is undocumented (and inappropriately named)
%% backwards compatibility for this, protocol_error the documented
%% alternative.
request_cb(noreply, _App, EvalPktFs, EvalFs) ->
- {{answer_message, 3001}, EvalPktFs, EvalFs};
+ [{answer_message, 3001}, EvalPktFs | EvalFs];
%% Relay a request to another peer. This is equivalent to doing an
%% explicit call/4 with the message in question except that (1) a loop
@@ -469,7 +498,7 @@ request_cb({A, Opts}, #diameter_app{id = Id}, EvalPktFs, EvalFs)
when A == relay, Id == ?APP_ID_RELAY;
A == proxy, Id /= ?APP_ID_RELAY;
A == resend ->
- {{call, Opts}, EvalPktFs, EvalFs};
+ [{call, Opts}, EvalPktFs | EvalFs];
request_cb(discard = No, _, _, _) ->
No;
@@ -483,71 +512,95 @@ request_cb({eval, RC, F}, App, EvalPktFs, Fs) ->
request_cb(T, App, _, _) ->
?ERROR({invalid_return, T, handle_request, App}).
-%% send_A/4
+%% send_A/8
-send_A({Caps, Pkt}, TPid, Dict0, _RecvData) -> %% unsupported application
- #diameter_packet{errors = [RC|_]} = Pkt,
- send_A(answer_message(RC, Caps, Dict0, Pkt),
- TPid,
- {Dict0, Dict0},
- Pkt,
- [],
- []);
+send_A({reply, Ans}, TPid, App, Dict0, RecvData, Pkt, _Caps, Fs) ->
+ AppDict = App#diameter_app.dictionary,
+ MsgDict = msg_dict(AppDict, Dict0, Ans),
+ send_answer(Ans,
+ TPid,
+ MsgDict,
+ AppDict,
+ Dict0,
+ RecvData,
+ Pkt,
+ Fs);
+
+send_A({call, Opts}, TPid, App, Dict0, RecvData, Pkt, Caps, Fs) ->
+ AppDict = App#diameter_app.dictionary,
+ case resend(Opts, Caps, Pkt, App, Dict0, RecvData) of
+ #diameter_packet{bin = Bin} = Ans -> %% answer: reset hop by hop id
+ #diameter_packet{header = #diameter_header{hop_by_hop_id = Id},
+ transport_data = TD}
+ = Pkt,
+ Reset = diameter_codec:hop_by_hop_id(Id, Bin),
+ MsgDict = msg_dict(AppDict, Dict0, Ans),
+ send_answer(Ans#diameter_packet{bin = Reset,
+ transport_data = TD},
+ TPid,
+ MsgDict,
+ AppDict,
+ Dict0,
+ Fs);
+ RC ->
+ send_answer(answer_message(RC, Dict0, Caps, Pkt),
+ TPid,
+ Dict0,
+ AppDict,
+ Dict0,
+ RecvData,
+ Pkt,
+ Fs)
+ end;
+
+%% RFC 3588 only allows 3xxx errors in an answer-message. RFC 6733
+%% added the possibility of setting 5xxx.
+
+send_A({answer_message, RC} = T, TPid, App, Dict0, RecvData, Pkt, Caps, Fs) ->
+ Dict0 /= ?BASE orelse 3 == RC div 1000
+ orelse ?ERROR({invalid_return, T, handle_request, App}),
+ send_answer(answer_message(RC, Dict0, Caps, Pkt),
+ TPid,
+ Dict0,
+ App#diameter_app.dictionary,
+ Dict0,
+ RecvData,
+ Pkt,
+ Fs).
-send_A({Caps, Pkt, App, {T, EvalPktFs, EvalFs}}, TPid, Dict0, RecvData) ->
- send_A(answer(T, Caps, Pkt, App, Dict0, RecvData),
- TPid,
- {App#diameter_app.dictionary, Dict0},
- Pkt,
- EvalPktFs,
- EvalFs);
+%% send_answer/8
-send_A(_, _, _, _) ->
- ok.
+%% Skip the setting of Result-Code and Failed-AVP's below. This is
+%% undocumented and shouldn't be relied on.
+send_answer([Ans], TPid, MsgDict, AppDict, Dict0, RecvData, Pkt, Fs)
+ when [] == Pkt#diameter_packet.errors ->
+ send_answer(Ans, TPid, MsgDict, AppDict, Dict0, RecvData, Pkt, Fs);
+send_answer([Ans], TPid, MsgDict, AppDict, Dict0, RecvData, Pkt0, Fs) ->
+ Pkt = Pkt0#diameter_packet{errors = []},
+ send_answer(Ans, TPid, MsgDict, AppDict, Dict0, RecvData, Pkt, Fs);
+
+send_answer(Ans, TPid, MsgDict, AppDict, Dict0, RecvData, DecPkt, Fs) ->
+ Pkt = encode({MsgDict, AppDict},
+ TPid,
+ RecvData#recvdata.codec,
+ make_answer_packet(Ans, DecPkt, MsgDict, Dict0)),
+ send_answer(Pkt, TPid, MsgDict, AppDict, Dict0, Fs).
-%% send_A/6
+%% send_answer/6
-send_A(T, TPid, {AppDict, Dict0} = DictT0, ReqPkt, EvalPktFs, EvalFs) ->
- {MsgDict, Pkt} = reply(T, TPid, DictT0, EvalPktFs, ReqPkt),
+send_answer(Pkt, TPid, MsgDict, AppDict, Dict0, [EvalPktFs | EvalFs]) ->
+ eval_packet(Pkt, EvalPktFs),
incr(send, Pkt, TPid, AppDict),
incr_rc(send, Pkt, TPid, {MsgDict, AppDict, Dict0}), %% count outgoing
- send(TPid, Pkt),
+ send(TPid, z(Pkt), _Route = self()),
lists:foreach(fun diameter_lib:eval/1, EvalFs).
-%% answer/6
-
-answer({reply, Ans}, _Caps, _Pkt, App, Dict0, _RecvData) ->
- {msg_dict(App#diameter_app.dictionary, Dict0, Ans), Ans};
-
-answer({call, Opts}, Caps, Pkt, App, Dict0, RecvData) ->
- #diameter_caps{origin_host = {OH,_}}
- = Caps,
- #diameter_packet{avps = Avps}
- = Pkt,
- {Code, _Flags, Vid} = Dict0:avp_header('Route-Record'),
- resend(is_loop(Code, Vid, OH, Dict0, Avps),
- Opts,
- Caps,
- Pkt,
- App,
- Dict0,
- RecvData);
-
-%% RFC 3588 only allows 3xxx errors in an answer-message. RFC 6733
-%% added the possibility of setting 5xxx.
-answer({answer_message, RC} = T, Caps, Pkt, App, Dict0, _RecvData) ->
- Dict0 /= ?BASE orelse 3 == RC div 1000
- orelse ?ERROR({invalid_return, T, handle_request, App}),
- answer_message(RC, Caps, Dict0, Pkt).
-
%% msg_dict/3
%%
%% Return the dictionary defining the message grammar in question: the
%% application dictionary or the common dictionary.
-msg_dict(AppDict, Dict0, [Msg])
- when is_list(Msg);
- is_tuple(Msg) ->
+msg_dict(AppDict, Dict0, [Msg]) ->
msg_dict(AppDict, Dict0, Msg);
msg_dict(AppDict, Dict0, Msg) ->
@@ -578,14 +631,10 @@ is_answer_message(Rec, Dict) ->
error:_ -> false
end.
-%% answer_message/4
+%% resend/6
-answer_message(RC,
- #diameter_caps{origin_host = {OH,_},
- origin_realm = {OR,_}},
- Dict0,
- Pkt) ->
- {Dict0, answer_message(OH, OR, RC, Dict0, Pkt)}.
+resend(Opts, Caps, Pkt, App, Dict0, RecvData) ->
+ resend(is_loop(Dict0, Caps, Pkt), Opts, Caps, Pkt, App, Dict0, RecvData).
%% resend/7
@@ -595,8 +644,8 @@ answer_message(RC,
%% if one is available, but the peer reporting the error has
%% identified a configuration problem.
-resend(true, _Opts, Caps, Pkt, _App, Dict0, _RecvData) ->
- answer_message(3005, Caps, Dict0, Pkt);
+resend(true, _Opts, _Caps, _Pkt, _App, _Dict0, _RecvData) ->
+ 3005;
%% 6.1.8. Relaying and Proxying Requests
%%
@@ -606,11 +655,9 @@ resend(true, _Opts, Caps, Pkt, _App, Dict0, _RecvData) ->
resend(false,
Opts,
- #diameter_caps{origin_host = {_,OH}}
- = Caps,
+ #diameter_caps{origin_host = {_,OH}},
#diameter_packet{header = Hdr0,
- avps = Avps}
- = Pkt,
+ avps = Avps},
App,
Dict0,
#recvdata{service_name = SvcName,
@@ -619,7 +666,12 @@ resend(false,
Seq = diameter_session:sequence(Mask),
Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq},
Msg = [Hdr, Route | Avps], %% reordered at encode
- resend(send_request(SvcName, App, Msg, Opts), Caps, Dict0, Pkt).
+ case send_request(SvcName, App, Msg, Opts) of
+ #diameter_packet{} = Ans ->
+ Ans;
+ _ ->
+ 3002 %% DIAMETER_UNABLE_TO_DELIVER.
+ end.
%% The incoming request is relayed with the addition of a
%% Route-Record. Note the requirement on the return from call/4 below,
%% which places a requirement on the value returned by the
@@ -636,96 +688,38 @@ resend(false,
%% RFC 6.3 says that a relay agent does not modify Origin-Host but
%% says nothing about a proxy. Assume it should behave the same way.
-%% resend/4
-%%
-%% Relay a reply to a relayed request.
-
-%% Answer from the peer: reset the hop by hop identifier.
-resend(#diameter_packet{bin = B}
- = Pkt,
- _Caps,
- _Dict0,
- #diameter_packet{header = #diameter_header{hop_by_hop_id = Id},
- transport_data = TD}) ->
- Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B),
- transport_data = TD};
-%% TODO: counters
+%% is_loop/3
-%% Or not: DIAMETER_UNABLE_TO_DELIVER.
-resend(_, Caps, Dict0, Pkt) ->
- answer_message(3002, Caps, Dict0, Pkt).
+is_loop(Dict0,
+ #diameter_caps{origin_host = {OH,_}},
+ #diameter_packet{avps = Avps}) ->
+ {Code, _Flags, Vid} = Dict0:avp_header('Route-Record'),
+ is_loop(Code, Vid, OH, Avps).
-%% is_loop/5
+%% is_loop/4
%%
%% Is there a Route-Record AVP with our Origin-Host?
-is_loop(Code,
- Vid,
- Bin,
- _Dict0,
- [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) ->
+is_loop(Code, Vid, Bin, [#diameter_avp{code = Code,
+ vendor_id = Vid,
+ data = Bin}
+ | _]) ->
true;
-is_loop(_, _, _, _, []) ->
+is_loop(_, _, _, []) ->
false;
-is_loop(Code, Vid, OH, Dict0, [_ | Avps])
+is_loop(Code, Vid, OH, [_ | Avps])
when is_binary(OH) ->
- is_loop(Code, Vid, OH, Dict0, Avps);
-
-is_loop(Code, Vid, OH, Dict0, Avps) ->
- is_loop(Code, Vid, Dict0:avp(encode, OH, 'Route-Record'), Dict0, Avps).
-
-%% reply/5
-
-%% Local answer ...
-reply({MsgDict, Ans}, TPid, {AppDict, Dict0}, Fs, ReqPkt) ->
- local(Ans, TPid, {MsgDict, AppDict, Dict0}, Fs, ReqPkt);
-
-%% ... or relayed.
-reply(#diameter_packet{} = Pkt, _TPid, {AppDict, Dict0}, Fs, _ReqPkt) ->
- eval_packet(Pkt, Fs),
- {msg_dict(AppDict, Dict0, Pkt), Pkt}.
-
-%% local/5
-%%
-%% Send a locally originating reply.
-
-%% Skip the setting of Result-Code and Failed-AVP's below. This is
-%% undocumented and shouldn't be relied on.
-local([Msg], TPid, DictT, Fs, ReqPkt)
- when is_list(Msg);
- is_tuple(Msg) ->
- local(Msg, TPid, DictT, Fs, ReqPkt#diameter_packet{errors = []});
-
-local(Msg, TPid, {MsgDict, AppDict, Dict0}, Fs, ReqPkt) ->
- Pkt = encode({MsgDict, AppDict},
- TPid,
- reset(make_answer_packet(Msg, ReqPkt), MsgDict, Dict0),
- Fs),
- {MsgDict, Pkt}.
-
-%% reset/3
+ is_loop(Code, Vid, OH, Avps);
-%% Header/avps list: send as is.
-reset(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _, _) ->
- Pkt;
-
-%% No errors to set or errors explicitly ignored.
-reset(#diameter_packet{errors = Es} = Pkt, _, _)
- when Es == [];
- Es == false ->
- Pkt;
-
-%% Otherwise possibly set Result-Code and/or Failed-AVP.
-reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict, Dict0) ->
- {RC, Failed} = select_error(Msg, Es, Dict0),
- Pkt#diameter_packet{msg = reset(Msg, Dict, RC, Failed)}.
+is_loop(Code, Vid, OH, Avps) ->
+ is_loop(Code, Vid, list_to_binary(OH), Avps).
%% select_error/3
%%
%% Extract the first appropriate RC or {RC, #diameter_avp{}}
-%% pair from an errors list, and accumulate all #diameter_avp{}.
+%% pair from an errors list, along with any leading #diameter_avp{}.
%%
%% RFC 6733:
%%
@@ -740,95 +734,138 @@ reset(#diameter_packet{msg = Msg, errors = Es} = Pkt, Dict, Dict0) ->
%% indicated by the Result-Code AVP. For practical purposes, this
%% Failed-AVP would typically refer to the first AVP processing error
%% that a Diameter node encounters.
+%%
+%% 3xxx can only be set in an answer setting the E-bit. RFC 6733 also
+%% allows 5xxx, RFC 3588 doesn't.
-select_error(Msg, Es, Dict0) ->
- {RC, Avps} = lists:foldl(fun(T,A) -> select(T, A, Dict0) end,
- {is_answer_message(Msg, Dict0), []},
- Es),
- {RC, lists:reverse(Avps)}.
+select_error(E, Es, Dict0) ->
+ select(E, Es, Dict0, []).
-%% Only integer() and {integer(), #diameter_avp{}} are the result of
-%% decode. #diameter_avp{} can only be set in a reply for encode.
+%% select/4
-select(#diameter_avp{} = A, {RC, As}, _) ->
- {RC, [A|As]};
+select(E, [{RC, _} = T | Es], Dict0, Avps) ->
+ select(E, RC, T, Es, Dict0, Avps);
-select(_, {RC, _} = Acc, _)
- when is_integer(RC) ->
- Acc;
+select(E, [#diameter_avp{} = A | Es], Dict0, Avps) ->
+ select(E, Es, Dict0, [A | Avps]);
-select({RC, #diameter_avp{} = A}, {IsAns, As} = Acc, Dict0)
- when is_integer(RC) ->
- case is_result(RC, IsAns, Dict0) of
- true -> {RC, [A|As]};
- false -> Acc
- end;
+select(E, [RC | Es], Dict0, Avps) ->
+ select(E, RC, RC, Es, Dict0, Avps);
-select(RC, {IsAns, As} = Acc, Dict0)
- when is_boolean(IsAns), is_integer(RC) ->
- case is_result(RC, IsAns, Dict0) of
- true -> {RC, As};
- false -> Acc
- end.
+select(_, [], _, Avps) ->
+ Avps.
-%% reset/4
+%% select/6
+
+select(E, RC, T, _, Dict0, Avps)
+ when E, 3000 =< RC, RC < 4000; %% E-bit with 3xxx
+ E, ?BASE /= Dict0, 5000 =< RC, RC < 6000; %% E-bit with 5xxx
+ not E, RC < 3000 orelse 4000 =< RC -> %% no E-bit
+ [T | Avps];
-reset(Msg, Dict, RC, Avps) ->
- FailedAVP = failed_avp(Msg, Avps, Dict),
- ResultCode = rc(Msg, RC, Dict),
- set(set(Msg, FailedAVP, Dict), ResultCode, Dict).
+select(E, _, _, Es, Dict0, Avps) ->
+ select(E, Es, Dict0, Avps).
%% eval_packet/2
eval_packet(Pkt, Fs) ->
lists:foreach(fun(F) -> diameter_lib:eval([F,Pkt]) end, Fs).
-%% make_answer_packet/2
+%% make_answer_packet/4
%% Use decode errors to set Result-Code and/or Failed-AVP unless the
%% the errors field has been explicitly set. Unfortunately, the
%% default value is the empty list rather than 'undefined' so use the
%% atom 'false' for "set nothing". (This is historical and changing
-%% the default value would require modules including diameter.hrl to
-%% be recompiled.)
-make_answer_packet(#diameter_packet{errors = []}
- = Pkt,
- #diameter_packet{errors = [_|_] = Es}
- = ReqPkt) ->
- make_answer_packet(Pkt#diameter_packet{errors = Es}, ReqPkt);
+%% the default value would impact anyone expecting relying on the old
+%% default.)
-%% A reply message clears the R and T flags and retains the P flag.
-%% The E flag will be set at encode. 6.2 of 3588 requires the same P
-%% flag on an answer as on the request. A #diameter_packet{} returned
-%% from a handle_request callback can circumvent this by setting its
-%% own header values.
make_answer_packet(#diameter_packet{header = Hdr,
msg = Msg,
errors = Es,
transport_data = TD},
- #diameter_packet{header = ReqHdr}) ->
- Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION,
- is_request = false,
- is_error = undefined,
- is_retransmitted = false},
- #diameter_packet{header = fold_record(Hdr0, Hdr),
- msg = Msg,
- errors = Es,
+ #diameter_packet{header = Hdr0,
+ errors = Es0},
+ MsgDict,
+ Dict0) ->
+ #diameter_packet{header = make_answer_header(Hdr0, Hdr),
+ msg = reset(Msg, Es0, Es, MsgDict, Dict0),
transport_data = TD};
%% Binaries and header/avp lists are sent as-is.
-make_answer_packet(Bin, #diameter_packet{transport_data = TD})
+make_answer_packet(Bin, #diameter_packet{transport_data = TD}, _, _)
when is_binary(Bin) ->
#diameter_packet{bin = Bin,
transport_data = TD};
make_answer_packet([#diameter_header{} | _] = Msg,
- #diameter_packet{transport_data = TD}) ->
+ #diameter_packet{transport_data = TD},
+ _,
+ _) ->
#diameter_packet{msg = Msg,
transport_data = TD};
-%% Otherwise, preserve transport_data.
-make_answer_packet(Msg, #diameter_packet{transport_data = TD} = Pkt) ->
- make_answer_packet(#diameter_packet{msg = Msg, transport_data = TD}, Pkt).
+make_answer_packet(Msg,
+ #diameter_packet{header = Hdr,
+ errors = Es,
+ transport_data = TD},
+ MsgDict,
+ Dict0) ->
+ #diameter_packet{header = make_answer_header(Hdr, undefined),
+ msg = reset(Msg, [], Es, MsgDict, Dict0),
+ transport_data = TD}.
+
+%% make_answer_header/2
+
+%% A reply message clears the R and T flags and retains the P flag.
+%% The E flag will be set at encode. 6.2 of 3588 requires the same P
+%% flag on an answer as on the request. A #diameter_packet{} returned
+%% from a handle_request callback can circumvent this by setting its
+%% own header values.
+make_answer_header(ReqHdr, Hdr) ->
+ Hdr0 = ReqHdr#diameter_header{version = ?DIAMETER_VERSION,
+ is_request = false,
+ is_error = undefined,
+ is_retransmitted = false},
+ fold_record(Hdr0, Hdr).
+
+%% reset/5
+
+reset(Msg, [_|_] = Es0, [] = Es, MsgDict, Dict0) ->
+ reset(Msg, Es, Es0, MsgDict, Dict0);
+
+reset(Msg, _, Es, _, _)
+ when Es == false;
+ Es == [] ->
+ Msg;
+
+reset(Msg, _, Es, MsgDict, Dict0) ->
+ E = is_answer_message(Msg, Dict0),
+ reset(Msg, select_error(E, Es, Dict0), choose(E, Dict0, MsgDict)).
+
+%% reset/4
+%%
+%% Set Result-Code and/or Failed-AVP (maybe). Only RC and {RC, AVP}
+%% are the result of decode. AVP or {RC, [AVP]} can be set in an
+%% answer for encode, as a convenience for injecting additional AVPs
+%% into Failed-AVP; eg. 5001 = DIAMETER_AVP_UNSUPPORTED.
+
+reset(Msg, [], _) ->
+ Msg;
+
+reset(Msg, [{RC, As} | Avps], Dict)
+ when is_list(As) ->
+ reset(Msg, [RC | As ++ Avps], Dict);
+
+reset(Msg, [{RC, Avp} | Avps], Dict) ->
+ reset(Msg, [RC, Avp | Avps], Dict);
+
+reset(Msg, [#diameter_avp{} | _] = Avps, Dict) ->
+ set(Msg, failed_avp(Msg, Avps, Dict), Dict);
+
+reset(Msg, [RC | Avps], Dict) ->
+ set(Msg, rc(Msg, RC, Dict) ++ failed_avp(Msg, Avps, Dict), Dict).
+
+%% set/3
%% Reply as name and tuple list ...
set([_|_] = Ans, Avps, _) ->
@@ -842,11 +879,7 @@ set(Rec, Avps, Dict) ->
%%
%% Turn the result code into a list if its optional and only set it if
%% the arity is 1 or {0,1}. In other cases (which probably shouldn't
-%% exist in practise) we can't know what's appropriate.
-
-rc(_, B, _)
- when is_boolean(B) ->
- [];
+%% exist in practice) we can't know what's appropriate.
rc([MsgName | _], RC, Dict) ->
K = 'Result-Code',
@@ -864,8 +897,8 @@ rc(Rec, RC, Dict) ->
failed_avp(_, [] = No, _) ->
No;
-failed_avp(Rec, Avps, Dict) ->
- [failed(Rec, [{'AVP', Avps}], Dict)].
+failed_avp(Msg, [_|_] = Avps, Dict) ->
+ [failed(Msg, [{'AVP', Avps}], Dict)].
%% Reply as name and tuple list ...
failed([MsgName | Values], FailedAvp, Dict) ->
@@ -962,22 +995,26 @@ failed(Rec, FailedAvp, Dict) ->
%% Error-Message AVP is not intended to be useful in real-time, and
%% SHOULD NOT be expected to be parsed by network entities.
-%% answer_message/5
+%% answer_message/4
-answer_message(OH, OR, RC, Dict0, #diameter_packet{avps = Avps,
- errors = Es}) ->
+answer_message(RC,
+ Dict0,
+ #diameter_caps{origin_host = {OH,_},
+ origin_realm = {OR,_}},
+ #diameter_packet{avps = Avps,
+ errors = Es}) ->
{Code, _, Vid} = Dict0:avp_header('Session-Id'),
['answer-message', {'Origin-Host', OH},
{'Origin-Realm', OR},
{'Result-Code', RC}]
- ++ session_id(Code, Vid, Dict0, Avps)
+ ++ session_id(Code, Vid, Avps)
++ failed_avp(RC, Es).
-session_id(Code, Vid, Dict0, Avps)
+session_id(Code, Vid, Avps)
when is_list(Avps) ->
try
#diameter_avp{data = Bin} = find_avp(Code, Vid, Avps),
- [{'Session-Id', [Dict0:avp(decode, Bin, 'Session-Id')]}]
+ [{'Session-Id', [Bin]}]
catch
error: _ ->
[]
@@ -1197,8 +1234,6 @@ get_result(Dict, Msg) ->
try
[throw(A) || N <- ['Result-Code', 'Experimental-Result'],
#diameter_avp{} = A <- [get_avp(Dict, N, Msg)]]
- of
- [] -> false
catch
#diameter_avp{} = A -> A
end.
@@ -1207,7 +1242,7 @@ x(T) ->
exit(T).
%% ---------------------------------------------------------------------------
-%% # send_request/4
+%% send_request/4
%%
%% Handle an outgoing Diameter request.
%% ---------------------------------------------------------------------------
@@ -1260,11 +1295,10 @@ answer_rc(_, _, Sent) ->
%%
%% In the process spawned for the outgoing request.
-send_R(SvcName, AppOrAlias, Msg, Opts, Caller) ->
- case pick_peer(SvcName, AppOrAlias, Msg, Opts) of
- {Transport, Mask, SvcOpts} ->
- diameter_codec:setopts(SvcOpts),
- send_request(Transport, Mask, Msg, Opts, Caller, SvcName);
+send_R(SvcName, AppOrAlias, Msg, CallOpts, Caller) ->
+ case pick_peer(SvcName, AppOrAlias, Msg, CallOpts) of
+ {{_,_} = Transport, SvcOpts} ->
+ send_request(Transport, SvcOpts, Msg, CallOpts, Caller, SvcName);
{error, _} = No ->
No
end.
@@ -1272,31 +1306,45 @@ send_R(SvcName, AppOrAlias, Msg, Opts, Caller) ->
%% make_options/1
make_options(Options) ->
- lists:foldl(fun mo/2, #options{}, Options).
-
-mo({timeout, T}, Rec)
- when is_integer(T), 0 =< T ->
- Rec#options{timeout = T};
-
-mo({filter, F}, #options{filter = none} = Rec) ->
- Rec#options{filter = F};
-mo({filter, F}, #options{filter = {all, Fs}} = Rec) ->
- Rec#options{filter = {all, [F | Fs]}};
-mo({filter, F}, #options{filter = F0} = Rec) ->
- Rec#options{filter = {all, [F0, F]}};
-
-mo({extra, L}, #options{extra = X} = Rec)
+ make_opts(Options, [], false, [], none, 5000).
+
+%% Do our own recursion since this is faster than a lists:foldl/3
+%% setting elements in an #options{} accumulator.
+
+make_opts([], Peers, Detach, Extra, Filter, Tmo) ->
+ #options{peers = lists:reverse(Peers),
+ detach = Detach,
+ extra = Extra,
+ filter = Filter,
+ timeout = Tmo};
+
+make_opts([{timeout, Tmo} | Rest], Peers, Detach, Extra, Filter, _)
+ when is_integer(Tmo), 0 =< Tmo ->
+ make_opts(Rest, Peers, Detach, Extra, Filter, Tmo);
+
+make_opts([{filter, F} | Rest], Peers, Detach, Extra, none, Tmo) ->
+ make_opts(Rest, Peers, Detach, Extra, F, Tmo);
+make_opts([{filter, F} | Rest], Peers, Detach, Extra, {all, Fs}, Tmo) ->
+ make_opts(Rest, Peers, Detach, Extra, {all, [F|Fs]}, Tmo);
+make_opts([{filter, F} | Rest], Peers, Detach, Extra, F0, Tmo) ->
+ make_opts(Rest, Peers, Detach, Extra, {all, [F0, F]}, Tmo);
+
+make_opts([{extra, L} | Rest], Peers, Detach, Extra, Filter, Tmo)
when is_list(L) ->
- Rec#options{extra = X ++ L};
+ make_opts(Rest, Peers, Detach, Extra ++ L, Filter, Tmo);
+
+make_opts([detach | Rest], Peers, _, Extra, Filter, Tmo) ->
+ make_opts(Rest, Peers, true, Extra, Filter, Tmo);
-mo(detach, Rec) ->
- Rec#options{detach = true};
+make_opts([{peer, TPid} | Rest], Peers, Detach, Extra, Filter, Tmo)
+ when is_pid(TPid) ->
+ make_opts(Rest, [TPid | Peers], Detach, Extra, Filter, Tmo);
-mo(T, _) ->
+make_opts([T | _], _, _, _, _, _) ->
?ERROR({invalid_option, T}).
%% ---------------------------------------------------------------------------
-%% # send_request/6
+%% send_request/6
%% ---------------------------------------------------------------------------
%% Send an outgoing request in its dedicated process.
@@ -1309,44 +1357,51 @@ mo(T, _) ->
%% The module field of the #diameter_app{} here includes any extra
%% arguments passed to diameter:call/4.
-send_request({TPid, Caps, App}
+send_request({{TPid, _Caps} = TC, App}
= Transport,
- Mask,
- Msg,
- Opts,
+ #{sequence := Mask}
+ = SvcOpts,
+ Msg0,
+ CallOpts,
Caller,
SvcName) ->
- Pkt = make_prepare_packet(Mask, Msg),
-
- send_R(cb(App, prepare_request, [Pkt, SvcName, {TPid, Caps}]),
- Pkt,
- Transport,
- Opts,
- Caller,
- SvcName,
- []).
+ Pkt = make_prepare_packet(Mask, Msg0),
+
+ case prepare(cb(App, prepare_request, [Pkt, SvcName, TC]), []) of
+ [Msg | Fs] ->
+ ReqPkt = make_request_packet(Msg, Pkt),
+ EncPkt = encode(App#diameter_app.dictionary,
+ TPid,
+ SvcOpts,
+ ReqPkt),
+ eval_packet(EncPkt, Fs),
+ T = send_R(ReqPkt, EncPkt, Transport, CallOpts, Caller, SvcName),
+ Ans = recv_answer(SvcName, App, CallOpts, T),
+ handle_answer(SvcName, SvcOpts, App, Ans);
+ {discard, Reason} ->
+ {error, Reason};
+ discard ->
+ {error, discarded};
+ {error, Reason} ->
+ ?ERROR({invalid_return, Reason, prepare_request, App})
+ end.
-%% send_R/7
+%% prepare/2
-send_R({send, Msg}, Pkt, Transport, Opts, Caller, SvcName, Fs) ->
- send_R(make_request_packet(Msg, Pkt),
- Transport,
- Opts,
- Caller,
- SvcName,
- Fs);
+prepare({send, Msg}, Fs) ->
+ [Msg | Fs];
-send_R({discard, Reason} , _, _, _, _, _, _) ->
- {error, Reason};
+prepare({eval_packet, RC, F}, Fs) ->
+ prepare(RC, [F|Fs]);
-send_R(discard, _, _, _, _, _, _) ->
- {error, discarded};
+prepare({discard, _Reason} = RC, _) ->
+ RC;
-send_R({eval_packet, RC, F}, Pkt, T, Opts, Caller, SvcName, Fs) ->
- send_R(RC, Pkt, T, Opts, Caller, SvcName, [F|Fs]);
+prepare(discard = RC, _) ->
+ RC;
-send_R(E, _, {_, _, App}, _, _, _, _) ->
- ?ERROR({invalid_return, E, prepare_request, App}).
+prepare(Reason, _) ->
+ {error, Reason}.
%% make_prepare_packet/2
%%
@@ -1366,43 +1421,39 @@ make_prepare_packet(Mask, #diameter_packet{msg = [#diameter_header{} = Hdr
make_prepare_packet(Mask, #diameter_packet{header = Hdr} = Pkt) ->
Pkt#diameter_packet{header = make_prepare_header(Mask, Hdr)};
+make_prepare_packet(Mask, [#diameter_header{} = Hdr | Avps]) ->
+ #diameter_packet{msg = [make_prepare_header(Mask, Hdr) | Avps]};
+
make_prepare_packet(Mask, Msg) ->
- make_prepare_packet(Mask, #diameter_packet{msg = Msg}).
+ #diameter_packet{header = make_prepare_header(Mask, undefined),
+ msg = Msg}.
%% make_prepare_header/2
make_prepare_header(Mask, undefined) ->
Seq = diameter_session:sequence(Mask),
- make_prepare_header(#diameter_header{end_to_end_id = Seq,
- hop_by_hop_id = Seq});
-
-make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined,
- hop_by_hop_id = undefined}
- = H) ->
- Seq = diameter_session:sequence(Mask),
- make_prepare_header(H#diameter_header{end_to_end_id = Seq,
- hop_by_hop_id = Seq});
-
-make_prepare_header(Mask, #diameter_header{end_to_end_id = undefined} = H) ->
- Seq = diameter_session:sequence(Mask),
- make_prepare_header(H#diameter_header{end_to_end_id = Seq});
-
-make_prepare_header(Mask, #diameter_header{hop_by_hop_id = undefined} = H) ->
- Seq = diameter_session:sequence(Mask),
- make_prepare_header(H#diameter_header{hop_by_hop_id = Seq});
-
-make_prepare_header(_, Hdr) ->
- make_prepare_header(Hdr).
-
-%% make_prepare_header/1
-
-make_prepare_header(#diameter_header{version = undefined} = Hdr) ->
- make_prepare_header(Hdr#diameter_header{version = ?DIAMETER_VERSION});
-
-make_prepare_header(#diameter_header{} = Hdr) ->
- Hdr;
-
-make_prepare_header(T) ->
+ #diameter_header{version = ?DIAMETER_VERSION,
+ end_to_end_id = Seq,
+ hop_by_hop_id = Seq};
+
+make_prepare_header(Mask, #diameter_header{version = V,
+ end_to_end_id = EI,
+ hop_by_hop_id = HI}
+ = H)
+ when EI == undefined;
+ HI == undefined ->
+ Id = diameter_session:sequence(Mask),
+ H#diameter_header{version = ?DEFAULT(V, ?DIAMETER_VERSION),
+ end_to_end_id = ?DEFAULT(EI, Id),
+ hop_by_hop_id = ?DEFAULT(HI, Id)};
+
+make_prepare_header(_, #diameter_header{version = undefined} = H) ->
+ H#diameter_header{version = ?DIAMETER_VERSION};
+
+make_prepare_header(_, #diameter_header{} = H) ->
+ H;
+
+make_prepare_header(_, T) ->
?ERROR({invalid_header, T}).
%% make_request_packet/2
@@ -1446,42 +1497,45 @@ make_retransmit_header(Hdr) ->
Hdr#diameter_header{is_retransmitted = true}.
%% fold_record/2
+%%
+%% Replace elements in the first record by those in the second that
+%% differ from undefined.
-fold_record(undefined, R) ->
- R;
-fold_record(Rec, R) ->
- diameter_lib:fold_tuple(2, Rec, R).
+fold_record(Rec0, undefined) ->
+ Rec0;
+fold_record(Rec0, Rec) ->
+ list_to_tuple(fold(tuple_to_list(Rec0), tuple_to_list(Rec))).
+
+fold([], []) ->
+ [];
+fold([H | T0], [undefined | T]) ->
+ [H | fold(T0, T)];
+fold([_ | T0], [H | T]) ->
+ [H | fold(T0, T)].
%% send_R/6
-send_R(Pkt0,
- {TPid, Caps, #diameter_app{dictionary = AppDict} = App},
- Opts,
+send_R(ReqPkt,
+ EncPkt,
+ {{TPid, _Caps} = TC, #diameter_app{dictionary = AppDict}},
+ #options{timeout = Timeout},
{Pid, Ref},
- SvcName,
- Fs) ->
- Pkt = encode(AppDict, TPid, Pkt0, Fs),
-
- #options{timeout = Timeout}
- = Opts,
-
+ SvcName) ->
Req = #request{ref = Ref,
caller = Pid,
handler = self(),
- transport = TPid,
- caps = Caps,
- packet = Pkt0},
+ peer = TC,
+ packet = ReqPkt},
- incr(send, Pkt, TPid, AppDict),
- {TRef, MRef} = zend_requezt(TPid, Pkt, Req, SvcName, Timeout),
+ incr(send, EncPkt, TPid, AppDict),
+ {TRef, MRef} = zend_requezt(TPid, EncPkt, Req, SvcName, Timeout),
Pid ! Ref, %% tell caller a send has been attempted
- handle_answer(SvcName,
- App,
- recv_A(Timeout, SvcName, App, Opts, {TRef, MRef, Req})).
+ {TRef, MRef, Req}.
-%% recv_A/5
+%% recv_answer/4
-recv_A(Timeout, SvcName, App, Opts, {TRef, MRef, #request{ref = Ref} = Req}) ->
+recv_answer(SvcName, App, CallOpts, {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 pid of the transport on which it was received,
@@ -1492,97 +1546,90 @@ recv_A(Timeout, SvcName, App, Opts, {TRef, MRef, #request{ref = Ref} = Req}) ->
{timeout = Reason, TRef, _} -> %% No timely reply
{error, Req, Reason};
{'DOWN', MRef, process, _, _} when false /= MRef -> %% local peer_down
- failover(SvcName, App, Req, Opts, Timeout);
+ failover(SvcName, App, Req, CallOpts);
{failover, TRef} -> %% local or remote peer_down
- failover(SvcName, App, Req, Opts, Timeout)
+ failover(SvcName, App, Req, CallOpts)
end.
-%% failover/5
+%% failover/4
-failover(SvcName, App, Req, Opts, Timeout) ->
- retransmit(pick_peer(SvcName, App, Req, Opts),
- Req,
- Opts,
- SvcName,
- Timeout).
+failover(SvcName, App, Req, CallOpts) ->
+ resend_request(pick_peer(SvcName, App, Req, CallOpts),
+ Req,
+ CallOpts,
+ SvcName).
-%% handle_answer/3
+%% handle_answer/4
-handle_answer(SvcName, App, {error, Req, Reason}) ->
- handle_error(App, Req, Reason, SvcName);
+handle_answer(SvcName, _, App, {error, Req, Reason}) ->
+ #request{packet = Pkt,
+ peer = {_TPid, _Caps} = TC}
+ = Req,
+ cb(App, handle_error, [Reason, msg(Pkt), SvcName, TC]);
handle_answer(SvcName,
- #diameter_app{dictionary = AppDict,
- id = Id}
+ SvcOpts,
+ #diameter_app{id = Id,
+ dictionary = AppDict,
+ options = [{answer_errors, AE} | _]}
= App,
{answer, Req, Dict0, Pkt}) ->
MsgDict = msg_dict(AppDict, Dict0, Pkt),
- handle_A(errors(Id, diameter_codec:decode({MsgDict, AppDict}, Pkt)),
- SvcName,
- MsgDict,
- Dict0,
- App,
- Req).
-
-%% We don't really need to do a full decode if we're a relay and will
-%% just resend with a new hop by hop identifier, but might a proxy
-%% want to examine the answer?
-
-handle_A(Pkt, SvcName, Dict, Dict0, App, #request{transport = TPid} = Req) ->
- AppDict = App#diameter_app.dictionary,
-
- incr(recv, Pkt, TPid, AppDict),
-
- try
- incr_result(recv, Pkt, TPid, {Dict, AppDict, Dict0}) %% count incoming
- of
- _ -> answer(Pkt, SvcName, App, Req)
- catch
- exit: {no_result_code, _} ->
- %% RFC 6733 requires one of Result-Code or
- %% Experimental-Result, but the decode will have detected
- %% a missing AVP. If both are optional in the dictionary
- %% then this isn't a decode error: just continue on.
- answer(Pkt, SvcName, App, Req);
- exit: {invalid_error_bit, {_, _, _, Avp}} ->
- #diameter_packet{errors = Es}
- = Pkt,
- E = {5004, Avp},
- answer(Pkt#diameter_packet{errors = [E|Es]}, SvcName, App, Req)
- end.
-
-%% answer/4
-
-answer(Pkt,
- SvcName,
- #diameter_app{module = ModX,
- options = [{answer_errors, AE} | _]},
- Req) ->
- a(Pkt, SvcName, ModX, AE, Req).
-
--spec a(_, _, _) -> no_return(). %% silence dialyzer
-
-a(#diameter_packet{errors = Es}
- = Pkt,
- SvcName,
- ModX,
- AE,
- #request{transport = TPid,
- caps = Caps,
- packet = P})
- when [] == Es;
- callback == AE ->
- cb(ModX, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]);
-
-a(Pkt, SvcName, _, AE, _) ->
- a(Pkt#diameter_packet.header, SvcName, AE).
-
-a(Hdr, SvcName, report) ->
+ DecPkt = errors(Id, diameter_codec:decode({MsgDict, AppDict},
+ SvcOpts,
+ Pkt)),
+ #request{peer = {TPid, _}}
+ = Req,
+
+ incr(recv, DecPkt, TPid, AppDict),
+
+ AnsPkt = try
+ incr_result(recv, DecPkt, TPid, {MsgDict, AppDict, Dict0})
+ of
+ _ -> DecPkt
+ catch
+ exit: {no_result_code, _} ->
+ %% RFC 6733 requires one of Result-Code or
+ %% Experimental-Result, but the decode will have
+ %% detected a missing AVP. If both are optional in
+ %% the dictionary then this isn't a decode error:
+ %% just continue on.
+ DecPkt;
+ exit: {invalid_error_bit, {_, _, _, Avp}} ->
+ #diameter_packet{errors = Es}
+ = DecPkt,
+ E = {5004, Avp},
+ DecPkt#diameter_packet{errors = [E|Es]}
+ end,
+
+ handle_answer(AnsPkt, SvcName, App, AE, Req).
+
+%% handle_answer/5
+
+handle_answer(#diameter_packet{errors = Es}
+ = Pkt,
+ SvcName,
+ App,
+ AE,
+ #request{peer = {_TPid, _Caps} = TC,
+ packet = P})
+ when callback == AE;
+ [] == Es ->
+ cb(App, handle_answer, [Pkt, msg(P), SvcName, TC]);
+
+handle_answer(#diameter_packet{header = H}, SvcName, _, AE, _) ->
+ handle_error(H, SvcName, AE).
+
+%% handle_error/3
+
+-spec handle_error(_, _, _) -> no_return(). %% silence dialyzer
+
+handle_error(Hdr, SvcName, report) ->
MFA = {?MODULE, handle_answer, [SvcName, Hdr]},
diameter_lib:warning_report(errors, MFA),
- a(Hdr, SvcName, discard);
+ handle_error(Hdr, SvcName, discard);
-a(Hdr, SvcName, discard) ->
+handle_error(Hdr, SvcName, discard) ->
x({answer_errors, {SvcName, Hdr}}).
%% Note that we don't check that the application id in the answer's
@@ -1593,16 +1640,38 @@ a(Hdr, SvcName, discard) ->
%% timer value is ignored. This means that an answer could be accepted
%% from a peer after timeout in the case of failover.
-%% retransmit/5
+%% resend_request/4
-retransmit({{_,_,App} = Transport, _, _}, Req, Opts, SvcName, Timeout) ->
- try retransmit(Transport, Req, SvcName, Timeout) of
- T -> recv_A(Timeout, SvcName, App, Opts, T)
- catch
- ?FAILURE(Reason) -> {error, Req, Reason}
+resend_request({{{TPid, _Caps} = TC, App}, SvcOpts},
+ Req0,
+ #options{timeout = Timeout}
+ = CallOpts,
+ SvcName) ->
+ case
+ undefined == get(TPid)
+ andalso prepare_retransmit(TC, App, Req0, SvcName)
+ of
+ [ReqPkt | Fs] ->
+ AppDict = App#diameter_app.dictionary,
+ EncPkt = encode(AppDict, TPid, SvcOpts, ReqPkt),
+ eval_packet(EncPkt, Fs),
+ Req = Req0#request{peer = TC,
+ packet = ReqPkt},
+ ?LOG(retransmission, EncPkt#diameter_packet.header),
+ incr(TPid, {msg_id(EncPkt, AppDict), send, retransmission}),
+ {TRef, MRef} = zend_requezt(TPid, EncPkt, Req, SvcName, Timeout),
+ recv_answer(SvcName, App, CallOpts, {TRef, MRef, Req});
+ false ->
+ {error, Req0, timeout};
+ {discard, Reason} ->
+ {error, Req0, Reason};
+ discard ->
+ {error, Req0, discarded};
+ {error, T} ->
+ ?ERROR({invalid_return, T, prepare_retransmit, App})
end;
-retransmit(_, Req, _, _, _) -> %% no alternate peer
+resend_request(_, Req, _, _) -> %% no alternate peer
{error, Req, failover}.
%% pick_peer/4
@@ -1612,8 +1681,8 @@ retransmit(_, Req, _, _, _) -> %% no alternate peer
pick_peer(SvcName,
App,
#request{packet = #diameter_packet{msg = Msg}},
- Opts) ->
- pick_peer(SvcName, App, Msg, Opts#options{extra = []});
+ CallOpts) ->
+ pick_peer(SvcName, App, Msg, CallOpts#options{extra = []});
pick_peer(_, _, undefined, _) ->
{error, no_connection};
@@ -1621,28 +1690,14 @@ pick_peer(_, _, undefined, _) ->
pick_peer(SvcName,
AppOrAlias,
Msg,
- #options{filter = Filter, extra = Xtra}) ->
- pick(diameter_service:pick_peer(SvcName,
- AppOrAlias,
- {fun(D) -> get_destination(D, Msg) end,
- Filter,
- Xtra})).
-
-pick(false) ->
- {error, no_connection};
-
-pick(T) ->
- T.
-
-%% handle_error/4
-
-handle_error(App,
- #request{packet = Pkt,
- transport = TPid,
- caps = Caps},
- Reason,
- SvcName) ->
- cb(App, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]).
+ #options{peers = TPids, filter = Filter, extra = Xtra}) ->
+ X = {fun(D) -> get_destination(D, Msg) end, Filter, Xtra, TPids},
+ case diameter_service:pick_peer(SvcName, AppOrAlias, X) of
+ false ->
+ {error, no_connection};
+ T ->
+ T
+ end.
msg(#diameter_packet{msg = undefined, bin = Bin}) ->
Bin;
@@ -1651,27 +1706,20 @@ msg(#diameter_packet{msg = Msg}) ->
%% encode/4
-encode(Dict, TPid, Pkt, Fs) ->
- P = encode(Dict, TPid, Pkt),
- eval_packet(P, Fs),
- P.
-
-%% encode/2
-
%% Note that prepare_request can return a diameter_packet containing a
%% header or transport_data. Even allow the returned record to contain
%% an encoded binary. This isn't the usual case and doesn't properly
%% support retransmission but is useful for test.
-encode(Dict, TPid, Pkt)
+encode(Dict, TPid, Opts, Pkt)
when is_atom(Dict) ->
- encode({Dict, Dict}, TPid, Pkt);
+ encode({Dict, Dict}, TPid, Opts, Pkt);
%% A message to be encoded.
-encode(DictT, TPid, #diameter_packet{bin = undefined} = Pkt) ->
+encode(DictT, TPid, Opts, #diameter_packet{bin = undefined} = Pkt) ->
{Dict, AppDict} = DictT,
try
- diameter_codec:encode(Dict, Pkt)
+ diameter_codec:encode(Dict, Opts, Pkt)
catch
exit: {diameter_codec, encode, T} = Reason ->
incr_error(send, T, TPid, AppDict),
@@ -1679,7 +1727,7 @@ encode(DictT, TPid, #diameter_packet{bin = undefined} = Pkt) ->
end;
%% An encoded binary: just send.
-encode(_, _, #diameter_packet{} = Pkt) ->
+encode(_, _, _, #diameter_packet{} = Pkt) ->
Pkt.
%% zend_requezt/5
@@ -1745,81 +1793,26 @@ recv(TPid, Pid, TRef, {LocalTRef, MRef}) ->
exit({timeout, LocalTRef, TPid} = T)
end.
-%% send/2
-
-send(Pid, Pkt) ->
- Pid ! {send, Pkt}.
-
%% send/3
send(Pid, Pkt, Route) ->
Pid ! {send, Pkt, Route}.
-%% retransmit/4
+%% prepare_retransmit/4
-retransmit({TPid, Caps, App}
- = Transport,
- #request{packet = Pkt0}
- = Req,
- SvcName,
- Timeout) ->
- undefined == get(TPid) %% Don't failover to a peer we've
- orelse ?THROW(timeout), %% already sent to.
+prepare_retransmit({_TPid, _Caps} = TC, App, Req, SvcName) ->
+ Pkt = make_retransmit_packet(Req#request.packet),
- Pkt = make_retransmit_packet(Pkt0),
+ case prepare(cb(App, prepare_retransmit, [Pkt, SvcName, TC]), []) of
+ [Msg | Fs] ->
+ [make_request_packet(Msg, Pkt) | Fs];
+ No ->
+ No
+ end.
- retransmit(cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]),
- Transport,
- Req#request{packet = Pkt},
- SvcName,
- Timeout,
- []).
%% When sending a binary, it's up to prepare_retransmit to modify it
%% accordingly.
-retransmit({send, Msg},
- Transport,
- #request{packet = Pkt}
- = Req,
- SvcName,
- Timeout,
- Fs) ->
- resend_request(make_request_packet(Msg, Pkt),
- Transport,
- Req,
- SvcName,
- Timeout,
- Fs);
-
-retransmit({discard, Reason}, _, _, _, _, _) ->
- ?THROW(Reason);
-
-retransmit(discard, _, _, _, _, _) ->
- ?THROW(discarded);
-
-retransmit({eval_packet, RC, F}, Transport, Req, SvcName, Timeout, Fs) ->
- retransmit(RC, Transport, Req, SvcName, Timeout, [F|Fs]);
-
-retransmit(T, {_, _, App}, _, _, _, _) ->
- ?ERROR({invalid_return, T, prepare_retransmit, App}).
-
-resend_request(Pkt0,
- {TPid, Caps, #diameter_app{dictionary = AppDict}},
- Req0,
- SvcName,
- Tmo,
- Fs) ->
- Pkt = encode(AppDict, TPid, Pkt0, Fs),
-
- Req = Req0#request{transport = TPid,
- packet = Pkt0,
- caps = Caps},
-
- ?LOG(retransmission, Pkt#diameter_packet.header),
- incr(TPid, {msg_id(Pkt, AppDict), send, retransmission}),
- {TRef, MRef} = zend_requezt(TPid, Pkt, Req, SvcName, Tmo),
- {TRef, MRef, Req}.
-
%% peer_monitor/2
peer_monitor(TPid, TRef) ->
@@ -1919,7 +1912,7 @@ ungroup(Avp) ->
avp_decode(Dict, Name, #diameter_avp{value = undefined,
data = Bin}
= Avp) ->
- try Dict:avp(decode, Bin, Name) of
+ try Dict:avp(decode, Bin, Name, decode_opts(Dict)) of
V ->
Avp#diameter_avp{value = V}
catch
@@ -1930,8 +1923,6 @@ avp_decode(_, _, #diameter_avp{} = Avp) ->
Avp.
cb(#diameter_app{module = [_|_] = M}, F, A) ->
- eval(M, F, A);
-cb([_|_] = M, F, A) ->
eval(M, F, A).
eval([M|X], F, A) ->
@@ -1939,3 +1930,10 @@ eval([M|X], F, A) ->
choose(true, X, _) -> X;
choose(false, _, X) -> X.
+
+%% Decode options sufficient for AVP extraction.
+decode_opts(Dict) ->
+ #{string_decode => false,
+ strict_mbit => false,
+ failed_avp => false,
+ dictionary => Dict}.
diff --git a/lib/diameter/src/base/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl
index 6ecf385239..86b674dd48 100644
--- a/lib/diameter/src/base/diameter_types.erl
+++ b/lib/diameter/src/base/diameter_types.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2015. 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.
@@ -26,32 +26,16 @@
%%
%% Basic types.
--export(['OctetString'/2,
- 'Integer32'/2,
- 'Integer64'/2,
- 'Unsigned32'/2,
- 'Unsigned64'/2,
- 'Float32'/2,
- 'Float64'/2]).
-
-%% Derived types.
--export(['Address'/2,
- 'Time'/2,
- 'UTF8String'/2,
- 'DiameterIdentity'/2,
- 'DiameterURI'/2,
- 'IPFilterRule'/2,
- 'QoSFilterRule'/2]).
-
-%% Functions taking the AVP name in question as second parameter.
-export(['OctetString'/3,
'Integer32'/3,
'Integer64'/3,
'Unsigned32'/3,
'Unsigned64'/3,
'Float32'/3,
- 'Float64'/3,
- 'Address'/3,
+ 'Float64'/3]).
+
+%% Derived types.
+-export(['Address'/3,
'Time'/3,
'UTF8String'/3,
'DiameterIdentity'/3,
@@ -89,81 +73,80 @@
%% AVP Data Format is needed, a new version of this RFC must be created.
%% --------------------
-'OctetString'(decode, Bin)
+'OctetString'(decode, Bin, #{string_decode := true})
when is_binary(Bin) ->
- case diameter_codec:getopt(string_decode) of
- true ->
- binary_to_list(Bin);
- false ->
- Bin
- end;
-
-'OctetString'(decode, B) ->
+ binary_to_list(Bin);
+
+'OctetString'(decode, Bin, _)
+ when is_binary(Bin) ->
+ Bin;
+
+'OctetString'(decode, B, _) ->
?INVALID_LENGTH(B);
-'OctetString'(encode = M, zero) ->
- 'OctetString'(M, []);
+'OctetString'(encode, zero, _) ->
+ <<>>;
-'OctetString'(encode, Str) ->
+'OctetString'(encode, Str, _) ->
iolist_to_binary(Str).
%% --------------------
-'Integer32'(decode, <<X:32/signed>>) ->
+'Integer32'(decode, <<X:32/signed>>, _) ->
X;
-'Integer32'(decode, B) ->
+'Integer32'(decode, B, _) ->
?INVALID_LENGTH(B);
-'Integer32'(encode = M, zero) ->
- 'Integer32'(M, 0);
+'Integer32'(encode, zero, _) ->
+ <<0:32/signed>>;
-'Integer32'(encode, I)
+'Integer32'(encode, I, _)
when ?SINT(32,I) ->
<<I:32/signed>>.
%% --------------------
-'Integer64'(decode, <<X:64/signed>>) ->
+'Integer64'(decode, <<X:64/signed>>, _) ->
X;
-'Integer64'(decode, B) ->
+'Integer64'(decode, B, _) ->
?INVALID_LENGTH(B);
-'Integer64'(encode = M, zero) ->
- 'Integer64'(M, 0);
+'Integer64'(encode, zero, _) ->
+ <<0:64/signed>>;
-'Integer64'(encode, I)
+'Integer64'(encode, I, _)
when ?SINT(64,I) ->
<<I:64/signed>>.
%% --------------------
-'Unsigned32'(decode, <<X:32>>) ->
+'Unsigned32'(decode, <<X:32>>, _) ->
X;
-'Unsigned32'(decode, B) ->
+'Unsigned32'(decode, B, _) ->
?INVALID_LENGTH(B);
-'Unsigned32'(encode = M, zero) ->
- 'Unsigned32'(M, 0);
+'Unsigned32'(encode, zero, _) ->
+ <<0:32>>;
-'Unsigned32'(encode, I)
+'Unsigned32'(encode, I, _)
when ?UINT(32,I) ->
<<I:32>>.
%% --------------------
-'Unsigned64'(decode, <<X:64>>) ->
+'Unsigned64'(decode, <<X:64>>, _) ->
X;
-'Unsigned64'(decode, B) ->
+'Unsigned64'(decode, B, _) ->
?INVALID_LENGTH(B);
-'Unsigned64'(encode = M, zero) ->
- 'Unsigned64'(M, 0);
+'Unsigned64'(encode, zero, _) ->
+ <<0:64>>;
-'Unsigned64'(encode, I)
+'Unsigned64'(encode, I, _)
when ?UINT(64,I) ->
<<I:64>>.
@@ -184,25 +167,25 @@
%% arithmetic is performed on the decoded value. Better to be explicit
%% that precision has been lost.
-'Float32'(decode, <<S:1, 255:8, _:23>>) ->
+'Float32'(decode, <<S:1, 255:8, _:23>>, _) ->
choose(S, infinity, '-infinity');
-'Float32'(decode, <<X:32/float>>) ->
+'Float32'(decode, <<X:32/float>>, _) ->
X;
-'Float32'(decode, B) ->
+'Float32'(decode, B, _) ->
?INVALID_LENGTH(B);
-'Float32'(encode = M, zero) ->
- 'Float32'(M, 0.0);
+'Float32'(encode, zero, _) ->
+ <<0.0:32/float>>;
-'Float32'(encode, infinity) ->
+'Float32'(encode, infinity, _) ->
<<0:1, 255:8, 0:23>>;
-'Float32'(encode, '-infinity') ->
+'Float32'(encode, '-infinity', _) ->
<<1:1, 255:8, 0:23>>;
-'Float32'(encode, X)
+'Float32'(encode, X, _)
when is_float(X) ->
<<X:32/float>>.
%% Note that this could also encode infinity/-infinity for large
@@ -222,25 +205,25 @@
%% The 64 bit format is entirely analogous to the 32 bit format.
-'Float64'(decode, <<S:1, 2047:11, _:52>>) ->
+'Float64'(decode, <<S:1, 2047:11, _:52>>, _) ->
choose(S, infinity, '-infinity');
-'Float64'(decode, <<X:64/float>>) ->
+'Float64'(decode, <<X:64/float>>, _) ->
X;
-'Float64'(decode, B) ->
+'Float64'(decode, B, _) ->
?INVALID_LENGTH(B);
-'Float64'(encode, infinity) ->
+'Float64'(encode, infinity, _) ->
<<0:1, 2047:11, 0:52>>;
-'Float64'(encode, '-infinity') ->
+'Float64'(encode, '-infinity', _) ->
<<1:1, 2047:11, 0:52>>;
-'Float64'(encode = M, zero) ->
- 'Float64'(M, 0.0);
+'Float64'(encode, zero, _) ->
+ <<0.0:64/float>>;
-'Float64'(encode, X)
+'Float64'(encode, X, _)
when is_float(X) ->
<<X:64/float>>.
@@ -256,18 +239,18 @@
%% format.
%% --------------------
-'Address'(encode, zero) ->
+'Address'(encode, zero, _) ->
<<0:48>>;
-'Address'(decode, <<A:16, B/binary>>)
+'Address'(decode, <<A:16, B/binary>>, _)
when 1 == A, 4 == size(B);
2 == A, 16 == size(B) ->
list_to_tuple([N || <<N:A/unit:8>> <= B]);
-'Address'(decode, B) ->
+'Address'(decode, B, _) ->
?INVALID_LENGTH(B);
-'Address'(encode, T) ->
+'Address'(encode, T, _) ->
Ns = tuple_to_list(diameter_lib:ipaddr(T)), %% length 4 or 8
A = length(Ns) div 4, %% 1 or 2
B = << <<N:A/unit:8>> || N <- Ns >>,
@@ -278,36 +261,38 @@
%% A DiameterIdentity is a FQDN as definined in RFC 1035, which is at
%% least one character.
-'DiameterIdentity'(encode = M, zero) ->
- 'OctetString'(M, [0]);
+'DiameterIdentity'(encode, zero, _) ->
+ <<0>>;
-'DiameterIdentity'(encode = M, X) ->
- <<_,_/binary>> = 'OctetString'(M, X);
+'DiameterIdentity'(encode = M, X, Opts) ->
+ <<_,_/binary>> = 'OctetString'(M, X, Opts);
-'DiameterIdentity'(decode = M, <<_,_/binary>> = X) ->
- 'OctetString'(M, X);
+'DiameterIdentity'(decode = M, <<_,_/binary>> = X, Opts) ->
+ 'OctetString'(M, X, Opts);
-'DiameterIdentity'(decode, X) ->
+'DiameterIdentity'(decode, X, _) ->
?INVALID_LENGTH(X).
%% --------------------
-'DiameterURI'(decode, Bin)
+'DiameterURI'(decode, Bin, Opts)
when is_binary(Bin) ->
- scan_uri(Bin);
+ scan_uri(Bin, Opts);
-'DiameterURI'(decode, B) ->
+'DiameterURI'(decode, B, _) ->
?INVALID_LENGTH(B);
%% The minimal DiameterURI is "aaa://x", 7 characters.
-'DiameterURI'(encode = M, zero) ->
- 'OctetString'(M, lists:duplicate(0,7));
-
-'DiameterURI'(encode, #diameter_uri{type = Type,
- fqdn = DN,
- port = PN,
- transport = T,
- protocol = P})
+'DiameterURI'(encode, zero, _) ->
+ <<0:7/unit:8>>;
+
+'DiameterURI'(encode,
+ #diameter_uri{type = Type,
+ fqdn = DN,
+ port = PN,
+ transport = T,
+ protocol = P},
+ _)
when (Type == 'aaa' orelse Type == 'aaas'),
is_integer(PN),
0 =< PN,
@@ -324,48 +309,47 @@
%% defaults, so it's best to be explicit. Interpret defaults on decode
%% since there's no choice.
-'DiameterURI'(encode, Str) ->
+'DiameterURI'(encode, Str, Opts) ->
Bin = iolist_to_binary(Str),
- #diameter_uri{} = scan_uri(Bin), %% assert
+ #diameter_uri{} = scan_uri(Bin, Opts), %% assert
Bin.
%% --------------------
%% This minimal rule is "deny in 0 from 0.0.0.0 to 0.0.0.0", 33 characters.
-'IPFilterRule'(encode = M, zero) ->
- 'OctetString'(M, lists:duplicate(0,33));
+'IPFilterRule'(encode, zero, _) ->
+ <<0:33/unit:8>>;
-'IPFilterRule'(M, X) ->
- 'OctetString'(M, X).
+'IPFilterRule'(M, X, Opts) ->
+ 'OctetString'(M, X, Opts).
%% --------------------
%% This minimal rule is the same as for an IPFilterRule.
-'QoSFilterRule'(encode = M, zero = X) ->
- 'IPFilterRule'(M, X);
+'QoSFilterRule'(encode, zero, _) ->
+ <<0:33/unit:8>>;
-'QoSFilterRule'(M, X) ->
- 'OctetString'(M, X).
+'QoSFilterRule'(M, X, Opts) ->
+ 'OctetString'(M, X, Opts).
%% --------------------
-'UTF8String'(decode, Bin)
+'UTF8String'(decode, Bin, #{string_decode := true})
when is_binary(Bin) ->
- case diameter_codec:getopt(string_decode) of
- true ->
- %% assert list return
- tl([0|_] = unicode:characters_to_list([0, Bin]));
- false ->
- <<_/binary>> = unicode:characters_to_binary(Bin)
- end;
-
-'UTF8String'(decode, B) ->
+ %% assert list return
+ tl([0|_] = unicode:characters_to_list([0, Bin]));
+
+'UTF8String'(decode, Bin, _)
+ when is_binary(Bin) ->
+ <<_/binary>> = unicode:characters_to_binary(Bin);
+
+'UTF8String'(decode, B, _) ->
?INVALID_LENGTH(B);
-'UTF8String'(encode = M, zero) ->
- 'UTF8String'(M, []);
+'UTF8String'(encode, zero, _) ->
+ <<>>;
-'UTF8String'(encode, S) ->
+'UTF8String'(encode, S, _) ->
<<_/binary>> = unicode:characters_to_binary(S). %% assert binary return
%% --------------------
@@ -414,67 +398,23 @@
-define(TIME_MIN, {{1968,1,20},{3,14,8}}). %% TIME_1900 + 1 bsl 31
-define(TIME_MAX, {{2104,2,26},{9,42,24}}). %% TIME_2036 + 1 bsl 31
-'Time'(decode, <<Time:32>>) ->
+'Time'(decode, <<Time:32>>, _) ->
Offset = msb(1 == Time bsr 31),
calendar:gregorian_seconds_to_datetime(Time + Offset);
-'Time'(decode, B) ->
+'Time'(decode, B, _) ->
?INVALID_LENGTH(B);
-'Time'(encode, {{_Y,_M,_D},{_HH,_MM,_SS}} = Datetime)
+'Time'(encode, {{_Y,_M,_D},{_HH,_MM,_SS}} = Datetime, _)
when ?TIME_MIN =< Datetime, Datetime < ?TIME_MAX ->
S = calendar:datetime_to_gregorian_seconds(Datetime),
T = S - msb(S < ?TIME_2036),
0 = T bsr 32, %% sanity check
<<T:32>>;
-'Time'(encode, zero) ->
+'Time'(encode, zero, _) ->
<<0:32>>.
-%% -------------------------------------------------------------------------
-
-'OctetString'(M, _, Data) ->
- 'OctetString'(M, Data).
-
-'Integer32'(M, _, Data) ->
- 'Integer32'(M, Data).
-
-'Integer64'(M, _, Data) ->
- 'Integer64'(M, Data).
-
-'Unsigned32'(M, _, Data) ->
- 'Unsigned32'(M, Data).
-
-'Unsigned64'(M, _, Data) ->
- 'Unsigned64'(M, Data).
-
-'Float32'(M, _, Data) ->
- 'Float32'(M, Data).
-
-'Float64'(M, _, Data) ->
- 'Float64'(M, Data).
-
-'Address'(M, _, Data) ->
- 'Address'(M, Data).
-
-'Time'(M, _, Data) ->
- 'Time'(M, Data).
-
-'UTF8String'(M, _, Data) ->
- 'UTF8String'(M, Data).
-
-'DiameterIdentity'(M, _, Data) ->
- 'DiameterIdentity'(M, Data).
-
-'DiameterURI'(M, _, Data) ->
- 'DiameterURI'(M, Data).
-
-'IPFilterRule'(M, _, Data) ->
- 'IPFilterRule'(M, Data).
-
-'QoSFilterRule'(M, _, Data) ->
- 'QoSFilterRule'(M, Data).
-
%% ===========================================================================
%% ===========================================================================
@@ -564,7 +504,7 @@ msb(false) -> ?TIME_2036.
%%
%% aaa-protocol = ( "diameter" / "radius" / "tacacs+" )
-scan_uri(Bin) ->
+scan_uri(Bin, Opts) ->
RE = "^(aaas?)://"
"([-a-zA-Z0-9.]{1,255})"
"(:0{0,5}([0-9]{1,5}))?"
@@ -583,28 +523,30 @@ scan_uri(Bin) ->
RE,
[{capture, [1,2,4,6,8], binary}]),
Type = to_atom(A),
- {PN0, T0} = defaults(diameter_codec:getopt(rfc), Type),
- PortNr = to_int(PN, PN0),
- 0 = PortNr bsr 16, %% assert
#diameter_uri{type = Type,
- fqdn = 'OctetString'(decode, DN),
- port = PortNr,
- transport = to_atom(T, T0),
+ fqdn = 'OctetString'(decode, DN, Opts),
+ port = portnr(PN, Type, Opts),
+ transport = transport(T, Opts),
protocol = to_atom(P, diameter)}.
%% Choose defaults based on the RFC, since 6733 has changed them.
-defaults(3588, _) ->
- {3868, sctp};
-defaults(6733, aaa) ->
- {3868, tcp};
-defaults(6733, aaas) ->
- {5658, tcp}.
-
-to_int(<<>>, N) ->
- N;
-to_int(B, _) ->
+
+portnr(<<>>, aaa, #{rfc := 6733}) ->
+ 3868;
+portnr(<<>>, aaas, #{rfc := 6733}) ->
+ 5868;
+portnr(<<>>, _, #{rfc := 3588}) ->
+ 3868;
+portnr(B, _, _) ->
binary_to_integer(B).
+transport(<<>>, #{rfc := 6733}) ->
+ tcp;
+transport(<<>>, #{rfc := 3588}) ->
+ sctp;
+transport(B, _) ->
+ to_atom(B).
+
to_atom(<<>>, A) ->
A;
to_atom(B, _) ->
diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl
index f28b8f2910..a63425d92a 100644
--- a/lib/diameter/src/base/diameter_watchdog.erl
+++ b/lib/diameter/src/base/diameter_watchdog.erl
@@ -50,10 +50,6 @@
-define(IS_NATURAL(N), (is_integer(N) andalso 0 =< N)).
--record(config,
- {suspect = 1 :: non_neg_integer(), %% OKAY -> SUSPECT
- okay = 3 :: non_neg_integer()}). %% REOPEN -> OKAY
-
-record(watchdog,
{%% PCB - Peer Control Block; see RFC 3539, Appendix A
status = initial :: initial | okay | suspect | down | reopen,
@@ -70,12 +66,19 @@
| integer() %% monotonic time
| undefined,
dictionary :: module(), %% common dictionary
- receive_data :: term(),
- %% term passed into diameter_service with incoming message
- sequence :: diameter:sequence(), %% mask
- restrict :: {diameter:restriction(), boolean()},
- shutdown = false :: boolean(),
- config :: #config{}}).
+ receive_data :: term(), %% term passed with incoming message
+ config :: #{sequence := diameter:sequence(), %% mask
+ restrict_connections := diameter:restriction(),
+ restrict := boolean(),
+ suspect := non_neg_integer(), %% OKAY -> SUSPECT
+ okay := non_neg_integer()}, %% REOPEN -> OKAY
+ codec :: #{string_decode := false,
+ strict_mbit := boolean(),
+ failed_avp := false,
+ rfc := 3588 | 6733,
+ ordered_encode := false,
+ incoming_maxlen := diameter:message_length()},
+ shutdown = false :: boolean()}).
%% ---------------------------------------------------------------------------
%% start/2
@@ -85,12 +88,12 @@
%% reason.
%% ---------------------------------------------------------------------------
--spec start(Type, {RecvData, [Opt], SvcOpts, #diameter_service{}})
+-spec start(Type, {[Opt], SvcOpts, RecvData, #diameter_service{}})
-> {reference(), pid()}
when Type :: {connect|accept, diameter:transport_ref()},
- RecvData :: term(),
Opt :: diameter:transport_opt(),
- SvcOpts :: [diameter:service_opt()].
+ SvcOpts :: map(),
+ RecvData :: term().
start({_,_} = Type, T) ->
Ack = make_ref(),
@@ -117,22 +120,28 @@ init(T) ->
proc_lib:init_ack({ok, self()}),
gen_server:enter_loop(?MODULE, [], i(T)).
-i({Ack, T, Pid, {RecvData,
- Opts,
- SvcOpts,
+i({Ack, T, Pid, {Opts,
+ #{restrict_connections := Restrict}
+ = SvcOpts0,
+ RecvData,
#diameter_service{applications = Apps,
capabilities = Caps}
= Svc}}) ->
monitor(process, Pid),
wait(Ack, Pid),
+
+ Dict0 = common_dictionary(Apps),
+ SvcOpts = SvcOpts0#{rfc => rfc(Dict0)},
putr(restart, {T, Opts, Svc, SvcOpts}), %% save seeing it in trace
putr(dwr, dwr(Caps)), %%
- {_,_} = Mask = proplists:get_value(sequence, SvcOpts),
- Restrict = proplists:get_value(restrict_connections, SvcOpts),
Nodes = restrict_nodes(Restrict),
- Dict0 = common_dictionary(Apps),
- diameter_codec:setopts([{common_dictionary, Dict0},
- {string_decode, false}]),
+ CodecKeys = [string_decode,
+ strict_mbit,
+ incoming_maxlen,
+ spawn_opt,
+ rfc,
+ ordered_encode],
+
#watchdog{parent = Pid,
transport = start(T, Opts, SvcOpts, Nodes, Dict0, Svc),
tw = proplists:get_value(watchdog_timer,
@@ -140,9 +149,14 @@ i({Ack, T, Pid, {RecvData,
?DEFAULT_TW_INIT),
receive_data = RecvData,
dictionary = Dict0,
- sequence = Mask,
- restrict = {Restrict, lists:member(node(), Nodes)},
- config = config(Opts)}.
+ config =
+ maps:without(CodecKeys,
+ config(SvcOpts#{restrict => restrict(Nodes),
+ suspect => 1,
+ okay => 3},
+ Opts)),
+ codec = maps:with(CodecKeys, SvcOpts#{string_decode := false,
+ ordered_encode => false})}.
wait(Ref, Pid) ->
receive
@@ -152,22 +166,31 @@ wait(Ref, Pid) ->
exit({shutdown, D})
end.
-%% config/1
+%% Regard anything but the generated RFC 3588 dictionary as modern.
+%% This affects the interpretation of defaults during the decode
+%% of values of type DiameterURI, this having changed from RFC 3588.
+%% (So much for backwards compatibility.)
+rfc(?BASE) ->
+ 3588;
+rfc(_) ->
+ 6733.
+
+%% config/2
%%
%% Could also configure counts for SUSPECT to DOWN and REOPEN to DOWN,
%% but don't.
-config(Opts) ->
+config(Map, Opts) ->
Config = proplists:get_value(watchdog_config, Opts, []),
- lists:foldl(fun config/2, #config{}, Config).
+ lists:foldl(fun cfg/2, Map, Config).
-config({suspect, N}, Rec)
+cfg({suspect, N}, Map)
when ?IS_NATURAL(N) ->
- Rec#config{suspect = N};
+ Map#{suspect := N};
-config({okay, N}, Rec)
+cfg({okay, N}, Map)
when ?IS_NATURAL(N) ->
- Rec#config{okay = N}.
+ Map#{okay := N}.
%% start/6
@@ -283,7 +306,7 @@ event(Msg,
?LOG(transition, {From, To}).
data(Msg, TPid, reopen, okay) ->
- {recv, TPid, false, 'DWA', _Pkt, _NPid} = Msg, %% assert
+ {recv, TPid, _, 'DWA', _Pkt} = Msg, %% assert
{TPid, T} = eraser(open),
[T];
@@ -302,6 +325,8 @@ tpid(_, Pid)
tpid(Pid, _) ->
Pid.
+%% send/2
+
send(Pid, T) ->
Pid ! T.
@@ -375,8 +400,8 @@ transition({accepted = T, TPid}, #watchdog{transport = TPid,
transition({open, TPid, Hosts, _} = Open,
#watchdog{transport = TPid,
status = initial,
- restrict = {_,R},
- config = #config{suspect = OS}}
+ config = #{restrict := R,
+ suspect := OS}}
= S) ->
case okay(role(), Hosts, R) of
okay ->
@@ -394,8 +419,8 @@ transition({open, TPid, Hosts, _} = Open,
transition({open = Key, TPid, _Hosts, T},
#watchdog{transport = TPid,
status = down,
- config = #config{suspect = OS,
- okay = RO}}
+ config = #{suspect := OS,
+ okay := RO}}
= S) ->
case RO of
0 -> %% non-standard: skip REOPEN
@@ -428,7 +453,7 @@ transition({'DOWN', _, process, TPid, _Reason},
transition({'DOWN', _, process, TPid, _Reason} = D,
#watchdog{transport = TPid,
status = T,
- restrict = {_,R}}
+ config = #{restrict := R}}
= S0) ->
S = S0#watchdog{pending = false,
transport = undefined},
@@ -447,14 +472,15 @@ transition({'DOWN', _, process, TPid, _Reason} = D,
end;
%% Incoming message.
-transition({recv, TPid, Route, Name, Pkt, NPid},
+transition({recv, TPid, Route, Name, Pkt},
#watchdog{transport = TPid}
= S) ->
- try
- incoming(Name, Pkt, NPid, S)
- catch
+ try incoming(Route, Name, Pkt, S) of
#watchdog{dictionary = Dict0, receive_data = T} = NS ->
- diameter_traffic:receive_message(TPid, Route, Pkt, NPid, Dict0, T),
+ diameter_traffic:receive_message(TPid, Route, Pkt, Dict0, T),
+ NS
+ catch
+ #watchdog{} = NS ->
NS
end;
@@ -483,9 +509,9 @@ getr(Key) ->
eraser(Key) ->
erase({?MODULE, Key}).
-%% encode/3
+%% encode/4
-encode(dwr = M, Dict0, Mask) ->
+encode(dwr = M, Dict0, Opts, Mask) ->
Msg = getr(M),
Seq = diameter_session:sequence(Mask),
Hdr = #diameter_header{version = ?DIAMETER_VERSION,
@@ -493,10 +519,10 @@ encode(dwr = M, Dict0, Mask) ->
hop_by_hop_id = Seq},
Pkt = #diameter_packet{header = Hdr,
msg = Msg},
- diameter_codec:encode(Dict0, Pkt);
+ diameter_codec:encode(Dict0, Opts, Pkt);
-encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD}
- = ReqPkt) ->
+encode(dwa, Dict0, Opts, #diameter_packet{header = H, transport_data = TD}
+ = ReqPkt) ->
AnsPkt = #diameter_packet{header
= H#diameter_header{is_request = false,
is_error = undefined,
@@ -504,7 +530,7 @@ encode(dwa, Dict0, #diameter_packet{header = H, transport_data = TD}
msg = dwa(ReqPkt),
transport_data = TD},
- diameter_codec:encode(Dict0, AnsPkt).
+ diameter_codec:encode(Dict0, Opts, AnsPkt).
%% okay/3
@@ -574,9 +600,10 @@ tw({M,F,A}) ->
send_watchdog(#watchdog{pending = false,
transport = TPid,
dictionary = Dict0,
- sequence = Mask}
+ config = #{sequence := Mask},
+ codec = Opts}
= S) ->
- #diameter_packet{bin = Bin} = EPkt = encode(dwr, Dict0, Mask),
+ #diameter_packet{bin = Bin} = EPkt = encode(dwr, Dict0, Opts, Mask),
diameter_traffic:incr(send, EPkt, TPid, Dict0),
send(TPid, {send, Bin}),
?LOG(send, 'DWR'),
@@ -586,41 +613,30 @@ send_watchdog(#watchdog{pending = false,
%% incoming/4
-incoming(Name, Pkt, false, S) ->
- recv(Name, Pkt, S);
-
-incoming(Name, Pkt, NPid, S) ->
- try
- recv(Name, Pkt, S)
- after
- NPid ! {diameter, discard}
- end.
-
-%% recv/3
-
-recv(Name, Pkt, S) ->
- try rcv(Name, Pkt, rcv(Name, S)) of
- #watchdog{} = NS ->
- throw(NS)
+incoming(Route, Name, Pkt, S) ->
+ try rcv(Name, S) of
+ NS -> rcv(Name, Pkt, NS)
catch
- #watchdog{} = NS -> %% throwaway
- NS
+ #watchdog{transport = TPid} = NS when Route -> %% incoming request
+ send(TPid, {send, false}), %% requiring ack
+ throw(NS)
end.
%% rcv/3
rcv('DWR', Pkt, #watchdog{transport = TPid,
- dictionary = Dict0}
+ dictionary = Dict0,
+ codec = Opts}
= S) ->
?LOG(recv, 'DWR'),
- DPkt = diameter_codec:decode(Dict0, Pkt),
+ DPkt = diameter_codec:decode(Dict0, Opts, Pkt),
diameter_traffic:incr(recv, DPkt, TPid, Dict0),
diameter_traffic:incr_error(recv, DPkt, TPid, Dict0),
#diameter_packet{header = H,
transport_data = T,
bin = Bin}
= EPkt
- = encode(dwa, Dict0, Pkt),
+ = encode(dwa, Dict0, Opts, Pkt),
diameter_traffic:incr(send, EPkt, TPid, Dict0),
diameter_traffic:incr_rc(send, EPkt, TPid, Dict0),
@@ -632,12 +648,13 @@ rcv('DWR', Pkt, #watchdog{transport = TPid,
throw(S);
rcv('DWA', Pkt, #watchdog{transport = TPid,
- dictionary = Dict0}
+ dictionary = Dict0,
+ codec = Opts}
= S) ->
?LOG(recv, 'DWA'),
diameter_traffic:incr(recv, Pkt, TPid, Dict0),
diameter_traffic:incr_rc(recv,
- diameter_codec:decode(Dict0, Pkt),
+ diameter_codec:decode(Dict0, Opts, Pkt),
TPid,
Dict0),
throw(S);
@@ -699,12 +716,12 @@ rcv(_, #watchdog{status = okay} = S) ->
%% SUSPECT Receive non-DWA Failback()
%% SetWatchdog() OKAY
-rcv('DWA', #watchdog{status = suspect, config = #config{suspect = OS}} = S) ->
+rcv('DWA', #watchdog{status = suspect, config = #{suspect := OS}} = S) ->
set_watchdog(S#watchdog{status = okay,
num_dwa = OS,
pending = false});
-rcv(_, #watchdog{status = suspect, config = #config{suspect = OS}} = S) ->
+rcv(_, #watchdog{status = suspect, config = #{suspect := OS}} = S) ->
set_watchdog(S#watchdog{status = okay,
num_dwa = OS});
@@ -714,8 +731,8 @@ rcv(_, #watchdog{status = suspect, config = #config{suspect = OS}} = S) ->
rcv('DWA', #watchdog{status = reopen,
num_dwa = N,
- config = #config{suspect = OS,
- okay = RO}}
+ config = #{suspect := OS,
+ okay := RO}}
= S)
when N+1 == RO ->
S#watchdog{status = okay,
@@ -846,18 +863,19 @@ restart(S) -> %% reconnect has won race with timeout
restart({{connect, _} = T, Opts, Svc, SvcOpts},
#watchdog{parent = Pid,
- restrict = {R,_},
+ config = #{restrict_connections := R}
+ = M,
dictionary = Dict0}
= S) ->
send(Pid, {reconnect, self()}),
Nodes = restrict_nodes(R),
S#watchdog{transport = start(T, Opts, SvcOpts, Nodes, Dict0, Svc),
- restrict = {R, lists:member(node(), Nodes)}};
+ config = M#{restrict => restrict(Nodes)}};
%% No restriction on the number of connections to the same peer: just
%% die. Note that a state machine never enters state REOPEN in this
%% case.
-restart({{accept, _}, _, _, _}, #watchdog{restrict = {_, false}}) ->
+restart({{accept, _}, _, _, _}, #watchdog{config = #{restrict := false}}) ->
stop;
%% Otherwise hang around until told to die, either by the service or
@@ -901,3 +919,8 @@ restrict_nodes(Nodes)
restrict_nodes(F) ->
diameter_lib:eval(F).
+
+%% restrict/1
+
+restrict(Nodes) ->
+ lists:member(node(), Nodes).
diff --git a/lib/diameter/src/compiler/diameter_codegen.erl b/lib/diameter/src/compiler/diameter_codegen.erl
index 928ae37e7f..f56e4a5249 100644
--- a/lib/diameter/src/compiler/diameter_codegen.erl
+++ b/lib/diameter/src/compiler/diameter_codegen.erl
@@ -150,20 +150,21 @@ erl_forms(Mod, ParseD) ->
{id, 0},
{vendor_id, 0},
{vendor_name, 0},
- {decode_avps, 2}, %% in diameter_gen.hrl
- {encode_avps, 2}, %%
+ {decode_avps, 3}, %% in diameter_gen.hrl
+ {encode_avps, 3}, %%
+ {grouped_avp, 4}, %%
{msg_name, 2},
{msg_header, 1},
{rec2msg, 1},
{msg2rec, 1},
{name2rec, 1},
{avp_name, 2},
+ {avp_arity, 1},
{avp_arity, 2},
{avp_header, 1},
- {avp, 3},
- {grouped_avp, 3},
+ {avp, 4},
{enumerated_avp, 3},
- {empty_value, 1},
+ {empty_value, 2},
{dict, 0}]},
%% diameter.hrl is included for #diameter_avp
{?attribute, include_lib, "diameter/include/diameter.hrl"},
@@ -178,7 +179,8 @@ erl_forms(Mod, ParseD) ->
f_msg2rec(ParseD),
f_name2rec(ParseD),
f_avp_name(ParseD),
- f_avp_arity(ParseD),
+ f_avp_arity_1(ParseD),
+ f_avp_arity_2(ParseD),
f_avp_header(ParseD),
f_avp(ParseD),
f_enumerated_avp(ParseD),
@@ -418,10 +420,32 @@ vendor_id_map(ParseD) ->
get_value(grouped, ParseD)).
%%% ------------------------------------------------------------------------
+%%% # avp_arity/1
+%%% ------------------------------------------------------------------------
+
+f_avp_arity_1(ParseD) ->
+ {?function, avp_arity, 1, avp_arities(ParseD) ++ [?BADARG(1)]}.
+
+avp_arities(ParseD) ->
+ Msgs = get_value(messages, ParseD),
+ Groups = get_value(grouped, ParseD)
+ ++ lists:flatmap(fun avps/1, get_value(import_groups, ParseD)),
+ lists:map(fun c_avp_arities/1, Msgs ++ Groups).
+
+c_avp_arities({N,_,_,_,As}) ->
+ c_avp_arities(N,As);
+c_avp_arities({N,_,_,As}) ->
+ c_avp_arities(N,As).
+
+c_avp_arities(Name, Avps) ->
+ Arities = [{?A(N), A} || T <- Avps, {N,A} <- [avp_info(T)]],
+ {?clause, [?Atom(Name)], [], [?TERM(Arities)]}.
+
+%%% ------------------------------------------------------------------------
%%% # avp_arity/2
%%% ------------------------------------------------------------------------
-f_avp_arity(ParseD) ->
+f_avp_arity_2(ParseD) ->
{?function, avp_arity, 2, avp_arity(ParseD)}.
avp_arity(ParseD) ->
@@ -452,7 +476,7 @@ c_arity(Name, Avp) ->
%%% ------------------------------------------------------------------------
f_avp(ParseD) ->
- {?function, avp, 3, avp(ParseD) ++ [?BADARG(3)]}.
+ {?function, avp, 4, avp(ParseD) ++ [?BADARG(4)]}.
avp(ParseD) ->
Native = get_value(avp_types, ParseD),
@@ -491,19 +515,25 @@ avp(Native, Imported, Custom, Enums) ->
not_in(List, X) ->
not lists:member(X, List).
-c_base_avp({AvpName, T}) ->
- {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName)],
+c_base_avp({AvpName, "Enumerated"}) ->
+ {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('_')],
[],
- [b_base_avp(AvpName, T)]}.
+ [?CALL(enumerated_avp, [?VAR('T'), ?Atom(AvpName), ?VAR('Data')])]};
-b_base_avp(AvpName, "Enumerated") ->
- ?CALL(enumerated_avp, [?VAR('T'), ?Atom(AvpName), ?VAR('Data')]);
-
-b_base_avp(AvpName, "Grouped") ->
- ?CALL(grouped_avp, [?VAR('T'), ?Atom(AvpName), ?VAR('Data')]);
+c_base_avp({AvpName, "Grouped"}) ->
+ {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('Opts')],
+ [],
+ [?CALL(grouped_avp, [?VAR('T'),
+ ?Atom(AvpName),
+ ?VAR('Data'),
+ ?VAR('Opts')])]};
-b_base_avp(_, Type) ->
- ?APPLY(diameter_types, ?A(Type), [?VAR('T'), ?VAR('Data')]).
+c_base_avp({AvpName, Type}) ->
+ {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('Opts')],
+ [],
+ [?APPLY(diameter_types, ?A(Type), [?VAR('T'),
+ ?VAR('Data'),
+ ?VAR('Opts')])]}.
cs_imported_avp({Mod, Avps}, Enums, CustomNames) ->
lists:map(fun(A) -> imported_avp(Mod, A, Enums) end,
@@ -525,11 +555,13 @@ imported_avp(Mod, {AvpName, _, _, _}, _) ->
c_imported_avp(Mod, AvpName).
c_imported_avp(Mod, AvpName) ->
- {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName)],
+ {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('Opts')],
[],
- [?APPLY(Mod, avp, [?VAR('T'),
- ?VAR('Data'),
- ?Atom(AvpName)])]}.
+ [?CALL(avp, [?VAR('T'),
+ ?VAR('Data'),
+ ?Atom(AvpName),
+ ?VAR('Opts'),
+ ?ATOM(Mod)])]}.
cs_custom_avp({Mod, Key, Avps}, Dict) ->
lists:map(fun(N) -> c_custom_avp(Mod, Key, N, orddict:fetch(N, Dict)) end,
@@ -537,9 +569,12 @@ cs_custom_avp({Mod, Key, Avps}, Dict) ->
c_custom_avp(Mod, Key, AvpName, Type) ->
{F,A} = custom(Key, AvpName, Type),
- {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName)],
+ {?clause, [?VAR('T'), ?VAR('Data'), ?Atom(AvpName), ?VAR('Opts')],
[],
- [?APPLY(?A(Mod), ?A(F), [?VAR('T'), ?Atom(A), ?VAR('Data')])]}.
+ [?APPLY(?A(Mod), ?A(F), [?VAR('T'),
+ ?Atom(A),
+ ?VAR('Data'),
+ ?VAR('Opts')])]}.
custom(custom_types, AvpName, Type) ->
{AvpName, Type};
@@ -568,7 +603,11 @@ enumerated_avp(Mod, Es, Enums) ->
Es).
cs_enumerated_avp(true, Mod, Name) ->
- [c_imported_avp(Mod, Name)];
+ [{?clause, [?VAR('T'), ?Atom(Name), ?VAR('Data')],
+ [],
+ [?APPLY(Mod, enumerated_avp, [?VAR('T'),
+ ?Atom(Name),
+ ?VAR('Data')])]}];
cs_enumerated_avp(false, _, _) ->
[].
@@ -682,7 +721,7 @@ v(false, _, _, _) ->
%%% ------------------------------------------------------------------------
f_empty_value(ParseD) ->
- {?function, empty_value, 1, empty_value(ParseD)}.
+ {?function, empty_value, 2, empty_value(ParseD)}.
empty_value(ParseD) ->
Imported = lists:flatmap(fun avps/1, get_value(import_enums, ParseD)),
@@ -692,15 +731,17 @@ empty_value(ParseD) ->
not lists:keymember(N, 1, Imported)]
++ Imported,
lists:map(fun c_empty_value/1, Groups ++ Enums)
- ++ [{?clause, [?VAR('Name')], [], [?CALL(empty, [?VAR('Name')])]}].
+ ++ [{?clause, [?VAR('Name'), ?VAR('Opts')],
+ [],
+ [?CALL(empty, [?VAR('Name'), ?VAR('Opts')])]}].
c_empty_value({Name, _, _, _}) ->
- {?clause, [?Atom(Name)],
+ {?clause, [?Atom(Name), ?VAR('Opts')],
[],
- [?CALL(empty_group, [?Atom(Name)])]};
+ [?CALL(empty_group, [?Atom(Name), ?VAR('Opts')])]};
c_empty_value({Name, _}) ->
- {?clause, [?Atom(Name)],
+ {?clause, [?Atom(Name), ?VAR('_')],
[],
[?TERM(<<0:32>>)]}.
diff --git a/lib/diameter/src/diameter.app.src b/lib/diameter/src/diameter.app.src
index d380ebbd92..9a6e47006b 100644
--- a/lib/diameter/src/diameter.app.src
+++ b/lib/diameter/src/diameter.app.src
@@ -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.
@@ -28,10 +28,10 @@
]},
{registered, [%REGISTERED%]},
{applications, [
- {stdlib, "2.0"}, {kernel, "3.0"}%, {erts, "6.0"}
- %% {syntax-tools, "1.6.14"}
- %% {runtime-tools, "1.8.14"}
- %, {ssl, "5.3.4"}
+ {stdlib, "2.4"}, {kernel, "3.2"}%, {erts, "6.4"}
+ %% {syntax-tools, "1.6,18"}
+ %% {runtime-tools, "1.8.16"}
+ %, {ssl, "6.0"}
]},
{env, []},
{mod, {diameter_app, []}},
diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src
index eb5a5a44f3..07d0389bfd 100644
--- a/lib/diameter/src/diameter.appup.src
+++ b/lib/diameter/src/diameter.appup.src
@@ -51,7 +51,8 @@
{"1.11.1", [{restart_application, diameter}]}, %% 18.2
{"1.11.2", [{restart_application, diameter}]}, %% 18.3
{"1.12", [{restart_application, diameter}]}, %% 19.0
- {"1.12.1", [{restart_application, diameter}]} %% 19.1
+ {"1.12.1", [{restart_application, diameter}]}, %% 19.1
+ {"1.12.2", [{restart_application, diameter}]} %% 19.3
],
[
{"0.9", [{restart_application, diameter}]},
@@ -84,6 +85,7 @@
{"1.11.1", [{restart_application, diameter}]},
{"1.11.2", [{restart_application, diameter}]},
{"1.12", [{restart_application, diameter}]},
- {"1.12.1", [{restart_application, diameter}]}
+ {"1.12.1", [{restart_application, diameter}]},
+ {"1.12.2", [{restart_application, diameter}]}
]
}.
diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk
index 4e4ce60ddf..bb3b234d20 100644
--- a/lib/diameter/src/modules.mk
+++ b/lib/diameter/src/modules.mk
@@ -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.
@@ -39,7 +39,7 @@ RT_MODULES = \
base/diameter_config \
base/diameter_config_sup \
base/diameter_codec \
- base/diameter_dict \
+ base/diameter_gen \
base/diameter_lib \
base/diameter_misc_sup \
base/diameter_peer \
diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl
index 76aacabcb8..a0104fac6e 100644
--- a/lib/diameter/src/transport/diameter_sctp.erl
+++ b/lib/diameter/src/transport/diameter_sctp.erl
@@ -52,21 +52,20 @@
%% Keys into process dictionary.
-define(INFO_KEY, info).
-define(REF_KEY, ref).
+-define(TRANSPORT_KEY, transport).
-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})).
%% The default port for a listener.
-define(DEFAULT_PORT, 3868). %% RFC 3588, ch 2.1
-%% Remote addresses to accept connections from.
--define(DEFAULT_ACCEPT, []). %% any
-
%% How long to wait for a transport process to attach after
%% association establishment.
-define(ACCEPT_TIMEOUT, 5000).
-type connect_option() :: {raddr, inet:ip_address()}
| {rport, inet:port_number()}
+ | option()
| term(). %% gen_sctp:open_option().
-type match() :: inet:ip_address()
@@ -74,8 +73,14 @@
| [match()].
-type listen_option() :: {accept, match()}
+ | option()
| term(). %% gen_sctp:open_option().
+-type option() :: {sender, boolean()}
+ | sender
+ | {packet, boolean() | raw}
+ | {message_cb, false | diameter:evaluable()}.
+
-type uint() :: non_neg_integer().
%% Accepting/connecting transport process state.
@@ -87,20 +92,35 @@
%% {RAs, RP, Errors}
| connect,
socket :: gen_sctp:sctp_socket() | undefined,
- assoc_id :: gen_sctp:assoc_id(), %% association identifier
+ active = false :: boolean(), %% is socket active?
+ recv = true :: boolean(), %% should it be active?
+ assoc_id :: gen_sctp:assoc_id() %% association identifier
+ | undefined
+ | true,
peer :: {[inet:ip_address()], uint()} %% {RAs, RP}
| undefined,
streams :: {uint(), uint()} %% {InStream, OutStream} counts
| undefined,
- os = 0 :: uint()}). %% next output stream
+ os = 0 :: uint(), %% next output stream
+ packet = true :: boolean() %% legacy transport_data?
+ | raw,
+ message_cb = false :: false | diameter:evaluable(),
+ send = false :: pid() | boolean()}). %% sending process
+
+%% Monitor process state.
+-record(monitor,
+ {transport :: pid(),
+ ack = false :: boolean(),
+ socket :: gen_sctp:sctp_socket(),
+ assoc_id :: gen_sctp:assoc_id()}).
%% Listener process state.
-record(listener,
{ref :: reference(),
socket :: gen_sctp:sctp_socket(),
- service = false :: false | pid(), %% service process
+ service :: pid(), %% service process
pending = {0, queue:new()},
- accept :: [match()]}).
+ opts :: [[match()] | boolean() | diameter:evaluable()]}).
%% Field pending implements two queues: the first of transport-to-be
%% processes to which an association has been assigned but for which
%% diameter hasn't yet spawned a transport process, a short-lived
@@ -132,11 +152,11 @@
start(T, Svc, Opts)
when is_list(Opts) ->
#diameter_service{capabilities = Caps,
- pid = SPid}
+ pid = Pid}
= Svc,
diameter_sctp_sup:start(), %% start supervisors on demand
Addrs = Caps#diameter_caps.host_ip_address,
- s(T, Addrs, SPid, lists:map(fun ip/1, Opts)).
+ s(T, Addrs, Pid, lists:map(fun ip/1, Opts)).
ip({ifaddr, A}) ->
{ip, A};
@@ -147,9 +167,9 @@ ip(T) ->
%% when there is not yet an association to assign it, or at comm_up on
%% a new association in which case the call retrieves a transport from
%% the pending queue.
-s({accept, Ref} = A, Addrs, SPid, Opts) ->
- {ok, LPid, LAs} = listener(Ref, {Opts, Addrs}),
- try gen_server:call(LPid, {A, self(), SPid}, infinity) of
+s({accept, Ref} = A, Addrs, SvcPid, Opts) ->
+ {ok, LPid, LAs} = listener(Ref, {Opts, SvcPid, Addrs}),
+ try gen_server:call(LPid, {A, self()}, infinity) of
{ok, TPid} ->
{ok, TPid, LAs};
No ->
@@ -162,7 +182,7 @@ s({accept, Ref} = A, Addrs, SPid, Opts) ->
%% gen_sctp in order to be able to accept a new association only
%% *after* an accepting transport has been spawned.
-s({connect = C, Ref}, Addrs, _SPid, Opts) ->
+s({connect = C, Ref}, Addrs, _SvcPid, Opts) ->
diameter_sctp_sup:start_child({C, self(), Opts, Addrs, Ref}).
%% start_link/1
@@ -216,22 +236,39 @@ init(T) ->
%% i/1
+i(#monitor{transport = TPid} = S) ->
+ monitor(process, TPid),
+ putr(?TRANSPORT_KEY, TPid),
+ proc_lib:init_ack({ok, self()}),
+ S;
+
%% A process owning a listening socket.
-i({listen, Ref, {Opts, Addrs}}) ->
+i({listen, Ref, {Opts, SvcPid, Addrs}}) ->
+ monitor(process, SvcPid),
[_] = diameter_config:subscribe(Ref, transport), %% assert existence
- {[Matches], Rest} = proplists:split(Opts, [accept]),
+ {Split, Rest}
+ = proplists:split(Opts, [accept, packet, sender, message_cb]),
+ OwnOpts = lists:append(Split),
{LAs, Sock} = AS = open(Addrs, Rest, ?DEFAULT_PORT),
ok = gen_sctp:listen(Sock, true),
true = diameter_reg:add_new({?MODULE, listener, {Ref, AS}}),
proc_lib:init_ack({ok, self(), LAs}),
#listener{ref = Ref,
+ service = SvcPid,
socket = Sock,
- accept = [[M] || {accept, M} <- Matches]};
+ opts = [[[M] || {accept, M} <- OwnOpts],
+ proplists:get_value(packet, OwnOpts, true)
+ | [proplists:get_value(K, OwnOpts, false)
+ || K <- [sender, message_cb]]]};
%% A connecting transport.
i({connect, Pid, Opts, Addrs, Ref}) ->
- {[As, Ps], Rest} = proplists:split(Opts, [raddr, rport]),
- RAs = [diameter_lib:ipaddr(A) || {raddr, A} <- As],
+ {[Ps | Split], Rest}
+ = proplists:split(Opts, [rport, raddr, packet, sender, message_cb]),
+ OwnOpts = lists:append(Split),
+ CB = proplists:get_value(message_cb, OwnOpts, false),
+ false == CB orelse (Pid ! {diameter, ack}),
+ RAs = [diameter_lib:ipaddr(A) || {raddr, A} <- OwnOpts],
[RP] = [P || {rport, P} <- Ps] ++ [P || P <- [?DEFAULT_PORT], [] == Ps],
{LAs, Sock} = open(Addrs, Rest, 0),
putr(?REF_KEY, Ref),
@@ -239,7 +276,10 @@ i({connect, Pid, Opts, Addrs, Ref}) ->
monitor(process, Pid),
#transport{parent = Pid,
mode = {connect, connect(Sock, RAs, RP, [])},
- socket = Sock};
+ socket = Sock,
+ message_cb = CB,
+ packet = proplists:get_value(packet, OwnOpts, true),
+ send = proplists:get_value(sender, OwnOpts, false)};
%% An accepting transport spawned by diameter, not yet owning an
%% association.
@@ -273,11 +313,16 @@ i({K, Ref}, #transport{mode = {accept, _}} = S) ->
receive
{Ref, Pid} when K == parent -> %% transport process started
S#transport{parent = Pid};
- {K, T, Matches} when K == peeloff -> %% association
+ {K, T, Opts} when K == peeloff -> %% association
{sctp, Sock, _RA, _RP, _Data} = T,
+ [Matches, Packet, Sender, CB] = Opts,
ok = accept_peer(Sock, Matches),
demonitor(Ref, [flush]),
- t(T, S#transport{socket = Sock});
+ false == CB orelse (S#transport.parent ! {diameter, ack}),
+ t(T, S#transport{socket = Sock,
+ message_cb = CB,
+ packet = Packet,
+ send = Sender});
accept_timeout = T ->
x(T);
{'DOWN', _, process, _, _} = T ->
@@ -374,13 +419,9 @@ handle_call({{accept, Ref}, Pid}, _, #listener{ref = Ref} = S) ->
{TPid, NewS} = accept(Ref, Pid, S),
{reply, {ok, TPid}, NewS};
-handle_call({{accept, _} = T, Pid, SPid}, From, #listener{service = P} = S) ->
- handle_call({T, Pid}, From, if not is_pid(P), is_pid(SPid) ->
- monitor(process, SPid),
- S#listener{service = SPid};
- true ->
- S
- end);
+%% Transport is telling us of parent death.
+handle_call({stop, _Pid} = Reason, _From, #monitor{} = S) ->
+ {stop, {shutdown, Reason}, ok, S};
handle_call(_, _, State) ->
{reply, nok, State}.
@@ -400,7 +441,11 @@ handle_info(T, #transport{} = S) ->
{noreply, #transport{} = t(T,S)};
handle_info(T, #listener{} = S) ->
- {noreply, #listener{} = l(T,S)}.
+ {noreply, #listener{} = l(T,S)};
+
+handle_info(T, #monitor{} = S) ->
+ m(T,S),
+ {noreply, S}.
%% Prior to the possibility of setting pool_size on in transport
%% configuration, a new accepting transport was only started following
@@ -422,6 +467,9 @@ code_change(_, State, _) ->
%% # terminate/2
%% ---------------------------------------------------------------------------
+terminate(_, #monitor{}) ->
+ ok;
+
terminate(_, #transport{assoc_id = undefined}) ->
ok;
@@ -445,11 +493,11 @@ getr(Key) ->
%% Incoming message from SCTP.
l({sctp, Sock, _RA, _RP, Data} = T, #listener{socket = Sock,
- accept = Matches}
+ opts = Opts}
= S) ->
Id = assoc_id(Data),
{TPid, NewS} = accept(S),
- TPid ! {peeloff, setelement(2, T, peeloff(Sock, Id, TPid)), Matches},
+ TPid ! {peeloff, setelement(2, T, peeloff(Sock, Id, TPid)), Opts},
setopts(Sock),
NewS;
@@ -503,12 +551,21 @@ t(T,S) ->
%% Incoming message.
transition({sctp, Sock, _RA, _RP, Data}, #transport{socket = Sock} = S) ->
- setopts(Sock),
- recv(Data, S);
+ setopts(S, recv(Data, S#transport{active = false}));
%% Outgoing message.
transition({diameter, {send, Msg}}, S) ->
- send(Msg, S);
+ message(send, Msg, S);
+
+%% Monitor has sent an outgoing message.
+transition(Msg, S)
+ when is_record(Msg, diameter_packet);
+ is_binary(Msg) ->
+ message(ack, Msg, S);
+
+%% Deferred actions from a message_cb.
+transition({actions, Dir, Acts}, S) ->
+ setopts(ok, actions(Acts, Dir, S));
%% Request to close the transport connection.
transition({diameter, {close, Pid}}, #transport{parent = Pid}) ->
@@ -522,8 +579,18 @@ transition({diameter, {close, Pid}}, #transport{parent = Pid}) ->
transition({diameter, {tls, _Ref, _Type, _Bool}}, _) ->
stop;
-%% Parent process has died.
-transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) ->
+%% Parent process has died: call the monitor to not close the socket
+%% during an ongoing send, but don't let it take forever.
+transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid,
+ send = MPid}) ->
+ is_boolean(MPid)
+ orelse ok == (catch gen_server:call(MPid, {stop, Pid}))
+ orelse exit(MPid, kill),
+ stop;
+
+%% Monitor process has died.
+transition({'DOWN', _, process, MPid, _}, #transport{send = MPid})
+ when is_pid(MPid) ->
stop;
%% Timeout after transport process has been started.
@@ -536,6 +603,18 @@ transition({resolve_port, Pid}, #transport{socket = Sock})
Pid ! inet:port(Sock),
ok.
+%% m/2
+
+m({Msg, StreamId}, #monitor{socket = Sock,
+ transport = TPid,
+ assoc_id = AId,
+ ack = B}) ->
+ send(Sock, AId, StreamId, Msg),
+ B andalso (TPid ! Msg);
+
+m({'DOWN', _, process, TPid, _} = T, #monitor{transport = TPid}) ->
+ x(T).
+
%% Crash on anything unexpected.
ok({ok, T}) ->
@@ -578,33 +657,52 @@ q(Ref, Pid, #listener{pending = {_,Q}}) ->
%% send/2
+%% Start monitor process on first send.
+send(Msg, #transport{send = true,
+ socket = Sock,
+ assoc_id = AId,
+ message_cb = CB}
+ = S) ->
+ {ok, MPid} = diameter_sctp_sup:start_child(#monitor{transport = self(),
+ socket = Sock,
+ assoc_id = AId,
+ ack = false /= CB}),
+ monitor(process, MPid),
+ send(Msg, S#transport{send = MPid});
+
%% Outbound Diameter message on a specified stream ...
-send(#diameter_packet{bin = Bin, transport_data = {outstream, SId}},
+send(#diameter_packet{transport_data = {outstream, SId}}
+ = Msg,
#transport{streams = {_, OS}}
= S) ->
- send(SId rem OS, Bin, S),
- S;
+ send(SId rem OS, Msg, S);
%% ... or not: rotate through all streams.
-send(#diameter_packet{bin = Bin}, S) ->
- send(Bin, S);
-send(Bin, #transport{streams = {_, OS},
+send(Msg, #transport{streams = {_, OS},
os = N}
- = S)
- when is_binary(Bin) ->
- send(N, Bin, S),
- S#transport{os = (N + 1) rem OS}.
+ = S) ->
+ send(N, Msg, S#transport{os = (N + 1) rem OS}).
%% send/3
-send(StreamId, Bin, #transport{socket = Sock,
- assoc_id = AId}) ->
- send(Sock, AId, StreamId, Bin).
+send(StreamId, Msg, #transport{send = false,
+ socket = Sock,
+ assoc_id = AId}
+ = S) ->
+ send(Sock, AId, StreamId, Msg),
+ message(ack, Msg, S);
+
+send(StreamId, Msg, #transport{send = MPid} = S) ->
+ MPid ! {Msg, StreamId},
+ S.
%% send/4
-send(Sock, AssocId, Stream, Bin) ->
- case gen_sctp:send(Sock, AssocId, Stream, Bin) of
+send(Sock, AssocId, StreamId, #diameter_packet{bin = Bin}) ->
+ send(Sock, AssocId, StreamId, Bin);
+
+send(Sock, AssocId, StreamId, Bin) ->
+ case gen_sctp:send(Sock, AssocId, StreamId, Bin) of
ok ->
ok;
{error, Reason} ->
@@ -624,7 +722,9 @@ recv({_, #sctp_assoc_change{state = comm_up,
= S) ->
Ref = getr(?REF_KEY),
publish(T, Ref, Id, Sock),
- up(S#transport{assoc_id = Id,
+ %% Deal with different association id after peeloff on Solaris by
+ %% taking the id from the first reception.
+ up(S#transport{assoc_id = T == accept orelse Id,
streams = {IS, OS}});
%% ... or not: try the next address.
@@ -639,17 +739,19 @@ recv({_, #sctp_assoc_change{} = E},
recv({_, #sctp_assoc_change{}}, _) ->
stop;
+%% First inbound on an accepting transport.
+recv({[#sctp_sndrcvinfo{assoc_id = Id}], _Bin}
+ = T,
+ #transport{assoc_id = true}
+ = S) ->
+ recv(T, S#transport{assoc_id = Id});
+
%% Inbound Diameter message.
-recv({[#sctp_sndrcvinfo{stream = Id}], Bin}, #transport{parent = Pid})
+recv({[#sctp_sndrcvinfo{}], Bin} = Msg, S)
when is_binary(Bin) ->
- diameter_peer:recv(Pid, #diameter_packet{transport_data = {stream, Id},
- bin = Bin}),
- ok;
+ message(recv, Msg, S);
-recv({_, #sctp_shutdown_event{assoc_id = A}},
- #transport{assoc_id = Id})
- when A == Id;
- A == 0 ->
+recv({_, #sctp_shutdown_event{}}, _) ->
stop;
%% Note that diameter_sctp(3) documents that sctp_events cannot be
@@ -765,6 +867,23 @@ connect(Sock, [Addr | AT] = As, Port, Reasons) ->
connect(Sock, AT, Port, [{Addr, E} | Reasons])
end.
+%% setopts/2
+
+setopts(_, #transport{socket = Sock,
+ active = A,
+ recv = B}
+ = S)
+ when B, not A ->
+ setopts(Sock),
+ S#transport{active = true};
+
+setopts(_, #transport{} = S) ->
+ S;
+
+setopts(#transport{socket = Sock}, T) ->
+ setopts(Sock),
+ T.
+
%% setopts/1
setopts(Sock) ->
@@ -772,3 +891,83 @@ setopts(Sock) ->
ok -> ok;
X -> x({setopts, Sock, X}) %% possibly on peer disconnect
end.
+
+%% A message_cb is invoked whenever a message is sent or received, or
+%% to provide acknowledgement of a completed send or discarded
+%% request. See diameter_tcp for semantics, the only difference being
+%% that a recv callback can get a diameter_packet record as Msg
+%% depending on how/if option packet has been specified.
+
+%% message/3
+
+message(send, false = M, S) ->
+ message(ack, M, S);
+
+message(ack, _, #transport{message_cb = false} = S) ->
+ S;
+
+message(Dir, Msg, S) ->
+ setopts(S, actions(cb(S, Dir, Msg), Dir, S)).
+
+%% actions/3
+
+actions([], _, S) ->
+ S;
+
+actions([B | As], Dir, S)
+ when is_boolean(B) ->
+ actions(As, Dir, S#transport{recv = B});
+
+actions([Dir | As], _, S)
+ when Dir == send;
+ Dir == recv ->
+ actions(As, Dir, S);
+
+actions([Msg | As], send = Dir, S)
+ when is_record(Msg, diameter_packet);
+ is_binary(Msg) ->
+ actions(As, Dir, send(Msg, S));
+
+actions([Msg | As], recv = Dir, #transport{parent = Pid} = S)
+ when is_record(Msg, diameter_packet);
+ is_binary(Msg) ->
+ diameter_peer:recv(Pid, Msg),
+ actions(As, Dir, S);
+
+actions([{defer, Tmo, Acts} | As], Dir, S) ->
+ erlang:send_after(Tmo, self(), {actions, Dir, Acts}),
+ actions(As, Dir, S);
+
+actions(CB, _, S) ->
+ S#transport{message_cb = CB}.
+
+%% cb/3
+
+cb(#transport{message_cb = false, packet = P}, recv, Msg) ->
+ [pkt(P, true, Msg)];
+
+cb(#transport{message_cb = CB, packet = P}, recv = D, Msg) ->
+ cb(CB, D, pkt(P, false, Msg));
+
+cb(#transport{message_cb = CB}, Dir, Msg) ->
+ cb(CB, Dir, Msg);
+
+cb(false, send, Msg) ->
+ [Msg];
+
+cb(CB, Dir, Msg) ->
+ diameter_lib:eval([CB, Dir, Msg]).
+
+%% pkt/3
+
+pkt(false, _, {_Info, Bin}) ->
+ Bin;
+
+pkt(true, _, {[#sctp_sndrcvinfo{stream = Id}], Bin}) ->
+ #diameter_packet{bin = Bin, transport_data = {stream, Id}};
+
+pkt(raw, true, {[Info], Bin}) ->
+ #diameter_packet{bin = Bin, transport_data = Info};
+
+pkt(raw, false, {[_], _} = Msg) ->
+ Msg.
diff --git a/lib/diameter/src/transport/diameter_sctp_sup.erl b/lib/diameter/src/transport/diameter_sctp_sup.erl
index 36050aaf28..e8e26ec7c5 100644
--- a/lib/diameter/src/transport/diameter_sctp_sup.erl
+++ b/lib/diameter/src/transport/diameter_sctp_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.
@@ -49,6 +49,7 @@ start() ->
start_child(T) ->
SupRef = case element(1,T) of
+ monitor -> ?TRANSPORT_SUP;
connect -> ?TRANSPORT_SUP;
accept -> ?TRANSPORT_SUP;
listen -> ?LISTENER_SUP
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index 44abc5c3b4..aa09a261a3 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.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.
@@ -19,7 +19,6 @@
%%
-module(diameter_tcp).
--dialyzer({no_fail_call, throttle/2}).
-behaviour(gen_server).
@@ -53,6 +52,7 @@
%% Keys into process dictionary.
-define(INFO_KEY, info).
-define(REF_KEY, ref).
+-define(TRANSPORT_KEY, transport).
-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})).
@@ -68,16 +68,23 @@
%% The same gen_server implementation supports three different kinds
%% of processes: an actual transport process, one that will club it to
%% death should the parent die before a connection is established, and
-%% a process owning the listening port.
+%% a process owning the listening port. The monitor process
+%% historically died after connection establishment, but can now live
+%% on as the sender of outgoing messages, so that a blocking send
+%% doesn't prevent messages from being received.
%% Listener process state.
-record(listener, {socket :: inet:socket(),
+ module :: module(),
service = false :: false | pid()}). %% service process
%% Monitor process state.
-record(monitor,
- {parent :: pid(),
- transport = self() :: pid()}).
+ {parent :: reference() | false | pid(),
+ transport = self() :: pid(),
+ ack = false :: boolean(),
+ socket :: inet:socket() | ssl:sslsocket() | undefined,
+ module :: module() | undefined}).
-type length() :: 0..16#FFFFFF. %% message length from Diameter header
-type size() :: non_neg_integer(). %% accumulated binary size
@@ -97,25 +104,30 @@
-type listen_option() :: {accept, match()}
| {ssl_options, true | [ssl:listen_option()]}
+ | option()
| ssl:listen_option()
| gen_tcp:listen_option().
-type option() :: {port, non_neg_integer()}
- | {fragment_timer, 0..16#FFFFFFFF}
- | {throttle_cb, diameter:evaluable()}.
+ | {sender, boolean()}
+ | sender
+ | {message_cb, false | diameter:evaluable()}
+ | {fragment_timer, 0..16#FFFFFFFF}.
%% Accepting/connecting transport process state.
-record(transport,
{socket :: inet:socket() | ssl:sslsocket(), %% accept/connect socket
+ active = false :: boolean(), %% is socket active?
+ recv = true :: boolean(), %% should it be active?
parent :: pid(), %% of process that started us
module :: module(), %% gen_tcp-like module
- frag = <<>> :: frag(), %% message fragment
ssl :: [term()] | boolean(), %% ssl options, ssl or not
+ frag = <<>> :: frag(), %% message fragment
timeout :: infinity | 0..16#FFFFFFFF, %% fragment timeout
tref = false :: false | reference(), %% fragment timer reference
flush = false :: boolean(), %% flush fragment at timeout?
- throttle_cb :: false | diameter:evaluable(), %% ask to receive
- throttled :: boolean() | binary()}). %% stopped receiving?
+ message_cb :: false | diameter:evaluable(),
+ send :: pid() | false}). %% sending process
%% The usual transport using gen_tcp can be replaced by anything
%% sufficiently gen_tcp-like by passing a 'module' option as the first
@@ -137,13 +149,13 @@
start({T, Ref}, Svc, Opts) ->
#diameter_service{capabilities = Caps,
- pid = SPid}
+ pid = SvcPid}
= Svc,
diameter_tcp_sup:start(), %% start tcp supervisors on demand
{Mod, Rest} = split(Opts),
Addrs = Caps#diameter_caps.host_ip_address,
- Arg = {T, Ref, Mod, self(), Rest, Addrs, SPid},
+ Arg = {T, Ref, Mod, self(), Rest, Addrs, SvcPid},
diameter_tcp_sup:start_child(Arg).
split([{module, M} | Opts]) ->
@@ -197,57 +209,53 @@ init(T) ->
%% i/1
%% A transport process.
-i({T, Ref, Mod, Pid, Opts, Addrs, SPid})
+i({T, Ref, Mod, Pid, Opts, Addrs, SvcPid})
when T == accept;
T == connect ->
monitor(process, Pid),
%% Since accept/connect might block indefinitely, spawn a process
- %% that does nothing but kill us with the parent until call
- %% returns.
- {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}),
+ %% that kills us with the parent until call returns, and then
+ %% sends outgoing messages.
{[SO|TO], Rest} = proplists:split(Opts, [ssl_options,
- fragment_timer,
- throttle_cb]),
+ sender,
+ message_cb,
+ fragment_timer]),
SslOpts = ssl_opts(SO),
OwnOpts = lists:append(TO),
Tmo = proplists:get_value(fragment_timer,
OwnOpts,
?DEFAULT_FRAGMENT_TIMEOUT),
+ [CB, Sender] = [proplists:get_value(K, OwnOpts, false)
+ || K <- [message_cb, sender]],
?IS_TIMEOUT(Tmo) orelse ?ERROR({fragment_timer, Tmo}),
- Throttle = proplists:get_value(throttle_cb, OwnOpts, false),
- Sock = init(T, Ref, Mod, Pid, SslOpts, Rest, Addrs, SPid),
- MPid ! {stop, self()}, %% tell the monitor to die
+ {ok, MPid} = diameter_tcp_sup:start_child(#monitor{parent = Pid}),
+ Sock = init(T, Ref, Mod, Pid, SslOpts, Rest, Addrs, SvcPid),
M = if SslOpts -> ssl; true -> Mod end,
+ Sender andalso monitor(process, MPid),
+ false == CB orelse (Pid ! {diameter, ack}),
+ MPid ! {start, self(), Sender andalso {Sock, M}, false /= CB},
putr(?REF_KEY, Ref),
- throttle(#transport{parent = Pid,
- module = M,
- socket = Sock,
- ssl = SslOpts,
- timeout = Tmo,
- throttle_cb = Throttle,
- throttled = false /= Throttle});
+ setopts(#transport{parent = Pid,
+ module = M,
+ socket = Sock,
+ ssl = SslOpts,
+ message_cb = CB,
+ timeout = Tmo,
+ send = Sender andalso MPid});
%% Put the reference in the process dictionary since we now use it
%% advertise the ssl socket after TLS upgrade.
-i({T, _Ref, _Mod, _Pid, _Opts, _Addrs} = Arg) %% from old code
- when T == accept;
- T == connect ->
- i(erlang:append_element(Arg, _SPid = false));
-
%% A monitor process to kill the transport if the parent dies.
i(#monitor{parent = Pid, transport = TPid} = S) ->
+ putr(?TRANSPORT_KEY, TPid),
proc_lib:init_ack({ok, self()}),
- monitor(process, Pid),
monitor(process, TPid),
- S;
+ S#monitor{parent = monitor(process, Pid)};
%% In principle a link between the transport and killer processes
%% could do the same thing: have the accepting/connecting process be
%% killed when the killer process dies as a consequence of parent
%% death. However, a link can be unlinked and this is exactly what
-%% gen_tcp seems to so. Links should be left to supervisors.
-
-i({listen = L, Ref, _APid, T}) -> %% from old code
- i({L, Ref, T});
+%% gen_tcp seems to do. Links should be left to supervisors.
i({listen, Ref, {Mod, Opts, Addrs}}) ->
[_] = diameter_config:subscribe(Ref, transport), %% assert existence
@@ -258,7 +266,8 @@ i({listen, Ref, {Mod, Opts, Addrs}}) ->
LAddr = laddr(LAddrOpt, Mod, LSock),
true = diameter_reg:add_new({?MODULE, listener, {Ref, {LAddr, LSock}}}),
proc_lib:init_ack({ok, self(), {LAddr, LSock}}),
- #listener{socket = LSock}.
+ #listener{socket = LSock,
+ module = Mod}.
laddr([], Mod, Sock) ->
{ok, {Addr, _Port}} = sockname(Mod, Sock),
@@ -279,19 +288,19 @@ ssl_opts(T) ->
%% init/8
%% Establish a TLS connection before capabilities exchange ...
-init(Type, Ref, Mod, Pid, true, Opts, Addrs, SPid) ->
- init(Type, Ref, ssl, Pid, [{cb_info, ?TCP_CB(Mod)} | Opts], Addrs, SPid);
+init(Type, Ref, Mod, Pid, true, Opts, Addrs, SvcPid) ->
+ init(Type, Ref, ssl, Pid, [{cb_info, ?TCP_CB(Mod)} | Opts], Addrs, SvcPid);
%% ... or not.
-init(Type, Ref, Mod, Pid, _, Opts, Addrs, SPid) ->
- init(Type, Ref, Mod, Pid, Opts, Addrs, SPid).
+init(Type, Ref, Mod, Pid, _, Opts, Addrs, SvcPid) ->
+ init(Type, Ref, Mod, Pid, Opts, Addrs, SvcPid).
%% init/7
-init(accept = T, Ref, Mod, Pid, Opts, Addrs, SPid) ->
+init(accept = T, Ref, Mod, Pid, Opts, Addrs, SvcPid) ->
{[Matches], Rest} = proplists:split(Opts, [accept]),
{ok, LPid, {LAddr, LSock}} = listener(Ref, {Mod, Rest, Addrs}),
- ok = gen_server:call(LPid, {accept, SPid}, infinity),
+ ok = gen_server:call(LPid, {accept, SvcPid}, infinity),
proc_lib:init_ack({ok, self(), [LAddr]}),
Sock = ok(accept(Mod, LSock)),
ok = accept_peer(Mod, Sock, accept(Matches)),
@@ -299,7 +308,7 @@ init(accept = T, Ref, Mod, Pid, Opts, Addrs, SPid) ->
diameter_peer:up(Pid),
Sock;
-init(connect = T, Ref, Mod, Pid, Opts, Addrs, _SPid) ->
+init(connect = T, Ref, Mod, Pid, Opts, Addrs, _SvcPid) ->
{[LA, RA, RP], Rest} = proplists:split(Opts, [ip, raddr, rport]),
LAddrOpt = get_addr(LA, Addrs),
RAddr = get_addr(RA),
@@ -451,14 +460,18 @@ portnr(Sock) ->
%% # handle_call/3
%% ---------------------------------------------------------------------------
-handle_call({accept, SPid}, _From, #listener{service = P} = S) ->
- {reply, ok, if not is_pid(P), is_pid(SPid) ->
- monitor(process, SPid),
- S#listener{service = SPid};
+handle_call({accept, SvcPid}, _From, #listener{service = P} = S) ->
+ {reply, ok, if not is_pid(P), is_pid(SvcPid) ->
+ monitor(process, SvcPid),
+ S#listener{service = SvcPid};
true ->
S
end};
-
+
+%% Transport is telling us of parent death.
+handle_call({stop, _Pid} = Reason, _From, #monitor{} = S) ->
+ {stop, {shutdown, Reason}, ok, S};
+
handle_call(_, _, State) ->
{reply, nok, State}.
@@ -480,8 +493,7 @@ handle_info(T, #listener{} = S) ->
{noreply, #listener{} = l(T,S)};
handle_info(T, #monitor{} = S) ->
- m(T,S),
- x(T).
+ {noreply, #monitor{} = m(T,S)}.
%% ---------------------------------------------------------------------------
%% # code_change/3
@@ -497,6 +509,7 @@ code_change(_, State, _) ->
terminate(_, _) ->
ok.
+
%% ---------------------------------------------------------------------------
putr(Key, Val) ->
@@ -509,18 +522,47 @@ getr(Key) ->
%%
%% Transition monitor state.
+%% Outgoing message.
+m(Msg, S)
+ when is_record(Msg, diameter_packet);
+ is_binary(Msg) ->
+ send(Msg, S),
+ S;
+
+%% Transport has established a connection. Stop monitoring on the
+%% parent so as not to die before a send from the transport.
+m({start, TPid, T, Ack} = M, #monitor{transport = TPid} = S) ->
+ case T of
+ {Sock, Mod} ->
+ demonitor(S#monitor.parent, [flush]),
+ S#monitor{parent = false,
+ socket = Sock,
+ module = Mod,
+ ack = Ack};
+ false -> %% monitor not sending
+ x(M)
+ end;
+
%% Transport is telling us to die.
-m({stop, TPid}, #monitor{transport = TPid}) ->
- ok;
+m({stop, TPid} = T, #monitor{transport = TPid}) ->
+ x(T);
-%% Transport has died.
-m({'DOWN', _, process, TPid, _}, #monitor{transport = TPid}) ->
- ok;
+%% Transport is telling us to die.
+m({stop, TPid} = T, #monitor{transport = TPid}) ->
+ x(T);
-%% Transport parent has died.
-m({'DOWN', _, process, Pid, _}, #monitor{parent = Pid,
- transport = TPid}) ->
- exit(TPid, {shutdown, parent}).
+%% Transport is telling us that TLS has been negotiated after
+%% capabilities exchange.
+m({tls, SSock}, S) ->
+ S#monitor{socket = SSock,
+ module = ssl};
+
+%% Transport or parent has died.
+m({'DOWN', M, process, P, _} = T, #monitor{parent = MRef,
+ transport = TPid})
+ when M == MRef;
+ P == TPid ->
+ x(T).
%% l/2
%%
@@ -528,18 +570,16 @@ m({'DOWN', _, process, Pid, _}, #monitor{parent = Pid,
%% Service process has died.
l({'DOWN', _, process, Pid, _} = T, #listener{service = Pid,
- socket = Sock}) ->
- gen_tcp:close(Sock),
+ socket = Sock,
+ module = M}) ->
+ M:close(Sock),
x(T);
%% Transport has been removed.
-l({transport, remove, _} = T, #listener{socket = Sock}) ->
- gen_tcp:close(Sock),
- x(T);
-
-%% Possibly death of an accepting process monitored in old code.
-l(_, S) ->
- S.
+l({transport, remove, _} = T, #listener{socket = Sock,
+ module = M}) ->
+ M:close(Sock),
+ x(T).
%% t/2
%%
@@ -557,21 +597,13 @@ t(T,S) ->
%% transition/2
-%% Incoming message.
+%% Incoming packets.
transition({P, Sock, Bin}, #transport{socket = Sock,
- ssl = B,
- throttled = T}
+ ssl = B}
= S)
when P == ssl, true == B;
P == tcp ->
- false = T, %% assert
- recv(Bin, S);
-
-%% Make a new throttling callback after a timeout.
-transition(throttle, #transport{throttled = false}) ->
- ok;
-transition(throttle, S) ->
- throttle(S);
+ recv(Bin, S#transport{active = false});
%% Capabilties exchange has decided on whether or not to run over TLS.
transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid}
@@ -581,7 +613,7 @@ transition({diameter, {tls, Ref, Type, B}}, #transport{parent = Pid}
= NS
= tls_handshake(Type, B, S),
Pid ! {diameter, {tls, Ref}},
- throttle(NS#transport{ssl = B});
+ NS#transport{ssl = B};
transition({C, Sock}, #transport{socket = Sock,
ssl = B})
@@ -597,8 +629,18 @@ transition({E, Sock, _Reason} = T, #transport{socket = Sock,
?ERROR({T,S});
%% Outgoing message.
-transition({diameter, {send, Bin}}, S) ->
- send(Bin, S);
+transition({diameter, {send, Msg}}, #transport{} = S) ->
+ message(send, Msg, S);
+
+%% Monitor has sent an outgoing message.
+transition(Msg, S)
+ when is_record(Msg, diameter_packet);
+ is_binary(Msg) ->
+ message(ack, Msg, S);
+
+%% Deferred actions from a message_cb.
+transition({actions, Dir, Acts}, S) ->
+ setopts(actions(Acts, Dir, S));
%% Request to close the transport connection.
transition({diameter, {close, Pid}}, #transport{parent = Pid,
@@ -618,8 +660,18 @@ transition({resolve_port, Pid}, #transport{socket = Sock,
Pid ! portnr(M, Sock),
ok;
-%% Parent process has died.
-transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid}) ->
+%% Parent process has died: call the monitor to not close the socket
+%% during an ongoing send, but don't let it take forever.
+transition({'DOWN', _, process, Pid, _}, #transport{parent = Pid,
+ send = MPid}) ->
+ false == MPid
+ orelse (ok == gen_server:call(MPid, {stop, self()}, 1000))
+ orelse exit(MPid, {shutdown, parent}),
+ stop;
+
+%% Monitor process has died.
+transition({'DOWN', _, process, MPid, _}, #transport{send = MPid})
+ when is_pid(MPid) ->
stop.
%% Crash on anything unexpected.
@@ -643,11 +695,13 @@ tls_handshake(_, true, #transport{ssl = false}) ->
%% Capabilities exchange negotiated TLS: upgrade the connection.
tls_handshake(Type, true, #transport{socket = Sock,
module = M,
- ssl = Opts}
+ ssl = Opts,
+ send = MPid}
= S) ->
{ok, SSock} = tls(Type, Sock, [{cb_info, ?TCP_CB(M)} | Opts]),
Ref = getr(?REF_KEY),
true = diameter_reg:add_new({?MODULE, Type, {Ref, SSock}}),
+ false == MPid orelse (MPid ! {tls, SSock}), %% tell the sender process
S#transport{socket = SSock,
module = ssl};
@@ -666,24 +720,15 @@ tls(accept, Sock, Opts) ->
%% using Nagle.
%% Receive packets until a full message is received,
-recv(Bin, #transport{frag = Head, throttled = false} = S) ->
+recv(Bin, #transport{frag = Head} = S) ->
case rcv(Head, Bin) of
- {Msg, B} ->
- throttle(S#transport{frag = B, throttled = Msg});
- Frag ->
- setopts(S),
- start_fragment_timer(S#transport{frag = Frag,
- flush = false})
+ {Msg, B} -> %% have a complete message ...
+ message(recv, Msg, S#transport{frag = B});
+ Frag -> %% read more on the socket
+ start_fragment_timer(setopts(S#transport{frag = Frag,
+ flush = false}))
end.
-%% recv/1
-
-recv(#transport{throttled = false} = S) ->
- recv(<<>>, S);
-
-recv(#transport{} = S) ->
- S.
-
%% rcv/2
%% No previous fragment.
@@ -743,13 +788,16 @@ recv1(Len, Bin) ->
<<Msg:Len/binary, Rest/binary>> = Bin,
{Msg, Rest}.
-%% bin/1-2
+%% bin/2
bin(Head, Acc) ->
list_to_binary([Head | lists:reverse(Acc)]).
+%% bin/1
+
bin({_, _, Head, Acc}) ->
bin(Head, Acc);
+
bin(Bin)
when is_binary(Bin) ->
Bin.
@@ -768,9 +816,7 @@ bin(Bin)
%% also eventually lead to watchdog failover.
%% No fragment to flush or not receiving messages.
-flush(#transport{frag = Frag, throttled = B} = S)
- when Frag == <<>>;
- B /= false ->
+flush(#transport{frag = <<>>} = S) ->
S;
%% Messages have been received since last timer expiry.
@@ -778,9 +824,8 @@ flush(#transport{flush = false} = S) ->
start_fragment_timer(S#transport{flush = true});
%% No messages since last expiry.
-flush(#transport{frag = Frag, parent = Pid} = S) ->
- diameter_peer:recv(Pid, bin(Frag)),
- S#transport{frag = <<>>}.
+flush(#transport{frag = Frag} = S) ->
+ message(recv, bin(Frag), S#transport{frag = <<>>}).
%% start_fragment_timer/1
%%
@@ -813,9 +858,27 @@ connect(Mod, Host, Port, Opts) ->
%% send/2
-send(Bin, #transport{socket = Sock,
- module = M}) ->
- case send(M, Sock, Bin) of
+send(Msg, #monitor{socket = Sock, module = M, transport = TPid, ack = B}) ->
+ send1(M, Sock, Msg),
+ B andalso (TPid ! Msg);
+
+send(Msg, #transport{socket = Sock, module = M, send = false} = S) ->
+ send1(M, Sock, Msg),
+ message(ack, Msg, S);
+
+%% Send from the monitor process to avoid deadlock if both the
+%% receiver and the peer were to block in send.
+send(Msg, #transport{send = Pid} = S) ->
+ Pid ! Msg,
+ S.
+
+%% send1/3
+
+send1(Mod, Sock, #diameter_packet{bin = Bin}) ->
+ send1(Mod, Sock, Bin);
+
+send1(Mod, Sock, Bin) ->
+ case send(Mod, Sock, Bin) of
ok ->
ok;
{error, Reason} ->
@@ -842,120 +905,19 @@ setopts(M, Sock, Opts) ->
%% setopts/1
-setopts(#transport{socket = Sock, module = M}) ->
- setopts(M, Sock).
-
-%% setopts/2
-
-setopts(M, Sock) ->
+setopts(#transport{socket = Sock,
+ active = A,
+ recv = B,
+ module = M}
+ = S)
+ when B, not A ->
case setopts(M, Sock, [{active, once}]) of
- ok -> ok;
- X -> x({setopts, M, Sock, X}) %% possibly on peer disconnect
- end.
-
-%% throttle/1
-
-%% Still collecting packets for a complete message: keep receiving.
-throttle(#transport{throttled = false} = S) ->
- recv(S);
-
-%% Decide whether to receive another, or whether to accept a message
-%% that's been received.
-throttle(#transport{throttle_cb = F, throttled = T} = S) ->
- Res = cb(F, T),
-
- try throttle(Res, S) of
- #transport{ssl = SB} = NS when is_boolean(SB) ->
- throttle(defrag(NS));
- #transport{throttled = Msg} = NS when is_binary(Msg) ->
- %% Initial incoming message when we might need to upgrade
- %% to TLS: wait for reception of a tls tuple.
- defrag(NS)
- catch
- #transport{} = NS ->
- recv(NS)
- end.
-
-%% cb/2
-
-cb(false, _) ->
- ok;
-
-cb(F, B) ->
- diameter_lib:eval([F, true /= B andalso B]).
-
-%% throttle/2
-
-%% Callback says to receive another message.
-throttle(ok, #transport{throttled = true} = S) ->
- throw(S#transport{throttled = false});
-
-%% Callback says to accept a received message.
-throttle(ok, #transport{parent = Pid, throttled = Msg} = S)
- when is_binary(Msg) ->
- diameter_peer:recv(Pid, Msg),
- S;
-
-throttle({ok = T, F}, S) ->
- throttle(T, S#transport{throttle_cb = F});
-
-%% Callback says to accept a received message and acknowledged the
-%% returned pid with a {request, Pid} message if a request pid is
-%% spawned, a discard message otherwise. The latter does not mean that
-%% the message was necessarily discarded: it could have been an
-%% answer.
-throttle(NPid, #transport{parent = Pid, throttled = Msg} = S)
- when is_pid(NPid), is_binary(Msg) ->
- diameter_peer:recv(Pid, {Msg, NPid}),
- S;
-
-throttle({NPid, F}, #transport{throttled = Msg} = S)
- when is_pid(NPid), is_binary(Msg) ->
- throttle(NPid, S#transport{throttle_cb = F});
-
-%% Callback to accept a received message says to discard it.
-throttle(discard, #transport{throttled = Msg} = S)
- when is_binary(Msg) ->
- S;
-
-throttle({discard = T, F}, #transport{throttled = Msg} = S)
- when is_binary(Msg) ->
- throttle(T, S#transport{throttle_cb = F});
-
-%% Callback to accept a received message says to answer it with the
-%% supplied binary.
-throttle(Bin, #transport{throttled = Msg} = S)
- when is_binary(Bin), is_binary(Msg) ->
- send(Bin, S),
- S;
-
-throttle({Bin, F}, #transport{throttled = Msg} = S)
- when is_binary(Bin), is_binary(Msg) ->
- throttle(Bin, S#transport{throttle_cb = F});
-
-%% Callback says to ask again in the specified number of milliseconds.
-throttle({timeout, Tmo}, S) ->
- erlang:send_after(Tmo, self(), throttle),
- throw(S);
-
-throttle({timeout = T, Tmo, F}, S) ->
- throttle({T, Tmo}, S#transport{throttle_cb = F});
-
-throttle(T, #transport{throttle_cb = F}) ->
- ?ERROR({invalid_return, T, F}).
-
-%% defrag/1
-%%
-%% Try to extract another message from packets already read before
-%% another throttling callback.
+ ok -> S#transport{active = true};
+ X -> x({setopts, Sock, M, X}) %% possibly on peer disconnect
+ end;
-defrag(#transport{frag = Head} = S) ->
- case rcv(Head, <<>>) of
- {Msg, B} ->
- S#transport{throttled = Msg, frag = B};
- _ ->
- S#transport{throttled = true}
- end.
+setopts(S) ->
+ S.
%% portnr/2
@@ -990,3 +952,80 @@ getstat(gen_tcp, Sock) ->
getstat(M, Sock) ->
M:getstat(Sock).
%% Note that ssl:getstat/1 doesn't yet exist in R15B01.
+
+%% A message_cb is invoked whenever a message is sent or received, or
+%% to provide acknowledgement of a completed send or discarded
+%% request. Ignoring possible extra arguments, calls are of the
+%% following form.
+%%
+%% cb(recv, Msg) Receive a message into diameter?
+%% cb(send, Msg) Send a message on the socket?
+%% cb(ack, Msg) Acknowledgement of a completed send.
+%% cb(ack, false) Acknowledgement of a discarded request.
+%%
+%% Msg will be binary() in a recv callback, but can be a
+%% diameter_packet record in a send/ack callback if a recv/send
+%% callback returns a record. Callbacks return a list of the following
+%% form.
+%%
+%% [boolean() | send | recv | binary() | #diameter_packet{}]
+%%
+%% The atoms are meaningless by themselves, but say whether subsequent
+%% messages are to be sent or received. A boolean says whether or not
+%% to continue reading on the socket. Messages can be received even
+%% after false is returned if these arrived in the same packet. A
+%% leading recv or send is implicit on the corresponding callbacks. A
+%% new callback can be returned as the tail of a returned list: any
+%% value not of the aforementioned list type is interpreted as a
+%% callback.
+
+%% message/3
+
+message(send, false = M, S) ->
+ message(ack, M, S);
+
+message(ack, _, #transport{message_cb = false} = S) ->
+ S;
+
+message(Dir, Msg, #transport{message_cb = CB} = S) ->
+ recv(<<>>, actions(cb(CB, Dir, Msg), Dir, S)).
+
+%% actions/3
+
+actions([], _, S) ->
+ S;
+
+actions([B | As], Dir, S)
+ when is_boolean(B) ->
+ actions(As, Dir, S#transport{recv = B});
+
+actions([Dir | As], _, S)
+ when Dir == send;
+ Dir == recv ->
+ actions(As, Dir, S);
+
+actions([Msg | As], send = Dir, S)
+ when is_binary(Msg);
+ is_record(Msg, diameter_packet) ->
+ actions(As, Dir, send(Msg, S));
+
+actions([Msg | As], recv = Dir, #transport{parent = Pid} = S)
+ when is_binary(Msg);
+ is_record(Msg, diameter_packet) ->
+ diameter_peer:recv(Pid, Msg),
+ actions(As, Dir, S);
+
+actions([{defer, Tmo, Acts} | As], Dir, S) ->
+ erlang:send_after(Tmo, self(), {actions, Dir, Acts}),
+ actions(As, Dir, S);
+
+actions(CB, _, S) ->
+ S#transport{message_cb = CB}.
+
+%% cb/3
+
+cb(false, _, Msg) ->
+ [Msg];
+
+cb(CB, Dir, Msg) ->
+ diameter_lib:eval([CB, Dir, Msg]).
diff --git a/lib/diameter/test/diameter_capx_SUITE.erl b/lib/diameter/test/diameter_capx_SUITE.erl
index fdeff96a58..51b6c1d7f2 100644
--- a/lib/diameter/test/diameter_capx_SUITE.erl
+++ b/lib/diameter/test/diameter_capx_SUITE.erl
@@ -433,7 +433,7 @@ server_reject(Config, F, RC) ->
?fail({LRef, OH})
end.
-%% cliient_closed/4
+%% client_closed/4
client_closed(Config, Host, F, RC) ->
true = diameter:subscribe(?CLIENT),
diff --git a/lib/diameter/test/diameter_codec_SUITE.erl b/lib/diameter/test/diameter_codec_SUITE.erl
index 558ba3b848..9f08f49f9f 100644
--- a/lib/diameter/test/diameter_codec_SUITE.erl
+++ b/lib/diameter/test/diameter_codec_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2015. 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.
@@ -31,6 +31,8 @@
-export([suite/0,
all/0,
groups/0,
+ init_per_suite/1,
+ end_per_suite/1,
init_per_group/2,
end_per_group/2,
init_per_testcase/2,
@@ -63,6 +65,12 @@ groups() ->
grouped_error,
failed_error]}].
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
init_per_group(recode, Config) ->
ok = diameter:start(),
Config.
@@ -277,7 +285,14 @@ recode(Msg) ->
recode(Msg, diameter_gen_base_rfc6733).
recode(#diameter_packet{} = Pkt, Dict) ->
- diameter_codec:decode(Dict, diameter_codec:encode(Dict, Pkt));
+ diameter_codec:decode(Dict, opts(Dict), diameter_codec:encode(Dict, Pkt));
recode(Msg, Dict) ->
recode(#diameter_packet{msg = Msg}, Dict).
+
+opts(Mod) ->
+ #{dictionary => Mod,
+ string_decode => false,
+ strict_mbit => true,
+ rfc => 6733,
+ failed_avp => false}.
diff --git a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
index 50cc6e7eef..700910878c 100644
--- a/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
+++ b/lib/diameter/test/diameter_codec_SUITE_data/diameter_test_unknown.erl
@@ -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.
@@ -59,7 +59,7 @@ enc(M, #diameter_packet{msg = Vs} = P) ->
P#diameter_packet{msg = [M|Vs]}).
run(M, Pkt) ->
- dec(M, diameter_codec:decode(diameter_test_recv, Pkt)).
+ dec(M, diameter_codec:decode(diameter_test_recv, opts(M), Pkt)).
%% Note that the recv dictionary defines neither XXX nor YYY.
dec('AR', #diameter_packet
@@ -75,3 +75,10 @@ dec('BR', #diameter_packet
errors = [{5001, ?MANDATORY_XXX},
{5008, ?NOT_MANDATORY_YYY}]}) ->
ok.
+
+opts(Mod) ->
+ #{dictionary => Mod,
+ string_decode => true,
+ strict_mbit => true,
+ rfc => 6733,
+ failed_avp => false}.
diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl
index 869797f11f..b548f85cb8 100644
--- a/lib/diameter/test/diameter_codec_test.erl
+++ b/lib/diameter/test/diameter_codec_test.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.
@@ -94,7 +94,7 @@ base(T) ->
%% Ensure that 'zero' values encode only zeros.
base(zero = T, F) ->
- B = diameter_types:F(encode, T),
+ B = diameter_types:F(encode, T, opts()),
B = z(B);
%% Ensure that we can decode what we encode and vice-versa, and that
@@ -106,7 +106,7 @@ base(decode, F) ->
[] = run([[fun base_invalid/2, F, V] || V <- Is]).
base_decode(F, Eq, Value) ->
- d(fun(X,V) -> diameter_types:F(X,V) end, Eq, Value).
+ d(fun(X,V) -> diameter_types:F(X, V, opts()) end, Eq, Value).
base_invalid(F, Value) ->
try
@@ -171,7 +171,7 @@ gen(M, avp_types, {Name, Code, Type, _Flags}) ->
V = undefined /= VendorId,
V = 0 /= Flags band 2#10000000,
{Name, Type} = M:avp_name(Code, VendorId),
- B = M:empty_value(Name),
+ B = M:empty_value(Name, #{module => M}),
B = z(B),
[] = avp_decode(M, Type, Name);
@@ -207,10 +207,22 @@ avp_decode(Mod, Name, Type, Eq, Value) ->
d(fun(X,V) -> avp(Mod, X, V, Name, Type) end, Eq, Value).
avp(Mod, decode = X, V, Name, 'Grouped') ->
- {Rec, _} = Mod:avp(X, V, Name),
+ {Rec, _} = Mod:avp(X, V, Name, opts(Mod)),
Rec;
-avp(Mod, X, V, Name, _) ->
- Mod:avp(X, V, Name).
+avp(Mod, decode = X, V, Name, _) ->
+ Mod:avp(X, V, Name, opts(Mod));
+avp(Mod, encode = X, V, Name, _) ->
+ iolist_to_binary(Mod:avp(X, V, Name, opts(Mod))).
+
+opts(Mod) ->
+ (opts())#{module => Mod,
+ dictionary => Mod}.
+
+opts() ->
+ #{string_decode => true,
+ strict_mbit => true,
+ rfc => 6733,
+ failed_avp => false}.
%% v/1
@@ -257,8 +269,8 @@ arity(M, Name, AvpName, Rec) ->
enum(M, Name, {_,E}) ->
B = <<E:32>>,
- B = M:avp(encode, E, Name),
- E = M:avp(decode, B, Name).
+ B = M:avp(encode, E, Name, opts(M)),
+ E = M:avp(decode, B, Name, opts(M)).
retag(import_avps) -> avp_types;
retag(import_groups) -> grouped;
@@ -280,7 +292,8 @@ d(F, Eq, V) ->
end.
z(B) ->
- << <<0>> || <<_>> <= B >>.
+ Sz = size(B),
+ <<0:Sz/unit:8>>.
%% values/1
%%
diff --git a/lib/diameter/test/diameter_compiler_SUITE.erl b/lib/diameter/test/diameter_compiler_SUITE.erl
index 7a9ac65ae3..73fe1ef6e0 100644
--- a/lib/diameter/test/diameter_compiler_SUITE.erl
+++ b/lib/diameter/test/diameter_compiler_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.
@@ -39,7 +39,7 @@
-export([dict/0]). %% fake dictionary module
%% dictionary callbacks for flatten2/1
--export(['A1'/3, 'Unsigned32'/3]).
+-export(['A1'/4, 'Unsigned32'/4]).
-define(base, "base_rfc3588.dia").
-define(util, diameter_util).
@@ -552,13 +552,13 @@ flatten2(_Config) ->
T <- [encode, decode],
M <- [M2, M3],
Ref <- [make_ref()],
- RC <- [M:avp(T, Ref, A)],
+ RC <- [M:avp(T, Ref, A, #{module => M})],
RC /= {T, Ref}].
-'A1'(T, 'Unsigned32', Ref) ->
+'A1'(T, 'Unsigned32', Ref, _Opts) ->
{T, Ref}.
-'Unsigned32'(T, 'A3', Ref) ->
+'Unsigned32'(T, 'A3', Ref, _Opts) ->
{T, Ref}.
load_forms(Forms) ->
diff --git a/lib/diameter/test/diameter_dict_SUITE.erl b/lib/diameter/test/diameter_dict_SUITE.erl
deleted file mode 100644
index 4c1349f4eb..0000000000
--- a/lib/diameter/test/diameter_dict_SUITE.erl
+++ /dev/null
@@ -1,145 +0,0 @@
-%%
-%% %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%
-%%
-
-%%
-%% Tests of the dict-like diameter_dict.
-%%
-
--module(diameter_dict_SUITE).
-
--export([suite/0,
- all/0,
- groups/0]).
-
-%% testcases
--export([append/1,
- fetch/1,
- fetch_keys/1,
- filter/1,
- find/1,
- fold/1,
- is_key/1,
- map/1,
- merge/1,
- update/1,
- update_counter/1]).
-
--include("diameter_ct.hrl").
-
--define(dict, diameter_dict).
--define(util, diameter_util).
-
-%% ===========================================================================
-
-suite() ->
- [{timetrap, {seconds, 60}}].
-
-all() ->
- [{group, all},
- {group, all, [parallel]}].
-
-groups() ->
- [{all, [], tc()}].
-
-tc() ->
- [append,
- fetch,
- fetch_keys,
- filter,
- find,
- fold,
- is_key,
- map,
- merge,
- update,
- update_counter].
-
-%% ===========================================================================
-
--define(KV100, [{N,[N]} || N <- lists:seq(1,100)]).
-
-append(_) ->
- D = ?dict:append(k, v, ?dict:new()),
- [{k,[v,v]}] = ?dict:to_list(?dict:append(k, v, D)).
-
-fetch(_) ->
- D = ?dict:from_list(?KV100),
- [50] = ?dict:fetch(50, D),
- Ref = make_ref(),
- Ref = try ?dict:fetch(Ref, D) catch _:_ -> Ref end.
-
-fetch_keys(_) ->
- L = ?KV100,
- D = ?dict:from_list(L),
- L = [{N,[N]} || N <- lists:sort(?dict:fetch_keys(D))].
-
-filter(_) ->
- L = ?KV100,
- F = fun(K,[_]) -> 0 == K rem 2 end,
- D = ?dict:filter(F, ?dict:from_list(L)),
- true = [T || {K,V} = T <- L, F(K,V)] == lists:sort(?dict:to_list(D)).
-
-find(_) ->
- D = ?dict:from_list(?KV100),
- {ok, [50]} = ?dict:find(50, D),
- error = ?dict:find(make_ref(), D).
-
-fold(_) ->
- L = ?KV100,
- S = lists:sum([N || {N,_} <- L]),
- S = ?dict:fold(fun(K,[_],A) -> K + A end, 0, ?dict:from_list(L)).
-
-is_key(_) ->
- L = ?KV100,
- D = ?dict:from_list(L),
- true = lists:all(fun({N,_}) -> ?dict:is_key(N,D) end, L),
- false = ?dict:is_key(make_ref(), D).
-
-map(_) ->
- L = ?KV100,
- F = fun(_,V) -> [N] = V, N*2 end,
- D = ?dict:map(F, ?dict:from_list(L)),
- M = [{K, F(K,V)} || {K,V} <- L],
- M = lists:sort(?dict:to_list(D)).
-
-merge(_) ->
- L = ?KV100,
- F = fun(_,V1,V2) -> V1 ++ V2 end,
- D = ?dict:merge(F, ?dict:from_list(L), ?dict:from_list(L)),
- M = [{K, F(K,V,V)} || {K,V} <- L],
- M = lists:sort(?dict:to_list(D)).
-
-update(_) ->
- L = ?KV100,
- F = fun([V]) -> 2*V end,
- D = ?dict:update(50, F, ?dict:from_list(L)),
- 100 = ?dict:fetch(50, D),
- Ref = make_ref(),
- Ref = try ?dict:update(Ref, F, D) catch _:_ -> Ref end,
- [Ref] = ?dict:fetch(Ref, ?dict:update(Ref,
- fun(_,_) -> ?ERROR(i_think_not) end,
- [Ref],
- D)).
-
-update_counter(_) ->
- L = [{N,2*N} || {N,_} <- ?KV100],
- D = ?dict:update_counter(50, 20, ?dict:from_list(L)),
- 120 = ?dict:fetch(50,D),
- 2 = ?dict:fetch(1,D).
diff --git a/lib/diameter/test/diameter_dpr_SUITE.erl b/lib/diameter/test/diameter_dpr_SUITE.erl
index 55702fbf78..779b919d3c 100644
--- a/lib/diameter/test/diameter_dpr_SUITE.erl
+++ b/lib/diameter/test/diameter_dpr_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2012-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2012-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.
@@ -27,6 +27,8 @@
-export([suite/0,
all/0,
groups/0,
+ init_per_suite/1,
+ end_per_suite/1,
init_per_group/2,
end_per_group/2]).
@@ -56,16 +58,12 @@
%% Config for diameter:start_service/2.
-define(SERVICE(Host),
- [{'Origin-Host', Host},
+ [{'Origin-Host', Host ++ ".erlang.org"},
{'Origin-Realm', "erlang.org"},
{'Host-IP-Address', [?ADDR]},
{'Vendor-Id', hd(Host)}, %% match this in disconnect/5
{'Product-Name', "OTP/diameter"},
- {'Acct-Application-Id', [0]},
- {restrict_connections, false},
- {application, [{dictionary, diameter_gen_base_rfc6733},
- {alias, common},
- {module, #diameter_callback{_ = false}}]}]).
+ {restrict_connections, false}]).
%% Disconnect reasons that diameter passes as the first argument of a
%% function configured as disconnect_cb.
@@ -89,13 +87,19 @@ suite() ->
[{timetrap, {seconds, 60}}].
all() ->
- [start, send_dpr, stop | [{group, R} || R <- ?REASONS]].
+ [{group, R} || R <- [client, server, uncommon | ?REASONS]].
%% The group determines how transports are terminated: by remove_transport,
%% stop_service or application stop.
groups() ->
- Ts = tc(),
- [{R, [], Ts} || R <- ?REASONS].
+ [{R, [], [start, send_dpr, stop]} || R <- [client, server, uncommon]]
+ ++ [{R, [], Ts} || Ts <- [tc()], R <- ?REASONS].
+
+init_per_suite(Config) -> %% not need, but a useful place to enable trace
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
init_per_group(Name, Config) ->
[{group, Name} | Config].
@@ -107,29 +111,86 @@ tc() ->
[start, connect, remove_transport, stop_service, check, stop].
%% ===========================================================================
-%% start/stop testcases
-start(_Config) ->
- ok = diameter:start(),
- ok = diameter:start_service(?SERVER, ?SERVICE(?SERVER)),
- ok = diameter:start_service(?CLIENT, ?SERVICE(?CLIENT)).
+%% start/1
-send_dpr(_Config) ->
+start(Config)
+ when is_list(Config) ->
+ Grp = group(Config),
+ ok = diameter:start(),
+ ok = diameter:start_service(?SERVER, service(?SERVER, Grp)),
+ ok = diameter:start_service(?CLIENT, service(?CLIENT, Grp)).
+
+service(?SERVER = Svc, _) ->
+ ?SERVICE(Svc)
+ ++ [{'Acct-Application-Id', [0,3]},
+ {application, [{dictionary, diameter_gen_base_rfc6733},
+ {alias, common},
+ {module, #diameter_callback{_ = false}}]},
+ {application, [{dictionary, diameter_gen_acct_rfc6733},
+ {alias, acct},
+ {module, #diameter_callback{_ = false}}]}];
+
+%% Client that receives a server DPR despite no explicit support for
+%% Diameter common messages.
+service(?CLIENT = Svc, server) ->
+ ?SERVICE(Svc)
+ ++ [{'Acct-Application-Id', [3]},
+ {application, [{dictionary, diameter_gen_acct_rfc6733},
+ {alias, acct},
+ {module, #diameter_callback{_ = false}}]}];
+
+%% Client that sends DPR despite advertised only the accounting
+%% application. The dictionary is required for encode.
+service(?CLIENT = Svc, uncommon) ->
+ ?SERVICE(Svc)
+ ++ [{'Acct-Application-Id', [3]},
+ {application, [{dictionary, diameter_gen_base_rfc6733},
+ {alias, common},
+ {module, #diameter_callback{_ = false}}]},
+ {application, [{dictionary, diameter_gen_acct_rfc6733},
+ {alias, acct},
+ {module, #diameter_callback{_ = false}}]}];
+
+service(?CLIENT = Svc, _) ->
+ ?SERVICE(Svc)
+ ++ [{'Auth-Application-Id', [0]},
+ {application, [{dictionary, diameter_gen_base_rfc6733},
+ {alias, common},
+ {module, #diameter_callback{_ = false}}]}].
+
+%% send_dpr/1
+
+send_dpr(Config) ->
LRef = ?util:listen(?SERVER, tcp),
Ref = ?util:connect(?CLIENT, tcp, LRef, [{dpa_timeout, 10000}]),
+ Svc = sender(group(Config)),
+ [Info] = diameter:service_info(Svc, connections),
+ {_, {TPid, _}} = lists:keyfind(peer, 1, Info),
#diameter_base_DPA{'Result-Code' = 2001}
- = diameter:call(?CLIENT,
+ = diameter:call(Svc,
common,
- ['DPR', {'Origin-Host', "CLIENT.erlang.org"},
- {'Origin-Realm', "erlang.org"},
- {'Disconnect-Cause', 0}]),
- ok = receive %% endure the transport dies on DPA
+ ['DPR', {'Origin-Host', Svc ++ ".erlang.org"},
+ {'Origin-Realm', "erlang.org"},
+ {'Disconnect-Cause', 0}],
+ [{peer, TPid}]),
+ ok = receive %% ensure the transport dies on DPA
#diameter_event{service = ?CLIENT, info = {down, Ref, _, _}} ->
ok
after 5000 ->
erlang:process_info(self(), messages)
end.
+%% sender/1
+
+sender(server) ->
+ ?SERVER;
+
+sender(_) ->
+ ?CLIENT.
+
+%% connect/1
+
connect(Config) ->
Pid = spawn(fun init/0), %% process for disconnect_cb to bang
Grp = group(Config),
@@ -138,16 +199,22 @@ connect(Config) ->
|| RCs <- ?RETURNS],
?util:write_priv(Config, config, [Pid | Refs]).
+%% remove_transport/1
+
%% Remove all the client transports only in the transport group.
remove_transport(Config) ->
transport == group(Config)
andalso (ok = diameter:remove_transport(?CLIENT, true)).
+%% stop_service/1
+
%% Stop the service only in the service group.
stop_service(Config) ->
service == group(Config)
andalso (ok = diameter:stop_service(?CLIENT)).
+%% check/1
+
%% Check for callbacks before diameter:stop/0, not the other way around
%% for the timing reason explained below.
check(Config) ->
@@ -157,9 +224,13 @@ check(Config) ->
Dict = receive {Pid, D} -> D end, %% get it
check(Refs, ?RETURNS, Grp, Dict). %% check for callbacks
+%% stop/1
+
stop(_Config) ->
ok = diameter:stop().
+%% ===========================================================================
+
%% Whether or not there are callbacks after diameter:stop() depends on
%% timing as long as the server runs on the same node: a server
%% transport could close the connection before the client has chance
diff --git a/lib/diameter/test/diameter_examples_SUITE.erl b/lib/diameter/test/diameter_examples_SUITE.erl
index e4ed2b227d..eb99f10fe6 100644
--- a/lib/diameter/test/diameter_examples_SUITE.erl
+++ b/lib/diameter/test/diameter_examples_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2015. 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.
@@ -92,12 +92,10 @@ init_per_group(tcp = N, Config) ->
[{group, N} | Config];
init_per_group(sctp = N, Config) ->
- case gen_sctp:open() of
- {ok, Sock} ->
- gen_sctp:close(Sock),
+ case ?util:have_sctp() of
+ true ->
[{group, N} | Config];
- {error, E} when E == eprotonosupport;
- E == esocktnosupport -> %% fail on any other reason
+ false->
{skip, no_sctp}
end.
diff --git a/lib/diameter/test/diameter_gen_sctp_SUITE.erl b/lib/diameter/test/diameter_gen_sctp_SUITE.erl
index 79db39ca45..ccee6baec1 100644
--- a/lib/diameter/test/diameter_gen_sctp_SUITE.erl
+++ b/lib/diameter/test/diameter_gen_sctp_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.
@@ -33,8 +33,8 @@
end_per_suite/1]).
%% testcases
--export([send_not_from_controlling_process/1,
- send_from_multiple_clients/1, send_from_multiple_clients/0,
+-export([send_one_from_many/1, send_one_from_many/0,
+ send_many_from_one/1, send_many_from_one/0,
receive_what_was_sent/1]).
-include_lib("kernel/include/inet_sctp.hrl").
@@ -45,16 +45,24 @@
%% Open sockets on the loopback address.
-define(ADDR, {127,0,0,1}).
-%% Snooze, nap, siesta.
--define(SLEEP(T), receive after T -> ok end).
-
%% An indescribably long number of milliseconds after which everthing
%% that should have happened has.
-define(FOREVER, 2000).
+%% How many milliseconds to tolerate between the fastest and slowest
+%% turnaround times.
+-define(VARIANCE, 100).
+
%% The first byte in each message we send as a simple guard against
%% not receiving what was sent.
--define(MAGIC, 42).
+-define(MAGIC, 0).
+
+%% Requested number of inbound/outbound streams.
+-define(STREAMS, 5).
+
+%% Success for send_multiple. Match in each testcase rather than in
+%% send_multiple itself for a better failure in common_test.
+-define(OK, {_, true, _, [true, true], [], _}).
%% ===========================================================================
@@ -62,8 +70,8 @@ suite() ->
[{timetrap, {seconds, 10}}].
all() ->
- [send_not_from_controlling_process,
- send_from_multiple_clients,
+ [send_one_from_many,
+ send_many_from_one,
receive_what_was_sent].
init_per_suite(Config) ->
@@ -81,130 +89,37 @@ end_per_suite(_Config) ->
%% ===========================================================================
-%% send_not_from_controlling_process/1
-%%
-%% This testcase failing shows gen_sctp:send/4 hanging when called
-%% outside the controlling process of the socket in question.
-
-send_not_from_controlling_process(_) ->
- Pids = send_not_from_controlling_process(),
- ?SLEEP(?FOREVER),
- try
- [] = [{P,I} || P <- Pids, I <- [process_info(P)], I /= undefined]
- after
- lists:foreach(fun(P) -> exit(P, kill) end, Pids)
- end.
-
-%% send_not_from_controlling_process/0
-%%
-%% Returns the pids of three spawned processes: a listening process, a
-%% connecting process and a sending process.
-%%
-%% The expected behaviour is that all three processes exit:
-%%
-%% - The listening process exits upon receiving an SCTP message
-%% sent by the sending process.
-%% - The connecting process exits upon listening process exit.
-%% - The sending process exits upon gen_sctp:send/4 return.
-%%
-%% The observed behaviour is that all three processes remain alive
-%% indefinitely:
-%%
-%% - The listening process never receives the SCTP message sent
-%% by the sending process.
-%% - The connecting process has an inet_reply message in its mailbox
-%% as a consequence of the call to gen_sctp:send/4 call from the
-%% sending process.
-%% - The call to gen_sctp:send/4 in the sending process doesn't return,
-%% hanging in prim_inet:getopts/2.
-
-send_not_from_controlling_process() ->
- FPid = self(),
- {L, MRef} = spawn_monitor(fun() -> listen(FPid) end),
- receive
- {?MODULE, C, S} ->
- demonitor(MRef, [flush]),
- [L,C,S];
- {'DOWN', MRef, process, _, _} = T ->
- error(T)
- end.
-
-%% listen/1
-
-listen(FPid) ->
- {ok, Sock} = open(),
- ok = gen_sctp:listen(Sock, true),
- {ok, PortNr} = inet:port(Sock),
- LPid = self(),
- spawn(fun() -> connect1(PortNr, FPid, LPid) end), %% connecting process
- Id = assoc(Sock),
- recv(Sock, Id).
-
-%% connect1/3
-
-connect1(PortNr, FPid, LPid) ->
- {ok, Sock} = open(),
- ok = gen_sctp:connect_init(Sock, ?ADDR, PortNr, []),
- Id = assoc(Sock),
- FPid ! {?MODULE,
- self(),
- spawn(fun() -> send(Sock, Id) end)}, %% sending process
- MRef = monitor(process, LPid),
- down(MRef). %% Waits with this as current_function.
-
-%% down/1
-
-down(MRef) ->
- receive {'DOWN', MRef, process, _, Reason} -> Reason end.
-
-%% send/2
-
-send(Sock, Id) ->
- ok = gen_sctp:send(Sock, Id, 0, <<0:32>>).
-
-%% ===========================================================================
-
-%% send_from_multiple_clients/0
+%% send_one_from_many/0
%%
%% Demonstrates sluggish delivery of messages.
-send_from_multiple_clients() ->
- [{timetrap, {seconds, 60}}].
+send_one_from_many() ->
+ [{timetrap, {seconds, 30}}].
-send_from_multiple_clients(_) ->
- {S, Rs} = T = send_from_multiple_clients(8, 1024),
- Max = ?FOREVER*1000,
- {false, [], _} = {Max < S,
- Rs -- [OI || {O,_} = OI <- Rs, is_integer(O)],
- T}.
+send_one_from_many(_) ->
+ ?OK = send_multiple(128, 1, 1024).
-%% send_from_multiple_clients/2
+%% send_one_from_many/2
%%
%% Opens a listening socket and then spawns a specified number of
-%% processes, each of which connects to the listening socket. Each
-%% connecting process then sends a message, whose size in bytes is
-%% passed as an argument, the listening process sends a reply
-%% containing the time at which the message was received, and the
-%% connecting process then exits upon reception of this reply.
+%% processes, each of which connects, sends a message, receives a
+%% reply, and exits.
%%
%% Returns the elapsed time for all connecting process to exit
-%% together with a list of exit reasons for the connecting processes.
-%% In the successful case a connecting process exits with the
-%% outbound/inbound transit times for the sent/received message as
-%% reason.
+%% together with a list of exit reasons. In the successful case a
+%% connecting process exits with the outbound/inbound transit times
+%% for the sent/received message as reason.
%%
%% The observed behaviour is that some outbound messages (that is,
%% from a connecting process to the listening process) can take an
%% unexpectedly long time to complete their journey. The more
-%% connecting processes, the longer the possible delay it seems.
+%% connecting processes, the longer it can take it seems.
%%
-%% eg. (With F = fun send_from_multiple_clients/2.)
-%%
-%% 5> F(2, 1024).
+%% eg. 5> send_one_from_many(2, 1024).
%% {875,[{128,116},{113,139}]}
-%% 6> F(4, 1024).
+%% 6> send_one_from_many(4, 1024).
%% {2995290,[{2994022,250},{2994071,80},{200,130},{211,113}]}
-%% 7> F(8, 1024).
+%% 7> send_one_from_many(8, 1024).
%% {8997461,[{8996161,116},
%% {2996471,86},
%% {2996278,116},
@@ -213,7 +128,7 @@ send_from_multiple_clients(_) ->
%% {213,159},
%% {373,173},
%% {376,118}]}
-%% 8> F(8, 1024).
+%% 8> send_one_from_many(8, 1024).
%% {21001891,[{20999968,128},
%% {8997891,172},
%% {8997927,91},
@@ -223,120 +138,279 @@ send_from_multiple_clients(_) ->
%% {117,98},
%% {149,125}]}
%%
-%% This turns out to have been due to SCTP resends as a consequence of
-%% the listener having an insufficient recbuf. Increasing the size
-%% solves the problem.
-%%
-
-send_from_multiple_clients(N, Sz)
- when is_integer(N), 0 < N, is_integer(Sz), 0 < Sz ->
- timer:tc(fun listen/2, [N, <<?MAGIC, 0:Sz/unit:8>>]).
-%% listen/2
-
-listen(N, Bin) ->
+send_multiple(Clients, Msgs, Sz)
+ when is_integer(Clients), 0 < Clients,
+ is_integer(Msgs), 0 < Msgs,
+ is_integer(Sz), 0 < Sz ->
+ T0 = diameter_lib:now(),
+ {S, Res} = timer:tc(fun listen/3, [Clients, Msgs, Sz]),
+ report(T0, Res),
+ Ts = lists:append(Res),
+ Outgoing = [DT || {_,{_,_,DT},{_,_,_},_} <- Ts],
+ Incoming = [DT || {_,{_,_,_},{_,_,DT},_} <- Ts],
+ Diffs = [lists:max(L) - lists:min(L) || L <- [Outgoing, Incoming]],
+ {S,
+ S < ?FOREVER*1000,
+ Diffs,
+ [D < V || V <- [?VARIANCE*1000], D <- Diffs],
+ [T || T <- Ts, [] == [T || {_,{_,_,_},{_,_,_},_} <- [T]]],
+ Res}.
+
+%% listen/3
+
+listen(Clients, Msgs, Sz) ->
{ok, Sock} = open(),
ok = gen_sctp:listen(Sock, true),
{ok, PortNr} = inet:port(Sock),
%% Spawn a middleman that in turn spawns N connecting processes,
%% collects a list of exit reasons and then exits with the list as
- %% reason. loop/3 returns when we receive this list from the
+ %% reason. accept/2 returns when we receive this list from the
%% middleman's 'DOWN'.
Self = self(),
- Fun = fun() -> exit(connect2(Self, PortNr, Bin)) end,
- {_, MRef} = spawn_monitor(fun() -> exit(fold(N, Fun)) end),
- loop(Sock, MRef, Bin).
+ Fun = fun() -> exit(client(Self, PortNr, Msgs, Sz)) end, %% start clients
+ {_, MRef} = spawn_monitor(fun() -> exit(clients(Clients, Fun)) end),
+ accept_loop(Sock, MRef).
-%% fold/2
+%% fclients/2
%%
%% Spawn N processes and collect their exit reasons in a list.
-fold(N, Fun) ->
+clients(N, Fun) ->
start(N, Fun),
acc(N, []).
+%% start/2
+
start(0, _) ->
ok;
+
start(N, Fun) ->
spawn_monitor(Fun),
start(N-1, Fun).
+%% acc/2
+
acc(0, Acc) ->
Acc;
+
acc(N, Acc) ->
receive
{'DOWN', _MRef, process, _, RC} ->
acc(N-1, [RC | Acc])
end.
-%% loop/3
+%% accept_loop/2
-loop(Sock, MRef, Bin) ->
+accept_loop(Sock, MRef) ->
+ ok = inet:setopts(Sock, [{active, once}]),
receive
- ?SCTP(Sock, {[#sctp_sndrcvinfo{assoc_id = Id}], B})
- when is_binary(B) ->
- Sz = size(Bin),
- {Sz, Bin} = {size(B), B}, %% assert
- ok = send(Sock, Id, mark(Bin)),
- loop(Sock, MRef, Bin);
+ ?SCTP(Sock, {_, #sctp_assoc_change{state = comm_up,
+ outbound_streams = OS,
+ assoc_id = Id}}) ->
+ Self = self(),
+ TPid = spawn(fun() -> assoc(monitor(process, Self), Id, OS) end),
+ NewSock = peeloff(Sock, Id, TPid),
+ TPid ! {peeloff, NewSock},
+ accept_loop(Sock, MRef);
?SCTP(Sock, _) ->
- loop(Sock, MRef, Bin);
+ accept_loop(Sock, MRef);
{'DOWN', MRef, process, _, Reason} ->
- Reason
+ Reason;
+ T ->
+ error(T)
end.
-%% connect2/3
+%% assoc/3
+%%
+%% Server process that answers incoming messages as long as the parent
+%% lives.
+
+assoc(MRef, _Id, OS)
+ when is_reference(MRef) ->
+ {peeloff, Sock} = receive T -> T end,
+ recv_loop(Sock, false, sender(Sock, false, OS), MRef).
+
+%% recv_loop/4
+
+recv_loop(Sock, Id, Pid, MRef) ->
+ ok = inet:setopts(Sock, [{active, once}]),
+ recv(Sock, Id, Pid, MRef, receive T -> T end).
+
+%% recv/5
+
+%% Association id can change on a peeloff socket on some versions of
+%% Solaris.
+recv(Sock,
+ false,
+ Pid,
+ MRef,
+ ?SCTP(Sock, {[#sctp_sndrcvinfo{assoc_id = Id}], _})
+ = T) ->
+ Pid ! {assoc_id, Id},
+ recv(Sock, Id, Pid, MRef, T);
+
+recv(Sock, Id, Pid, MRef, ?SCTP(Sock, {[#sctp_sndrcvinfo{assoc_id = I}], B}))
+ when is_binary(B) ->
+ T2 = diameter_lib:now(),
+ Id = I, %% assert
+ <<?MAGIC, Bin/binary>> = B, %% assert
+ {[_,_,_,Sz] = L, Bytes} = unmark(Bin),
+ Sz = size(Bin) - Bytes, %% assert
+ <<_:Bytes/binary, Body:Sz/binary>> = Bin,
+ send(Pid, [T2|L], Body), %% answer
+ recv_loop(Sock, Id, Pid, MRef);
+
+recv(Sock, Id, Pid, MRef, ?SCTP(Sock, _)) ->
+ recv_loop(Sock, Id, Pid, MRef);
+
+recv(_, _, _, MRef, {'DOWN', MRef, process, _, Reason}) ->
+ Reason;
+
+recv(_, _, _, _, T) ->
+ error(T).
-connect2(Pid, PortNr, Bin) ->
- monitor(process, Pid),
+%% send/3
- {ok, Sock} = open(),
- ok = gen_sctp:connect_init(Sock, ?ADDR, PortNr, []),
- Id = assoc(Sock),
+send(Pid, Header, Body) ->
+ Pid ! {send, Header, Body}.
- %% T1 = time before send
- %% T2 = time after listening process received our message
- %% T3 = time after reply is received
+%% sender/3
+%%
+%% Start a process that sends, so as not to block the controlling process.
- T1 = diameter_lib:now(),
- ok = send(Sock, Id, Bin),
- T2 = unmark(recv(Sock, Id)),
- T3 = diameter_lib:now(),
- {diameter_lib:micro_diff(T2, T1), %% Outbound
- diameter_lib:micro_diff(T3, T2)}. %% Inbound
+sender(Sock, Id, OS) ->
+ Pid = self(),
+ spawn(fun() -> send_loop(Sock, Id, OS, 1, monitor(process, Pid)) end).
-%% recv/2
+%% send_loop/5
-recv(Sock, Id) ->
+send_loop(Sock, Id, OS, N, MRef) ->
receive
- ?SCTP(Sock, {[#sctp_sndrcvinfo{assoc_id = I}], Bin})
- when is_binary(Bin) ->
- Id = I, %% assert
- Bin;
- ?SCTP(S, _) ->
- Sock = S, %% assert
- recv(Sock, Id);
+ {assoc_id, I} ->
+ send_loop(Sock, I, OS, N, MRef);
+ {send, L, Body} ->
+ Stream = N rem OS,
+ ok = send(Sock, Id, Stream, mark(Body, [N, Stream | L])),
+ send_loop(Sock, Id, OS, N+1, MRef);
+ {'DOWN', MRef, process, _, _} = T ->
+ T;
T ->
- exit(T)
+ error(T)
end.
-%% send/3
+%% peeloff/3
+
+peeloff(LSock, Id, TPid) ->
+ {ok, Sock} = gen_sctp:peeloff(LSock, Id),
+ ok = gen_sctp:controlling_process(Sock, TPid),
+ Sock.
+
+%% client/4
+
+client(Pid, PortNr, Msgs, Sz) ->
+ monitor(process, Pid),
+ {ok, Sock} = open(),
+ ok = gen_sctp:connect_init(Sock, ?ADDR, PortNr, []),
+ recv_loop(Sock, Msgs, Sz).
-send(Sock, Id, Bin) ->
- gen_sctp:send(Sock, Id, 0, Bin).
+%% recv_loop/3
-%% mark/1
+recv_loop(_, 0, T) ->
+ [_,_|Acc] = T,
+ Acc;
+
+recv_loop(Sock, Msgs, T) ->
+ ok = inet:setopts(Sock, [{active, once}]),
+ {I, NewT} = recv(Sock, Msgs, T, receive X -> X end),
+ recv_loop(Sock, Msgs - I, NewT).
+
+%% recv/4
+
+recv(Sock, Msgs, Sz, ?SCTP(Sock, {_, #sctp_assoc_change{} = A})) ->
+ #sctp_assoc_change{state = comm_up, %% assert
+ assoc_id = Id,
+ outbound_streams = OS}
+ = A,
+ true = is_integer(Sz), %% assert
+ send_n(Msgs, sender(Sock, Id, OS), Sz),
+ {0, [Id, OS]};
+
+recv(Sock, _, T, ?SCTP(Sock, {[#sctp_sndrcvinfo{assoc_id = Id}], Bin})) ->
+ T4 = diameter_lib:now(),
+ [Id, OS | Acc] = T,
+ {1, [Id, OS, stat(T4, Bin) | Acc]};
+
+recv(Sock, _, T, ?SCTP(Sock, _)) ->
+ {0, [_,_|_] = T};
+
+recv(_, _, _, T) ->
+ error(T).
+
+%% send_n/3
+%%
+%% Send messages to the server from dedicated processes.
+
+send_n(0, _, _) ->
+ ok;
-mark(Bin) ->
- Info = term_to_binary(diameter_lib:now()),
+send_n(N, Pid, Sz) ->
+ M = rand:uniform(255),
+ send(Pid, [Sz], binary:copy(<<M>>, Sz)),
+ send_n(N-1, Pid, Sz).
+
+%% send/4
+
+send(Sock, Id, Stream, Bin) ->
+ case gen_sctp:send(Sock, Id, Stream, <<?MAGIC, Bin/binary>>) of
+ {error, eagain} ->
+ send(Sock, Id, Stream, Bin);
+ RC ->
+ RC
+ end.
+
+%% stat/2
+
+stat(T4, <<?MAGIC, Bin/binary>>) ->
+ %% T1 = time at send
+ %% T2 = time at reception by server
+ %% T3 = time at reception by server's sender
+ %% T4 = time at reception of answer
+
+ {[T3,NI,SI,T2,T1,NO,SO,Sz], Bytes} = unmark(Bin),
+
+ Sz = size(Bin) - Bytes, %% assert
+
+ {T1,
+ {NO, SO, diameter_lib:micro_diff(T2, T1)}, %% Outbound
+ {NI, SI, diameter_lib:micro_diff(T4, T3)}, %% Inbound
+ T4}.
+
+%% mark/2
+
+mark(Bin, T) ->
+ Info = term_to_binary([diameter_lib:now() | T]),
<<Info/binary, Bin/binary>>.
%% unmark/1
unmark(Bin) ->
- binary_to_term(Bin).
+ T = binary_to_term(Bin),
+ {T, size(term_to_binary(T))}.
+
+%% ===========================================================================
+
+%% send_many_from_one/0
+%%
+%% Demonstrates sluggish delivery of messages.
+
+send_many_from_one() ->
+ [{timetrap, {seconds, 30}}].
+
+send_many_from_one(_) ->
+ ?OK = send_multiple(1, 128, 1024).
%% ===========================================================================
@@ -345,7 +419,7 @@ unmark(Bin) ->
%% Demonstrates reception of a message that differs from that sent.
receive_what_was_sent(_Config) ->
- send_from_multiple_clients(1, 1024*32). %% fails
+ ?OK = send_multiple(1, 1, 1024*32).
%% ===========================================================================
@@ -357,16 +431,23 @@ open() ->
%% open/1
open(Opts) ->
- gen_sctp:open([{ip, ?ADDR}, {port, 0}, {active, true}, binary,
+ gen_sctp:open([{ip, ?ADDR}, {port, 0}, {active, false}, binary,
+ {sctp_initmsg, #sctp_initmsg{num_ostreams = ?STREAMS,
+ max_instreams = ?STREAMS}},
{recbuf, 1 bsl 16}, {sndbuf, 1 bsl 16}
| Opts]).
-%% assoc/1
+%% report/2
-assoc(Sock) ->
- receive
- ?SCTP(Sock, {_, #sctp_assoc_change{state = S,
- assoc_id = Id}}) ->
- comm_up = S, %% assert
- Id
- end.
+report(T0, Ts) ->
+ ct:pal("~p~n", [lists:sort([sort([{diameter_lib:micro_diff(T1,T0),
+ OT,
+ IT,
+ diameter_lib:micro_diff(T4,T0)}
+ || {T1,OT,IT,T4} <- L])
+ || L <- Ts])]).
+
+%% sort/1
+
+sort(L) ->
+ lists:sort(fun({_,{N,_,_},_,_}, {_,{M,_,_},_,_}) -> N =< M end, L).
diff --git a/lib/diameter/test/diameter_gen_tcp_SUITE.erl b/lib/diameter/test/diameter_gen_tcp_SUITE.erl
index 2be2cf4b35..db42ea813e 100644
--- a/lib/diameter/test/diameter_gen_tcp_SUITE.erl
+++ b/lib/diameter/test/diameter_gen_tcp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2014-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2014-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.
@@ -54,7 +54,7 @@ all() ->
send_long(_) ->
{Sock, SendF} = connection(),
- B = list_to_binary(lists:duplicate(1 bsl 20, $X)),
+ B = binary:copy(<<$X>>, 1 bsl 20),
ok = SendF(B),
B = recv(Sock, size(B), []).
diff --git a/lib/diameter/test/diameter_relay_SUITE.erl b/lib/diameter/test/diameter_relay_SUITE.erl
index 5353688bf4..9de5cbe685 100644
--- a/lib/diameter/test/diameter_relay_SUITE.erl
+++ b/lib/diameter/test/diameter_relay_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.
@@ -302,7 +302,7 @@ stats(?RELAY1, L) ->
%% RAR x 2 (send_timeout_[12])
{{{0,257,0},recv},3}, %% CEA
{{{0,257,0},send},1}, %% "
- {{{0,257,1},recv},1}, %% CER
+ {{{0,257,1},recv},1}, %% CER
{{{0,257,1},send},3}, %% "
{{{relay,0},recv,{'Result-Code',2001}},2}, %% STA x 2 (send[34])
{{{relay,0},recv,{'Result-Code',3005}},1}, %% ASA (send_loop)
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 4c82d4dee2..84b41f14b7 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-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.
@@ -27,6 +27,8 @@
-export([suite/0,
all/0,
groups/0,
+ init_per_suite/1,
+ end_per_suite/1,
init_per_group/2,
end_per_group/2,
init_per_testcase/2,
@@ -90,7 +92,6 @@
send_multiple_filters_2/1,
send_multiple_filters_3/1,
send_anything/1,
- outstanding/1,
remove_transports/1,
empty/1,
stop_services/1,
@@ -106,6 +107,9 @@
handle_error/6,
handle_request/3]).
+%% diameter_{tcp,sctp} callbacks
+-export([message/3]).
+
-include("diameter.hrl").
-include("diameter_gen_base_rfc3588.hrl").
-include("diameter_gen_base_accounting.hrl").
@@ -145,21 +149,29 @@
%% Whether to decode stringish Diameter types to strings, or leave
%% them as binary.
--define(STRING_DECODES, [true, false]).
+-define(STRING_DECODES, [false, true]).
%% Which transport protocol to use.
-define(TRANSPORTS, [tcp, sctp]).
+%% Send from a dedicated process?
+-define(SENDERS, [true, false]).
+
+%% Message callbacks from diameter_{tcp,sctp}?
+-define(CALLBACKS, [true, false]).
+
-record(group,
{transport,
+ strings,
client_service,
client_encoding,
client_dict0,
- client_strings,
+ client_sender,
server_service,
server_encoding,
server_container,
- server_strings}).
+ server_sender,
+ server_throttle}).
%% Not really what we should be setting unless the message is sent in
%% the common application but diameter doesn't care.
@@ -190,8 +202,7 @@
{'Acct-Application-Id', [?DIAMETER_APP_ID_ACCOUNTING]},
{restrict_connections, false},
{string_decode, Decode},
- {incoming_maxlen, 1 bsl 21},
- {spawn_opt, [{min_heap_size, 5000}]}
+ {incoming_maxlen, 1 bsl 21}
| [{application, [{dictionary, D},
{module, ?MODULE},
{answer_errors, callback}]}
@@ -243,76 +254,128 @@ suite() ->
[{timetrap, {seconds, 10}}].
all() ->
- [start, result_codes, {group, traffic}, outstanding, empty, stop].
+ [start, result_codes, {group, traffic}, empty, stop].
groups() ->
- Ts = tc(),
- Sctp = ?util:have_sctp(),
- [{B, [P], Ts} || {B,P} <- [{true, shuffle}, {false, parallel}]]
+ [{P, [P], Ts} || Ts <- [tc(tc())], P <- [shuffle, parallel]]
++
- [{?util:name([T,R,D,A,C,SD,CD]),
+ [{?util:name([T,R,D,A,C,S,SS,ST,CS]),
[],
- [start_services,
- add_transports,
- result_codes,
- {group, SD orelse CD},
- remove_transports,
- stop_services]}
+ [{group, if S -> shuffle; not S -> parallel end}]}
|| T <- ?TRANSPORTS,
- T /= sctp orelse Sctp,
R <- ?ENCODINGS,
D <- ?RFCS,
A <- ?ENCODINGS,
C <- ?CONTAINERS,
- SD <- ?STRING_DECODES,
- CD <- ?STRING_DECODES]
+ S <- ?STRING_DECODES,
+ SS <- ?SENDERS,
+ ST <- ?CALLBACKS,
+ CS <- ?SENDERS]
++
- [{traffic, [], [{group, ?util:name([T,R,D,A,C,SD,CD])}
- || T <- ?TRANSPORTS,
- T /= sctp orelse Sctp,
- R <- ?ENCODINGS,
- D <- ?RFCS,
- A <- ?ENCODINGS,
- C <- ?CONTAINERS,
- SD <- ?STRING_DECODES,
- CD <- ?STRING_DECODES]}].
+ [{T, [], groups([[T,R,D,A,C,S,SS,ST,CS]
+ || R <- ?ENCODINGS,
+ D <- ?RFCS,
+ A <- ?ENCODINGS,
+ C <- ?CONTAINERS,
+ S <- ?STRING_DECODES,
+ SS <- ?SENDERS,
+ ST <- ?CALLBACKS,
+ CS <- ?SENDERS,
+ SS orelse CS])} %% avoid deadlock
+ || T <- ?TRANSPORTS]
+ ++
+ [{traffic, [], [{group, T} || T <- ?TRANSPORTS]}].
+
+%groups(_) -> %% debug
+% Name = [sctp,record,rfc6733,record,pkt,false,false,false,false],
+% [{group, ?util:name(Name)}];
+groups(Names) ->
+ [{group, ?util:name(L)} || L <- Names].
+
+%tc([N|_]) -> %% debug
+% [N];
+tc(L) ->
+ L.
+
+%% --------------------
+
+init_per_suite(Config) ->
+ [{sctp, ?util:have_sctp()} | Config].
+
+end_per_suite(_Config) ->
+ ok.
+
+%% --------------------
+
+init_per_group(Name, Config)
+ when Name == shuffle;
+ Name == parallel ->
+ start_services(Config),
+ add_transports(Config);
+
+init_per_group(sctp = Name, Config) ->
+ {_, Sctp} = lists:keyfind(Name, 1, Config),
+ if Sctp ->
+ Config;
+ true ->
+ {skip, Name}
+ end;
init_per_group(Name, Config) ->
case ?util:name(Name) of
- [T,R,D,A,C,SD,CD] ->
+ [T,R,D,A,C,S,SS,ST,CS] ->
G = #group{transport = T,
+ strings = S,
client_service = [$C|?util:unique_string()],
client_encoding = R,
client_dict0 = dict0(D),
- client_strings = CD,
+ client_sender = CS,
server_service = [$S|?util:unique_string()],
server_encoding = A,
server_container = C,
- server_strings = SD},
- [{group, G} | Config];
+ server_sender = SS,
+ server_throttle = ST},
+ %% Limit the number of testcase, since the number of
+ %% groups is large.
+ All = ?util:scramble(tc()),
+ TCs = lists:sublist(All, rand:uniform(32)),
+ [{group, G}, {runlist, TCs} | Config];
_ ->
Config
end.
+end_per_group(Name, Config)
+ when Name == shuffle;
+ Name == parallel ->
+ remove_transports(Config),
+ stop_services(Config);
+
end_per_group(_, _) ->
ok.
+%% --------------------
+
%% Skip testcases that can reasonably fail under SCTP.
init_per_testcase(Name, Config) ->
- case [skip || #group{transport = sctp}
- <- [proplists:get_value(group, Config)],
- send_maxlen == Name
- orelse send_long == Name]
+ TCs = proplists:get_value(runlist, Config, []),
+ Run = [] == TCs orelse lists:member(Name, TCs),
+ case [G || #group{transport = sctp} = G
+ <- [proplists:get_value(group, Config)]]
of
- [skip] ->
+ [_] when Name == send_maxlen;
+ Name == send_long ->
{skip, sctp};
- [] ->
+ _ when not Run ->
+ {skip, random};
+ _ ->
[{testcase, Name} | Config]
end.
end_per_testcase(_, _) ->
ok.
+%% --------------------
+
%% Testcases to run when services are started and connections
%% established.
tc() ->
@@ -377,28 +440,34 @@ start(_Config) ->
ok = diameter:start().
start_services(Config) ->
- #group{client_service = CN,
- client_strings = CD,
- server_service = SN,
- server_strings = SD}
+ #group{strings = S,
+ client_service = CN,
+ server_service = SN}
= group(Config),
- ok = diameter:start_service(SN, ?SERVICE(SN, SD)),
+ ok = diameter:start_service(SN, ?SERVICE(SN, S)),
ok = diameter:start_service(CN, [{sequence, ?CLIENT_MASK}
- | ?SERVICE(CN, CD)]).
+ | ?SERVICE(CN, S)]).
add_transports(Config) ->
#group{transport = T,
client_service = CN,
- server_service = SN}
- = group(Config),
+ client_sender = CS,
+ server_service = SN,
+ server_sender = SS,
+ server_throttle = ST}
+ = group(Config),
LRef = ?util:listen(SN,
- T,
+ [T,
+ {sender, SS},
+ {message_cb, ST andalso {?MODULE, message, [4]}}
+ | [{packet, hd(?util:scramble([false, raw]))}
+ || T == sctp andalso CS]],
[{capabilities_cb, fun capx/2},
{pool_size, 8},
- {spawn_opt, [{min_heap_size, 8096}]},
- {applications, apps(rfc3588)}]),
+ {applications, apps(rfc3588)}]
+ ++ [{spawn_opt, {erlang, spawn, []}} || CS]),
Cs = [?util:connect(CN,
- T,
+ [T, {sender, CS}],
LRef,
[{id, Id},
{capabilities, [{'Origin-State-Id', origin(Id)}]},
@@ -415,11 +484,6 @@ apps(D0) ->
D = dict0(D0),
[acct(D), D].
-%% Ensure there are no outstanding requests in request table.
-outstanding(_Config) ->
- [] = [T || T <- ets:tab2list(diameter_request),
- is_atom(element(1,T))].
-
remove_transports(Config) ->
#group{client_service = CN,
server_service = SN}
@@ -689,14 +753,14 @@ send_unexpected_mandatory(Config) ->
%% Send something long that will be fragmented by TCP.
send_long(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
- {'User-Name', [lists:duplicate(1 bsl 20, $X)]}],
+ {'User-Name', [binary:copy(<<$X>>, 1 bsl 20)]}],
['STA', {'Session-Id', _}, {'Result-Code', ?SUCCESS} | _]
= call(Config, Req).
%% Send something longer than the configure incoming_maxlen.
send_maxlen(Config) ->
Req = ['STR', {'Termination-Cause', ?LOGOUT},
- {'User-Name', [lists:duplicate(1 bsl 21, $X)]}],
+ {'User-Name', [binary:copy(<<$X>>, 1 bsl 21)]}],
{timeout, _} = call(Config, Req).
%% Send something for which pick_peer finds no suitable peer.
@@ -875,7 +939,7 @@ group(Config) ->
#group{} = proplists:get_value(group, Config).
string(V, Config) ->
- #group{client_strings = B} = group(Config),
+ #group{strings = B} = group(Config),
decode(V,B).
decode(S, true)
@@ -995,7 +1059,7 @@ pick_peer(Peers, _, [$C|_], _State, {send_detach, Group}, _, {_,_}) ->
find(#group{client_service = CN,
server_encoding = A,
server_container = C},
- Peers) ->
+ [_|_] = Peers) ->
Id = {A,C},
[P] = [P || P <- Peers, id(Id, P, CN)],
{ok, P}.
@@ -1429,3 +1493,33 @@ request(#diameter_base_STR{'Session-Id' = SId},
%% send_error/send_timeout
request(#diameter_base_RAR{}, _Caps) ->
receive after 2000 -> {protocol_error, ?TOO_BUSY} end.
+
+%% message/3
+%%
+%% Limit the number of messages received. More can be received if read
+%% in the same packet.
+
+message(recv = D, {[_], Bin}, N) ->
+ message(D, Bin, N);
+message(Dir, #diameter_packet{bin = Bin}, N) ->
+ message(Dir, Bin, N);
+
+%% incoming request
+message(recv, <<_:32, 1, _/bits>> = Bin, N) ->
+ [Bin, 1 < N, fun ?MODULE:message/3, N-1];
+
+%% incoming answer
+message(recv, Bin, _) ->
+ [Bin];
+
+%% outgoing
+message(send, Bin, _) ->
+ [Bin];
+
+%% sent request
+message(ack, <<_:32, 1, _/bits>>, _) ->
+ [];
+
+%% sent answer or discarded request
+message(ack, _, N) ->
+ [0 =< N, fun ?MODULE:message/3, N+1].
diff --git a/lib/diameter/test/diameter_transport_SUITE.erl b/lib/diameter/test/diameter_transport_SUITE.erl
index c94f46b7a5..9d981d0a2b 100644
--- a/lib/diameter/test/diameter_transport_SUITE.erl
+++ b/lib/diameter/test/diameter_transport_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.
@@ -294,10 +294,17 @@ init(gen_accept, {Prot, Ref}) ->
{ok, PortNr} = inet:port(LSock),
true = diameter_reg:add_new(?TEST_LISTENER(Ref, PortNr)),
- %% Accept a connection, receive a message and send it back.
+ %% Accept a connection, receive a message send it back, and wait
+ %% for the peer to close the connection.
{ok, Sock} = gen_accept(Prot, LSock),
Bin = gen_recv(Prot, Sock),
- ok = gen_send(Prot, Sock, Bin);
+ ok = gen_send(Prot, Sock, Bin),
+ receive
+ {tcp_closed, Sock} = T ->
+ T;
+ ?SCTP(Sock, {_, #sctp_assoc_change{}}) = T ->
+ T
+ end;
init(connect, {Prot, Ref}) ->
%% Lookup the peer's listening socket.
@@ -311,12 +318,7 @@ init(connect, {Prot, Ref}) ->
%% Send a message and receive it back.
Bin = make_msg(),
TPid ! ?TMSG({send, Bin}),
- Bin = bin(Prot, ?RECV(?TMSG({recv, P}), P)),
-
- %% Expect the transport process to die as a result of the peer
- %% closing the connection.
- MRef = erlang:monitor(process, TPid),
- ?RECV({'DOWN', MRef, process, _, _}).
+ Bin = bin(Prot, ?RECV(?TMSG({recv, P}), P)).
bin(sctp, #diameter_packet{bin = Bin}) ->
Bin;
@@ -336,15 +338,11 @@ make_msg() ->
<<1:8, Len:24, Bin/binary>>.
%% crypto:rand_bytes/1 isn't available on all platforms (since openssl
-%% isn't) so roll our own.
+%% isn't) so roll our own. Not particularly random, but less verbose
+%% in trace.
rand_bytes(N) ->
- rand_bytes(N, <<>>).
-
-rand_bytes(0, Bin) ->
- Bin;
-rand_bytes(N, Bin) ->
Oct = rand:uniform(256) - 1,
- rand_bytes(N-1, <<Oct, Bin/binary>>).
+ binary:copy(<<Oct>>, N).
%% ===========================================================================
diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl
index cca28dd23c..03f79096ac 100644
--- a/lib/diameter/test/diameter_util.erl
+++ b/lib/diameter/test/diameter_util.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.
@@ -172,18 +172,7 @@ recvl([{MRef, F} | L], Ref, Fun, Acc) ->
%% Sort a list into random order.
scramble(L) ->
- foldl(fun(true, _, S, false) -> S end,
- false,
- [[fun s/1, L]]).
-
-s(L) ->
- s([], L).
-
-s(Acc, []) ->
- Acc;
-s(Acc, L) ->
- {H, [T|Rest]} = lists:split(rand:uniform(length(L)) - 1, L),
- s([T|Acc], H ++ Rest).
+ [X || {_,X} <- lists:sort([{rand:uniform(), T} || T <- L])].
%% ---------------------------------------------------------------------------
%% unique_string/0
@@ -195,21 +184,22 @@ unique_string() ->
%% have_sctp/0
have_sctp() ->
- case erlang:system_info(system_architecture) of
- %% We do not support the sctp version present in solaris
- %% version "sparc-sun-solaris2.10", that behaves differently
- %% from later versions and linux
- "sparc-sun-solaris2.10" ->
- false;
- _->
- case gen_sctp:open() of
- {ok, Sock} ->
- gen_sctp:close(Sock),
- true;
- {error, E} when E == eprotonosupport;
- E == esocktnosupport -> %% fail on any other reason
- false
- end
+ have_sctp(erlang:system_info(system_architecture)).
+
+%% Don't run SCTP on platforms where it's either known to be flakey or
+%% isn't available.
+
+have_sctp("sparc-sun-solaris2.10") ->
+ false;
+
+have_sctp(_) ->
+ case gen_sctp:open() of
+ {ok, Sock} ->
+ gen_sctp:close(Sock),
+ true;
+ {error, E} when E == eprotonosupport;
+ E == esocktnosupport -> %% fail on any other reason
+ false
end.
%% ---------------------------------------------------------------------------
@@ -313,17 +303,23 @@ listen(SvcName, Prot, Opts) ->
connect(Client, Prot, LRef) ->
connect(Client, Prot, LRef, []).
-connect(Client, Prot, LRef, Opts) ->
+connect(Client, ProtOpts, LRef, Opts) ->
+ Prot = head(ProtOpts),
[PortNr] = lport(Prot, LRef),
Client = diameter:service_info(Client, name), %% assert
true = diameter:subscribe(Client),
- Ref = add_transport(Client, {connect, opts(Prot, PortNr) ++ Opts}),
+ Ref = add_transport(Client, {connect, opts(ProtOpts, PortNr) ++ Opts}),
true = transport(Client, Ref), %% assert
diameter_lib:for_n(fun(_) -> ok = up(Client, Ref, Prot, PortNr) end,
proplists:get_value(pool_size, Opts, 1)),
Ref.
+head([T|_]) ->
+ T;
+head(T) ->
+ T.
+
up(Client, Ref, Prot, PortNr) ->
receive
{diameter_event, Client, {up, Ref, _, _, _}} -> ok
@@ -366,10 +362,13 @@ tmod(sctp) ->
tmod(any) ->
[diameter_sctp, diameter_tcp].
-opts(Prot, T) ->
- tmo(T, lists:append([[{transport_module, M}, {transport_config, C}]
+opts([Prot | Opts], T) ->
+ tmo(T, lists:append([[{transport_module, M}, {transport_config, C ++ Opts}]
|| M <- tmod(Prot),
- C <- [cfg(M,T) ++ cfg(M) ++ cfg(T)]])).
+ C <- [cfg(M,T) ++ cfg(M) ++ cfg(T)]]));
+
+opts(Prot, T) ->
+ opts([Prot], T).
tmo(listen, Opts) ->
Opts;
diff --git a/lib/diameter/test/diameter_watchdog_SUITE.erl b/lib/diameter/test/diameter_watchdog_SUITE.erl
index 6d22ddcc18..39c4f051a5 100644
--- a/lib/diameter/test/diameter_watchdog_SUITE.erl
+++ b/lib/diameter/test/diameter_watchdog_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2015. 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.
@@ -44,13 +44,8 @@
-export([peer_up/3,
peer_down/3]).
-%% gen_tcp-ish interface
--export([listen/2,
- accept/1,
- connect/3,
- send/2,
- setopts/2,
- close/1]).
+%% diameter_tcp message_cb
+-export([message/3]).
-include("diameter.hrl").
-include("diameter_ct.hrl").
@@ -161,9 +156,9 @@ reopen(Type, Test, Ref, Wd, N, M) ->
reopen(Type, Test, SvcName, TRef, Wd, N, M).
cfg(Type, Type, Wd) ->
- {Wd, [], []};
+ {Wd, [], false};
cfg(_Type, _Test, _Wd) ->
- {?WD(?PEER_WD), [{okay, 0}], [{module, ?MODULE}]}.
+ {?WD(?PEER_WD), [{okay, 0}], true}.
%% reopen/7
@@ -346,7 +341,7 @@ recv_reopen(listen, Ref) ->
%% reg/3
%%
%% Lookup the pid of the transport process and publish a term for
-%% send/2 to lookup.
+%% message/3 to lookup.
reg(TRef, SvcName, T) ->
TPid = tpid(TRef, diameter:service_info(SvcName, transport)),
true = diameter_reg:add_new({?MODULE, TPid, T}).
@@ -394,7 +389,7 @@ suspect(_) ->
suspect(Type, Fake, Ref, N)
when is_reference(Ref) ->
{SvcName, TRef}
- = start(Type, Ref, {?WD(10000), [{suspect, N}], mod(Fake)}),
+ = start(Type, Ref, {?WD(10000), [{suspect, N}], Fake}),
{initial, okay} = ?WD_EVENT(TRef),
suspect(TRef, Fake, SvcName, N);
@@ -436,11 +431,6 @@ abuse([F|A], Test) ->
abuse(F, Test) ->
abuse([F], Test).
-mod(true) ->
- [{module, ?MODULE}];
-mod(false) ->
- [].
-
%% ===========================================================================
%% # okay/1
%% ===========================================================================
@@ -456,7 +446,7 @@ okay(Type, Fake, Ref, N)
{SvcName, TRef}
= start(Type, Ref, {?WD(10000),
[{okay, choose(Fake, 0, N)}],
- mod(Fake)}),
+ Fake}),
{initial, okay} = ?WD_EVENT(TRef),
okay(TRef,
Fake,
@@ -515,12 +505,17 @@ start(Type, Ref, T) ->
true = diameter_reg:add_new({Type, Ref, Name}),
{Name, TRef}.
-opts(Type, Ref, {Timer, Config, Mod}) ->
+opts(Type, Ref, {Timer, Config, Fake})
+ when is_boolean(Fake) ->
[{transport_module, diameter_tcp},
- {transport_config, Mod ++ [{ip, ?ADDR}, {port, 0}] ++ cfg(Type, Ref)},
+ {transport_config, mod(Fake) ++ [{ip, ?ADDR}, {port, 0}]
+ ++ cfg(Type, Ref)},
{watchdog_timer, Timer},
{watchdog_config, Config}].
+mod(B) ->
+ [{message_cb, [fun message/3, capx]} || B].
+
cfg(listen, _) ->
[];
cfg(connect, Ref) ->
@@ -531,37 +526,29 @@ cfg(connect, Ref) ->
%% ===========================================================================
-listen(PortNr, Opts) ->
- gen_tcp:listen(PortNr, Opts).
-
-accept(LSock) ->
- gen_tcp:accept(LSock).
+%% message/3
-connect(Addr, Port, Opts) ->
- gen_tcp:connect(Addr, Port, Opts).
+message(send, Bin, X) ->
+ send(Bin, X);
-setopts(Sock, Opts) ->
- inet:setopts(Sock, Opts).
+message(recv, Bin, _) ->
+ [Bin];
-send(Sock, Bin) ->
- send(getr(config), Sock, Bin).
-
-close(Sock) ->
- gen_tcp:close(Sock).
+message(_, _, _) ->
+ [].
-%% send/3
+%% send/2
%% First outgoing message from a new transport process is CER/CEA.
%% Remaining outgoing messages are either DWR or DWA.
-send(undefined, Sock, Bin) ->
- <<_:32, _:8, 257:24, _/binary>> = Bin,
- putr(config, init),
- gen_tcp:send(Sock, Bin);
+send(Bin, capx) ->
+ <<_:32, _:8, 257:24, _/binary>> = Bin, %% assert on CER/CEA
+ [Bin, fun message/3, init];
%% Outgoing DWR: fake reception of DWA. Use the fact that AVP values
%% are ignored. This is to ensure that the peer's watchdog state
%% transitions are only induced by responses to messages it sends.
-send(_, Sock, <<_:32, 1:1, _:7, 280:24, _:32, EId:32, HId:32, _/binary>>) ->
+send(<<_:32, 1:1, _:7, 280:24, _:32, EId:32, HId:32, _/binary>>, _) ->
Pkt = #diameter_packet{header = #diameter_header{version = 1,
end_to_end_id = EId,
hop_by_hop_id = HId},
@@ -569,47 +556,36 @@ send(_, Sock, <<_:32, 1:1, _:7, 280:24, _:32, EId:32, HId:32, _/binary>>) ->
{'Origin-Host', "XXX"},
{'Origin-Realm', ?REALM}]},
#diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Pkt),
- self() ! {tcp, Sock, Bin},
- ok;
+ [recv, Bin];
%% First outgoing DWA.
-send(init, Sock, Bin) ->
+send(Bin, init) ->
[{{?MODULE, _, T}, _}] = diameter_reg:wait({?MODULE, self(), '_'}),
- putr(config, T),
- send(Sock, Bin);
+ send(Bin, T);
%% First transport process.
-send({SvcName, {_,_,_} = T}, Sock, Bin) ->
+send(Bin, {SvcName, {_,_,_} = T}) ->
[{'Origin-Host', _} = OH, {'Origin-Realm', _} = OR | _]
= ?SERVICE(SvcName),
putr(origin, [OH, OR]),
- putr(config, T),
- send(Sock, Bin);
+ send(Bin, T);
%% Discard DWA, failback after another timeout in the peer.
-send({Wd, 0 = No, Msg}, Sock, Bin) ->
+send(Bin, {Wd, 0 = No, Msg}) ->
Origin = getr(origin),
- spawn(fun() -> failback(?ONE_WD(Wd), Msg, Sock, Bin, Origin) end),
- putr(config, No),
- ok;
+ [{defer, ?ONE_WD(Wd), [msg(Msg, Bin, Origin)]}, fun message/3, No];
%% Send DWA while we're in the mood (aka 0 < N).
-send({Wd, N, Msg}, Sock, Bin) ->
- putr(config, {Wd, N-1, Msg}),
- gen_tcp:send(Sock, Bin);
+send(Bin, {Wd, N, Msg}) ->
+ [Bin, fun message/3, {Wd, N-1, Msg}];
%% Discard DWA.
-send(0, _Sock, _Bin) ->
- ok;
+send(_Bin, 0 = No) ->
+ [fun message/3, No];
%% Send DWA.
-send(N, Sock, <<_:32, 0:1, _:7, 280:24, _/binary>> = Bin) ->
- putr(config, N-1),
- gen_tcp:send(Sock, Bin).
-
-failback(Tmo, Msg, Sock, Bin, Origin) ->
- timer:sleep(Tmo),
- ok = gen_tcp:send(Sock, msg(Msg, Bin, Origin)).
+send(<<_:32, 0:1, _:7, 280:24, _/binary>> = DWA, N) ->
+ [DWA, fun message/3, N-1].
%% msg/2
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index 80d0f8d59c..0c73adca12 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -1,7 +1,7 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2010-2015. 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.
@@ -31,7 +31,6 @@ MODULES = \
diameter_codec_test \
diameter_config_SUITE \
diameter_compiler_SUITE \
- diameter_dict_SUITE \
diameter_distribution_SUITE \
diameter_dpr_SUITE \
diameter_event_SUITE \
diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk
index 94d9d72a48..4801f542fb 100644
--- a/lib/diameter/vsn.mk
+++ b/lib/diameter/vsn.mk
@@ -17,5 +17,5 @@
# %CopyrightEnd%
APPLICATION = diameter
-DIAMETER_VSN = 1.12.2
+DIAMETER_VSN = 2.0
APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN)
diff --git a/lib/edoc/doc/src/notes.xml b/lib/edoc/doc/src/notes.xml
index 4982488335..7894811c78 100644
--- a/lib/edoc/doc/src/notes.xml
+++ b/lib/edoc/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2007</year><year>2016</year>
+ <year>2007</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -32,6 +32,28 @@
<p>This document describes the changes made to the EDoc
application.</p>
+<section><title>Edoc 0.9</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>To support stable builds, <c>edoc</c> no longer
+ includes time stamps in the footer for generated
+ files.</p>
+ <p>
+ Own Id: OTP-14277</p>
+ </item>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Edoc 0.8.1</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/edoc/vsn.mk b/lib/edoc/vsn.mk
index d66802fdac..1a933b2ad8 100644
--- a/lib/edoc/vsn.mk
+++ b/lib/edoc/vsn.mk
@@ -1 +1 @@
-EDOC_VSN = 0.8.1
+EDOC_VSN = 0.9
diff --git a/lib/eldap/test/eldap_basic_SUITE.erl b/lib/eldap/test/eldap_basic_SUITE.erl
index ac3447cfe6..4bfb0dd291 100644
--- a/lib/eldap/test/eldap_basic_SUITE.erl
+++ b/lib/eldap/test/eldap_basic_SUITE.erl
@@ -119,7 +119,10 @@ init_per_suite(Config) ->
{ldaps_server, LDAPS_server} | Config].
end_per_suite(_Config) ->
- ssl:stop().
+ try ssl:stop()
+ catch
+ _:_ -> ok
+ end.
init_per_group(return_values, Config) ->
diff --git a/lib/erl_docgen/doc/src/notes.xml b/lib/erl_docgen/doc/src/notes.xml
index 4824a755d9..59a268d6ac 100644
--- a/lib/erl_docgen/doc/src/notes.xml
+++ b/lib/erl_docgen/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2004</year><year>2016</year>
+ <year>2004</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -31,7 +31,42 @@
</header>
<p>This document describes the changes made to the <em>erl_docgen</em> application.</p>
- <section><title>Erl_Docgen 0.6.1</title>
+ <section><title>Erl_Docgen 0.7</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Sort index of C functions alphabetically in the sidebar.</p>
+ <p>
+ Own Id: OTP-14333 Aux Id: ERL-393 </p>
+ </item>
+ <item>
+ <p> The right side index of functions now handle
+ functions with same name but different arity. </p>
+ <p>
+ Own Id: OTP-14431</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Improvements in the OTP documentation style.</p>
+ <p>
+ (Thanks to Mariano Guerra)</p>
+ <p>
+ Own Id: OTP-14371 Aux Id: PR-1215 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erl_Docgen 0.6.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml
index 77d503b4d2..ec20f3c67f 100644
--- a/lib/erl_interface/doc/src/notes.xml
+++ b/lib/erl_interface/doc/src/notes.xml
@@ -31,6 +31,45 @@
</header>
<p>This document describes the changes made to the Erl_interface application.</p>
+<section><title>Erl_Interface 3.10</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix bug where gethostname would incorrectly fail with
+ enametoolong on Linux.</p>
+ <p>
+ Own Id: OTP-14310</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Remove generation of atoms in old latin1 external format
+ in the distribution between erlang nodes,
+ <c>erl_interface</c>, and <c>jinterface</c>. The new utf8
+ format for atoms was introduced in OTP R16. An OTP 20
+ node can therefore not connect to nodes older than R16.</p>
+ <p>
+ Atoms that can be encoded using latin1 are still encoded
+ by <c>term_to_binary()</c> using latin1 encoding. Note
+ that all atoms will by default be encoded using utf8 in a
+ future Erlang/OTP release. For more information see the
+ documentation of <seealso
+ marker="erts:erlang#term_to_binary/2"><c>erlang:term_to_binary/2</c></seealso>.</p>
+ <p>
+ Own Id: OTP-14337</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erl_Interface 3.9.3</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c
index 9dc66fbc96..b7a2c4bb8b 100644
--- a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c
+++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c
@@ -614,11 +614,11 @@ TESTCASE(test_ei_decode_misc)
EI_DECODE_2(decode_double, 9, double, -1.0);
EI_DECODE_2(decode_double, 9, double, 1.0);
- EI_DECODE_2(decode_boolean, 7, int, 0);
- EI_DECODE_2(decode_boolean, 6, int, 1);
+ EI_DECODE_2(decode_boolean, 8, int, 0);
+ EI_DECODE_2(decode_boolean, 7, int, 1);
- EI_DECODE_STRING(decode_my_atom, 5, "foo");
- EI_DECODE_STRING(decode_my_atom, 2, "");
+ EI_DECODE_STRING(decode_my_atom, 6, "foo");
+ EI_DECODE_STRING(decode_my_atom, 3, "");
EI_DECODE_STRING(decode_my_atom, 9, "������");
EI_DECODE_STRING(decode_my_string, 6, "foo");
@@ -665,10 +665,10 @@ TESTCASE(test_ei_decode_utf8_atom)
P99({ERLANG_ANY,ERLANG_LATIN1,ERLANG_ASCII}));
EI_DECODE_STRING_4(decode_my_atom_as, 4, "b",
P99({ERLANG_UTF8,ERLANG_LATIN1,ERLANG_ASCII}));
- EI_DECODE_STRING_4(decode_my_atom_as, 3, "c",
- P99({ERLANG_LATIN1,ERLANG_UTF8,ERLANG_ASCII}));
- EI_DECODE_STRING_4(decode_my_atom_as, 3, "d",
- P99({ERLANG_ASCII,ERLANG_UTF8,ERLANG_ASCII}));
+ EI_DECODE_STRING_4(decode_my_atom_as, 4, "c",
+ P99({ERLANG_LATIN1,ERLANG_LATIN1,ERLANG_ASCII}));
+ EI_DECODE_STRING_4(decode_my_atom_as, 4, "d",
+ P99({ERLANG_ASCII,ERLANG_LATIN1,ERLANG_ASCII}));
report(1);
}
diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE.erl b/lib/erl_interface/test/ei_decode_encode_SUITE.erl
index 6715b840c8..160720b413 100644
--- a/lib/erl_interface/test/ei_decode_encode_SUITE.erl
+++ b/lib/erl_interface/test/ei_decode_encode_SUITE.erl
@@ -125,7 +125,7 @@ test_ei_decode_encode(Config) when is_list(Config) ->
% We read two packets for each test, the ei_decode_encode and ei_x_decode_encode version....
send_rec(P, Term) when is_port(P) ->
- P ! {self(), {command, term_to_binary(Term)}},
+ P ! {self(), {command, term_to_binary(Term, [{minor_version, 2}])}},
{_B,Term} = get_buf_and_term(P).
diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk
index 563694a0c1..01fcee86dd 100644
--- a/lib/erl_interface/vsn.mk
+++ b/lib/erl_interface/vsn.mk
@@ -1,2 +1,2 @@
-EI_VSN = 3.9.3
+EI_VSN = 3.10
ERL_INTERFACE_VSN = $(EI_VSN)
diff --git a/lib/eunit/doc/src/notes.xml b/lib/eunit/doc/src/notes.xml
index cd4e230254..2a4ca6d12c 100644
--- a/lib/eunit/doc/src/notes.xml
+++ b/lib/eunit/doc/src/notes.xml
@@ -33,6 +33,21 @@
</header>
<p>This document describes the changes made to the EUnit application.</p>
+<section><title>Eunit 2.3.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>The surefire reports from <c>eunit</c> will no longer
+ have names with embedded double quotes.</p>
+ <p>
+ Own Id: OTP-14287</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Eunit 2.3.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/eunit/vsn.mk b/lib/eunit/vsn.mk
index 7eee75ee10..107ad5c101 100644
--- a/lib/eunit/vsn.mk
+++ b/lib/eunit/vsn.mk
@@ -1 +1 @@
-EUNIT_VSN = 2.3.2
+EUNIT_VSN = 2.3.3
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 4cfa80f153..0883a69918 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -228,7 +228,7 @@
-export([t_is_identifier/1]).
-endif.
--export_type([erl_type/0, opaques/0, type_table/0, mod_records/0,
+-export_type([erl_type/0, opaques/0, type_table/0,
var_table/0, cache/0]).
%%-define(DEBUG, true).
@@ -366,15 +366,17 @@
-type opaques() :: [erl_type()] | 'universe'.
+-type file_line() :: {file:name(), erl_anno:line()}.
-type record_key() :: {'record', atom()}.
-type type_key() :: {'type' | 'opaque', mfa()}.
--type record_value() :: [{atom(), erl_parse:abstract_expr(), erl_type()}].
--type type_value() :: {{module(), {file:name(), erl_anno:line()},
+-type field() :: {atom(), erl_parse:abstract_expr(), erl_type()}.
+-type record_value() :: {file_line(),
+ [{RecordSize :: non_neg_integer(), [field()]}]}.
+-type type_value() :: {{module(), file_line(),
erl_parse:abstract_type(), ArgNames :: [atom()]},
erl_type()}.
-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()}.
@@ -528,7 +530,9 @@ list_contains_opaque(List, Opaques) ->
'error' | {'ok', erl_type(), erl_type()}.
t_find_opaque_mismatch(T1, T2, Opaques) ->
- catch t_find_opaque_mismatch(T1, T2, T2, Opaques).
+ try t_find_opaque_mismatch(T1, T2, T2, Opaques)
+ catch throw:error -> error
+ end.
t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error;
t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> throw(error);
@@ -580,8 +584,9 @@ 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 = [catch t_find_opaque_mismatch(T1, T2, T2, Opaques) ||
- T1 <- L1, T2 <- L2],
+ List = [try t_find_opaque_mismatch(T1, T2, T2, Opaques)
+ catch throw:error -> error
+ end || T1 <- L1, T2 <- L2],
t_find_opaque_mismatch_list(List).
t_find_opaque_mismatch_list([]) -> throw(error);
@@ -611,7 +616,9 @@ t_find_unknown_opaque(T1, T2, Opaques) ->
%% is assumed to be taken from the contract.
t_decorate_with_opaque(T1, T2, Opaques) ->
- case t_is_equal(T1, T2) orelse not t_contains_opaque(T2) of
+ case
+ Opaques =:= [] orelse t_is_equal(T1, T2) orelse not t_contains_opaque(T2)
+ of
true -> T1;
false ->
T = t_inf(T1, T2),
@@ -4249,8 +4256,8 @@ t_to_string(?opaque(Set), RecDict) ->
<- set_to_list(Set)],
" | ");
t_to_string(?matchstate(Pres, Slots), RecDict) ->
- flat_format("ms(~s,~s)", [t_to_string(Pres, RecDict),
- t_to_string(Slots,RecDict)]);
+ flat_format("ms(~ts,~ts)", [t_to_string(Pres, RecDict),
+ t_to_string(Slots,RecDict)]);
t_to_string(?nil, _RecDict) ->
"[]";
t_to_string(?nonempty_list(Contents, Termination), RecDict) ->
@@ -4428,10 +4435,10 @@ opaque_type(Mod, Name, Args, _S, RecDict) ->
opaque_name(Mod, Name, Extra) ->
S = mod_name(Mod, Name),
- flat_format("~s(~s)", [S, Extra]).
+ flat_format("~ts(~ts)", [S, Extra]).
mod_name(Mod, Name) ->
- flat_format("~w:~w", [Mod, Name]).
+ flat_format("~w:~tw", [Mod, Name]).
%%=============================================================================
%%
@@ -4447,11 +4454,11 @@ mod_name(Mod, Name) ->
-type cache_key() :: {module(), atom(), expand_depth(),
[erl_type()], type_names()}.
-type mod_type_table() :: ets:tid().
+-type mod_records() :: dict:dict(module(), type_table()).
-record(cache,
{
types = maps:new() :: #{cache_key() => {erl_type(), expand_limit()}},
- mod_recs = {mrecs, dict:new()} :: 'undefined'
- | {'mrecs', mod_records()}
+ mod_recs = {mrecs, dict:new()} :: {'mrecs', mod_records()}
}).
-opaque cache() :: #cache{}.
@@ -4800,7 +4807,7 @@ type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, S, D, L, C) ->
{NewType, L3, C4}
end;
error ->
- Msg = io_lib:format("Unable to find type ~w/~w\n",
+ Msg = io_lib:format("Unable to find type ~tw/~w\n",
[Name, ArgsLen]),
throw({error, Msg})
end.
@@ -4872,7 +4879,7 @@ remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames,
{NewType, L3, C4}
end;
error ->
- Msg = io_lib:format("Unable to find remote type ~w:~w()\n",
+ Msg = io_lib:format("Unable to find remote type ~w:~tw()\n",
[RemMod, Name]),
throw({error, Msg})
end.
@@ -4917,7 +4924,7 @@ record_from_form({atom, _, Name}, ModFields, S, D0, L0, C) ->
case GetModRec of
{error, FieldName} ->
throw({error,
- io_lib:format("Illegal declaration of #~w{~w}\n",
+ io_lib:format("Illegal declaration of #~tw{~tw}\n",
[Name, FieldName])});
{ok, NewFields} ->
S2 = S1#from_form{vtab = var_table__new()},
@@ -4931,7 +4938,7 @@ record_from_form({atom, _, Name}, ModFields, S, D0, L0, C) ->
end,
recur_limit(Fun, D0, L0, RecordType, TypeNames);
error ->
- throw({error, io_lib:format("Unknown record #~w{}\n", [Name])})
+ throw({error, io_lib:format("Unknown record #~tw{}\n", [Name])})
end;
false ->
{t_any(), L0, C}
@@ -5105,8 +5112,8 @@ check_record({atom, _, Name}, ModFields, S, C) ->
{ok, DeclFields} = lookup_record(Name, R),
case check_fields(Name, ModFields, DeclFields, S, C1) of
{error, FieldName} ->
- throw({error, io_lib:format("Illegal declaration of #~w{~w}\n",
- [Name, FieldName])});
+ throw({error, io_lib:format("Illegal declaration of #~tw{~tw}\n",
+ [Name, FieldName])});
C2 -> C2
end.
@@ -5199,10 +5206,10 @@ t_form_to_string({op, _L, _Op, _Arg1, _Arg2} = Op) ->
t_form_to_string({ann_type, _L, [Var, Type]}) ->
t_form_to_string(Var) ++ "::" ++ t_form_to_string(Type);
t_form_to_string({paren_type, _L, [Type]}) ->
- flat_format("(~s)", [t_form_to_string(Type)]);
+ flat_format("(~ts)", [t_form_to_string(Type)]);
t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) ->
ArgString = "(" ++ string:join(t_form_to_string_list(Args), ",") ++ ")",
- flat_format("~w:~w", [Mod, Name]) ++ ArgString;
+ flat_format("~w:~tw", [Mod, Name]) ++ ArgString;
t_form_to_string({type, _L, arity, []}) -> "arity()";
t_form_to_string({type, _L, binary, []}) -> "binary()";
t_form_to_string({type, _L, binary, [Base, Unit]} = Type) ->
@@ -5252,12 +5259,12 @@ t_form_to_string({type, _L, range, [From, To]} = Type) ->
_ -> flat_format("Badly formed type ~w",[Type])
end;
t_form_to_string({type, _L, record, [{atom, _, Name}]}) ->
- flat_format("#~w{}", [Name]);
+ flat_format("#~tw{}", [Name]);
t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) ->
FieldString = string:join(t_form_to_string_list(Fields), ","),
- flat_format("#~w{~s}", [Name, FieldString]);
+ flat_format("#~tw{~ts}", [Name, FieldString]);
t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) ->
- flat_format("~w::~s", [Name, t_form_to_string(Type)]);
+ flat_format("~tw::~ts", [Name, t_form_to_string(Type)]);
t_form_to_string({type, _L, term, []}) -> "term()";
t_form_to_string({type, _L, timeout, []}) -> "timeout()";
t_form_to_string({type, _L, tuple, any}) -> "tuple()";
@@ -5281,7 +5288,7 @@ t_form_to_string({type, _L, Name, []} = T) ->
catch throw:{error, _} -> atom_to_string(Name) ++ "()"
end;
t_form_to_string({user_type, _L, Name, List}) ->
- flat_format("~w(~s)",
+ flat_format("~tw(~ts)",
[Name, string:join(t_form_to_string_list(List), ",")]);
t_form_to_string({type, L, Name, List}) ->
%% Compatibility: modules compiled before Erlang/OTP 18.0.
@@ -5298,7 +5305,7 @@ t_form_to_string_list([], Acc) ->
-spec atom_to_string(atom()) -> string().
atom_to_string(Atom) ->
- flat_format("~w", [Atom]).
+ flat_format("~tw", [Atom]).
%%=============================================================================
%%
@@ -5331,21 +5338,17 @@ is_erl_type(_) -> false.
'error' | {type_table(), cache()}.
lookup_module_types(Module, CodeTable, Cache) ->
- #cache{mod_recs = ModRecs} = Cache,
- case ModRecs of
- undefined -> error;
- {mrecs, MRecs} ->
- case dict:find(Module, MRecs) of
- {ok, R} ->
- {R, Cache};
- error ->
- try ets:lookup_element(CodeTable, Module, 2) of
- R ->
- NewMRecs = dict:store(Module, R, MRecs),
- {R, Cache#cache{mod_recs = {mrecs, NewMRecs}}}
- catch
- _:_ -> error
- end
+ #cache{mod_recs = {mrecs, MRecs}} = Cache,
+ case dict:find(Module, MRecs) of
+ {ok, R} ->
+ {R, Cache};
+ error ->
+ try ets:lookup_element(CodeTable, Module, 2) of
+ R ->
+ NewMRecs = dict:store(Module, R, MRecs),
+ {R, Cache#cache{mod_recs = {mrecs, NewMRecs}}}
+ catch
+ _:_ -> error
end
end.
@@ -5551,7 +5554,7 @@ set_size(Set) ->
set_to_string(Set) ->
L = [case is_atom(X) of
true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs '
- false -> flat_format("~w", [X])
+ false -> flat_format("~tw", [X])
end || X <- set_to_list(Set)],
string:join(L, " | ").
diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml
index 38f8dbfea3..9167d0aaec 100644
--- a/lib/hipe/doc/src/notes.xml
+++ b/lib/hipe/doc/src/notes.xml
@@ -31,6 +31,101 @@
</header>
<p>This document describes the changes made to HiPE.</p>
+<section><title>Hipe 3.16</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix hipe compiler flags <c>o0</c> and <c>o1</c> that have
+ previously been ignored by mistake.</p>
+ <p>
+ Own Id: OTP-13862 Aux Id: PR-1154 </p>
+ </item>
+ <item>
+ <p>
+ Fix LLVM backend to not convert all remote calls to own
+ module, like <c>?MODULE:foo()</c>, into local calls.</p>
+ <p>
+ Own Id: OTP-13983</p>
+ </item>
+ <item>
+ <p>
+ Hipe optional LLVM backend does require LLVM version 3.9
+ or later as older versions forced strong dependencies on
+ erts internals structures.</p>
+ <p>
+ Own Id: OTP-14238</p>
+ </item>
+ <item>
+ <p>
+ Fix a bug that has been seen causing failed loading of
+ hipe compiled modules on NetBSD due to unaligned data
+ pointers.</p>
+ <p>
+ Own Id: OTP-14302 Aux Id: ERL-376, PR-1386 </p>
+ </item>
+ <item>
+ <p>
+ Fix miscompilation bug in hipe that could cause wrong
+ function clause to be called from non-tail calls, where
+ the return value is unused, if the right function clause
+ is only reachable from those non-tail calls.</p>
+ <p>
+ Own Id: OTP-14306 Aux Id: ERL-278, PR-1392 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Improve hipe compilation time for large functions.</p>
+ <p>
+ Own Id: OTP-13810 Aux Id: PR-1124 </p>
+ </item>
+ <item>
+ <p>Replaced usage of deprecated symbolic <seealso
+ marker="erts:erlang#type-time_unit"><c>time
+ unit</c></seealso> representations.</p>
+ <p>
+ Own Id: OTP-13831 Aux Id: OTP-13735 </p>
+ </item>
+ <item>
+ <p>
+ Speed up hipe compile time register allocation for larger
+ function.</p>
+ <p>
+ Own Id: OTP-13879</p>
+ </item>
+ <item>
+ <p>
+ Various code generation improvements.</p>
+ <p>
+ Own Id: OTP-14261 Aux Id: PR-1360 </p>
+ </item>
+ <item>
+ <p>
+ Improve hipe compiler to generate code with better CPU
+ register utilization at runtime by the use of 'Live Range
+ Splitting' techniques.</p>
+ <p>
+ Own Id: OTP-14293 Aux Id: PR-1380 </p>
+ </item>
+ <item>
+ <p>
+ Allow HiPE to run on VM built with
+ <c>--enable-m32-build</c>.</p>
+ <p>
+ Own Id: OTP-14330 Aux Id: PR-1397 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Hipe 3.15.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk
index 172d976931..0ef4aa7f09 100644
--- a/lib/hipe/vsn.mk
+++ b/lib/hipe/vsn.mk
@@ -1 +1 @@
-HIPE_VSN = 3.15.4
+HIPE_VSN = 3.16
diff --git a/lib/inets/doc/src/http_uri.xml b/lib/inets/doc/src/http_uri.xml
index acf0d2163a..20c042c202 100644
--- a/lib/inets/doc/src/http_uri.xml
+++ b/lib/inets/doc/src/http_uri.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2012</year><year>2016</year>
+ <year>2012</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml
index 46484977c9..29e4b22632 100644
--- a/lib/inets/doc/src/httpc.xml
+++ b/lib/inets/doc/src/httpc.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2004</year><year>2016</year>
+ <year>2004</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -408,7 +408,7 @@
<c>{self, once}</c>, the first message has an extra
element, that is, <c>{http, {RequestId, stream_start, Headers, Pid}}</c>.
This is the process id to be used as an argument to
- <c>http:stream_next/1</c> to trigger the next message to be sent to
+ <c>httpc:stream_next/1</c> to trigger the next message to be sent to
the calling process.</p>
<p>Notice that chunked encoding can add
headers so that there are more headers in the <c>stream_end</c>
diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index 1fad94fac1..2f4f20347a 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -33,7 +33,44 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 6.3.9</title>
+ <section><title>Inets 6.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ httpd_util:rfc1123_date/1 gracefully handle invalid DST
+ dates by returning the original time in the expected
+ rfc1123 format.</p>
+ <p>
+ Own Id: OTP-14394</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Add unicode binary support to http_uri functions</p>
+ <p>
+ Own Id: OTP-14404</p>
+ </item>
+ <item>
+ <p>
+ httpc - Change timeout handling so the redirects cause a
+ new timer to be set. This means that a simple redirected
+ request could return after 2*timeout milliseconds.</p>
+ <p>
+ Own Id: OTP-14429</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 6.3.9</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 89c17a8679..bd1d2e833a 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2002-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.
@@ -1175,17 +1175,20 @@ handle_empty_queue(Session, ProfileName, TimeOut, State) ->
%% If a pipline | keep_alive session has been idle for some time is not
%% closed by the server, the client may want to close it.
NewState = activate_queue_timeout(TimeOut, State),
- update_session(ProfileName, Session, #session.queue_length, 0),
- %% Note mfa will be initialized when a new request
- %% arrives.
- {noreply,
- NewState#state{request = undefined,
- mfa = undefined,
- status_line = undefined,
- headers = undefined,
- body = undefined
- }
- }.
+ case update_session(ProfileName, Session, #session.queue_length, 0) of
+ {stop, Reason} ->
+ {stop, {shutdown, Reason}, State};
+ _ ->
+ %% Note mfa will be initialized when a new request
+ %% arrives.
+ {noreply,
+ NewState#state{request = undefined,
+ mfa = undefined,
+ status_line = undefined,
+ headers = undefined,
+ body = undefined
+ }}
+ end.
receive_response(Request, Session, Data, State) ->
NewState = init_wait_for_response_state(Request, State),
@@ -1677,7 +1680,7 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) ->
Session2 = erlang:setelement(Pos, Session, Value),
insert_session(Session2, ProfileName);
error:badarg ->
- exit(normal); %% Manager has been shutdown
+ {stop, normal};
T:E ->
%% Unexpected this must be an error!
Stacktrace = erlang:get_stacktrace(),
@@ -1697,14 +1700,14 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) ->
Session,
(catch httpc_manager:lookup_session(SessionId, ProfileName)),
T, E]),
- exit({failed_updating_session,
- [{profile, ProfileName},
- {session_id, SessionId},
- {pos, Pos},
- {value, Value},
- {etype, T},
- {error, E},
- {stacktrace, Stacktrace}]})
+ {stop, {failed_updating_session,
+ [{profile, ProfileName},
+ {session_id, SessionId},
+ {pos, Pos},
+ {value, Value},
+ {etype, T},
+ {error, E},
+ {stacktrace, Stacktrace}]}}
end.
diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl
index 4568d165e7..c4be5abd7c 100644
--- a/lib/inets/src/http_lib/http_uri.erl
+++ b/lib/inets/src/http_lib/http_uri.erl
@@ -1,7 +1,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.
diff --git a/lib/inets/src/http_lib/http_util.erl b/lib/inets/src/http_lib/http_util.erl
index 78b0aa2885..487d04f7aa 100644
--- a/lib/inets/src/http_lib/http_util.erl
+++ b/lib/inets/src/http_lib/http_util.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.
diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl
index 4f771015a6..4a2eff4770 100644
--- a/lib/inets/src/http_server/httpd_util.erl
+++ b/lib/inets/src/http_server/httpd_util.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.
diff --git a/lib/inets/src/http_server/mod_disk_log.erl b/lib/inets/src/http_server/mod_disk_log.erl
index 3be5f2dd74..2023546f01 100644
--- a/lib/inets/src/http_server/mod_disk_log.erl
+++ b/lib/inets/src/http_server/mod_disk_log.erl
@@ -363,17 +363,21 @@ create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList) ->
%%----------------------------------------------------------------------
open(Filename, MaxBytes, MaxFiles, internal) ->
- Opts = [{format, internal}, {repair, truncate}],
- open1(Filename, MaxBytes, MaxFiles, Opts);
+ Opt0 = {format, internal},
+ Opts1 = [Opt0, {repair, true}],
+ Opts2 = [Opt0, {repair, truncate}],
+ open1(Filename, MaxBytes, MaxFiles, Opts1, Opts2);
open(Filename, MaxBytes, MaxFiles, _) ->
Opts = [{format, external}],
- open1(Filename, MaxBytes, MaxFiles, Opts).
+ open1(Filename, MaxBytes, MaxFiles, Opts, Opts).
-open1(Filename, MaxBytes, MaxFiles, Opts0) ->
- Opts1 = [{name, Filename}, {file, Filename}, {type, wrap}] ++ Opts0,
- case open2(Opts1, {MaxBytes, MaxFiles}) of
+open1(Filename, MaxBytes, MaxFiles, Opts1, Opts2) ->
+ Opts0 = [{name, Filename}, {file, Filename}, {type, wrap}],
+ case open2(Opts0 ++ Opts1, Opts0 ++ Opts2, {MaxBytes, MaxFiles}) of
{ok, LogDB} ->
{ok, LogDB};
+ {repaired, LogDB, {recovered, _}, {badbytes, _}} ->
+ {ok, LogDB};
{error, Reason} ->
{error,
?NICE("Can't create " ++ Filename ++
@@ -382,11 +386,16 @@ open1(Filename, MaxBytes, MaxFiles, Opts0) ->
{error, ?NICE("Can't create "++Filename)}
end.
-open2(Opts, Size) ->
- case disk_log:open(Opts) of
+open2(Opts1, Opts2, Size) ->
+ case disk_log:open(Opts1) of
{error, {badarg, size}} ->
%% File did not exist, add the size option and try again
- disk_log:open([{size, Size} | Opts]);
+ disk_log:open([{size, Size} | Opts1]);
+ {error, {Reason, _}} when
+ Reason == not_a_log_file;
+ Reason == invalid_index_file ->
+ %% File was corrupt, add the truncate option and try again
+ disk_log:open([{size, Size} | Opts2]);
Else ->
Else
end.
diff --git a/lib/inets/src/http_server/mod_log.erl b/lib/inets/src/http_server/mod_log.erl
index ad7e9713d9..ec570504be 100644
--- a/lib/inets/src/http_server/mod_log.erl
+++ b/lib/inets/src/http_server/mod_log.erl
@@ -105,8 +105,8 @@ do(Info) ->
Code = proplists:get_value(code,Head,unknown),
transfer_log(Info, "-", AuthUser, Date, Code, Size),
{proceed, Info#mod.data};
- {_StatusCode, Response} ->
- transfer_log(Info,"-",AuthUser,Date,200,
+ {StatusCode, Response} ->
+ transfer_log(Info, "-", AuthUser, Date, StatusCode,
httpd_util:flatlength(Response)),
{proceed,Info#mod.data};
undefined ->
diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl
index 055b847319..b4f0f2aa7d 100644
--- a/lib/inets/test/httpd_SUITE.erl
+++ b/lib/inets/test/httpd_SUITE.erl
@@ -73,6 +73,7 @@ all() ->
{group, http_reload},
{group, https_reload},
{group, http_mime_types},
+ {group, http_logging},
mime_types_format
].
@@ -96,6 +97,7 @@ groups() ->
{https_htaccess, [], [{group, htaccess}]},
{http_security, [], [{group, security}]},
{https_security, [], [{group, security}]},
+ {http_logging, [], [{group, logging}]},
{http_reload, [], [{group, reload}]},
{https_reload, [], [{group, reload}]},
{http_mime_types, [], [alias_1_1, alias_1_0, alias_0_9]},
@@ -119,6 +121,8 @@ groups() ->
]},
{htaccess, [], [htaccess_1_1, htaccess_1_0, htaccess_0_9]},
{security, [], [security_1_1, security_1_0]}, %% Skip 0.9 as causes timing issus in test code
+ {logging, [], [disk_log_internal, disk_log_exists,
+ disk_log_bad_size, disk_log_bad_file]},
{http_1_1, [],
[host, chunked, expect, cgi, cgi_chunked_encoding_test,
trace, range, if_modified_since, mod_esi_chunk_timeout,
@@ -254,6 +258,11 @@ init_per_group(auth_api_dets, Config) ->
init_per_group(auth_api_mnesia, Config) ->
start_mnesia(proplists:get_value(node, Config)),
[{auth_prefix, "mnesia_"} | Config];
+init_per_group(http_logging, Config) ->
+ Config1 = [{http_version, "HTTP/1.1"} | Config],
+ ServerRoot = proplists:get_value(server_root, Config1),
+ Path = ServerRoot ++ "/httpd_log_transfer",
+ [{transfer_log, Path} | Config1];
init_per_group(_, Config) ->
Config.
@@ -310,10 +319,60 @@ init_per_testcase(range, Config) ->
create_range_data(DocRoot),
dbg(range, Config, init);
+init_per_testcase(disk_log_internal, Config0) ->
+ ok = start_apps(http_logging),
+ Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]),
+ ct:timetrap({seconds, 20}),
+ dbg(disk_log_internal, Config1, init);
+
+init_per_testcase(disk_log_exists, Config0) ->
+ ServerRoot = proplists:get_value(server_root, Config0),
+ Filename = ServerRoot ++ "/httpd_log_transfer",
+ {ok, Log} = disk_log:open([{name, Filename}, {file, Filename},
+ {repair, truncate}, {format, internal},
+ {type, wrap}, {size, {1048576, 5}}]),
+ ok = disk_log:log(Log, {bogus, node(), self()}),
+ ok = disk_log:close(Log),
+ ok = start_apps(http_logging),
+ Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]),
+ ct:timetrap({seconds, 20}),
+ dbg(disk_log_internal, Config1, init);
+
+init_per_testcase(disk_log_bad_size, Config0) ->
+ ServerRoot = proplists:get_value(server_root, Config0),
+ Filename = ServerRoot ++ "/httpd_log_transfer",
+ {ok, Log} = disk_log:open([{name, Filename}, {file, Filename},
+ {repair, truncate}, {format, internal},
+ {type, wrap}, {size, {1048576, 5}}]),
+ ok = disk_log:log(Log, {bogus, node(), self()}),
+ ok = disk_log:close(Log),
+ ok = file:delete(Filename ++ ".siz"),
+ ok = start_apps(http_logging),
+ Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]),
+ ct:timetrap({seconds, 20}),
+ dbg(disk_log_internal, Config1, init);
+
+init_per_testcase(disk_log_bad_file, Config0) ->
+ ServerRoot = proplists:get_value(server_root, Config0),
+ Filename = ServerRoot ++ "/httpd_log_transfer",
+ ok = file:write_file(Filename ++ ".1", <<>>),
+ ok = start_apps(http_logging),
+ Config1 = init_httpd(http_logging, [{type, ip_comm} | Config0]),
+ ct:timetrap({seconds, 20}),
+ dbg(disk_log_internal, Config1, init);
+
init_per_testcase(Case, Config) ->
ct:timetrap({seconds, 20}),
dbg(Case, Config, init).
+end_per_testcase(Case, Config) when
+ Case == disk_log_internal;
+ Case == disk_log_exists;
+ Case == disk_log_bad_size;
+ Case == disk_log_bad_file ->
+ inets:stop(),
+ dbg(Case, Config, 'end');
+
end_per_testcase(Case, Config) ->
dbg(Case, Config, 'end').
@@ -1257,6 +1316,63 @@ security(Config) ->
true = unblock_user(Node, "two", Port, OpenDir).
%%-------------------------------------------------------------------------
+
+disk_log_internal() ->
+ ["Test mod_disk_log"].
+
+disk_log_internal(Config) ->
+ Version = proplists:get_value(http_version, Config),
+ Request = "GET /" ++ integer_to_list(rand:uniform(1000000)) ++ " ",
+ ok = http_status(Request, Config, [{statuscode, 404}]),
+ Log = proplists:get_value(transfer_log, Config),
+ Match = list_to_binary(Request ++ Version),
+ disk_log_internal1(Log, Match, disk_log:chunk(Log, start)).
+disk_log_internal1(_, _, eof) ->
+ ct:fail(eof);
+disk_log_internal1(Log, Match, {Cont, [H | T]}) ->
+ case binary:match(H, Match) of
+ nomatch ->
+ disk_log_internal1(Log, Match, {Cont, T});
+ _ ->
+ ok
+ end;
+disk_log_internal1(Log, Match, {Cont, []}) ->
+ disk_log_internal1(Log, Match, disk_log:chunk(Log, Cont)).
+
+disk_log_exists() ->
+ ["Test mod_disk_log with existing logs"].
+
+disk_log_exists(Config) ->
+ Log = proplists:get_value(transfer_log, Config),
+ Self = self(),
+ Node = node(),
+ Log = proplists:get_value(transfer_log, Config),
+ {_, [{bogus, Node, Self} | _]} = disk_log:chunk(Log, start).
+
+disk_log_bad_size() ->
+ ["Test mod_disk_log with existing log, missing .siz"].
+
+disk_log_bad_size(Config) ->
+ Log = proplists:get_value(transfer_log, Config),
+ Self = self(),
+ Node = node(),
+ Log = proplists:get_value(transfer_log, Config),
+ {_, [{bogus, Node, Self} | _]} = disk_log:chunk(Log, start).
+
+disk_log_bad_file() ->
+ ["Test mod_disk_log with bad file"].
+
+disk_log_bad_file(Config) ->
+ Log = proplists:get_value(transfer_log, Config),
+ Version = proplists:get_value(http_version, Config),
+ Request = "GET /" ++ integer_to_list(rand:uniform(1000000)) ++ " ",
+ ok = http_status(Request, Config, [{statuscode, 404}]),
+ Log = proplists:get_value(transfer_log, Config),
+ Match = list_to_binary(Request ++ Version),
+ {_, [H | _]} = disk_log:chunk(Log, start),
+ {_, _} = binary:match(H, Match).
+
+%%-------------------------------------------------------------------------
non_disturbing_reconfiger_dies(Config) when is_list(Config) ->
do_reconfiger_dies([{http_version, "HTTP/1.1"} | Config], non_disturbing).
disturbing_reconfiger_dies(Config) when is_list(Config) ->
@@ -1567,6 +1683,7 @@ start_apps(Group) when Group == http_basic;
Group == http_auth_api_mnesia;
Group == http_htaccess;
Group == http_security;
+ Group == http_logging;
Group == http_reload;
Group == http_mime_types->
inets_test_lib:start_apps([inets]).
@@ -1662,6 +1779,8 @@ server_config(http_security, Config) ->
server_config(https_security, Config) ->
ServerRoot = proplists:get_value(server_root, Config),
tl(auth_conf(ServerRoot)) ++ security_conf(ServerRoot) ++ server_config(https, Config);
+server_config(http_logging, Config) ->
+ log_conf() ++ server_config(http, Config);
server_config(http_mime_types, Config0) ->
Config1 = basic_conf() ++ server_config(http, Config0),
ServerRoot = proplists:get_value(server_root, Config0),
@@ -1863,6 +1982,16 @@ mod_security_conf(SecFile, Dir) ->
{path, Dir} %% This is should not be needed, but is atm, awful design!
].
+log_conf() ->
+ [{modules, [mod_alias, mod_dir, mod_get, mod_head, mod_disk_log]},
+ {transfer_disk_log, "httpd_log_transfer"},
+ {security_disk_log, "httpd_log_security"},
+ {error_disk_log, "httpd_log_error"},
+ {transfer_disk_log_size, {1048576, 5}},
+ {error_disk_log_size, {1048576, 5}},
+ {error_disk_log_size, {1048576, 5}},
+ {security_disk_log_size, {1048576, 5}},
+ {disk_log_format, internal}].
http_status(Request, Config, Expected) ->
Version = proplists:get_value(http_version, Config),
diff --git a/lib/inets/test/httpd_basic_SUITE.erl b/lib/inets/test/httpd_basic_SUITE.erl
index a0a38ca103..931cd076cc 100644
--- a/lib/inets/test/httpd_basic_SUITE.erl
+++ b/lib/inets/test/httpd_basic_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
diff --git a/lib/inets/test/uri_SUITE.erl b/lib/inets/test/uri_SUITE.erl
index d055af59e3..3e7799141c 100644
--- a/lib/inets/test/uri_SUITE.erl
+++ b/lib/inets/test/uri_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.
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index 758cef7ac4..96796f11c0 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 6.3.9
+INETS_VSN = 6.4
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
diff --git a/lib/jinterface/doc/src/notes.xml b/lib/jinterface/doc/src/notes.xml
index 30f607c357..b44a04d7cd 100644
--- a/lib/jinterface/doc/src/notes.xml
+++ b/lib/jinterface/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2000</year><year>2016</year>
+ <year>2000</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -31,6 +31,32 @@
</header>
<p>This document describes the changes made to the Jinterface application.</p>
+<section><title>Jinterface 1.8</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Remove generation of atoms in old latin1 external format
+ in the distribution between erlang nodes,
+ <c>erl_interface</c>, and <c>jinterface</c>. The new utf8
+ format for atoms was introduced in OTP R16. An OTP 20
+ node can therefore not connect to nodes older than R16.</p>
+ <p>
+ Atoms that can be encoded using latin1 are still encoded
+ by <c>term_to_binary()</c> using latin1 encoding. Note
+ that all atoms will by default be encoded using utf8 in a
+ future Erlang/OTP release. For more information see the
+ documentation of <seealso
+ marker="erts:erlang#term_to_binary/2"><c>erlang:term_to_binary/2</c></seealso>.</p>
+ <p>
+ Own Id: OTP-14337</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Jinterface 1.7.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/jinterface/vsn.mk b/lib/jinterface/vsn.mk
index c29d9df3d7..373e2dab22 100644
--- a/lib/jinterface/vsn.mk
+++ b/lib/jinterface/vsn.mk
@@ -1 +1 @@
-JINTERFACE_VSN = 1.7.1
+JINTERFACE_VSN = 1.8
diff --git a/lib/kernel/doc/src/disk_log.xml b/lib/kernel/doc/src/disk_log.xml
index 570d3ef9bd..884cb32c0c 100644
--- a/lib/kernel/doc/src/disk_log.xml
+++ b/lib/kernel/doc/src/disk_log.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>1997</year>
- <year>2016</year>
+ <year>2017</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -972,7 +972,7 @@
<item>
<p>Specifies if messages will be sent to
<c>error_logger</c> on recoverable errors with
- the log files. Defaults to <c>true</c>.</p>
+ the log files. Defaults to <c>false</c>.</p>
</item>
</taglist>
<p><c>open/1</c> returns <c>{ok, <anno>Log</anno>}</c> if the
diff --git a/lib/kernel/doc/src/error_logger.xml b/lib/kernel/doc/src/error_logger.xml
index 27db00819f..91bf57cb91 100644
--- a/lib/kernel/doc/src/error_logger.xml
+++ b/lib/kernel/doc/src/error_logger.xml
@@ -126,6 +126,12 @@ ok</pre>
<seealso marker="#error_report/1"><c>error_report/1</c></seealso>
instead.</p>
</warning>
+ <warning>
+ <p>If the Unicode translation modifier (<c>t</c>) is used in
+ the format string, all error handlers must ensure that the
+ formatted output is correctly encoded for the I/O
+ device.</p>
+ </warning>
</desc>
</func>
<func>
@@ -197,6 +203,12 @@ ok</pre>
the standard event handler, meaning no further events are
logged. When in doubt, use <c>info_report/1</c> instead.</p>
</warning>
+ <warning>
+ <p>If the Unicode translation modifier (<c>t</c>) is used in
+ the format string, all error handlers must ensure that the
+ formatted output is correctly encoded for the I/O
+ device.</p>
+ </warning>
</desc>
</func>
<func>
@@ -262,7 +274,7 @@ ok</pre>
successful, or <c>{error, allready_have_logfile}</c> if
logging to file is already enabled, or an error tuple if
another error occurred (for example, if <c><anno>Filename</anno></c>
- cannot be opened).</p>
+ cannot be opened). The file is opened with encoding UTF-8.</p>
</item>
<tag><c>close</c></tag>
<item>
@@ -345,6 +357,12 @@ ok</pre>
the standard event handler, meaning no further events are
logged. When in doubt, use <c>warning_report/1</c> instead.</p>
</warning>
+ <warning>
+ <p>If the Unicode translation modifier (<c>t</c>) is used in
+ the format string, all error handlers must ensure that the
+ formatted output is correctly encoded for the I/O
+ device.</p>
+ </warning>
</desc>
</func>
<func>
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
index b71e8a1e5d..169a76463b 100644
--- a/lib/kernel/doc/src/inet.xml
+++ b/lib/kernel/doc/src/inet.xml
@@ -222,11 +222,18 @@ fe80::204:acff:fe17:bf38
<name name="get_rc" arity="0"/>
<fsummary>Return a list of IP configuration parameters.</fsummary>
<desc>
- <p>Returns the state of the <c>Inet</c> configuration database in
+ <p>
+ Returns the state of the <c>Inet</c> configuration database in
form of a list of recorded configuration parameters. For more
information, see <seealso marker="erts:inet_cfg">ERTS User's Guide:
Inet Configuration</seealso>.
- Only parameters with other than default values are returned.</p>
+ </p>
+ <p>
+ Only actual parameters with other than default values
+ are returned, for example not directives that specify
+ other sources for configuration parameters nor
+ directives that clear parameters.
+ </p>
</desc>
</func>
diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
index 75e1e18d86..e5ac031539 100644
--- a/lib/kernel/doc/src/kernel_app.xml
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -186,7 +186,7 @@
<tag><c>{file, FileName}</c></tag>
<item><p>Installs the standard event handler, which prints error
reports to file <c>FileName</c>, where <c>FileName</c>
- is a string.</p></item>
+ is a string. The file is opened with encoding UTF-8.</p></item>
<tag><c>false</c></tag>
<item>
<p>No standard event handler is installed, but
diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml
index 7ddb849824..0b94fc0fa6 100644
--- a/lib/kernel/doc/src/net_kernel.xml
+++ b/lib/kernel/doc/src/net_kernel.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml
index 7127a59a0c..9cd03ffcad 100644
--- a/lib/kernel/doc/src/notes.xml
+++ b/lib/kernel/doc/src/notes.xml
@@ -31,6 +31,176 @@
</header>
<p>This document describes the changes made to the Kernel application.</p>
+<section><title>Kernel 5.3.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>The documentation for the 'quiet' option in
+ disk_log:open/1 had an incorrect default value.</p>
+ <p>
+ Own Id: OTP-14498</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 5.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Function <c>inet:ntoa/1</c> has been fixed to return
+ lowercase letters according to RFC 5935 that has been
+ approved after this function was written. Previously
+ uppercase letters were returned so this may be a
+ backwards incompatible change depending on how the
+ returned address string is used.</p>
+ <p>Function <c>inet:parse_address/1</c> has been fixed to
+ accept %-suffixes on scoped addresses. The addresses does
+ not work yet, but gives no parse errors.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-13006 Aux Id: ERIERL-20, ERL-429 </p>
+ </item>
+ <item>
+ <p>
+ Fix bug where gethostname would incorrectly fail with
+ enametoolong on Linux.</p>
+ <p>
+ Own Id: OTP-14310</p>
+ </item>
+ <item>
+ <p>
+ Fix bug causing <c>code:is_module_native</c> to falsely
+ return true when <c>local</c> call trace is enabled for
+ the module.</p>
+ <p>
+ Own Id: OTP-14390</p>
+ </item>
+ <item>
+ <p>
+ Add early reject of invalid node names from distributed
+ nodes.</p>
+ <p>
+ Own Id: OTP-14426</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Since Unicode is now allowed in atoms an extra check is
+ needed for node names, which are restricted to Latin-1.</p>
+ <p>
+ Own Id: OTP-13805</p>
+ </item>
+ <item>
+ <p>Replaced usage of deprecated symbolic <seealso
+ marker="erts:erlang#type-time_unit"><c>time
+ unit</c></seealso> representations.</p>
+ <p>
+ Own Id: OTP-13831 Aux Id: OTP-13735 </p>
+ </item>
+ <item>
+ <p><c>file:write_file(Name, Data, [raw])</c> would turn
+ <c>Data</c> into a single binary before writing. This
+ meant it could not take advantage of the <c>writev()</c>
+ system call if it was given a list of binaries and told
+ to write with <c>raw</c> mode.</p>
+ <p>
+ Own Id: OTP-13909</p>
+ </item>
+ <item>
+ <p>The performance of the <c>disk_log</c> has been
+ somewhat improved in some corner cases (big items), and
+ the documentation has been clarified. </p>
+ <p>
+ Own Id: OTP-14057 Aux Id: PR-1245 </p>
+ </item>
+ <item>
+ <p>Functions for detecting changed code has been added.
+ <c>code:modified_modules/0</c> returns all currently
+ loaded modules that have changed on disk.
+ <c>code:module_status/1</c> returns the status for a
+ module. In the shell and in <c>c</c> module, <c>mm/0</c>
+ is short for <c>code:modified_modules/0</c>, and
+ <c>lm/0</c> reloads all currently loaded modules that
+ have changed on disk.</p>
+ <p>
+ Own Id: OTP-14059</p>
+ </item>
+ <item>
+ <p>
+ Introduce an event manager in Erlang to handle OS
+ signals. A subset of OS signals may be subscribed to and
+ those are described in the Kernel application.</p>
+ <p>
+ Own Id: OTP-14186</p>
+ </item>
+ <item>
+ <p> Sockets can now be bound to device (SO_BINDTODEVICE)
+ on platforms where it is supported. </p> <p> This has
+ been implemented e.g to support VRF-Lite under Linux; see
+ <url
+ href="https://www.kernel.org/doc/Documentation/networking/vrf.txt">
+ VRF </url>, and GitHub pull request <url
+ href="https://github.com/erlang/otp/pull/1326">#1326</url>.
+ </p>
+ <p>
+ Own Id: OTP-14357 Aux Id: PR-1326 </p>
+ </item>
+ <item>
+ <p>
+ Added option to store shell_history on disk so that the
+ history can be reused between sessions.</p>
+ <p>
+ Own Id: OTP-14409 Aux Id: PR-1420 </p>
+ </item>
+ <item>
+ <p> The size of crash reports created by
+ <c>gen_server</c>, <c>gen_statem</c> and <c>proc_lib</c>
+ is limited with aid of the Kernel application variable
+ <c>error_logger_format_depth</c>. The purpose is to limit
+ the size of the messages sent to the <c>error_logger</c>
+ process when processes with huge message queues or states
+ crash. </p> <p>The crash report generated by
+ <c>proc_lib</c> includes the new tag
+ <c>message_queue_len</c>. The neighbour report also
+ includes the new tag <c>current_stacktrace</c>. Finally,
+ the neighbour report no longer includes the tags
+ <c>messages</c> and <c>dictionary</c>. </p> <p> The new
+ function <c>error_logger:get_format_depth/0</c> can be
+ used to retrieve the value of the Kernel application
+ variable <c>error_logger_format_depth</c>. </p>
+ <p>
+ Own Id: OTP-14417</p>
+ </item>
+ <item>
+ <p> One of the ETS tables used by the <c>global</c>
+ module is created with <c>{read_concurrency, true}</c> in
+ order to reduce contention. </p>
+ <p>
+ Own Id: OTP-14419</p>
+ </item>
+ <item>
+ <p>
+ Warnings have been added to the relevant documentation
+ about not using un-secure distributed nodes in exposed
+ environments.</p>
+ <p>
+ Own Id: OTP-14425</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Kernel 5.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile
index 78aa6192a9..5946620f0f 100644
--- a/lib/kernel/src/Makefile
+++ b/lib/kernel/src/Makefile
@@ -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.
diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl
index 10c22e1ad6..93856aa7b3 100644
--- a/lib/kernel/src/disk_log_1.erl
+++ b/lib/kernel/src/disk_log_1.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.
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index ad92aafc2f..480db6814e 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -33,10 +33,10 @@
-export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2,
dump_monitors/1, dump_links/1, flat_size/1,
- get_internal_state/1, instructions/0, lock_counters/1,
+ get_internal_state/1, instructions/0,
map_info/1, same/2, set_internal_state/2,
- size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2,
- dirty/3]).
+ size_shared/1, copy_shared/1, dirty_cpu/2, dirty_io/2, dirty/3,
+ lcnt_control/1, lcnt_control/2, lcnt_collect/0, lcnt_clear/0]).
-spec breakpoint(MFA, Flag) -> non_neg_integer() when
MFA :: {Module :: module(),
@@ -142,12 +142,31 @@ ic(F) when is_function(F) ->
io:format("Total: ~w~n",[lists:sum([C||{_I,C}<-Is])]),
R.
--spec lock_counters(info) -> term();
- (clear) -> ok;
- ({copy_save, boolean()}) -> boolean();
- ({process_locks, boolean()}) -> boolean().
+-spec lcnt_control
+ (copy_save, boolean()) -> ok;
+ (mask, list(atom())) -> ok.
-lock_counters(_) ->
+lcnt_control(_Option, _Value) ->
+ erlang:nif_error(undef).
+
+-spec lcnt_control
+ (copy_save) -> boolean();
+ (mask) -> list(atom()).
+
+lcnt_control(_Option) ->
+ erlang:nif_error(undef).
+
+-type lcnt_lock_info() :: {atom(), term(), atom(), term()}.
+
+-spec lcnt_collect() ->
+ list({duration, {non_neg_integer(), non_neg_integer()}} |
+ {locks, list(lcnt_lock_info())}).
+
+lcnt_collect() ->
+ erlang:nif_error(undef).
+
+-spec lcnt_clear() -> ok.
+lcnt_clear() ->
erlang:nif_error(undef).
-spec same(Term1, Term2) -> boolean() when
diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl
index 0eeaaad8d2..bf785959ff 100644
--- a/lib/kernel/src/group.erl
+++ b/lib/kernel/src/group.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.
diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl
index 5ca5e2d1dd..91f3663cc5 100644
--- a/lib/kernel/src/group_history.erl
+++ b/lib/kernel/src/group_history.erl
@@ -218,7 +218,7 @@ handle_open_error({invalid_header, Term}) ->
[Term]);
handle_open_error({file_error, FileName, Reason}) ->
show('$#erlang-history-file-error',
- "Error handling File ~s. Reason: ~p~n"
+ "Error handling File ~ts. Reason: ~p~n"
"History logging will be disabled.~n",
[FileName, Reason]);
handle_open_error(Err) ->
@@ -309,7 +309,7 @@ show_rename_warning() ->
show_invalid_file_warning(FileName) ->
show('$#erlang-history-invalid-file',
- "Shell history expects to be able to use the file ~s "
+ "Shell history expects to be able to use the file ~ts "
"which currently exists and is not a file usable for "
"history logging purposes. History logging will be "
"disabled.~n", [FileName]).
diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl
index 6aef5476f1..dc20c21c77 100644
--- a/lib/kernel/src/inet.erl
+++ b/lib/kernel/src/inet.erl
@@ -151,7 +151,8 @@
%%% ---------------------------------
--spec get_rc() -> [{Par :: any(), Val :: any()}].
+-spec get_rc() -> [{Par :: atom(), Val :: any()} |
+ {Par :: atom(), Val1 :: any(), Val2 :: any()}].
get_rc() ->
inet_db:get_rc().
diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl
index 0f5dc40553..29804dc50b 100644
--- a/lib/kernel/src/inet_parse.erl
+++ b/lib/kernel/src/inet_parse.erl
@@ -644,8 +644,12 @@ ipv6_addr(Cs) ->
ipv6_addr(hex(Cs), [], 0).
%% Before "::"
+ipv6_addr({Cs0,"%"++Cs1}, A, N) when N == 7 ->
+ ipv6_addr_scope(Cs1, [hex_to_int(Cs0)|A], [], N+1, []);
ipv6_addr({Cs0,[]}, A, N) when N == 7 ->
ipv6_addr_done([hex_to_int(Cs0)|A]);
+ipv6_addr({Cs0,"::%"++Cs1}, A, N) when N =< 6 ->
+ ipv6_addr_scope(Cs1, [hex_to_int(Cs0)|A], [], N+1, []);
ipv6_addr({Cs0,"::"}, A, N) when N =< 6 ->
ipv6_addr_done([hex_to_int(Cs0)|A], [], N+1);
ipv6_addr({Cs0,"::"++Cs1}, A, N) when N =< 5 ->
@@ -658,6 +662,8 @@ ipv6_addr(_, _, _) ->
erlang:error(badarg).
%% After "::"
+ipv6_addr({Cs0,"%"++Cs1}, A, B, N) when N =< 6 ->
+ ipv6_addr_scope(Cs1, A, [hex_to_int(Cs0)|B], N+1, []);
ipv6_addr({Cs0,[]}, A, B, N) when N =< 6 ->
ipv6_addr_done(A, [hex_to_int(Cs0)|B], N+1);
ipv6_addr({Cs0,":"++Cs1}, A, B, N) when N =< 5 ->
@@ -667,6 +673,43 @@ ipv6_addr({Cs0,"."++_=Cs1}, A, B, N) when N =< 5 ->
ipv6_addr(_, _, _, _) ->
erlang:error(badarg).
+%% After "%"
+ipv6_addr_scope([], Ar, Br, N, Sr) ->
+ ScopeId =
+ case lists:reverse(Sr) of
+ %% Empty scope id
+ "" -> 0;
+ %% Scope id starts with 0
+ "0"++S -> dec16(S);
+ _ -> 0
+ end,
+ %% Suggested formats for scope id parsing:
+ %% "" -> "0"
+ %% "0" -> Scope id 0
+ %% "1" - "9", "10" - "99" -> "0"++S
+ %% "0"++DecimalScopeId -> decimal scope id
+ %% "25"++PercentEncoded -> Percent encoded interface name
+ %% S -> Interface name (Unicode?)
+ %% Missing: translation from interface name into integer scope id.
+ %% XXX: scope id is actually 32 bit, but we only have room for
+ %% 16 bit in the second address word - ignore or fix (how)?
+ ipv6_addr_scope(ScopeId, Ar, Br, N);
+ipv6_addr_scope([C|Cs], Ar, Br, N, Sr) ->
+ ipv6_addr_scope(Cs, Ar, Br, N, [C|Sr]).
+%%
+ipv6_addr_scope(ScopeId, [P], Br, N)
+ when N =< 7, P =:= 16#fe80;
+ N =< 7, P =:= 16#ff02 ->
+ %% Optimized special case
+ ipv6_addr_done([ScopeId,P], Br, N+1);
+ipv6_addr_scope(ScopeId, Ar, Br, N) ->
+ case lists:reverse(Br++dup(8-N, 0, Ar)) of
+ [P,0|Xs] when P =:= 16#fe80; P =:= 16#ff02 ->
+ list_to_tuple([P,ScopeId|Xs]);
+ _ ->
+ erlang:error(badarg)
+ end.
+
ipv6_addr_done(Ar, Br, N, {D1,D2,D3,D4}) ->
ipv6_addr_done(Ar, [((D3 bsl 8) bor D4),((D1 bsl 8) bor D2)|Br], N+2).
@@ -690,6 +733,19 @@ hex(Cs, [_|_]=R, _) when is_list(Cs) ->
hex(_, _, _) ->
erlang:error(badarg).
+%% Parse a reverse decimal integer string, empty is 0
+dec16(Cs) -> dec16(Cs, 0).
+%%
+dec16([], I) -> I;
+dec16([C|Cs], I) when C >= $0, C =< $9 ->
+ case 10*I + (C - $0) of
+ J when 16#ffff < J ->
+ erlang:error(badarg);
+ J ->
+ dec16(Cs, J)
+ end;
+dec16(_, _) -> erlang:error(badarg).
+
%% Hex string to integer
hex_to_int(Cs) -> erlang:list_to_integer(Cs, 16).
@@ -703,7 +759,7 @@ dup(N, E, L) when is_integer(N), N >= 1 ->
%% Convert IPv4 address to ascii
%% Convert IPv6 / IPV4 address to ascii (plain format)
-ntoa({A,B,C,D}) ->
+ntoa({A,B,C,D}) when (A band B band C band D band (bnot 16#ff)) =:= 0 ->
integer_to_list(A) ++ "." ++ integer_to_list(B) ++ "." ++
integer_to_list(C) ++ "." ++ integer_to_list(D);
%% ANY
@@ -711,13 +767,25 @@ ntoa({0,0,0,0,0,0,0,0}) -> "::";
%% LOOPBACK
ntoa({0,0,0,0,0,0,0,1}) -> "::1";
%% IPV4 ipv6 host address
-ntoa({0,0,0,0,0,0,A,B}) -> "::" ++ dig_to_dec(A) ++ "." ++ dig_to_dec(B);
+ntoa({0,0,0,0,0,0,A,B}) when (A band B band (bnot 16#ffff)) =:= 0 ->
+ "::" ++ dig_to_dec(A) ++ "." ++ dig_to_dec(B);
%% IPV4 non ipv6 host address
-ntoa({0,0,0,0,0,16#ffff,A,B}) ->
- "::FFFF:" ++ dig_to_dec(A) ++ "." ++ dig_to_dec(B);
-ntoa({_,_,_,_,_,_,_,_}=T) ->
- %% Find longest sequence of zeros, at least 2, to replace with "::"
- ntoa(tuple_to_list(T), []);
+ntoa({0,0,0,0,0,16#ffff,A,B}) when (A band B band (bnot 16#ffff)) =:= 0 ->
+ "::ffff:" ++ dig_to_dec(A) ++ "." ++ dig_to_dec(B);
+ntoa({A,B,C,D,E,F,G,H})
+ when (A band B band C band D band E band F band G band H band
+ (bnot 16#ffff)) =:= 0 ->
+ if
+ A =:= 16#fe80, B =/= 0;
+ A =:= 16#ff02, B =/= 0 ->
+ %% Find longest sequence of zeros, at least 2,
+ %% to replace with "::"
+ ntoa([A,0,C,D,E,F,G,H], []) ++ "%0" ++ integer_to_list(B);
+ true ->
+ %% Find longest sequence of zeros, at least 2,
+ %% to replace with "::"
+ ntoa([A,B,C,D,E,F,G,H], [])
+ end;
ntoa(_) ->
{error, einval}.
@@ -780,9 +848,19 @@ dig_to_dec(X) ->
integer_to_list((X bsr 8) band 16#ff) ++ "." ++
integer_to_list(X band 16#ff).
-%% Convert a integer to hex string
-dig_to_hex(X) ->
- erlang:integer_to_list(X, 16).
+%% Convert a integer to hex string (lowercase)
+dig_to_hex(0) -> "0";
+dig_to_hex(X) when is_integer(X), 0 < X ->
+ dig_to_hex(X, "").
+%%
+dig_to_hex(0, Acc) -> Acc;
+dig_to_hex(X, Acc) ->
+ dig_to_hex(
+ X bsr 4,
+ [case X band 15 of
+ D when D < 10 -> D + $0;
+ D -> D - 10 + $a
+ end|Acc]).
%%
%% Count number of '.' in a name
diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl
index 8c8fe86811..e3fdb1bb22 100644
--- a/lib/kernel/src/inet_tcp_dist.erl
+++ b/lib/kernel/src/inet_tcp_dist.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.
@@ -390,14 +390,14 @@ splitnode(Driver, Node, LongOrShortNames) ->
error_msg("** System running to use "
"fully qualified "
"hostnames **~n"
- "** Hostname ~s is illegal **~n",
+ "** Hostname ~ts is illegal **~n",
[Host]),
?shutdown(Node)
end;
L when length(L) > 1, LongOrShortNames =:= shortnames ->
error_msg("** System NOT running to use fully qualified "
"hostnames **~n"
- "** Hostname ~s is illegal **~n",
+ "** Hostname ~ts is illegal **~n",
[Host]),
?shutdown(Node);
_ ->
diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src
index 1128ee3ec5..2a11b04310 100644
--- a/lib/kernel/src/kernel.app.src
+++ b/lib/kernel/src/kernel.app.src
@@ -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.
@@ -120,6 +120,6 @@
{applications, []},
{env, [{error_logger, tty}]},
{mod, {kernel, []}},
- {runtime_dependencies, ["erts-9.0", "stdlib-3.0", "sasl-3.0"]}
+ {runtime_dependencies, ["erts-9.1", "stdlib-3.0", "sasl-3.0"]}
]
}.
diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src
index 77085b2064..f1ef70a373 100644
--- a/lib/kernel/src/kernel.appup.src
+++ b/lib/kernel/src/kernel.appup.src
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"5\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*
+ [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*, OTP-20.0
%% Down to - max one major revision back
- [{<<"5\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*
+ [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*, OTP-20.0
}.
diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl
index 2b11a0381f..fe2fc778f2 100644
--- a/lib/kernel/test/disk_log_SUITE.erl
+++ b/lib/kernel/test/disk_log_SUITE.erl
@@ -481,7 +481,7 @@ halt_ro_crash(Conf) when is_list(Conf) ->
%% This is how it was before R6B:
%% {C1,T1,15} = disk_log:chunk(a,start),
%% {C2,T2} = disk_log:chunk(a,C1),
- {C1,_OneItem,7476} = disk_log:chunk(a,start),
+ {C1,_OneItem,7478} = disk_log:chunk(a,start),
{C2, [], 7} = disk_log:chunk(a,C1),
eof = disk_log:chunk(a,C2),
ok = disk_log:close(a),
@@ -2503,8 +2503,8 @@ error_repair(Conf) when is_list(Conf) ->
ok = disk_log:close(n),
BadFile = add_ext(File, 2), % current file
set_opened(BadFile),
- crash(BadFile, 26), % the binary is now invalid
- {repaired,n,{recovered,0},{badbytes,24}} =
+ crash(BadFile, 28), % the binary is now invalid
+ {repaired,n,{recovered,0},{badbytes,26}} =
disk_log:open([{name, n}, {file, File}, {type, wrap},
{format, internal}, {size, {40,No}}]),
ok = disk_log:close(n),
@@ -2521,8 +2521,8 @@ error_repair(Conf) when is_list(Conf) ->
ok = disk_log:close(n),
BadFile2 = add_ext(File, 1), % current file
set_opened(BadFile2),
- crash(BadFile2, 47), % the second binary is now invalid
- {repaired,n,{recovered,1},{badbytes,24}} =
+ crash(BadFile2, 51), % the second binary is now invalid
+ {repaired,n,{recovered,1},{badbytes,26}} =
disk_log:open([{name, n}, {file, File}, {type, wrap},
{format, internal}, {size, {4000,No}}]),
ok = disk_log:close(n),
@@ -2580,7 +2580,7 @@ error_repair(Conf) when is_list(Conf) ->
ok = disk_log:close(n),
set_opened(File),
crash(File, 30),
- {repaired,n,{recovered,3},{badbytes,15}} =
+ {repaired,n,{recovered,3},{badbytes,16}} =
disk_log:open([{name, n}, {file, File}, {type, halt},
{format, internal},{repair,true}, {quiet, true},
{head_func, {?MODULE, head_fun, [{ok,"head"}]}}]),
@@ -2807,7 +2807,7 @@ chunk(Conf) when is_list(Conf) ->
ok = disk_log:log_terms(n, [{some,terms}]), % second file full
2 = curf(n),
BadFile = add_ext(File, 1),
- crash(BadFile, 26), % the _binary_ is now invalid
+ crash(BadFile, 28), % the _binary_ is now invalid
{error, {corrupt_log_file, BFile}} = disk_log:chunk(n, start, 1),
BadFile = BFile,
ok = disk_log:close(n),
@@ -2817,7 +2817,7 @@ chunk(Conf) when is_list(Conf) ->
{format, internal}]),
ok = disk_log:log_terms(n, [{this,is}]),
ok = disk_log:sync(n),
- crash(File, 26), % the _binary_ is now invalid
+ crash(File, 28), % the _binary_ is now invalid
{error, {corrupt_log_file, File2}} = disk_log:chunk(n, start, 1),
crash(File, 10),
{error,{corrupt_log_file,_}} = disk_log:bchunk(n, start, 1),
@@ -2911,8 +2911,8 @@ chunk(Conf) when is_list(Conf) ->
{ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
{format, internal}, {mode, read_only}]),
CrashFile = add_ext(File, 1),
- crash(CrashFile, 46), % the binary term {some,terms} is now bad
- {H1, [{this,is}], 16} = disk_log:chunk(n, start, 10),
+ crash(CrashFile, 51), % the binary term {some,terms} is now bad
+ {H1, [{this,is}], 18} = disk_log:chunk(n, start, 10),
{H2, [{on,a},{wrap,file}]} = disk_log:chunk(n, H1),
eof = disk_log:chunk(n, H2),
ok = disk_log:close(n),
@@ -2926,8 +2926,8 @@ chunk(Conf) when is_list(Conf) ->
ok = disk_log:close(n),
{ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
{format, internal}, {mode, read_only}]),
- crash(File, 46), % the binary term {some,terms} is now bad
- {J1, [{this,is}], 16} = disk_log:chunk(n, start, 10),
+ crash(File, 51), % the binary term {some,terms} is now bad
+ {J1, [{this,is}], 18} = disk_log:chunk(n, start, 10),
{J2, [{on,a},{halt,file}]} = disk_log:chunk(n, J1),
eof = disk_log:chunk(n, J2),
ok = disk_log:close(n),
@@ -2942,8 +2942,8 @@ chunk(Conf) when is_list(Conf) ->
ok = disk_log:close(n),
{ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
{format, internal}, {mode, read_only}]),
- crash(File, 40), % the binary term {s} is now bad
- {J11, [{this,is}], 6} = disk_log:chunk(n, start, 10),
+ crash(File, 44), % the binary term {s} is now bad
+ {J11, [{this,is}], 7} = disk_log:chunk(n, start, 10),
{J21, [{on,a},{halt,file}]} = disk_log:chunk(n, J11),
eof = disk_log:chunk(n, J21),
ok = disk_log:close(n),
@@ -3062,7 +3062,7 @@ truncate(Conf) when is_list(Conf) ->
ok = disk_log:truncate(n, apa),
rec(1, {disk_log, node(), n, {truncated, 6}}),
{0, 0} = no_overflows(n),
- 22 = curb(n),
+ 23 = curb(n),
1 = curf(n),
1 = cur_cnt(n),
true = (Size == sz(n)),
@@ -3082,7 +3082,7 @@ truncate(Conf) when is_list(Conf) ->
ok = disk_log:truncate(n, apa),
rec(1, {disk_log, node(), n, {truncated, 3}}),
{0, 0} = no_overflows(n),
- 22 = curb(n),
+ 23 = curb(n),
1 = curf(n),
1 = cur_cnt(n),
true = (Size == sz(n)),
@@ -3191,45 +3191,45 @@ info_current(Conf) when is_list(Conf) ->
%% Internal with header.
{ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
{head, header}, {size, {100,No}}]),
- {25, 1} = {curb(n), cur_cnt(n)},
+ {26, 1} = {curb(n), cur_cnt(n)},
{1, 1} = {no_written_items(n), no_items(n)},
ok = disk_log:log(n, B),
- {93, 2} = {curb(n), cur_cnt(n)},
+ {94, 2} = {curb(n), cur_cnt(n)},
{2, 2} = {no_written_items(n), no_items(n)},
ok = disk_log:close(n),
{ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
{notify, true},
{head, header}, {size, {100,No}}]),
- {93, 2} = {curb(n), cur_cnt(n)},
+ {94, 2} = {curb(n), cur_cnt(n)},
{0, 2} = {no_written_items(n), no_items(n)},
ok = disk_log:log(n, B),
rec(1, {disk_log, node(), n, {wrap, 0}}),
- {93, 2} = {curb(n), cur_cnt(n)},
+ {94, 2} = {curb(n), cur_cnt(n)},
{2, 4} = {no_written_items(n), no_items(n)},
disk_log:inc_wrap_file(n),
rec(1, {disk_log, node(), n, {wrap, 0}}),
- {25, 1} = {curb(n), cur_cnt(n)},
+ {26, 1} = {curb(n), cur_cnt(n)},
{3, 4} = {no_written_items(n), no_items(n)},
ok = disk_log:log_terms(n, [B,B,B]),
%% Used to be one message, but now one per wrapped file.
rec(1, {disk_log, node(), n, {wrap, 0}}),
rec(1, {disk_log, node(), n, {wrap, 2}}),
- {93, 2} = {curb(n), cur_cnt(n)},
+ {94, 2} = {curb(n), cur_cnt(n)},
{8, 7} = {no_written_items(n), no_items(n)},
ok = disk_log:log_terms(n, [B]),
rec(1, {disk_log, node(), n, {wrap, 2}}),
ok = disk_log:log_terms(n, [B]),
rec(1, {disk_log, node(), n, {wrap, 2}}),
- {93, 2} = {curb(n), cur_cnt(n)},
+ {94, 2} = {curb(n), cur_cnt(n)},
{12, 7} = {no_written_items(n), no_items(n)},
ok = disk_log:log_terms(n, [BB,BB]),
%% Used to be one message, but now one per wrapped file.
rec(2, {disk_log, node(), n, {wrap, 2}}),
- {193, 2} = {curb(n), cur_cnt(n)},
+ {194, 2} = {curb(n), cur_cnt(n)},
{16, 7} = {no_written_items(n), no_items(n)},
ok = disk_log:log_terms(n, [SB,SB,SB]),
rec(1, {disk_log, node(), n, {wrap, 2}}),
- {79, 4} = {curb(n), cur_cnt(n)},
+ {80, 4} = {curb(n), cur_cnt(n)},
{20, 9} = {no_written_items(n), no_items(n)},
ok = disk_log:close(n),
del(File, No),
diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl
index 3f11e25b93..12d22519ce 100644
--- a/lib/kernel/test/gen_tcp_api_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_api_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-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.
diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl
index 929f66d400..331864b5de 100644
--- a/lib/kernel/test/gen_tcp_misc_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl
@@ -50,9 +50,8 @@
killing_acceptor/1,killing_multi_acceptors/1,killing_multi_acceptors2/1,
several_accepts_in_one_go/1, accept_system_limit/1,
active_once_closed/1, send_timeout/1, send_timeout_active/1,
- otp_7731/1, zombie_sockets/1, otp_7816/1, otp_8102/1,
- wrapping_oct/0, wrapping_oct/1,
- otp_9389/1]).
+ otp_7731/1, zombie_sockets/1, otp_7816/1, otp_8102/1,
+ wrapping_oct/0, wrapping_oct/1, otp_9389/1, otp_13939/1]).
%% Internal exports.
-export([sender/3, not_owner/1, passive_sockets_server/2, priority_server/1,
@@ -3014,3 +3013,42 @@ ok({ok,V}) -> V.
get_hostname(Name) ->
"@"++Host = lists:dropwhile(fun(C) -> C =/= $@ end, atom_to_list(Name)),
Host.
+
+otp_13939(doc) ->
+ ["Check that writing to a remotely closed socket doesn't block forever "
+ "when exit_on_close is false."];
+otp_13939(suite) ->
+ [];
+otp_13939(Config) when is_list(Config) ->
+ {Pid, Ref} = spawn_opt(
+ fun() ->
+ {ok, Listener} = gen_tcp:listen(0, [{exit_on_close, false}]),
+ {ok, Port} = inet:port(Listener),
+
+ spawn_link(
+ fun() ->
+ {ok, Client} = gen_tcp:connect("localhost", Port,
+ [{active, false}]),
+ ok = gen_tcp:close(Client)
+ end),
+
+ {ok, Accepted} = gen_tcp:accept(Listener),
+
+ ok = gen_tcp:send(Accepted, <<0:(10*1024*1024*8)>>),
+
+ %% The bug surfaces when there's a delay between the send
+ %% operations; inet:getstat is a red herring.
+ timer:sleep(100),
+
+ {error, Code} = gen_tcp:send(Accepted, <<0:(10*1024*1024*8)>>),
+ ct:pal("gen_tcp:send returned ~p~n", [Code])
+ end, [link, monitor]),
+
+ receive
+ {'DOWN', Ref, process, Pid, normal} ->
+ ok
+ after 1000 ->
+ demonitor(Ref, [flush]),
+ exit(Pid, normal),
+ ct:fail("Server process blocked on send.")
+ end.
diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl
index 836e0c5a05..aa616d43d6 100644
--- a/lib/kernel/test/gen_udp_SUITE.erl
+++ b/lib/kernel/test/gen_udp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-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.
diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl
index 97f789b61c..3b502be8b8 100644
--- a/lib/kernel/test/inet_SUITE.erl
+++ b/lib/kernel/test/inet_SUITE.erl
@@ -447,91 +447,125 @@ parse_hosts(Config) when is_list(Config) ->
inet_parse:resolv(ResolvErr1).
parse_address(Config) when is_list(Config) ->
- V4Strict =
+ V4Reversable =
[{{0,0,0,0},"0.0.0.0"},
- {{1,2,3,4},"1.2.3.4"},
+ {{1,2,3,4},"1.2.3.4"},
{{253,252,251,250},"253.252.251.250"},
{{1,2,255,254},"1.2.255.254"}],
- V6Strict =
+ V6Reversable =
[{{0,0,0,0,0,0,0,0},"::"},
+ {{0,0,0,0,0,0,0,1},"::1"},
+ {{0,0,0,0,0,0,0,2},"::0.0.0.2"},
{{15,0,0,0,0,0,0,2},"f::2"},
- {{15,16#f11,0,0,0,0,256,2},"f:f11::0100:2"},
- {{0,0,0,0,0,0,0,16#17},"::17"},
- {{16#700,0,0,0,0,0,0,0},"0700::"},
- {{0,0,0,0,0,0,2,1},"::2:1"},
+ {{15,16#f11,0,0,0,0,256,2},"f:f11::100:2"},
+ {{16#700,0,0,0,0,0,0,0},"700::"},
+ {{0,0,0,0,0,0,2,1},"::0.2.0.1"},
{{0,0,0,0,0,3,2,1},"::3:2:1"},
{{0,0,0,0,4,3,2,1},"::4:3:2:1"},
{{0,0,0,5,4,3,2,1},"::5:4:3:2:1"},
{{0,0,6,5,4,3,2,1},"::6:5:4:3:2:1"},
- {{0,7,6,5,4,3,2,1},"::7:6:5:4:3:2:1"},
+ {{0,7,6,5,4,3,2,1},"0:7:6:5:4:3:2:1"},
{{7,0,0,0,0,0,0,0},"7::"},
{{7,6,0,0,0,0,0,0},"7:6::"},
{{7,6,5,0,0,0,0,0},"7:6:5::"},
{{7,6,5,4,0,0,0,0},"7:6:5:4::"},
{{7,6,5,4,3,0,0,0},"7:6:5:4:3::"},
{{7,6,5,4,3,2,0,0},"7:6:5:4:3:2::"},
- {{7,6,5,4,3,2,1,0},"7:6:5:4:3:2:1::"},
+ {{7,6,5,4,3,2,1,0},"7:6:5:4:3:2:1:0"},
+ {{0,0,6,5,4,3,0,0},"::6:5:4:3:0:0"},
+ {{0,0,6,5,4,0,0,0},"0:0:6:5:4::"},
+ {{8,0,0,5,4,0,0,1},"8::5:4:0:0:1"},
+ {{8,0,0,5,0,0,0,1},"8:0:0:5::1"},
+ {{0,7,6,5,4,3,2,0},"0:7:6:5:4:3:2:0"},
+ {{0,0,6,5,4,3,0,0},"::6:5:4:3:0:0"},
+ {{0,0,0,5,4,0,0,0},"::5:4:0:0:0"},
+ {{0,0,0,0,4,0,0,0},"::4:0:0:0"},
+ {{0,0,0,5,0,0,0,0},"0:0:0:5::"},
{{16#c11,16#c22,16#5c33,16#c440,16#55c0,16#c66c,16#77,16#88},
- "c11:0c22:5c33:c440:55c0:c66c:77:0088"},
+ "c11:c22:5c33:c440:55c0:c66c:77:88"},
+ {{0,16#c22,16#5c33,16#c440,16#55c0,16#c66c,16#77,16#88},
+ "0:c22:5c33:c440:55c0:c66c:77:88"},
{{16#c11,0,16#5c33,16#c440,16#55c0,16#c66c,16#77,16#88},
- "c11::5c33:c440:55c0:c66c:77:0088"},
+ "c11:0:5c33:c440:55c0:c66c:77:88"},
{{16#c11,16#c22,0,16#c440,16#55c0,16#c66c,16#77,16#88},
- "c11:0c22::c440:55c0:c66c:77:0088"},
+ "c11:c22:0:c440:55c0:c66c:77:88"},
{{16#c11,16#c22,16#5c33,0,16#55c0,16#c66c,16#77,16#88},
- "c11:0c22:5c33::55c0:c66c:77:0088"},
+ "c11:c22:5c33:0:55c0:c66c:77:88"},
{{16#c11,16#c22,16#5c33,16#c440,0,16#c66c,16#77,16#88},
- "c11:0c22:5c33:c440::c66c:77:0088"},
+ "c11:c22:5c33:c440:0:c66c:77:88"},
{{16#c11,16#c22,16#5c33,16#c440,16#55c0,0,16#77,16#88},
- "c11:0c22:5c33:c440:55c0::77:0088"},
+ "c11:c22:5c33:c440:55c0:0:77:88"},
{{16#c11,16#c22,16#5c33,16#c440,16#55c0,16#c66c,0,16#88},
- "c11:0c22:5c33:c440:55c0:c66c::0088"},
+ "c11:c22:5c33:c440:55c0:c66c:0:88"},
+ {{16#c11,16#c22,16#5c33,16#c440,16#55c0,16#c66c,16#77,0},
+ "c11:c22:5c33:c440:55c0:c66c:77:0"},
+ {{0,0,16#5c33,16#c440,16#55c0,16#c66c,16#77,16#88},
+ "::5c33:c440:55c0:c66c:77:88"},
{{16#c11,0,0,16#c440,16#55c0,16#c66c,16#77,16#88},
- "c11::c440:55c0:c66c:77:0088"},
+ "c11::c440:55c0:c66c:77:88"},
{{16#c11,16#c22,0,0,16#55c0,16#c66c,16#77,16#88},
- "c11:0c22::55c0:c66c:77:0088"},
+ "c11:c22::55c0:c66c:77:88"},
{{16#c11,16#c22,16#5c33,0,0,16#c66c,16#77,16#88},
- "c11:0c22:5c33::c66c:77:0088"},
+ "c11:c22:5c33::c66c:77:88"},
{{16#c11,16#c22,16#5c33,16#c440,0,0,16#77,16#88},
- "c11:0c22:5c33:c440::77:0088"},
+ "c11:c22:5c33:c440::77:88"},
{{16#c11,16#c22,16#5c33,16#c440,16#55c0,0,0,16#88},
- "c11:0c22:5c33:c440:55c0::0088"},
+ "c11:c22:5c33:c440:55c0::88"},
+ {{16#c11,16#c22,16#5c33,16#c440,16#55c0,16#c66c,0,0},
+ "c11:c22:5c33:c440:55c0:c66c::"},
+ {{0,0,0,16#c440,16#55c0,16#c66c,16#77,16#88},
+ "::c440:55c0:c66c:77:88"},
{{16#c11,0,0,0,16#55c0,16#c66c,16#77,16#88},
- "c11::55c0:c66c:77:0088"},
+ "c11::55c0:c66c:77:88"},
{{16#c11,16#c22,0,0,0,16#c66c,16#77,16#88},
- "c11:0c22::c66c:77:0088"},
+ "c11:c22::c66c:77:88"},
{{16#c11,16#c22,16#5c33,0,0,0,16#77,16#88},
- "c11:0c22:5c33::77:0088"},
+ "c11:c22:5c33::77:88"},
{{16#c11,16#c22,16#5c33,16#c440,0,0,0,16#88},
- "c11:0c22:5c33:c440::0088"},
+ "c11:c22:5c33:c440::88"},
+ {{16#c11,16#c22,16#5c33,16#c440,16#55c0,0,0,0},
+ "c11:c22:5c33:c440:55c0::"},
+ {{0,0,0,0,16#55c0,16#c66c,16#77,16#88},
+ "::55c0:c66c:77:88"},
{{16#c11,0,0,0,0,16#c66c,16#77,16#88},
- "c11::c66c:77:0088"},
+ "c11::c66c:77:88"},
{{16#c11,16#c22,0,0,0,0,16#77,16#88},
- "c11:0c22::77:0088"},
+ "c11:c22::77:88"},
{{16#c11,16#c22,16#5c33,0,0,0,0,16#88},
- "c11:0c22:5c33::0088"},
+ "c11:c22:5c33::88"},
+ {{16#c11,16#c22,16#5c33,16#c440,0,0,0,0},
+ "c11:c22:5c33:c440::"},
+ {{0,0,0,0,0,16#c66c,16#77,16#88},
+ "::c66c:77:88"},
{{16#c11,0,0,0,0,0,16#77,16#88},
- "c11::77:0088"},
+ "c11::77:88"},
{{16#c11,16#c22,0,0,0,0,0,16#88},
- "c11:0c22::0088"},
- {{0,0,0,0,0,65535,258,65534},"::FFFF:1.2.255.254"},
+ "c11:c22::88"},
+ {{16#c11,16#c22,16#5c33,0,0,0,0,0},
+ "c11:c22:5c33::"},
+ {{0,0,0,0,0,65535,258,65534},"::ffff:1.2.255.254"},
+ {{16#fe80,12345,0,0,0,0,0,16#12},"fe80::12%012345"},
{{16#ffff,16#ffff,16#ffff,16#ffff,16#ffff,16#ffff,16#ffff,16#ffff},
"ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"}
- |[{{D2,0,0,0,0,P,(D1 bsl 8) bor D2,(D3 bsl 8) bor D4},
- erlang:integer_to_list(D2, 16)++"::"++Q++S}
- || {{D1,D2,D3,D4},S} <- V4Strict,
- {P,Q} <- [{0,""},{16#17,"17:"},{16#ff0,"0ff0:"}]]],
+ |[{list_to_tuple(P++[(D1 bsl 8) bor D2,(D3 bsl 8) bor D4]),
+ Q++S}
+ || {{D1,D2,D3,D4},S} <-
+ tl(V4Reversable),
+ {P,Q} <-
+ [{[0,0,0,0,0,16#ffff],"::ffff:"},
+ {[0,0,0,0,0,0],"::"}]]],
V4Sloppy =
[{{10,1,16#98,16#76},"10.0x019876"},
{{8#12,1,8#130,8#321},"012.01.054321"},
- {{255,255,255,255},"255.255.255.0377"},
- {{255,255,255,255},"0Xff.000000000377.0x0000ff.255"},
- {{255,255,255,255},"255.255.65535"},
- {{255,255,255,255},"255.0xFF.0177777"},
- {{255,255,255,255},"255.16777215"},
- {{255,255,255,255},"00377.0XFFFFFF"},
- {{255,255,255,255},"4294967295"},
- {{255,255,255,255},"0xffffffff"},
- {{255,255,255,255},"00000000000037777777777"},
+ {{252,253,254,255},"252.253.254.0377"},
+ {{252,253,254,255},"0Xfc.000000000375.0x0000fe.255"},
+ {{252,253,254,255},"252.253.65279"},
+ {{252,253,254,255},"252.0xFD.0177377"},
+ {{252,253,254,255},"252.16645887"},
+ {{252,253,254,255},"00374.0XFDFEFF"},
+ {{252,253,254,255},"4244504319"},
+ {{252,253,254,255},"0xfcfdfeff"},
+ {{252,253,254,255},"00000000000037477377377"},
{{16#12,16#34,16#56,16#78},"0x12345678"},
{{16#12,16#34,16#56,16#78},"0x12.0x345678"},
{{16#12,16#34,16#56,16#78},"0x12.0X34.0x5678"},
@@ -543,8 +577,14 @@ parse_address(Config) when is_list(Config) ->
{{0,0,0,0},"0.00.0.0"},
{{0,0,0,0},"0.0.000000000000.0"}],
V6Sloppy =
- [{{0,0,0,0,0,65535,(D1 bsl 8) bor D2,(D3 bsl 8) bor D4},S}
- || {{D1,D2,D3,D4},S} <- V4Strict++V4Sloppy],
+ [{{16#a,16#b,16#c,16#0,16#0,16#d,16#e,16#f},"A:B:C::d:e:f"},
+ {{16#fe80,0,0,0,0,0,0,16#12},"fe80::12%XXXXXXX"}]
+ ++
+ [{{P,0,0,0,0,D2,(D1 bsl 8) bor D2,(D3 bsl 8) bor D4},
+ Q++erlang:integer_to_list(D2, 16)++":"++S}
+ || {{D1,D2,D3,D4},S} <- V4Reversable,
+ {P,Q} <-
+ [{16#2001,"2001::"},{16#177,"177::"},{16#ff0,"Ff0::"}]],
V4Err =
["0.256.0.1",
"1.2.3.4.5",
@@ -588,28 +628,36 @@ parse_address(Config) when is_list(Config) ->
"fec0::fFfF:127.0.0.1."],
t_parse_address
(parse_ipv6_address,
- V6Strict++V6Sloppy++V6Err++V4Err),
+ false,
+ V6Reversable++V6Sloppy++V6Err++V4Err),
t_parse_address
(parse_ipv6strict_address,
- V6Strict++V6Err++V4Err++[S || {_,S} <- V6Sloppy]),
+ true,
+ V6Reversable++V6Err++V4Err),
t_parse_address
(parse_ipv4_address,
- V4Strict++V4Sloppy++V4Err++V6Err++[S || {_,S} <- V6Strict]),
+ false,
+ V4Reversable++V4Sloppy++V4Err++V6Err++[S || {_,S} <- V6Reversable]),
t_parse_address
(parse_ipv4strict_address,
- V4Strict++V4Err++V6Err++[S || {_,S} <- V4Sloppy++V6Strict]).
+ true,
+ V4Reversable++V4Err++V6Err++[S || {_,S} <- V4Sloppy++V6Reversable]).
-t_parse_address(Func, []) ->
+t_parse_address(Func, _Reversable, []) ->
io:format("~p done.~n", [Func]),
ok;
-t_parse_address(Func, [{Addr,String}|L]) ->
+t_parse_address(Func, Reversable, [{Addr,String}|L]) ->
io:format("~p = ~p.~n", [Addr,String]),
{ok,Addr} = inet:Func(String),
- t_parse_address(Func, L);
-t_parse_address(Func, [String|L]) ->
+ case Reversable of
+ true ->String = inet:ntoa(Addr);
+ false -> ok
+ end,
+ t_parse_address(Func, Reversable, L);
+t_parse_address(Func, Reversable, [String|L]) ->
io:format("~p.~n", [String]),
{error,einval} = inet:Func(String),
- t_parse_address(Func, L).
+ t_parse_address(Func, Reversable, L).
parse_strict_address(Config) when is_list(Config) ->
{ok, {127,0,0,1}} =
diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl
index 9413cbd976..ada9c2689c 100644
--- a/lib/kernel/test/inet_sockopt_SUITE.erl
+++ b/lib/kernel/test/inet_sockopt_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl
index 3cbb75a633..53a9e168ef 100644
--- a/lib/kernel/test/os_SUITE.erl
+++ b/lib/kernel/test/os_SUITE.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.
@@ -319,31 +319,38 @@ perf_counter_api(_Config) ->
true = is_integer(os:perf_counter()),
true = os:perf_counter() > 0,
- T1 = os:perf_counter(),
+ Conv = fun(T1, T2) ->
+ erlang:convert_time_unit(T2 - T1, perf_counter, nanosecond)
+ end,
+
+ do_perf_counter_test([], Conv, 120000000, 80000000),
+ do_perf_counter_test([1000], fun(T1, T2) -> T2 - T1 end, 120, 80).
+
+do_perf_counter_test(CntArgs, Conv, Upper, Lower) ->
+ %% We run the test multiple times to try to get a somewhat
+ %% stable value... what does this test? That the
+ %% calculate_perf_counter_unit in sys_time.c works somewhat ok.
+ do_perf_counter_test(CntArgs, Conv, Upper, Lower, 10).
+
+do_perf_counter_test(CntArgs, _Conv, Upper, Lower, 0) ->
+ ct:fail("perf_counter_test ~p ~p ~p",[CntArgs, Upper, Lower]);
+do_perf_counter_test(CntArgs, Conv, Upper, Lower, Iters) ->
+
+ T1 = apply(os, perf_counter, CntArgs),
timer:sleep(100),
- T2 = os:perf_counter(),
- TsDiff = erlang:convert_time_unit(T2 - T1, perf_counter, nanosecond),
- ct:pal("T1: ~p~n"
+ T2 = apply(os, perf_counter, CntArgs),
+ TsDiff = Conv(T1, T2),
+ ct:log("T1: ~p~n"
"T2: ~p~n"
"TsDiff: ~p~n",
[T1,T2,TsDiff]),
- %% We allow a 15% diff
- true = TsDiff < 115000000,
- true = TsDiff > 85000000,
-
- T1Ms = os:perf_counter(1000),
- timer:sleep(100),
- T2Ms = os:perf_counter(1000),
- MsDiff = T2Ms - T1Ms,
- ct:pal("T1Ms: ~p~n"
- "T2Ms: ~p~n"
- "MsDiff: ~p~n",
- [T1Ms,T2Ms,MsDiff]),
-
- %% We allow a 15% diff
- true = MsDiff < 115,
- true = MsDiff > 85.
+ if
+ TsDiff < Upper, TsDiff > Lower ->
+ ok;
+ true ->
+ do_perf_counter_test(CntArgs, Conv, Upper, Lower, Iters-1)
+ end.
%% Util functions
diff --git a/lib/kernel/test/sendfile_SUITE.erl b/lib/kernel/test/sendfile_SUITE.erl
index 2673c38494..bfa564c32c 100644
--- a/lib/kernel/test/sendfile_SUITE.erl
+++ b/lib/kernel/test/sendfile_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -100,13 +100,13 @@ init_per_testcase(TC,Config) when TC == t_sendfile_recvduring;
%% Check if sendfile is supported on this platform
case catch sendfile_send(Send) of
ok ->
- Config;
+ init_per_testcase(t_sendfile, Config);
Error ->
ct:log("Error: ~p",[Error]),
{skip,"Not supported"}
end;
init_per_testcase(_Tc,Config) ->
- Config.
+ Config ++ [{sendfile_opts,[{use_threads,false}]}].
t_sendfile_small(Config) when is_list(Config) ->
diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk
index 76b020e8ed..c9463241d1 100644
--- a/lib/kernel/vsn.mk
+++ b/lib/kernel/vsn.mk
@@ -1 +1 @@
-KERNEL_VSN = 5.2
+KERNEL_VSN = 5.3.1
diff --git a/lib/megaco/doc/src/notes.xml b/lib/megaco/doc/src/notes.xml
index a05a339003..068389c0c2 100644
--- a/lib/megaco/doc/src/notes.xml
+++ b/lib/megaco/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2000</year><year>2016</year>
+ <year>2000</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -37,7 +37,22 @@
section is the version number of Megaco.</p>
- <section><title>Megaco 3.18.1</title>
+ <section><title>Megaco 3.18.2</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Typos have been fixed.</p>
+ <p>
+ Own Id: OTP-14387</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Megaco 3.18.1</title>
<section><title>Improvements and New Features</title>
<list>
diff --git a/lib/megaco/vsn.mk b/lib/megaco/vsn.mk
index 0d40f863b2..9c6ba5bba0 100644
--- a/lib/megaco/vsn.mk
+++ b/lib/megaco/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 = megaco
-MEGACO_VSN = 3.18.1
+MEGACO_VSN = 3.18.2
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(MEGACO_VSN)$(PRE_VSN)"
diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml
index 062a62298b..3ca4026190 100644
--- a/lib/mnesia/doc/src/notes.xml
+++ b/lib/mnesia/doc/src/notes.xml
@@ -39,7 +39,26 @@
thus constitutes one section in this document. The title of each
section is the version number of Mnesia.</p>
- <section><title>Mnesia 4.14.3</title>
+ <section><title>Mnesia 4.15</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Removed the wrapping of select continuations in extension
+ plugin handling. This might require the user to rewrite
+ user backend plugin if used.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14039</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Mnesia 4.14.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl
index 17b47c059e..6b93935cb4 100644
--- a/lib/mnesia/src/mnesia_controller.erl
+++ b/lib/mnesia/src/mnesia_controller.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.
@@ -1888,7 +1888,7 @@ info_format(Tab, Size, Mem, Media) ->
StrT = mnesia_lib:pad_name(atom_to_list(Tab), 15, []),
StrS = mnesia_lib:pad_name(integer_to_list(Size), 8, []),
StrM = mnesia_lib:pad_name(integer_to_list(Mem), 8, []),
- io:format("~s: with ~s records occupying ~s ~s~n",
+ io:format("~ts: with ~s records occupying ~s ~s~n",
[StrT, StrS, StrM, Media]).
%% Handle early arrived messages
diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk
index e272a469bb..81b15d65db 100644
--- a/lib/mnesia/vsn.mk
+++ b/lib/mnesia/vsn.mk
@@ -1 +1 @@
-MNESIA_VSN = 4.14.3
+MNESIA_VSN = 4.15
diff --git a/lib/observer/doc/src/notes.xml b/lib/observer/doc/src/notes.xml
index bd9aa265f8..d329be5d5a 100644
--- a/lib/observer/doc/src/notes.xml
+++ b/lib/observer/doc/src/notes.xml
@@ -32,6 +32,63 @@
<p>This document describes the changes made to the Observer
application.</p>
+<section><title>Observer 2.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ <c>etop</c> had a hardcoded timeout value of 1 second
+ when waiting for data from a remote node. When this
+ expired, which could happen for instance if there were
+ very many processes on the remote node, etop would exit
+ with reason <c>connection_lost</c>. To overcome this
+ problem, the timeout is now changed to be the same as the
+ update interval, which is configurable.</p>
+ <p>
+ Own Id: OTP-14393</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Show dirty-scheduler threads in performance monitor graph
+ and add a column with maximum allocated memory in the
+ Memory Allocators table.</p>
+ <p>
+ Own Id: OTP-14137</p>
+ </item>
+ <item>
+ <p>
+ Keep table and port selection after refresh of tables.
+ Store settings before shutdown and restore when starting
+ application.</p>
+ <p>
+ Own Id: OTP-14270</p>
+ </item>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ <item>
+ <p>
+ When observing a node older than OTP-19.0, a pop-up will
+ be displayed when trying to access port information.
+ Earlier, observer would crash in this situation.</p>
+ <p>
+ Own Id: OTP-14345 Aux Id: ERL-399 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Observer 2.3.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/observer/src/etop.erl b/lib/observer/src/etop.erl
index 2093e6a0d7..f0990f1f25 100644
--- a/lib/observer/src/etop.erl
+++ b/lib/observer/src/etop.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2002-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.
@@ -81,7 +81,7 @@ check_runtime_config(accumulate,A) when A=:=true; A=:=false -> ok;
check_runtime_config(_Key,_Value) -> error.
dump(File) ->
- case file:open(File,[write]) of
+ case file:open(File,[write,{encoding,utf8}]) of
{ok,Fd} -> etop_server ! {dump,Fd};
Error -> Error
end.
@@ -161,7 +161,7 @@ data_handler(Reader, Opts) ->
{'EXIT', EPid, Reason} when EPid == Opts#opts.out_proc ->
case Reason of
normal -> ok;
- _ -> io:format("Output server crashed: ~p~n",[Reason])
+ _ -> io:format("Output server crashed: ~tp~n",[Reason])
end,
stop(Opts),
out_proc_stopped;
diff --git a/lib/observer/src/etop_txt.erl b/lib/observer/src/etop_txt.erl
index 6b8f9df24f..183641119a 100644
--- a/lib/observer/src/etop_txt.erl
+++ b/lib/observer/src/etop_txt.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2002-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,8 +29,6 @@
-import(etop,[loadinfo/2,meminfo/2]).
--define(PROCFORM,"~-15w~-20s~8w~8w~8w~8w ~-20s~n").
-
stop(Pid) -> Pid ! stop.
init(Config) ->
@@ -50,6 +48,7 @@ do_update(Prev,Config) ->
do_update(standard_io,Info,Prev,Config).
do_update(Fd,Info,Prev,Config) ->
+ Encoding = encoding(Fd),
{Cpu,NProcs,RQ,Clock} = loadinfo(Info,Prev),
io:nl(Fd),
writedoubleline(Fd),
@@ -73,7 +72,7 @@ do_update(Fd,Info,Prev,Config) ->
io:nl(Fd),
writepinfo_header(Fd),
writesingleline(Fd),
- writepinfo(Fd,Info#etop_info.procinfo),
+ writepinfo(Fd,Info#etop_info.procinfo,Encoding),
writedoubleline(Fd),
io:nl(Fd),
Info.
@@ -93,19 +92,37 @@ writepinfo(Fd,[#etop_proc_info{pid=Pid,
runtime=Time,
cf=MFA,
mq=MQ}
- |T]) ->
- io:fwrite(Fd,?PROCFORM,[Pid,to_list(Name),Time,Reds,Mem,MQ,formatmfa(MFA)]),
- writepinfo(Fd,T);
-writepinfo(_Fd,[]) ->
+ |T],
+ Encoding) ->
+ io:fwrite(Fd,proc_format(Encoding),
+ [Pid,to_list(Name,Encoding),Time,Reds,Mem,MQ,
+ formatmfa(MFA,Encoding)]),
+ writepinfo(Fd,T,Encoding);
+writepinfo(_Fd,[],_) ->
ok.
-formatmfa({M, F, A}) ->
+formatmfa({M, F, A},latin1) ->
io_lib:format("~w:~w/~w",[M, F, A]);
-formatmfa(Other) ->
+formatmfa({M, F, A},_) ->
+ io_lib:format("~w:~tw/~w",[M, F, A]);
+formatmfa(Other,_) ->
%% E.g. when running hipe - the current_function for some
%% processes will be 'undefined'
io_lib:format("~w",[Other]).
-to_list(Name) when is_atom(Name) -> atom_to_list(Name);
-to_list({_M,_F,_A}=MFA) -> formatmfa(MFA).
+to_list(Name,_) when is_atom(Name) -> atom_to_list(Name);
+to_list({_M,_F,_A}=MFA,Encoding) -> formatmfa(MFA,Encoding).
+
+encoding(Device) ->
+ case io:getopts(Device) of
+ List when is_list(List) ->
+ proplists:get_value(encoding,List,latin1);
+ _ ->
+ latin1
+ end.
+
+proc_format(latin1) ->
+ "~-15w~-20s~8w~8w~8w~8w ~-20s~n";
+proc_format(_) ->
+ "~-15w~-20ts~8w~8w~8w~8w ~-20ts~n".
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 7352af936c..8b6036f52a 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -297,6 +297,8 @@ to_str(No) when is_integer(No) ->
integer_to_list(No);
to_str(Float) when is_float(Float) ->
io_lib:format("~.3f", [Float]);
+to_str({trunc, Float}) when is_float(Float) ->
+ float_to_list(Float, [{decimals,0}]);
to_str(Term) ->
io_lib:format("~w", [Term]).
@@ -636,12 +638,12 @@ user_term_multiline(Parent, Title, Default) ->
parse_string(Str) ->
try
- Tokens = case erl_scan:string(Str) of
+ Tokens = case erl_scan:string(Str, 1, [text]) of
{ok, Ts, _} -> Ts;
{error, {_SLine, SMod, SError}, _} ->
throw(io_lib:format("~s", [SMod:format_error(SError)]))
end,
- case erl_parse:parse_term(Tokens) of
+ case lib:extended_parse_term(Tokens) of
{error, {_PLine, PMod, PError}} ->
throw(io_lib:format("~s", [PMod:format_error(PError)]));
Res -> Res
diff --git a/lib/observer/src/observer_sys_wx.erl b/lib/observer/src/observer_sys_wx.erl
index db86c05bed..2e1af3ada9 100644
--- a/lib/observer/src/observer_sys_wx.erl
+++ b/lib/observer/src/observer_sys_wx.erl
@@ -48,7 +48,7 @@ start_link(Notebook, Parent, Config) ->
init([Notebook, Parent, Config]) ->
SysInfo = observer_backend:sys_info(),
- {Sys, Mem, Cpu, Stats} = info_fields(),
+ {Sys, Mem, Cpu, Stats, Limits} = info_fields(),
Panel = wxPanel:new(Notebook),
Sizer = wxBoxSizer:new(?wxVERTICAL),
HSizer0 = wxBoxSizer:new(?wxHORIZONTAL),
@@ -63,17 +63,26 @@ init([Notebook, Parent, Config]) ->
wxSizer:add(HSizer1, FPanel2, [{flag, ?wxEXPAND}, {proportion, 1}]),
wxSizer:add(HSizer1, FPanel3, [{flag, ?wxEXPAND}, {proportion, 1}]),
+ HSizer2 = wxBoxSizer:new(?wxHORIZONTAL),
+ {FPanel4, _FSizer4, Fields4} = observer_lib:display_info(Panel, observer_lib:fill_info(Limits, SysInfo)),
+ wxSizer:add(HSizer2, FPanel4, [{flag, ?wxEXPAND}, {proportion, 1}]),
+
+
BorderFlags = ?wxLEFT bor ?wxRIGHT,
wxSizer:add(Sizer, HSizer0, [{flag, ?wxEXPAND bor BorderFlags bor ?wxTOP},
{proportion, 0}, {border, 5}]),
wxSizer:add(Sizer, HSizer1, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM},
{proportion, 0}, {border, 5}]),
+ wxSizer:add(Sizer, HSizer2, [{flag, ?wxEXPAND bor BorderFlags bor ?wxBOTTOM},
+ {proportion, 0}, {border, 5}]),
+
wxPanel:setSizer(Panel, Sizer),
Timer = observer_lib:start_timer(Config, 10),
{Panel, #sys_wx_state{parent=Parent,
parent_notebook=Notebook,
panel=Panel, sizer=Sizer,
- timer=Timer, fields=Fields0 ++ Fields1++Fields2++Fields3}}.
+ timer=Timer, fields=Fields0 ++ Fields1++Fields2++Fields3++Fields4}}.
+
create_sys_menu(Parent) ->
View = {"View", [#create_menu{id = ?ID_REFRESH, text = "Refresh\tCtrl-R"},
@@ -83,14 +92,40 @@ create_sys_menu(Parent) ->
update_syspage(#sys_wx_state{node = undefined}) -> ignore;
update_syspage(#sys_wx_state{node = Node, fields=Fields, sizer=Sizer}) ->
SysInfo = observer_wx:try_rpc(Node, observer_backend, sys_info, []),
- {Sys, Mem, Cpu, Stats} = info_fields(),
+ {Sys, Mem, Cpu, Stats, Limits} = info_fields(),
observer_lib:update_info(Fields,
observer_lib:fill_info(Sys, SysInfo) ++
observer_lib:fill_info(Mem, SysInfo) ++
observer_lib:fill_info(Cpu, SysInfo) ++
- observer_lib:fill_info(Stats, SysInfo)),
+ observer_lib:fill_info(Stats, SysInfo)++
+ observer_lib:fill_info(Limits, SysInfo)),
+
wxSizer:layout(Sizer).
+
+maybe_convert(undefined) -> "Not available";
+maybe_convert(V) -> observer_lib:to_str(V).
+
+get_dist_buf_busy_limit_info() ->
+ fun(Data) ->
+ maybe_convert(proplists:get_value(dist_buf_busy_limit, Data))
+ end.
+
+get_limit_count_info(Count, Limit) ->
+ fun(Data) ->
+ C = proplists:get_value(Count, Data),
+ L = proplists:get_value(Limit, Data),
+ lists:flatten(
+ io_lib:format("~s / ~s ~s",
+ [maybe_convert(C), maybe_convert(L),
+ if
+ C =:= undefined -> "";
+ L =:= undefined -> "";
+ true -> io_lib:format("(~s % used)",[observer_lib:to_str({trunc, (C / L) *100})])
+ end]))
+ end.
+
+
info_fields() ->
Sys = [{"System and Architecture",
[{"System Version", otp_release},
@@ -122,14 +157,20 @@ info_fields() ->
]}],
Stats = [{"Statistics", right,
[{"Up time", {time_ms, uptime}},
- {"Max Processes", process_limit},
- {"Processes", process_count},
{"Run Queue", run_queue},
{"IO Input", {bytes, io_input}},
{"IO Output", {bytes, io_output}}
]}
],
- {Sys, Mem, Cpu, Stats}.
+ Limits = [{"System statistics / limit",
+ [{"Atoms", get_limit_count_info(atom_count, atom_limit)},
+ {"Processes", get_limit_count_info(process_count, process_limit)},
+ {"Ports", get_limit_count_info(port_count, port_limit)},
+ {"ETS", get_limit_count_info(ets_count, ets_limit)},
+ {"Distribution buffer busy limit", get_dist_buf_busy_limit_info()}
+ ]}],
+ {Sys, Mem, Cpu, Stats, Limits}.
+
%%%%%%%%%%%%%%%%%%%%%%% Callbacks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl
index 87a50e046b..09b0bc6710 100644
--- a/lib/observer/src/ttb.erl
+++ b/lib/observer/src/ttb.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2002-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.
@@ -391,16 +391,16 @@ run_config(ConfigFile,N) ->
print_func(M,F,A) ->
Args = arg_list(A,[]),
- io:format("~w:~w(~s) ->~n",[M,F,Args]).
+ io:format("~w:~tw(~ts) ->~n",[M,F,Args]).
print_result(R) ->
- io:format("~p~n~n",[R]).
+ io:format("~tp~n~n",[R]).
arg_list([],[]) ->
"";
arg_list([A1],Acc) ->
- Acc++io_lib:format("~w",[A1]);
+ Acc++io_lib:format("~tw",[A1]);
arg_list([A1|A],Acc) ->
- arg_list(A,Acc++io_lib:format("~w,",[A1])).
+ arg_list(A,Acc++io_lib:format("~tw,",[A1])).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1117,7 +1117,7 @@ get_fd(Out) ->
Out;
_file ->
file:delete(Out),
- case file:open(Out,[append]) of
+ case file:open(Out,[append,{encoding,utf8}]) of
{ok,Fd} -> Fd;
Error -> exit(Error)
end
diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk
index ca9ad72473..21edfcd184 100644
--- a/lib/observer/vsn.mk
+++ b/lib/observer/vsn.mk
@@ -1 +1 @@
-OBSERVER_VSN = 2.3.1
+OBSERVER_VSN = 2.4
diff --git a/lib/orber/test/multi_ORB_SUITE.erl b/lib/orber/test/multi_ORB_SUITE.erl
index 8becc11d6a..3c5bb0b5e5 100644
--- a/lib/orber/test/multi_ORB_SUITE.erl
+++ b/lib/orber/test/multi_ORB_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.
diff --git a/lib/orber/test/orber_test_lib.erl b/lib/orber/test/orber_test_lib.erl
index 4a247ce492..9b19c4bc4e 100644
--- a/lib/orber/test/orber_test_lib.erl
+++ b/lib/orber/test/orber_test_lib.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.
diff --git a/lib/parsetools/doc/src/notes.xml b/lib/parsetools/doc/src/notes.xml
index 5a16445577..3fa7169f50 100644
--- a/lib/parsetools/doc/src/notes.xml
+++ b/lib/parsetools/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>1997</year><year>2016</year>
+ <year>1997</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -31,6 +31,33 @@
</header>
<p>This document describes the changes made to the Parsetools application.</p>
+<section><title>Parsetools 2.1.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Minor documentation fixes</p>
+ <p>
+ Own Id: OTP-14276 Aux Id: PR-1357 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Parsetools 2.1.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/parsetools/include/yeccpre.hrl b/lib/parsetools/include/yeccpre.hrl
index fe958e9738..91d6cd49a6 100644
--- a/lib/parsetools/include/yeccpre.hrl
+++ b/lib/parsetools/include/yeccpre.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2015. 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.
@@ -151,21 +151,20 @@ yecctoken_location(Token) ->
end.
-compile({nowarn_unused_function, yecctoken2string/1}).
-yecctoken2string({atom, _, A}) -> io_lib:write(A);
+yecctoken2string({atom, _, A}) -> io_lib:write_atom(A);
yecctoken2string({integer,_,N}) -> io_lib:write(N);
yecctoken2string({float,_,F}) -> io_lib:write(F);
yecctoken2string({char,_,C}) -> io_lib:write_char(C);
yecctoken2string({var,_,V}) -> io_lib:format("~s", [V]);
yecctoken2string({string,_,S}) -> io_lib:write_string(S);
yecctoken2string({reserved_symbol, _, A}) -> io_lib:write(A);
-yecctoken2string({_Cat, _, Val}) -> io_lib:format("~p",[Val]);
+yecctoken2string({_Cat, _, Val}) -> io_lib:format("~tp", [Val]);
yecctoken2string({dot, _}) -> "'.'";
-yecctoken2string({'$end', _}) ->
- [];
+yecctoken2string({'$end', _}) -> [];
yecctoken2string({Other, _}) when is_atom(Other) ->
- io_lib:write(Other);
+ io_lib:write_atom(Other);
yecctoken2string(Other) ->
- io_lib:write(Other).
+ io_lib:format("~tp", [Other]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl
index 48559ec402..36e33b52a4 100644
--- a/lib/parsetools/src/yecc.erl
+++ b/lib/parsetools/src/yecc.erl
@@ -2597,18 +2597,18 @@ format_symbol(Symbol) ->
String = concat([Symbol]),
case erl_scan:string(String) of
{ok, [{atom, _, _}], _} ->
- io_lib:fwrite(<<"~w">>, [Symbol]);
+ io_lib:fwrite(<<"~tw">>, [Symbol]);
{ok, [{Word, _}], _} when Word =/= ':', Word =/= '->' ->
case erl_scan:reserved_word(Word) of
true ->
String;
false ->
- io_lib:fwrite(<<"~w">>, [Symbol])
+ io_lib:fwrite(<<"~tw">>, [Symbol])
end;
{ok, [{var, _, _}], _} ->
String;
_ ->
- io_lib:fwrite(<<"~w">>, [Symbol])
+ io_lib:fwrite(<<"~tw">>, [Symbol])
end.
inverse(L) ->
diff --git a/lib/parsetools/vsn.mk b/lib/parsetools/vsn.mk
index d102c63730..502ca00a47 100644
--- a/lib/parsetools/vsn.mk
+++ b/lib/parsetools/vsn.mk
@@ -1 +1 @@
-PARSETOOLS_VSN = 2.1.4
+PARSETOOLS_VSN = 2.1.5
diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml
index dd83e1961d..64592a6d87 100644
--- a/lib/public_key/doc/src/notes.xml
+++ b/lib/public_key/doc/src/notes.xml
@@ -35,6 +35,41 @@
<file>notes.xml</file>
</header>
+<section><title>Public_Key 1.4.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Bug for <c>public_key:generate_key({namedCurve,OID})</c>
+ fixed.</p>
+ <p>
+ Own Id: OTP-14258</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Modernized internal representation used for crl
+ validation by use of maps.</p>
+ <p>
+ Own Id: OTP-14111</p>
+ </item>
+ <item>
+ <p>
+ Support EC key in pkix_sign/2</p>
+ <p>
+ Own Id: OTP-14294</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Public_Key 1.4</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml
index 04966ffb9c..942203bd12 100644
--- a/lib/public_key/doc/src/public_key.xml
+++ b/lib/public_key/doc/src/public_key.xml
@@ -129,18 +129,31 @@
<p><c>| 'rsa_no_padding'</c></p>
</item>
+ <tag><c>public_sign_options() =</c></tag>
+ <item><p><c>[{rsa_pad, rsa_sign_padding()} | {rsa_pss_saltlen, integer()}]</c></p></item>
+
+ <tag><c>rsa_sign_padding() =</c></tag>
+ <item>
+ <p><c>'rsa_pkcs1_padding'</c></p>
+ <p><c>| 'rsa_pkcs1_pss_padding'</c></p>
+ </item>
+
<tag><c>digest_type() = </c></tag>
<item><p>Union of <c>rsa_digest_type()</c>, <c>dss_digest_type()</c>,
and <c>ecdsa_digest_type()</c>.</p></item>
<tag><c>rsa_digest_type() = </c></tag>
- <item><p><c>'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item>
+ <item><p><c>'md5' | 'ripemd160' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item>
<tag><c>dss_digest_type() = </c></tag>
- <item><p><c>'sha'</c></p></item>
+ <item><p><c>'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p>
+ <p>Note that the actual supported dss_digest_type depends on the underlying crypto library.
+ In OpenSSL version >= 1.0.1 the listed digest are supported, while in 1.0.0 only
+ sha, sha224 and sha256 are supported. In version 0.9.8 only sha is supported.</p>
+ </item>
<tag><c>ecdsa_digest_type() = </c></tag>
- <item><p><c>'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item>
+ <item><p><c>'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'</c></p></item>
<tag><c>crl_reason() = </c></tag>
<item>
@@ -621,8 +634,8 @@ fun(OtpCert :: #'OTPCertificate'{},
<v>OTPCertificate = #'OTPCertificate'{}</v>
<v>DPAndCRLs = [{DP::#'DistributionPoint'{}, {DerCRL::der_encoded(), CRL::#'CertificateList'{}}}] </v>
<v>Options = proplists:proplist()</v>
- <v>CRLStatus() = valid | {bad_cert, revocation_status_undetermined} |
- {bad_cert, {revoked, crl_reason()}}</v>
+ <v>CRLStatus() = valid | {bad_cert, revocation_status_undetermined} | {bad_cert, {revocation_status_undetermined,
+ {bad_crls, Details::term()}}} | {bad_cert, {revoked, crl_reason()}}</v>
</type>
<desc>
<p>Performs CRL validation. It is intended to be called from
@@ -650,7 +663,7 @@ fun(OtpCert :: #'OTPCertificate'{},
<tag>{issuer_fun, fun()}</tag>
<item>
<p>The fun has the following type specification:</p>
-
+
<code>
fun(#'DistributionPoint'{}, #'CertificateList'{},
{rdnSequence,[#'AttributeTypeAndValue'{}]}, term()) ->
@@ -660,7 +673,15 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
that has signed the CRL.
</p>
<code> fun(DP, CRL, Issuer, UserState) -> {ok, RootCert, CertChain}</code>
- </item>
+ </item>
+
+ <tag>{undetermined_details, boolean()}</tag>
+ <item>
+ <p>Defaults to false. When revocation status can not be
+ determined, and this option is set to true, details of why no
+ CRLs where accepted are included in the return value.</p>
+ </item>
+
</taglist>
</desc>
</func>
@@ -795,6 +816,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<func>
<name>sign(Msg, DigestType, Key) -> binary()</name>
+ <name>sign(Msg, DigestType, Key, Options) -> binary()</name>
<fsummary>Creates a digital signature.</fsummary>
<type>
<v>Msg = binary() | {digest,binary()}</v>
@@ -803,6 +825,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
digest.</d>
<v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Key = rsa_private_key() | dsa_private_key() | ec_private_key()</v>
+ <v>Options = public_sign_options()</v>
</type>
<desc>
<p>Creates a digital signature.</p>
@@ -895,6 +918,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<func>
<name>verify(Msg, DigestType, Signature, Key) -> boolean()</name>
+ <name>verify(Msg, DigestType, Signature, Key, Options) -> boolean()</name>
<fsummary>Verifies a digital signature.</fsummary>
<type>
<v>Msg = binary() | {digest,binary()}</v>
@@ -903,6 +927,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Signature = binary()</v>
<v>Key = rsa_public_key() | dsa_public_key() | ec_public_key()</v>
+ <v>Options = public_sign_options()</v>
</type>
<desc>
<p>Verifies a digital signature.</p>
diff --git a/lib/public_key/include/public_key.hrl b/lib/public_key/include/public_key.hrl
index a1e7dd31bc..663e1856ac 100644
--- a/lib/public_key/include/public_key.hrl
+++ b/lib/public_key/include/public_key.hrl
@@ -70,7 +70,8 @@
reasons_mask,
cert_status,
interim_reasons_mask,
- valid_ext
+ valid_ext,
+ details
}).
-record('ECPoint', {
diff --git a/lib/public_key/src/pubkey_crl.erl b/lib/public_key/src/pubkey_crl.erl
index 33bef91827..3621e9c0da 100644
--- a/lib/public_key/src/pubkey_crl.erl
+++ b/lib/public_key/src/pubkey_crl.erl
@@ -58,7 +58,8 @@ validate(OtpCert, OtherDPCRLs, DP, {DerCRL, CRL}, {DerDeltaCRL, DeltaCRL},
init_revokation_state() ->
#revoke_state{reasons_mask = sets:new(),
interim_reasons_mask = sets:new(),
- cert_status = unrevoked}.
+ cert_status = unrevoked,
+ details = []}.
fresh_crl(_, {undefined, undefined}, _) ->
%% Typically happens when there is no delta CRL that covers a CRL
@@ -152,9 +153,10 @@ verify_crl(OtpCert, DP, CRL, DerCRL, DeltaCRL, DerDeltaCRL, OtherDPCRLs,
RevokedState,
CRL, DerCRL, DeltaCRL, DerDeltaCRL,
IssuerFun, TrustedOtpCert, Path, OtherDPCRLs, IDP);
- _ ->
- {invalid, State0#revoke_state{valid_ext = ValidExt}}
- end;
+ _ ->
+ Details = RevokedState#revoke_state.details,
+ {invalid, RevokedState#revoke_state{valid_ext = ValidExt, details = [{{bad_crl, no_issuer_cert_chain}, CRL} | Details]}}
+ end;
{error, issuer_not_found} ->
case Fun(DP, CRL, issuer_not_found, AdditionalArgs) of
{ok, TrustedOtpCert, Path} ->
@@ -163,13 +165,16 @@ verify_crl(OtpCert, DP, CRL, DerCRL, DeltaCRL, DerDeltaCRL, OtherDPCRLs,
DerDeltaCRL, IssuerFun,
TrustedOtpCert, Path, OtherDPCRLs, IDP);
_ ->
- {invalid, {skip, State0}}
- end
+ Details = State0#revoke_state.details,
+ {invalid, {skip, State0#revoke_state{details = [{{bad_crl, no_issuer_cert_chain}, CRL} | Details] }}}
+ end
catch
- throw:{bad_crl, invalid_issuer} ->
- {invalid, {skip, State0}};
- throw:_ ->
- {invalid, State0#revoke_state{valid_ext = ValidExt}}
+ throw:{bad_crl, invalid_issuer} = Reason ->
+ Details = RevokedState#revoke_state.details,
+ {invalid, {skip, RevokedState#revoke_state{details = [{Reason, CRL} | Details]}}};
+ throw:Reason ->
+ Details = RevokedState#revoke_state.details,
+ {invalid, RevokedState#revoke_state{details = [{Reason, CRL} | Details]}}
end.
verify_mask_and_signatures(Revoked, DeltaRevoked, RevokedState, CRL, DerCRL, DeltaCRL, DerDeltaCRL,
@@ -183,10 +188,12 @@ verify_mask_and_signatures(Revoked, DeltaRevoked, RevokedState, CRL, DerCRL, Del
TrustedOtpCert, Path, IssuerFun, OtherDPCRLs, IDP),
{valid, Revoked, DeltaRevoked, RevokedState#revoke_state{reasons_mask = ReasonsMask}, IDP}
catch
- throw:_ ->
- {invalid, RevokedState};
+ throw:Reason ->
+ Details = RevokedState#revoke_state.details,
+ {invalid, RevokedState#revoke_state{details = [{Reason, CRL} | Details]}};
error:{badmatch, _} ->
- {invalid, RevokedState}
+ Details = RevokedState#revoke_state.details,
+ {invalid, RevokedState#revoke_state{details = [{{bad_crl, invalid_signature}, CRL} | Details]}}
end.
@@ -356,7 +363,7 @@ verify_scope(#'OTPCertificate'{tbsCertificate = TBSCert}, #'DistributionPoint'{c
verify_scope(DPName, IDPName, Names, TBSCert, IDP).
verify_scope(asn1_NOVALUE, _, asn1_NOVALUE, _, _) ->
- throw({bad_crl, scope_error1});
+ throw({bad_crl, scope_error});
verify_scope(asn1_NOVALUE, IDPName, DPIssuerNames, TBSCert, IDP) ->
verify_dp_name(IDPName, DPIssuerNames),
verify_dp_bools(TBSCert, IDP);
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index ec0806e423..c2060c144c 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -37,7 +37,7 @@
decrypt_public/2, decrypt_public/3,
dh_gex_group/4,
dh_gex_group_sizes/0,
- sign/3, verify/4,
+ sign/3, sign/4, verify/4, verify/5,
generate_key/1,
compute_key/2, compute_key/3,
pkix_sign/2, pkix_verify/2,
@@ -90,10 +90,12 @@
auth_keys.
-type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding'
| 'rsa_no_padding'.
+-type rsa_sign_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_pss_padding'.
-type public_crypt_options() :: [{rsa_pad, rsa_padding()}].
--type rsa_digest_type() :: 'md5' | 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'.
--type dss_digest_type() :: 'none' | 'sha'. %% None is for backwards compatibility
--type ecdsa_digest_type() :: 'sha'| 'sha224' | 'sha256' | 'sha384' | 'sha512'.
+-type rsa_digest_type() :: 'md5' | 'ripemd160' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'.
+-type dss_digest_type() :: 'none' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'. %% None is for backwards compatibility
+-type ecdsa_digest_type() :: 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'.
+-type public_sign_options() :: [{rsa_pad, rsa_sign_padding()} | {rsa_pss_saltlen, integer()}].
-type digest_type() :: rsa_digest_type() | dss_digest_type() | ecdsa_digest_type().
-type crl_reason() :: unspecified | keyCompromise | cACompromise | affiliationChanged | superseded
| cessationOfOperation | certificateHold | privilegeWithdrawn | aACompromise.
@@ -417,7 +419,7 @@ generate_key({rsa, ModulusSize, PublicExponent}) ->
{[E, N], [E, N, D, P, Q, D_mod_P_1, D_mod_Q_1, InvQ_mod_P]} ->
Nint = crypto:bytes_to_integer(N),
Eint = crypto:bytes_to_integer(E),
- #'RSAPrivateKey'{version = 0, % Two-factor (I guess since otherPrimeInfos is not given)
+ #'RSAPrivateKey'{version = 'two-prime', % Two-factor (I guess since otherPrimeInfos is not given)
modulus = Nint,
publicExponent = Eint,
privateExponent = crypto:bytes_to_integer(D),
@@ -435,7 +437,7 @@ generate_key({rsa, ModulusSize, PublicExponent}) ->
% 1976.
Nint = crypto:bytes_to_integer(N),
Eint = crypto:bytes_to_integer(E),
- #'RSAPrivateKey'{version = 0, % Two-factor (I guess since otherPrimeInfos is not given)
+ #'RSAPrivateKey'{version = 'two-prime', % Two-factor (I guess since otherPrimeInfos is not given)
modulus = Nint,
publicExponent = Eint,
privateExponent = crypto:bytes_to_integer(D),
@@ -498,35 +500,67 @@ pkix_sign_types(?'ecdsa-with-SHA512') ->
{sha512, ecdsa}.
%%--------------------------------------------------------------------
--spec sign(binary() | {digest, binary()}, rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
- rsa_private_key() |
- dsa_private_key() | ec_private_key()) -> Signature :: binary().
-%% Description: Create digital signature.
-%%--------------------------------------------------------------------
-sign(DigestOrPlainText, DigestType, Key = #'RSAPrivateKey'{}) ->
- crypto:sign(rsa, DigestType, DigestOrPlainText, format_rsa_private_key(Key));
+-spec sign(binary() | {digest, binary()},
+ rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
+ rsa_private_key() | dsa_private_key() | ec_private_key()
+ ) -> Signature :: binary().
-sign(DigestOrPlainText, sha, #'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) ->
- crypto:sign(dss, sha, DigestOrPlainText, [P, Q, G, X]);
+-spec sign(binary() | {digest, binary()},
+ rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
+ rsa_private_key() | dsa_private_key() | ec_private_key(),
+ public_sign_options()
+ ) -> Signature :: binary().
-sign(DigestOrPlainText, DigestType, #'ECPrivateKey'{privateKey = PrivKey,
- parameters = Param}) ->
- ECCurve = ec_curve_spec(Param),
- crypto:sign(ecdsa, DigestType, DigestOrPlainText, [PrivKey, ECCurve]);
+%% Description: Create digital signature.
+%%--------------------------------------------------------------------
+sign(DigestOrPlainText, DigestType, Key) ->
+ sign(DigestOrPlainText, DigestType, Key, []).
%% Backwards compatible
-sign(Digest, none, #'DSAPrivateKey'{} = Key) ->
- sign({digest,Digest}, sha, Key).
+sign(Digest, none, Key = #'DSAPrivateKey'{}, Options) when is_binary(Digest) ->
+ sign({digest, Digest}, sha, Key, Options);
+sign(DigestOrPlainText, DigestType, Key, Options) ->
+ case format_sign_key(Key) of
+ badarg ->
+ erlang:error(badarg, [DigestOrPlainText, DigestType, Key, Options]);
+ {Algorithm, CryptoKey} ->
+ crypto:sign(Algorithm, DigestType, DigestOrPlainText, CryptoKey, Options)
+ end.
%%--------------------------------------------------------------------
--spec verify(binary() | {digest, binary()}, rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
- Signature :: binary(), rsa_public_key()
- | dsa_public_key() | ec_public_key()) -> boolean().
+-spec verify(binary() | {digest, binary()},
+ rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
+ Signature :: binary(),
+ rsa_public_key() | dsa_public_key() | ec_public_key()
+ | rsa_private_key() | dsa_private_key() | ec_private_key()
+ ) -> boolean().
+
+-spec verify(binary() | {digest, binary()},
+ rsa_digest_type() | dss_digest_type() | ecdsa_digest_type(),
+ Signature :: binary(),
+ rsa_public_key() | dsa_public_key() | ec_public_key()
+ | rsa_private_key() | dsa_private_key() | ec_private_key(),
+ public_sign_options()
+ ) -> boolean().
+
%% Description: Verifies a digital signature.
%%--------------------------------------------------------------------
-verify(DigestOrPlainText, DigestType, Signature, Key) when is_binary(Signature) ->
- do_verify(DigestOrPlainText, DigestType, Signature, Key);
-verify(_,_,_,_) ->
+verify(DigestOrPlainText, DigestType, Signature, Key) ->
+ verify(DigestOrPlainText, DigestType, Signature, Key, []).
+
+%% Backwards compatible
+verify(Digest, none, Signature, Key = {_, #'Dss-Parms'{}}, Options) when is_binary(Digest) ->
+ verify({digest, Digest}, sha, Signature, Key, Options);
+verify(Digest, none, Signature, Key = #'DSAPrivateKey'{}, Options) when is_binary(Digest) ->
+ verify({digest, Digest}, sha, Signature, Key, Options);
+verify(DigestOrPlainText, DigestType, Signature, Key, Options) when is_binary(Signature) ->
+ case format_verify_key(Key) of
+ badarg ->
+ erlang:error(badarg, [DigestOrPlainText, DigestType, Signature, Key, Options]);
+ {Algorithm, CryptoKey} ->
+ crypto:verify(Algorithm, DigestType, DigestOrPlainText, Signature, CryptoKey, Options)
+ end;
+verify(_,_,_,_,_) ->
%% If Signature is a bitstring and not a binary we know already at this
%% point that the signature is invalid.
false.
@@ -789,8 +823,9 @@ pkix_path_validation(#'OTPCertificate'{} = TrustedCert, CertChain, Options)
%--------------------------------------------------------------------
-spec pkix_crls_validate(#'OTPCertificate'{},
[{DP::#'DistributionPoint'{}, {DerCRL::binary(), CRL::#'CertificateList'{}}}],
- Options :: proplists:proplist()) -> valid | {bad_cert, revocation_status_undetermined}
- | {bad_cert, {revoked, crl_reason()}}.
+ Options :: proplists:proplist()) -> valid | {bad_cert, revocation_status_undetermined} |
+ {bad_cert, {revocation_status_undetermined, Reason::term()}} |
+ {bad_cert, {revoked, crl_reason()}}.
%% Description: Performs a CRL validation according to RFC 5280.
%%--------------------------------------------------------------------
@@ -869,7 +904,7 @@ pkix_verify_hostname(Cert = #'OTPCertificate'{tbsCertificate = TbsCert}, Referen
false ->
%% Try to extract DNS-IDs from URIs etc
DNS_ReferenceIDs =
- [{dns_is,X} || X <- verify_hostname_fqnds(ReferenceIDs, FqdnFun)],
+ [{dns_id,X} || X <- verify_hostname_fqnds(ReferenceIDs, FqdnFun)],
verify_hostname_match_loop(DNS_ReferenceIDs, PresentedIDs,
MatchFun, FailCB, Cert);
true ->
@@ -993,22 +1028,32 @@ short_name_hash({rdnSequence, _Attributes} = Name) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-do_verify(DigestOrPlainText, DigestType, Signature,
- #'RSAPublicKey'{modulus = Mod, publicExponent = Exp}) ->
- crypto:verify(rsa, DigestType, DigestOrPlainText, Signature,
- [Exp, Mod]);
-
-do_verify(DigestOrPlaintext, DigestType, Signature, {#'ECPoint'{point = Point}, Param}) ->
- ECCurve = ec_curve_spec(Param),
- crypto:verify(ecdsa, DigestType, DigestOrPlaintext, Signature, [Point, ECCurve]);
-
-%% Backwards compatibility
-do_verify(Digest, none, Signature, {_, #'Dss-Parms'{}} = Key ) ->
- verify({digest,Digest}, sha, Signature, Key);
-
-do_verify(DigestOrPlainText, sha = DigestType, Signature, {Key, #'Dss-Parms'{p = P, q = Q, g = G}})
- when is_integer(Key), is_binary(Signature) ->
- crypto:verify(dss, DigestType, DigestOrPlainText, Signature, [P, Q, G, Key]).
+format_sign_key(Key = #'RSAPrivateKey'{}) ->
+ {rsa, format_rsa_private_key(Key)};
+format_sign_key(#'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) ->
+ {dss, [P, Q, G, X]};
+format_sign_key(#'ECPrivateKey'{privateKey = PrivKey, parameters = Param}) ->
+ {ecdsa, [PrivKey, ec_curve_spec(Param)]};
+format_sign_key(_) ->
+ badarg.
+
+format_verify_key(#'RSAPublicKey'{modulus = Mod, publicExponent = Exp}) ->
+ {rsa, [Exp, Mod]};
+format_verify_key({#'ECPoint'{point = Point}, Param}) ->
+ {ecdsa, [Point, ec_curve_spec(Param)]};
+format_verify_key({Key, #'Dss-Parms'{p = P, q = Q, g = G}}) ->
+ {dss, [P, Q, G, Key]};
+%% Convert private keys to public keys
+format_verify_key(#'RSAPrivateKey'{modulus = Mod, publicExponent = Exp}) ->
+ format_verify_key(#'RSAPublicKey'{modulus = Mod, publicExponent = Exp});
+format_verify_key(#'ECPrivateKey'{parameters = Param, publicKey = {_, Point}}) ->
+ format_verify_key({#'ECPoint'{point = Point}, Param});
+format_verify_key(#'ECPrivateKey'{parameters = Param, publicKey = Point}) ->
+ format_verify_key({#'ECPoint'{point = Point}, Param});
+format_verify_key(#'DSAPrivateKey'{y=Y, p=P, q=Q, g=G}) ->
+ format_verify_key({Y, #'Dss-Parms'{p=P, q=Q, g=G}});
+format_verify_key(_) ->
+ badarg.
do_pem_entry_encode(Asn1Type, Entity, CipherInfo, Password) ->
Der = der_encode(Asn1Type, Entity),
@@ -1121,8 +1166,13 @@ der_cert(#'OTPCertificate'{} = Cert) ->
der_cert(Der) when is_binary(Der) ->
Der.
-pkix_crls_validate(_, [],_, _, _) ->
- {bad_cert, revocation_status_undetermined};
+pkix_crls_validate(_, [],_, Options, #revoke_state{details = Details}) ->
+ case proplists:get_value(undetermined_details, Options, false) of
+ false ->
+ {bad_cert, revocation_status_undetermined};
+ true ->
+ {bad_cert, {revocation_status_undetermined, {bad_crls, format_details(Details)}}}
+ end;
pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, RevokedState0) ->
CallBack = proplists:get_value(update_crl, Options, fun(_, CurrCRL) ->
CurrCRL
@@ -1142,9 +1192,14 @@ pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, Revoked
do_pkix_crls_validate(OtpCert, [{DP, CRL, DeltaCRL} | Rest], All, Options, RevokedState0) ->
OtherDPCRLs = All -- [{DP, CRL, DeltaCRL}],
case pubkey_crl:validate(OtpCert, OtherDPCRLs, DP, CRL, DeltaCRL, Options, RevokedState0) of
- {undetermined, _, _} when Rest == []->
- {bad_cert, revocation_status_undetermined};
- {undetermined, _, RevokedState} when Rest =/= []->
+ {undetermined, unrevoked, #revoke_state{details = Details}} when Rest == []->
+ case proplists:get_value(undetermined_details, Options, false) of
+ false ->
+ {bad_cert, revocation_status_undetermined};
+ true ->
+ {bad_cert, {revocation_status_undetermined, {bad_crls, Details}}}
+ end;
+ {undetermined, unrevoked, RevokedState} when Rest =/= []->
pkix_crls_validate(OtpCert, Rest, All, Options, RevokedState);
{finished, unrevoked} ->
valid;
@@ -1417,3 +1472,7 @@ to_lower_ascii(C) -> C.
to_string(S) when is_list(S) -> S;
to_string(B) when is_binary(B) -> binary_to_list(B).
+format_details([]) ->
+ no_relevant_crls;
+format_details(Details) ->
+ Details.
diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk
index b94768ae77..83a77d2a28 100644
--- a/lib/public_key/vsn.mk
+++ b/lib/public_key/vsn.mk
@@ -1 +1 @@
-PUBLIC_KEY_VSN = 1.4
+PUBLIC_KEY_VSN = 1.4.1
diff --git a/lib/reltool/doc/src/notes.xml b/lib/reltool/doc/src/notes.xml
index b47d451055..8593a1017f 100644
--- a/lib/reltool/doc/src/notes.xml
+++ b/lib/reltool/doc/src/notes.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2009</year>
- <year>2016</year>
+ <year>2017</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -38,7 +38,23 @@
thus constitutes one section in this document. The title of each
section is the version number of Reltool.</p>
- <section><title>Reltool 0.7.3</title>
+ <section><title>Reltool 0.7.4</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> The User's Guide examples are updated after removal
+ of support for Dets files created with Erlang/OTP R7 and
+ earlier. </p>
+ <p>
+ Own Id: OTP-14422 Aux Id: OTP-13830 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Reltool 0.7.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml
index 83eee6017a..30cb3c13b6 100644
--- a/lib/reltool/doc/src/reltool_examples.xml
+++ b/lib/reltool/doc/src/reltool_examples.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2009</year>
- <year>2016</year>
+ <year>2017</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -41,30 +41,31 @@
<p>The main process in Reltool is the server. It can be used as it
is or be used via the GUI frontend process. When the GUI is
started, a server process will automatically be started. The GUI
- process is started with <c>reltool:start/0</c>,
- <c>reltool:start/1</c> or <c>reltool:start_link/1</c>. The pid of
- its server can be obtained with <c>reltool:get_server/1</c></p>
+ process is started with
+ <seealso marker="reltool#start-0"><c>reltool:start/0</c></seealso>,
+ <seealso marker="reltool#start-1"><c>reltool:start/1</c></seealso> or
+ <seealso marker="reltool#start_link-1"><c>reltool:start_link/1</c></seealso>.
+ The pid of its server can be obtained with
+ <seealso marker="reltool#start_link-1"><c>reltool:get_server/1</c></seealso>
+ </p>
<pre>
-Erlang R13B02 (erts-5.7.3) [source] [64-bit] [smp:4:4] [rq:4]
- [async-threads:0] [kernel-poll:false]
-
-Eshell V5.7.3 (abort with ^G)
+Erlang/OTP 20 [erts-9.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:10]
+[hipe] [kernel-poll:false]
+Eshell V9.0 (abort with ^G)
+1&gt;
1&gt; {ok, Win} = reltool:start([]).
{ok,&lt;0.36.01&gt;}
-2&gt; {ok, Server} = reltool:get_server([]).
+2&gt; {ok, Server} = reltool:get_server(Win).
{ok,&lt;0.37.01&gt;}
3&gt; reltool:get_config(Server).
{ok,{sys,[]}}
-4&gt; reltool:stop(Win).
-ok
-
-
-5&gt; {ok, Server2} = reltool:start_server([]).
+4&gt;
+4&gt; {ok, Server2} = reltool:start_server([]).
{ok,&lt;0.6535.01&gt;}
-6&gt; reltool:get_config(Server2).
+5&gt; reltool:get_config(Server2).
{ok,{sys,[]}}
-7&gt; reltool:stop(Server2).
+6&gt; reltool:stop(Server2).
ok
</pre>
@@ -74,13 +75,11 @@ ok
<title>Inspecting the configuration</title>
<pre>
-Erlang R13B02 (erts-5.7.3) [source] [64-bit] [smp:4:4] [rq:4]
- [async-threads:0] [kernel-poll:false]
-
-Eshell V5.7.3 (abort with ^G)
-1&gt; Config = {sys, [{escript,
- "examples/display_args",
- [{incl_cond, include}]},
+Erlang/OTP 20 [erts-9.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:10]
+[hipe] [kernel-poll:false]
+Eshell V9.0 (abort with ^G)
+1&gt;
+1&gt; Config = {sys, [{escript, "examples/display_args", [{incl_cond, include}]},
{app, inets, [{incl_cond, include}]},
{app, mnesia, [{incl_cond, exclude}]},
{app, ssl, [{incl_cond, exclude}]},
@@ -92,88 +91,105 @@ Eshell V5.7.3 (abort with ^G)
{app,ssl,[{incl_cond,exclude}]},
{app,runtime_tools,[{incl_cond,exclude}]},
{app,syntax_tools,[{incl_cond,exclude}]}]}
-
-
-
+2&gt;
2&gt; {ok, Server} = reltool:start_server([Config]).
-{ok,&lt;0.35.0&gt;}
+{ok,&lt;0.66.0&gt;}
+3&gt;
3&gt; reltool:get_config(Server).
-{ok,{sys,[{escript,"/clearcase/otp/tools/reltool/examples/display_args",
- [{incl_cond,include}]}]}}
+{ok,{sys,[{escript,"/usr/local/lib/erlang/lib/reltool-0.7.3/examples/display_args",
+ [{incl_cond,include}]},
+ {app,inets,[{incl_cond,include}]},
+ {app,mnesia,[{incl_cond,exclude}]},
+ {app,runtime_tools,[{incl_cond,exclude}]},
+ {app,ssl,[{incl_cond,exclude}]},
+ {app,syntax_tools,[{incl_cond,exclude}]}]}}
+4&gt;
4&gt; reltool:get_config(Server, false, false).
-{ok,{sys,[{escript,"/clearcase/otp/tools/reltool/examples/display_args",
- [{incl_cond,include}]}]}}
-
-
-
+{ok,{sys,[{escript,"/usr/local/lib/erlang/lib/reltool-0.7.3/examples/display_args",
+ [{incl_cond,include}]},
+ {app,inets,[{incl_cond,include}]},
+ {app,mnesia,[{incl_cond,exclude}]},
+ {app,runtime_tools,[{incl_cond,exclude}]},
+ {app,ssl,[{incl_cond,exclude}]},
+ {app,syntax_tools,[{incl_cond,exclude}]}]}}
+5&gt;
5&gt; reltool:get_config(Server, true, false).
-{ok,{sys,[{root_dir,"/ldisk/hakan/otp_test"},
+{ok,{sys,[{root_dir,"/usr/local/lib/erlang"},
{lib_dirs,[]},
- {escript,"/clearcase/otp/tools/reltool/examples/display_args",
+ {escript,"/usr/local/lib/erlang/lib/reltool-0.7.3/examples/display_args",
[{incl_cond,include}]},
{mod_cond,all},
{incl_cond,derived},
+ {app,inets,
+ [{incl_cond,include},{vsn,undefined},{lib_dir,undefined}]},
+ {app,mnesia,[{incl_cond,exclude}]},
+ {app,runtime_tools,[{incl_cond,exclude}]},
+ {app,ssl,[{incl_cond,exclude}]},
+ {app,syntax_tools,[{incl_cond,exclude}]},
{boot_rel,"start_clean"},
+ {rel,"start_clean","1.0",[]},
+ {rel,"start_sasl","1.0",[sasl]},
{emu_name,"beam"},
{relocatable,true},
{profile,development},
- {incl_sys_files,[".*"]},
- {excl_sys_files,[]},
- {incl_app_files,[".*"]},
- {excl_app_files,[]},
- {incl_archive_dirs,[".*"]},
- {excl_archive_dirs,["^include$","^priv$"]},
+ {incl_sys_filters,[".*"]},
+ {excl_sys_filters,[]},
+ {incl_app_filters,[".*"]},
+ {excl_app_filters,[]},
+ {incl_archive_filters,[".*"]},
+ {excl_archive_filters,[[...]|...]},
{archive_opts,[]},
- {app_type,permanent},
- {app_file,keep},
- {debug_info,keep}]}}
-
-
-
+ {rel_app_type,...},
+ {...}|...]}}
+6&gt;
6&gt; reltool:get_config(Server, true, true).
-{ok,{sys,[{root_dir,"/ldisk/hakan/otp_test"},
+{ok,{sys,[{root_dir,"/usr/local/lib/erlang"},
{lib_dirs,[]},
- {escript,"/clearcase/otp/tools/reltool/examples/display_args",
+ {escript,"/usr/local/lib/erlang/lib/reltool-0.7.3/examples/display_args",
[{incl_cond,include}]},
{mod_cond,all},
{incl_cond,derived},
- {erts,[{vsn,"5.7.3"},
- {mod,erl_prim_loader,[]},
- {mod,erlang,[]},
- {mod,init,[]},
- {mod,otp_ring0,[]},
- {mod,prim_file,[]},
- {mod,prim_inet,[]},
- {mod,prim_zip,[]},
- {mod,zlib,[]}]},
+ {erts,[{app,erts,
+ [{vsn,"9.0"},
+ {lib_dir,"/usr/local/lib/erlang/lib/erts-9.0"},
+ {mod,erl_prim_loader,[]},
+ {mod,erl_tracer,[]},
+ {mod,erlang,[]},
+ {mod,erts_code_purger,[]},
+ {mod,erts_dirty_process_code_checker,[]},
+ {mod,erts_internal,[]},
+ {mod,erts_literal_area_collector,[]},
+ {mod,init,[]},
+ {mod,otp_ring0,...},
+ {mod,...},
+ {...}|...]}]},
{app,compiler,
- [{vsn,"4.6.3"},
+ [{vsn,"7.0.4"},
+ {lib_dir,"/usr/local/lib/erlang/lib/compiler-7.0.4"},
+ {mod,beam_a,[]},
{mod,beam_asm,[]},
{mod,beam_block,[]},
- {mod,beam_bool,[]},
+ {mod,beam_bs,[]},
{mod,beam_bsm,[]},
{mod,beam_clean,[]},
{mod,beam_dead,[]},
{mod,beam_dict,[]},
{mod,beam_disasm,[]},
- {mod,beam_flatten,[]},
- {mod,beam_jump,[]},
- {mod,beam_listing,[]},
- {mod,beam_opcodes,...},
+ {mod,beam_except,[]},
+ {mod,beam_flatten,...},
{mod,...},
{...}|...]},
{app,crypto,
- [{vsn,"1.6.1"},
+ [{vsn,"3.7.4"},
+ {lib_dir,"/usr/local/lib/erlang/lib/crypto-3.7.4"},
{mod,crypto,[]},
- {mod,crypto_app,[]},
- {mod,crypto_server,[]},
- {mod,crypto_sup,[]}]},
+ {mod,crypto_ec_curves,[]}]},
{app,hipe,
- [{vsn,"3.7.3"},
+ [{vsn,"3.15.4"},
+ {lib_dir,"/usr/local/lib/erlang/lib/hipe-3.15.4"},
{mod,cerl_cconv,[]},
{mod,cerl_closurean,[]},
{mod,cerl_hipeify,[]},
- {mod,cerl_hybrid_transform,[]},
{mod,cerl_lib,[]},
{mod,cerl_messagean,[]},
{mod,cerl_pmatch,[]},
@@ -182,65 +198,110 @@ Eshell V5.7.3 (abort with ^G)
{mod,cerl_typean,...},
{mod,...},
{...}|...]},
+ {app,inets,
+ [{incl_cond,include},
+ {vsn,"6.3.9"},
+ {lib_dir,"/usr/local/lib/erlang/lib/inets-6.3.9"},
+ {mod,ftp,[]},
+ {mod,ftp_progress,[]},
+ {mod,ftp_response,[]},
+ {mod,ftp_sup,[]},
+ {mod,http_chunk,[]},
+ {mod,http_request,[]},
+ {mod,http_response,...},
+ {mod,...},
+ {...}|...]},
{app,kernel,
- [{vsn,"2.13.3"},
+ [{vsn,"5.2"},
+ {lib_dir,"/usr/local/lib/erlang/lib/kernel-5.2"},
{mod,application,[]},
{mod,application_controller,[]},
{mod,application_master,[]},
{mod,application_starter,[]},
{mod,auth,[]},
{mod,code,[]},
- {mod,code_server,[]},
- {mod,disk_log,[]},
- {mod,disk_log_1,...},
+ {mod,code_server,...},
+ {mod,...},
+ {...}|...]},
+ {app,mnesia,[{incl_cond,exclude}]},
+ {app,runtime_tools,[{incl_cond,exclude}]},
+ {app,sasl,
+ [{vsn,"3.0.3"},
+ {lib_dir,"/usr/local/lib/erlang/lib/sasl-3.0.3"},
+ {mod,alarm_handler,[]},
+ {mod,erlsrv,[]},
+ {mod,format_lib_supp,[]},
+ {mod,misc_supp,...},
{mod,...},
{...}|...]},
+ {app,ssl,[{incl_cond,exclude}]},
{app,stdlib,
- [{vsn,"1.16.3"},
+ [{vsn,"3.3"},
+ {lib_dir,"/usr/local/lib/erlang/lib/stdlib-3.3"},
{mod,array,[]},
- {mod,base64,[]},
- {mod,beam_lib,[]},
- {mod,c,[]},
- {mod,calendar,[]},
- {mod,dets,[]},
- {mod,dets_server,[]},
- {mod,dets_sup,...},
+ {mod,base64,...},
{mod,...},
{...}|...]},
+ {app,syntax_tools,[{incl_cond,exclude}]},
+ {app,tools,
+ [{vsn,"2.9.1"},{lib_dir,[...]},{mod,...},{...}|...]},
{boot_rel,"start_clean"},
+ {rel,"start_clean","1.0",[]},
+ {rel,"start_sasl","1.0",[...]},
{emu_name,"beam"},
{relocatable,true},
- {profile,development},
- {incl_sys_files,[".*"]},
- {excl_sys_files,[]},
- {incl_app_files,[".*"]},
- {excl_app_files,[]},
- {incl_archive_dirs,[".*"]},
- {excl_archive_dirs,["^include$",[...]]},
- {archive_opts,[]},
- {app_type,permanent},
- {app_file,...},
- {...}]}}
-
-
-
-7&gt; reltool:get_config([{sys,[{profile, embedded}]}]).
-{ok,{sys,[{profile,embedded},
+ {profile,...},
+ {...}|...]}}
+7&gt;
+7&gt; reltool:get_config([{sys, [{profile, embedded}]}], true, false).
+{ok,{sys,[{root_dir,"/usr/local/lib/erlang"},
+ {lib_dirs,[]},
+ {mod_cond,all},
+ {incl_cond,derived},
+ {boot_rel,"start_clean"},
+ {rel,"start_clean","1.0",[]},
+ {rel,"start_sasl","1.0",[sasl]},
+ {emu_name,"beam"},
+ {relocatable,true},
+ {profile,embedded},
{incl_sys_filters,["^bin","^erts","^lib","^releases"]},
{excl_sys_filters,["^bin/(erlc|dialyzer|typer)(|\\.exe)$",
"^erts.*/bin/(erlc|dialyzer|typer)(|\\.exe)$",
"^erts.*/bin/.*(debug|pdb)"]},
- {incl_app_filters,["^ebin","^include","^priv"]}]}}
-8&gt; reltool:get_config([{sys,[{profile, standalone}]}]).
-{ok,{sys,[{profile,standalone},
+ {incl_app_filters,["^ebin","^include","^priv"]},
+ {excl_app_filters,[]},
+ {incl_archive_filters,[".*"]},
+ {excl_archive_filters,["^include$","^priv$"]},
+ {archive_opts,[]},
+ {rel_app_type,permanent},
+ {embedded_app_type,load},
+ {app_file,keep},
+ {debug_info,keep}]}}
+8&gt;
+8&gt; reltool:get_config([{sys, [{profile, standalone}]}], true, false).
+{ok,{sys,[{root_dir,"/usr/local/lib/erlang"},
+ {lib_dirs,[]},
+ {mod_cond,all},
+ {incl_cond,derived},
+ {boot_rel,"start_clean"},
+ {rel,"start_clean","1.0",[]},
+ {rel,"start_sasl","1.0",[sasl]},
+ {emu_name,"beam"},
+ {relocatable,true},
+ {profile,standalone},
{incl_sys_filters,["^bin/(erl|epmd)(|\\.exe|\\.ini)$",
"^bin/start(|_clean).boot$","^erts.*/bin","^lib$"]},
{excl_sys_filters,["^erts.*/bin/(erlc|dialyzer|typer)(|\\.exe)$",
"^erts.*/bin/(start|escript|to_erl|run_erl)(|\\.exe)$",
"^erts.*/bin/.*(debug|pdb)"]},
{incl_app_filters,["^ebin","^priv"]},
- {excl_app_filters,["^ebin/.*\\.appup$"]}]}}
-
+ {excl_app_filters,["^ebin/.*\\.appup$"]},
+ {incl_archive_filters,[".*"]},
+ {excl_archive_filters,["^include$","^priv$"]},
+ {archive_opts,[]},
+ {rel_app_type,permanent},
+ {app_file,keep},
+ {debug_info,keep}]}}
</pre>
</section>
@@ -248,43 +309,51 @@ Eshell V5.7.3 (abort with ^G)
<section>
<title>Generate release and script files</title>
<pre>
-5&gt; {ok, Server} = reltool:start_server([{config, {sys, [{boot_rel, "NAME"},
+Erlang/OTP 20 [erts-9.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:10]
+[hipe] [kernel-poll:false]
+Eshell V9.0 (abort with ^G)
+1&gt;
+1&gt; {ok, Server} = reltool:start_server([{config, {sys, [{boot_rel, "NAME"},
{rel, "NAME", "VSN",
[sasl]}]}}]).
{ok,&lt;0.1288.0&gt;}
-6&gt; reltool:get_config(Server).
+2&gt;
+2&gt; reltool:get_config(Server).
{ok,{sys,[{boot_rel,"NAME"},
{rel,"NAME","VSN",[sasl]}]}}
-7&gt; reltool:get_rel(Server, "NAME").
+3&gt;
+3&gt; reltool:get_rel(Server, "NAME").
{ok,{release,{"NAME","VSN"},
- {erts,"5.7"},
- [{kernel,"2.13"},{stdlib,"1.16"},{sasl,"2.1.6"}]}}
-8&gt; reltool:get_script(Server, "NAME").
+ {erts,"9.0"},
+ [{kernel,"5.2"},{stdlib,"3.3"},{sasl,"3.0.3"}]}}
+4&gt;
+4&gt; reltool:get_script(Server, "NAME").
{ok,{script,{"NAME","VSN"},
- [{preLoaded,[erl_prim_loader,erlang,init,otp_ring0,
- prim_eval,prim_file,prim_inet,prim_zip,
- zlib]},
+ [{preLoaded,[erl_prim_loader,erl_tracer,erlang,
+ erts_code_purger,erts_dirty_process_code_checker,
+ erts_internal,erts_literal_area_collector,init,otp_ring0,
+ prim_eval,prim_file,prim_inet,prim_zip,zlib]},
{progress,preloaded},
- {path,["$ROOT/lib/kernel-2.13/ebin",
- "$ROOT/lib/stdlib-1.16/ebin"]},
+ {path,["$ROOT/lib/kernel-5.2/ebin",
+ "$ROOT/lib/stdlib-3.3/ebin"]},
{primLoad,[error_handler]},
{kernel_load_completed},
{progress,kernel_load_completed},
- {path,["$ROOT/lib/kernel-2.13/ebin"]},
+ {path,["$ROOT/lib/kernel-5.2/ebin"]},
{primLoad,[application,application_controller,
application_master,application_starter,auth,code,
code_server,disk_log,disk_log_1,disk_log_server,
disk_log_sup,dist_ac,dist_util,erl_boot_server|...]},
- {path,["$ROOT/lib/stdlib-1.16/ebin"]},
- {primLoad,[array,base64,beam_lib,c,calendar,dets,
+ {path,["$ROOT/lib/stdlib-3.3/ebin"]},
+ {primLoad,[array,base64,beam_lib,binary,c,calendar,dets,
dets_server,dets_sup,dets_utils,dets_v9,dict|...]},
- {path,["$ROOT/lib/sasl-2.1.6/ebin"]},
+ {path,["$ROOT/lib/sasl-3.0.3/ebin"]},
{primLoad,[alarm_handler,erlsrv,format_lib_supp,misc_supp,
- overload,rb,rb_format_supp,release_handler,
- release_handler_1,sasl|...]},
+ rb,rb_format_supp,release_handler,release_handler_1,sasl,
+ sasl_report|...]},
{progress,modules_loaded},
- {path,["$ROOT/lib/kernel-2.13/ebin",
- "$ROOT/lib/stdlib-1.16/ebin","$ROOT/lib/sasl-2.1.6/ebin"]},
+ {path,["$ROOT/lib/kernel-5.2/ebin",
+ "$ROOT/lib/stdlib-3.3/ebin","$ROOT/lib/sasl-3.0.3/ebin"]},
{kernelProcess,heart,{heart,start,[]}},
{kernelProcess,error_logger,{error_logger,start_link,[]}},
{kernelProcess,application_controller,
@@ -296,7 +365,8 @@ Eshell V5.7.3 (abort with ^G)
{apply,{...}},
{apply,...},
{...}|...]}}
-9&gt; reltool:stop(Server).
+5&gt;
+5&gt; reltool:stop(Server).
ok
</pre>
</section>
@@ -304,13 +374,11 @@ ok
<section>
<title>Create a target system</title>
<pre>
-Erlang R13B02 (erts-5.7.3) [source] [64-bit] [smp:4:4] [rq:4]
- [async-threads:0] [kernel-poll:false]
-
-Eshell V5.7.3 (abort with ^G)
-1&gt; Config = {sys, [{escript,
- "examples/display_args",
- [{incl_cond, include}]},
+Erlang/OTP 20 [erts-9.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:10]
+[hipe] [kernel-poll:false]
+Eshell V9.0 (abort with ^G)
+1&gt;
+1&gt; Config = {sys, [{escript, "examples/display_args", [{incl_cond, include}]},
{app, inets, [{incl_cond, include}]},
{app, mnesia, [{incl_cond, exclude}]},
{app, ssl, [{incl_cond, exclude}]},
@@ -322,156 +390,183 @@ Eshell V5.7.3 (abort with ^G)
{app,ssl,[{incl_cond,exclude}]},
{app,runtime_tools,[{incl_cond,exclude}]},
{app,syntax_tools,[{incl_cond,exclude}]}]}
-
-
-
+2&gt;
2&gt; {ok, Spec} = reltool:get_target_spec([Config]).
{ok,[{create_dir,"releases",
- [{write_file,"start_erl.data","5.7.3 1.0"},
- {create_dir,"1.0",
- [{write_file,"start_clean.rel",
- [37,37,32,114,101,108,32,103,101,110,101|...]},
- {write_file,"start_clean.script",
- [37,37,32,115,99,114,105,112,116,32|...]},
- {write_file,"start_clean.boot",
- &lt;&lt;131,104,3,100,0,6,115,99,114,...&gt;&gt;},
- {write_file,"start_sasl.rel",
- [37,37,32,114,101,108,32,103,101,110,101|...]},
- {write_file,"start_sasl.script",
- [37,37,32,115,99,114,105,112,116,32|...]},
- {write_file,"start_sasl.boot",
- &lt;&lt;131,104,3,100,0,6,115,99,114,...&gt;&gt;}]}]},
+ [{write_file,"start_erl.data","9.0 1.0\n"},
+ {create_dir,"1.0",
+ [{write_file,"start_clean.rel",
+ [37,37,32,114,101,108,32,103,101,110,101,114,97,116|...]},
+ {write_file,"start_clean.script",
+ [37,37,32,115,99,114,105,112,116,32,103,101,110|...]},
+ {write_file,"start_clean.boot",
+ &lt;&lt;131,104,3,119,6,115,99,114,105,112,116,104,...&gt;&gt;},
+ {write_file,"start_sasl.rel",
+ [37,37,32,114,101,108,32,103,101,110,101|...]},
+ {write_file,"start_sasl.script",
+ [37,37,32,115,99,114,105,112,116,32|...]},
+ {write_file,"start_sasl.boot",
+ &lt;&lt;131,104,3,119,6,115,99,114,105,...&gt;&gt;}]}]},
{create_dir,"bin",
- [{copy_file,"display_args.escript",
- "/clearcase/otp/tools/reltool/examples/display_args"},
- {copy_file,"display_args","erts-5.7.3/bin/escript"},
- {copy_file,"start","erts-5.7.3/bin/start"},
- {copy_file,"erl","erts-5.7.3/bin/dyn_erl"},
- {copy_file,"epmd","erts-5.7.3/bin/epmd"},
- {copy_file,"to_erl","erts-5.7.3/bin/to_erl"},
- {copy_file,"run_erl","erts-5.7.3/bin/run_erl"},
- {copy_file,"escript","erts-5.7.3/bin/escript"},
- {copy_file,"erlc","erts-5.7.3/bin/erlc"},
- {copy_file,"dialyzer","erts-5.7.3/bin/dialyzer"},
- {copy_file,"typer","erts-5.7.3/bin/typer"},
- {write_file,"start_clean.boot",
- &lt;&lt;131,104,3,100,0,6,115,...&gt;&gt;},
- {write_file,"start_sasl.boot",&lt;&lt;131,104,3,100,0,6,...&gt;&gt;},
- {write_file,"start.boot",&lt;&lt;131,104,3,100,0,...&gt;&gt;}]},
- {create_dir,"misc",
- [{copy_file,"makewhatis"},{copy_file,"format_man_pages"}]},
+ [{copy_file,"display_args.escript",
+ "/usr/local/lib/erlang/lib/reltool-0.7.3/examples/display_args"},
+ {copy_file,"display_args","erts-9.0/bin/escript"},
+ {copy_file,"start","erts-9.0/bin/start"},
+ {copy_file,"ct_run","erts-9.0/bin/ct_run"},
+ {copy_file,"dialyzer","erts-9.0/bin/dialyzer"},
+ {copy_file,"run_erl","erts-9.0/bin/run_erl"},
+ {copy_file,"erl","erts-9.0/bin/dyn_erl"},
+ {copy_file,"to_erl","erts-9.0/bin/to_erl"},
+ {copy_file,"epmd","erts-9.0/bin/epmd"},
+ {copy_file,"erlc","erts-9.0/bin/erlc"},
+ {copy_file,"typer","erts-9.0/bin/typer"},
+ {copy_file,"escript","erts-9.0/bin/escript"},
+ {write_file,"start_clean.boot",&lt;&lt;131,104,3,119,6,115,...&gt;&gt;},
+ {write_file,"start_sasl.boot",&lt;&lt;131,104,3,119,6,...&gt;&gt;},
+ {write_file,"start.boot",&lt;&lt;131,104,3,119,...&gt;&gt;}]},
{copy_file,"Install"},
+ {create_dir,"misc",
+ [{copy_file,"makewhatis"},{copy_file,"format_man_pages"}]},
{create_dir,"usr",
- [{create_dir,"lib",
- [{copy_file,"liberts_r.a"},{copy_file,"liberts.a"}]},
- {create_dir,"include",
- [{copy_file,"erl_fixed_size_int_types.h"},
- {copy_file,"erl_int_sizes_config.h"},
- {copy_file,"erl_memory_trace_parser.h"},
- {create_dir,"obsolete",[{copy_file,"driver.h"}]},
- {copy_file,"driver_int.h"},
- {copy_file,"erl_driver.h"}]}]},
- {create_dir,"erts-5.7.3",
- [{create_dir,"lib",
- [{create_dir,"internal",
- [{copy_file,"liberts_internal_r.a"},
- {copy_file,"liberts_internal.a"},
- {copy_file,"libethread.a"},
- {copy_file,"README"}]},
- {copy_file,"liberts_r.a"},
- {copy_file,"liberts.a"}]},
- {create_dir,"bin",
- [{copy_file,"start"},
- {copy_file,"erl","erts-5.7.3/bin/dyn_erl"},
- {copy_file,"epmd"},
- {copy_file,"to_erl"},
- {copy_file,"run_erl"},
- {copy_file,"escript"},
- {copy_file,"erlc"},
- {copy_file,"dialyzer"},
- {copy_file,"typer"},
- {copy_file,"erlexec"},
- {copy_file,[...]},
- {copy_file,...},
- {...}|...]},
- {create_dir,"doc",[]},
- {create_dir,"man",[]},
- {create_dir,"include",
- [{create_dir,"internal",
- [{create_dir,"tile",[{copy_file,...},{...}]},
- {create_dir,"sparc64",[{...}]},
- {create_dir,"sparc32",[...]},
- {create_dir,[...],...},
- {create_dir,...},
- {...}|...]},
- {copy_file,"erl_fixed_size_int_types.h"},
- {copy_file,"erl_int_sizes_config.h"},
- {copy_file,"erl_memory_trace_parser.h"},
- {copy_file,"driver_int.h"},
- {copy_file,"erl_driver.h"}]},
- {create_dir,"src",[{copy_file,"setuid_socket_wrap.c"}]}]},
+ [{create_dir,"lib",
+ [{copy_file,"liberts.a"},
+ {copy_file,"liberl_interface_st.a"},
+ {copy_file,"liberts_r.a"},
+ {copy_file,"libic.a"},
+ {copy_file,"liberl_interface.a"},
+ {copy_file,"libei_st.a"},
+ {copy_file,"libei.a"}]},
+ {create_dir,"include",
+ [{copy_file,"erl_memory_trace_parser.h"},
+ {copy_file,"driver_int.h"},
+ {copy_file,"ei_connect.h"},
+ {copy_file,"ei.h"},
+ {copy_file,"erl_nif_api_funcs.h"},
+ {copy_file,"erl_fixed_size_int_types.h"},
+ {copy_file,"erl_int_sizes_config.h"},
+ {copy_file,"erl_interface.h"},
+ {copy_file,"eicode.h"},
+ {copy_file,"erl_driver.h"},
+ {copy_file,"erlang.idl"},
+ {copy_file,[...]},
+ {copy_file,...},
+ {...}]}]},
+ {create_dir,"erts-9.0",
+ [{create_dir,"bin",
+ [{copy_file,"start"},
+ {copy_file,"ct_run"},
+ {copy_file,"erlexec"},
+ {copy_file,"dialyzer"},
+ {copy_file,"beam.smp"},
+ {copy_file,"run_erl"},
+ {copy_file,"erl","erts-9.0/bin/dyn_erl"},
+ {copy_file,"to_erl"},
+ {copy_file,"epmd"},
+ {copy_file,"erl_child_setup"},
+ {copy_file,"heart"},
+ {copy_file,[...]},
+ {copy_file,...},
+ {...}|...]},
+ {create_dir,"lib",
+ [{create_dir,"internal",
+ [{copy_file,"liberts_internal.a"},
+ {copy_file,"liberts_internal_r.a"},
+ {copy_file,"libethread.a"},
+ {copy_file,"README"}]},
+ {copy_file,"liberts.a"},
+ {copy_file,"liberts_r.a"}]},
+ {create_dir,"src",[{copy_file,"setuid_socket_wrap.c"}]},
+ {create_dir,"doc",[]},
+ {create_dir,"man",[]},
+ {create_dir,"include",
+ [{create_dir,"internal",
+ [{create_dir,"i386",[{...}|...]},
+ {copy_file,"erl_errno.h"},
+ {copy_file,[...]},
+ {copy_file,...},
+ {...}|...]},
+ {copy_file,"erl_memory_trace_parser.h"},
+ {copy_file,"driver_int.h"},
+ {copy_file,"erl_nif_api_funcs.h"},
+ {copy_file,"erl_fixed_size_int_types.h"},
+ {copy_file,"erl_int_sizes_config.h"},
+ {copy_file,[...]},
+ {copy_file,...},
+ {...}]}]},
{create_dir,"lib",
- [{archive,"compiler-4.6.3.ez",[],
- [{create_dir,"compiler-4.6.3",
- [{create_dir,"ebin",
- [{copy_file,"compiler.appup"},
- {copy_file,[...]},
- {copy_file,...},
- {...}|...]},
- {create_dir,"src",
- [{copy_file,[...]},
- {copy_file,...},{...}|...]}]}]},
- {archive,"crypto-1.6.1.ez",[],
- [{create_dir,"crypto-1.6.1",
- [{create_dir,"ebin",
- [{copy_file,[...]},
- {copy_file,...},{...}|...]},
- {create_dir,"src",[{copy_file,...},{...}|...]}]}]},
- {create_dir,"crypto-1.6.1",
- [{create_dir,"priv",
- [{create_dir,"lib",[{copy_file,[...]}]},
- {create_dir,"obj",[{copy_file,...},{...}]}]}]},
- {archive,"erts-5.7.3.ez",[],
- [{create_dir,"erts-5.7.3",
- [{create_dir,"ebin",[{...}|...]},
- {create_dir,"src",[...]}]}]},
- {archive,"hipe-3.7.3.ez",[],
- [{create_dir,"hipe-3.7.3",
- [{create_dir,"util",[...]},
- {create_dir,[...],...},
- {create_dir,...},
- {...}|...]}]},
- {archive,"kernel-2.13.3.ez",[],
- [{create_dir,"kernel-2.13.3",
- [{create_dir,[...],...},{create_dir,...},{...}]}]},
- {create_dir,"kernel-2.13.3",
- [{create_dir,"include",
- [{copy_file,[...]},{copy_file,...},{...}]}]},
- {archive,"stdlib-1.16.3.ez",[],
- [{create_dir,"stdlib-1.16.3",[{...}|...]}]},
- {create_dir,"stdlib-1.16.3",
- [{create_dir,"include",[{...}|...]}]}]}]}
-
-
-
-3&gt; TargetDir = "my_target_dir".
-"my_target_dir"
+ [{archive,"compiler-7.0.4.ez",[],
+ [{create_dir,"compiler-7.0.4",
+ [{create_dir,"src",
+ [{copy_file,"beam_flatten.erl"},
+ {copy_file,[...]},
+ {copy_file,...},
+ {...}|...]},
+ {create_dir,"ebin",
+ [{copy_file,[...]},{copy_file,...},{...}|...]}]}]},
+ {archive,"crypto-3.7.4.ez",[],
+ [{create_dir,"crypto-3.7.4",
+ [{create_dir,"src",[{copy_file,[...]},{copy_file,...}]},
+ {create_dir,"ebin",[{copy_file,...},{...}|...]}]}]},
+ {create_dir,"crypto-3.7.4",
+ [{create_dir,"priv",
+ [{create_dir,"lib",[{copy_file,[...]},{copy_file,...}]},
+ {create_dir,"obj",[{copy_file,...},{...}|...]}]}]},
+ {archive,"erts-9.0.ez",[],
+ [{create_dir,"erts-9.0",
+ [{create_dir,"src",[{...}|...]},
+ {create_dir,"ebin",[...]}]}]},
+ {archive,"hipe-3.15.4.ez",[],
+ [{create_dir,"hipe-3.15.4",
+ [{create_dir,"flow",[...]},
+ {copy_file,[...]},
+ {create_dir,...},
+ {...}|...]}]},
+ {archive,"inets-6.3.9.ez",[],
+ [{create_dir,"inets-6.3.9",
+ [{create_dir,[...],...},{create_dir,...},{...}]}]},
+ {create_dir,"inets-6.3.9",
+ [{create_dir,"priv",[{create_dir,[...],...}]},
+ {create_dir,"include",[{copy_file,...},{...}]}]},
+ {archive,"kernel-5.2.ez",[],
+ [{create_dir,"kernel-5.2",[{...}|...]}]},
+ {create_dir,"kernel-5.2",
+ [{create_dir,"include",[{...}|...]}]},
+ {archive,"sasl-3.0.3.ez",[],[{create_dir,[...],...}]},
+ {archive,"stdlib-3.3.ez",[],[{create_dir,...}]},
+ {create_dir,"stdlib-3.3",[{create_dir,...}]},
+ {archive,"tools-2.9.1.ez",[],[...]}]}]}
+3&gt;
+3&gt; TargetDir = "/tmp/my_target_dir".
+"/tmp/my_target_dir"
+4&gt;
4&gt; reltool:eval_target_spec(Spec, code:root_dir(), TargetDir).
-{error,"/clearcase/otp/tools/reltool/my_target_dir: no such file or directory"}
-5&gt; file:make_dir("my_target_dir").
+{error,"/tmp/my_target_dir: no such file or directory"}
+5&gt;
+5&gt; file:make_dir(TargetDir).
ok
+6&gt;
6&gt; reltool:eval_target_spec(Spec, code:root_dir(), TargetDir).
ok
+7&gt;
7&gt; file:list_dir(TargetDir).
-{ok,["lib","erts-5.7.3","usr","Install","misc","bin","releases"]}
+{ok,["bin","Install","lib","misc","usr","erts-9.0",
+ "releases"]}
+8&gt;
8&gt; file:list_dir(filename:join([TargetDir,"lib"])).
-{ok,["stdlib-1.16.3","stdlib-1.16.3.ez","kernel-2.13.3",
- "kernel-2.13.3.ez","hipe-3.7.3.ez","erts-5.7.3.ez",
- "crypto-1.6.1","crypto-1.6.1.ez","compiler-4.6.3.ez"]}
-9&gt; file:make_dir("yet_another_target_dir").
+{ok,["tools-2.9.1.ez","kernel-5.2.ez","inets-6.3.9.ez",
+ "kernel-5.2","sasl-3.0.3.ez","hipe-3.15.4.ez","inets-6.3.9",
+ "crypto-3.7.4","crypto-3.7.4.ez","stdlib-3.3.ez",
+ "erts-9.0.ez","stdlib-3.3","compiler-7.0.4.ez"]}
+9&gt;
+9&gt; file:make_dir("/tmp/yet_another_target_dir").
ok
-10&gt; reltool:create_target(Config, "yet_another_target_dir").
+10&gt;
+10&gt; reltool:create_target([Config], "/tmp/yet_another_target_dir").
ok
+11&gt;
+11&gt; file:list_dir("/tmp/yet_another_target_dir").
+{ok,["bin","Install","lib","misc","usr","erts-9.0",
+ "releases"]}
</pre>
</section>
diff --git a/lib/reltool/src/reltool.erl b/lib/reltool/src/reltool.erl
index f6ce5578bc..feb6925044 100644
--- a/lib/reltool/src/reltool.erl
+++ b/lib/reltool/src/reltool.erl
@@ -80,7 +80,7 @@ get_server(WinPid) ->
{ok, _ServerPid} = OK ->
OK;
{error, Reason} ->
- {error, lists:flatten(io_lib:format("~p", [Reason]))}
+ {error, lists:flatten(io_lib:format("~tp", [Reason]))}
end.
%% Stop a server or window process
@@ -93,7 +93,7 @@ stop(Pid) when is_pid(Pid) ->
{'DOWN', Ref, _, _, shutdown} ->
ok;
{'DOWN', Ref, _, _, Reason} ->
- {error, lists:flatten(io_lib:format("~p", [Reason]))}
+ {error, lists:flatten(io_lib:format("~tp", [Reason]))}
end.
%% Internal library function
diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl
index 3b1e868757..9c8aae6b7e 100644
--- a/lib/reltool/src/reltool.hrl
+++ b/lib/reltool/src/reltool.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -119,7 +119,7 @@
| {archive, base_file(), [archive_opt()], [target_spec()]}
| {copy_file, base_file()}
| {copy_file, base_file(), top_file()}
- | {write_file, base_file(), iolist()}
+ | {write_file, base_file(), binary()}
| {strip_beam_file, base_file()}.
-type target_dir() :: dir().
-type incl_defaults() :: boolean().
diff --git a/lib/reltool/src/reltool_app_win.erl b/lib/reltool/src/reltool_app_win.erl
index 468ba297bb..663144861f 100644
--- a/lib/reltool/src/reltool_app_win.erl
+++ b/lib/reltool/src/reltool_app_win.erl
@@ -174,7 +174,7 @@ loop(#state{xref_pid = Xref, common = C, app = App} = S) ->
S#state.mod_wins)},
?MODULE:loop(S2);
Msg ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end.
@@ -182,7 +182,7 @@ loop(#state{xref_pid = Xref, common = C, app = App} = S) ->
exit_warning({'EXIT', _Pid, shutdown}) ->
ok;
exit_warning({'EXIT', _Pid, _Reason} = Msg) ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]).
create_window(#state{app = App} = S) ->
@@ -629,7 +629,7 @@ handle_event(#state{sys = Sys, app = App} = S, Wx) ->
handle_mod_button(S, Items, Action);
_ ->
error_logger:format("~w~w got unexpected app event from "
- "wx:\n\t~p\n",
+ "wx:\n\t~tp\n",
[?MODULE, self(), Wx]),
S
end.
@@ -676,7 +676,7 @@ move_mod(App, {_ItemNo, ModStr}, Action) ->
undefined;
_ ->
error_logger:format("~w~w got unexpected mod "
- "button event: ~w\n\t ~p\n",
+ "button event: ~w\n\t ~tp\n",
[?MODULE, self(), ModName, Action]),
M#mod.incl_cond
end,
diff --git a/lib/reltool/src/reltool_fgraph_win.erl b/lib/reltool/src/reltool_fgraph_win.erl
index 915330794c..a10a2281db 100644
--- a/lib/reltool/src/reltool_fgraph_win.erl
+++ b/lib/reltool/src/reltool_fgraph_win.erl
@@ -526,7 +526,7 @@ loop(S, G) ->
exit(Reason);
Other ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Other]),
loop(S, G)
end.
diff --git a/lib/reltool/src/reltool_mod_win.erl b/lib/reltool/src/reltool_mod_win.erl
index 8cd63bdda1..2d56d74563 100644
--- a/lib/reltool/src/reltool_mod_win.erl
+++ b/lib/reltool/src/reltool_mod_win.erl
@@ -171,7 +171,7 @@ loop(#state{xref_pid = Xref, common = C, mod = Mod} = S) ->
S2 = handle_event(S, Wx),
?MODULE:loop(S2);
_ ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end
@@ -487,7 +487,7 @@ handle_event(#state{xref_pid = Xref} = S, Wx) ->
S;
_ ->
error_logger:format("~w~w got unexpected mod event from "
- "wx:\n\t~p\n",
+ "wx:\n\t~tp\n",
[?MODULE, self(), Wx]),
S
end.
@@ -667,7 +667,7 @@ goto_function(S, Editor) ->
wxStyledTextCtrl:setSelection(Editor, Left2, Right2),
Text = wxStyledTextCtrl:getSelectedText(Editor),
S2 = add_pos_to_history(S, CurrentPos),
- do_goto_function(S2, string:tokens(Text, ":"));
+ do_goto_function(S2, string:lexemes(Text, ":"));
_ ->
%% No function call
wxStyledTextCtrl:hideSelection(Editor, false),
diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl
index 89e90670cf..853191c696 100644
--- a/lib/reltool/src/reltool_server.erl
+++ b/lib/reltool/src/reltool_server.erl
@@ -225,12 +225,12 @@ parse_options([{Key, Val} | KeyVals], S, C, Sys) ->
Sys2 = read_config(Sys, {sys, Val}),
parse_options(KeyVals, S, C, Sys2);
_ ->
- reltool_utils:throw_error("Illegal option: ~p", [{Key, Val}])
+ reltool_utils:throw_error("Illegal option: ~tp", [{Key, Val}])
end;
parse_options([], S, C, Sys) ->
S#state{common = C, sys = Sys};
parse_options(KeyVals, _S, _C, _Sys) ->
- reltool_utils:throw_error("Illegal option: ~p", [KeyVals]).
+ reltool_utils:throw_error("Illegal option: ~tp", [KeyVals]).
loop(#state{sys = Sys} = S) ->
receive
@@ -400,12 +400,12 @@ loop(#state{sys = Sys} = S) ->
{'EXIT', Pid, Reason} when Pid =:= S#state.parent_pid ->
exit(Reason);
{call, ReplyTo, Ref, Msg} when is_pid(ReplyTo), is_reference(Ref) ->
- error_logger:format("~w~w got unexpected call:\n\t~p\n",
+ error_logger:format("~w~w got unexpected call:\n\t~tp\n",
[?MODULE, self(), Msg]),
reltool_utils:reply(ReplyTo, Ref, {error, {invalid_call, Msg}}),
?MODULE:loop(S);
Msg ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end.
@@ -1232,7 +1232,7 @@ parse_app_info(File, [{Key, Val} | KeyVals], AI, Status) ->
Status);
_ ->
Status2 =
- reltool_utils:add_warning("Unexpected item ~p in app file ~tp.",
+ reltool_utils:add_warning("Unexpected item ~tp in app file ~tp.",
[Key,File],
Status),
parse_app_info(File, KeyVals, AI, Status2)
@@ -1417,9 +1417,12 @@ shrink_app(A) ->
do_save_config(S, Filename, InclDef, InclDeriv) ->
{ok, Config} = do_get_config(S, InclDef, InclDeriv),
- IoList = io_lib:format("%% config generated at ~w ~w\n~p.\n\n",
- [date(), time(), Config]),
- file:write_file(Filename, IoList).
+ IoList = io_lib:format("%% ~s\n"
+ "%% config generated at ~w ~w\n"
+ "~tp.\n\n",
+ [epp:encoding_to_string(utf8),date(), time(), Config]),
+ Bin = unicode:characters_to_binary(IoList),
+ file:write_file(Filename, Bin).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1455,7 +1458,7 @@ read_config(OldSys, {sys, KeyVals}) ->
[NewSys2#sys.boot_rel])
end;
read_config(_OldSys, BadConfig) ->
- reltool_utils:throw_error("Illegal content: ~p", [BadConfig]).
+ reltool_utils:throw_error("Illegal content: ~tp", [BadConfig]).
decode(#sys{apps = Apps} = Sys, [{erts = Name, AppKeyVals} | SysKeyVals])
when is_atom(Name), is_list(AppKeyVals) ->
@@ -1565,7 +1568,7 @@ decode(#sys{} = Sys, [{Key, Val} | KeyVals]) ->
debug_info when Val =:= keep; Val =:= strip ->
Sys#sys{debug_info = Val};
_ ->
- reltool_utils:throw_error("Illegal option: ~p", [{Key, Val}])
+ reltool_utils:throw_error("Illegal option: ~tp", [{Key, Val}])
end,
decode(Sys3, KeyVals);
decode(#app{} = App, [{Key, Val} | KeyVals]) ->
@@ -1620,14 +1623,14 @@ decode(#app{} = App, [{Key, Val} | KeyVals]) ->
active_dir = Dir,
sorted_dirs = [Dir]};
false ->
- reltool_utils:throw_error("Illegal lib dir for ~w: ~p",
+ reltool_utils:throw_error("Illegal lib dir for ~w: ~tp",
[App#app.name, Val])
end;
SelectVsn when SelectVsn=:=vsn; SelectVsn=:=lib_dir ->
reltool_utils:throw_error("Mutual exclusive options "
"'vsn' and 'lib_dir'",[]);
_ ->
- reltool_utils:throw_error("Illegal option: ~p", [{Key, Val}])
+ reltool_utils:throw_error("Illegal option: ~tp", [{Key, Val}])
end,
decode(App2, KeyVals);
decode(#app{mods = Mods} = App, [{mod, Name, ModKeyVals} | AppKeyVals]) ->
@@ -1641,7 +1644,7 @@ decode(#mod{} = Mod, [{Key, Val} | KeyVals]) ->
debug_info when Val =:= keep; Val =:= strip ->
Mod#mod{debug_info = Val};
_ ->
- reltool_utils:throw_error("Illegal option: ~p", [{Key, Val}])
+ reltool_utils:throw_error("Illegal option: ~tp", [{Key, Val}])
end,
decode(Mod2, KeyVals);
decode(#rel{rel_apps = RelApps} = Rel, [RelApp | KeyVals]) ->
@@ -1666,12 +1669,12 @@ decode(#rel{rel_apps = RelApps} = Rel, [RelApp | KeyVals]) ->
true ->
decode(Rel#rel{rel_apps = RelApps ++ [RA]}, KeyVals);
false ->
- reltool_utils:throw_error("Illegal option: ~p", [RelApp])
+ reltool_utils:throw_error("Illegal option: ~tp", [RelApp])
end;
decode(Acc, []) ->
Acc;
decode(_Acc, KeyVal) ->
- reltool_utils:throw_error("Illegal option: ~p", [KeyVal]).
+ reltool_utils:throw_error("Illegal option: ~tp", [KeyVal]).
is_type(Type) ->
case Type of
@@ -1866,7 +1869,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) ->
{ok, AF} ->
AF;
{error, Reason1} ->
- reltool_utils:throw_error("Illegal escript ~tp: ~p",
+ reltool_utils:throw_error("Illegal escript ~tp: ~tp",
[Escript,Reason1])
end,
@@ -1950,7 +1953,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) ->
Status2),
escripts_to_apps(Escripts, Apps2, Status3);
{error, Reason2} ->
- reltool_utils:throw_error("Illegal escript ~tp: ~p",
+ reltool_utils:throw_error("Illegal escript ~tp: ~tp",
[Escript,Reason2])
end;
escripts_to_apps([], Apps, Status) ->
@@ -2013,7 +2016,7 @@ init_escript_app(AppName, EscriptAppName, Dir, Info, Mods, Apps, Status) ->
case lists:keymember(AppName, #app.name, Apps) of
true ->
reltool_utils:throw_error(
- "~w: Application name clash. Escript ~tp contains application ~tp.",
+ "~w: Application name clash. Escript ~tp contains application ~w.",
[AppName,Dir,AppName]);
false ->
{App2, Status}
diff --git a/lib/reltool/src/reltool_sys_win.erl b/lib/reltool/src/reltool_sys_win.erl
index ba0d90ef5f..92df270752 100644
--- a/lib/reltool/src/reltool_sys_win.erl
+++ b/lib/reltool/src/reltool_sys_win.erl
@@ -136,7 +136,7 @@ init(Options) ->
do_init(Options)
catch
error:Reason ->
- io:format("~p: ~p~n",[Reason, erlang:get_stacktrace()]),
+ io:format("~tp: ~tp~n",[Reason, erlang:get_stacktrace()]),
exit({Reason, erlang:get_stacktrace()})
end.
@@ -182,7 +182,7 @@ do_init([{safe_config, Safe}, {parent, Parent} | Options]) ->
end.
restart_server_safe_config(true,Parent,Reason) ->
- io:format("~w(~w): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]),
+ io:format("~w(~w): <ERROR> ~tp\n", [?MODULE, ?LINE, Reason]),
proc_lib:init_ack(Parent, {error,Reason});
restart_server_safe_config(false,Parent,Reason) ->
wx:new(),
@@ -199,7 +199,7 @@ restart_server_safe_config(false,Parent,Reason) ->
?wxID_OK ->
do_init([{safe_config,true},{parent,Parent},?safe_config]);
?wxID_CANCEL ->
- io:format("~w(~w): <ERROR> ~p\n", [?MODULE, ?LINE, Reason]),
+ io:format("~w(~w): <ERROR> ~tp\n", [?MODULE, ?LINE, Reason]),
proc_lib:init_ack(Parent,{error,Reason})
end.
@@ -251,7 +251,7 @@ loop(S) ->
?MODULE:loop(S#state{warning_wins = WWs2});
false ->
error_logger:format("~w~w got unexpected "
- "message:\n\t~p\n",
+ "message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end
@@ -292,7 +292,7 @@ loop(S) ->
S#state.app_wins),
?MODULE:loop(S#state{fgraph_wins = FWs, app_wins = AWs});
Msg ->
- error_logger:format("~w~w got unexpected message:\n\t~p\n",
+ error_logger:format("~w~w got unexpected message:\n\t~tp\n",
[?MODULE, self(), Msg]),
?MODULE:loop(S)
end.
@@ -316,7 +316,7 @@ handle_child_exit({'EXIT', Pid, _Reason} = Exit, FWs, AWs) ->
msg_warning({'EXIT', _Pid, shutdown}, Type) when Type =/= unknown ->
ok;
msg_warning(Exit, Type) ->
- error_logger:format("~w~w got unexpected message (~w):\n\t~p\n",
+ error_logger:format("~w~w got unexpected message (~w):\n\t~tp\n",
[?MODULE, self(), Type, Exit]).
create_window(S) ->
@@ -1163,12 +1163,12 @@ handle_system_event(#state{sys = Sys} = S,
do_set_sys(S#state{sys = Sys2});
handle_system_event(S, Event, ObjRef, UserData) ->
error_logger:format("~w~w got unexpected wx sys event to ~p "
- "with user data: ~p\n\t ~p\n",
+ "with user data: ~tp\n\t ~tp\n",
[?MODULE, self(), ObjRef, UserData, Event]),
S.
handle_release_event(S, _Event, _ObjRef, UserData) ->
- io:format("Release data: ~p\n", [UserData]),
+ io:format("Release data: ~tp\n", [UserData]),
S.
handle_source_event(S,
@@ -1225,7 +1225,7 @@ handle_app_event(S,
handle_app_button(S, Items, Action);
handle_app_event(S, Event, ObjRef, UserData) ->
error_logger:format("~w~w got unexpected wx app event to "
- "~p with user data: ~p\n\t ~p\n",
+ "~p with user data: ~tp\n\t ~tp\n",
[?MODULE, self(), ObjRef, UserData, Event]),
S.
@@ -1269,7 +1269,7 @@ move_app(S, {_ItemNo, AppBase}, Action) ->
undefined;
_ ->
error_logger:format("~w~w got unexpected app "
- "button event: ~p ~p\n",
+ "button event: ~tp ~tp\n",
[?MODULE, self(), Action, AppBase]),
OldApp#app.incl_cond
end,
@@ -1543,7 +1543,7 @@ check_and_refresh(S, Status) ->
display_message(Reason, ?wxICON_ERROR),
false;
{error, Reason} ->
- Msg = lists:flatten(io_lib:format("Error:\n\n~p\n", [Reason])),
+ Msg = lists:flatten(io_lib:format("Error:\n\n~tp\n", [Reason])),
display_message(Msg, ?wxICON_ERROR),
false
end,
diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl
index 1615a3e9b7..1b1461178e 100644
--- a/lib/reltool/src/reltool_target.erl
+++ b/lib/reltool/src/reltool_target.erl
@@ -787,16 +787,20 @@ do_spec_rel_files(#rel{name = RelName} = Rel, Sys) ->
{ok, BootBin} = gen_boot(Script),
Date = date(),
Time = time(),
- RelIoList = io_lib:format("%% rel generated at ~w ~w\n~p.\n\n",
+ RelIoList = io_lib:format("%% rel generated at ~w ~w\n~tp.\n\n",
[Date, Time, GenRel]),
- ScriptIoList = io_lib:format("%% script generated at ~w ~w\n~p.\n\n",
+ ScriptIoList = io_lib:format("%% script generated at ~w ~w\n~tp.\n\n",
[Date, Time, Script]),
[
- {write_file, RelFile, RelIoList},
- {write_file, ScriptFile, ScriptIoList},
+ {write_file, RelFile, to_utf8_bin_with_enc_comment(RelIoList)},
+ {write_file, ScriptFile, to_utf8_bin_with_enc_comment(ScriptIoList)},
{write_file, BootFile, BootBin}
].
+to_utf8_bin_with_enc_comment(IoList) when is_list(IoList) ->
+ unicode:characters_to_binary("%% " ++ epp:encoding_to_string(utf8) ++ "\n"
+ ++ IoList).
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Generate a complete target system
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1001,7 +1005,8 @@ spec_start_file(#sys{boot_rel = BootRelName,
{value, Erts} = lists:keysearch(erts, #app.name, Apps),
{value, BootRel} = lists:keysearch(BootRelName, #rel.name, Rels),
Data = Erts#app.vsn ++ " " ++ BootRel#rel.vsn ++ "\n",
- {BootRel#rel.vsn, {write_file, "start_erl.data", Data}}.
+ {BootRel#rel.vsn, {write_file, "start_erl.data",
+ unicode:characters_to_binary(Data)}}.
lookup_spec(Prefix, Specs) ->
lists:filter(fun(S) -> lists:prefix(Prefix, element(2, S)) end, Specs).
@@ -1183,18 +1188,18 @@ spec_app_file(#app{name = Name,
Info#app_info.modules)],
App2 = App#app{info = Info#app_info{modules = ModNames}},
Contents = gen_app(App2),
- AppIoList = io_lib:format("%% app generated at ~w ~w\n~p.\n\n",
+ AppIoList = io_lib:format("%% app generated at ~w ~w\n~tp.\n\n",
[date(), time(), Contents]),
- [{write_file, AppFilename, AppIoList}];
+ [{write_file, AppFilename, to_utf8_bin_with_enc_comment(AppIoList)}];
all ->
%% Include all included modules
%% Generate new file
ModNames = [M#mod.name || M <- Mods, M#mod.is_included],
App2 = App#app{info = Info#app_info{modules = ModNames}},
Contents = gen_app(App2),
- AppIoList = io_lib:format("%% app generated at ~w ~w\n~p.\n\n",
+ AppIoList = io_lib:format("%% app generated at ~w ~w\n~tp.\n\n",
[date(), time(), Contents]),
- [{write_file, AppFilename, AppIoList}]
+ [{write_file, AppFilename, to_utf8_bin_with_enc_comment(AppIoList)}]
end.
@@ -1285,7 +1290,7 @@ do_eval_spec({archive, Archive, Options, Files},
{ok, _} ->
ok;
{error, Reason} ->
- reltool_utils:throw_error("create archive ~ts failed: ~p",
+ reltool_utils:throw_error("create archive ~ts failed: ~tp",
[ArchiveFile, Reason])
end;
do_eval_spec({copy_file, File}, _OrigSourceDir, SourceDir, TargetDir) ->
@@ -1299,12 +1304,12 @@ do_eval_spec({copy_file, File, OldFile},
SourceFile = filename:join([OrigSourceDir, OldFile]),
TargetFile = filename:join([TargetDir, File]),
reltool_utils:copy_file(SourceFile, TargetFile);
-do_eval_spec({write_file, File, IoList},
+do_eval_spec({write_file, File, Bin},
_OrigSourceDir,
_SourceDir,
TargetDir) ->
TargetFile = filename:join([TargetDir, File]),
- reltool_utils:write_file(TargetFile, IoList);
+ reltool_utils:write_file(TargetFile, Bin);
do_eval_spec({strip_beam, File}, _OrigSourceDir, SourceDir, TargetDir) ->
SourceFile = filename:join([SourceDir, File]),
TargetFile = filename:join([TargetDir, File]),
@@ -1336,7 +1341,7 @@ cleanup_spec({copy_file, File}, TargetDir) ->
cleanup_spec({copy_file, NewFile, _OldFile}, TargetDir) ->
TargetFile = filename:join([TargetDir, NewFile]),
file:delete(TargetFile);
-cleanup_spec({write_file, File, _IoList}, TargetDir) ->
+cleanup_spec({write_file, File, _}, TargetDir) ->
TargetFile = filename:join([TargetDir, File]),
file:delete(TargetFile);
cleanup_spec({strip_beam, File}, TargetDir) ->
@@ -1406,7 +1411,7 @@ do_filter_spec(Path,
ExclRegexps) ->
Path2 = opt_join(Path, NewFile),
match(Path2, InclRegexps, ExclRegexps);
-do_filter_spec(Path, {write_file, File, _IoList}, InclRegexps, ExclRegexps) ->
+do_filter_spec(Path, {write_file, File, _}, InclRegexps, ExclRegexps) ->
Path2 = opt_join(Path, File),
match(Path2, InclRegexps, ExclRegexps);
do_filter_spec(Path, {strip_beam, File}, InclRegexps, ExclRegexps) ->
@@ -1448,7 +1453,7 @@ do_install(RelName, TargetDir) ->
RelDir = filename:join([TargetDir2, "releases"]),
DataFile = filename:join([RelDir, "start_erl.data"]),
Bin = reltool_utils:read_file(DataFile),
- case string:tokens(binary_to_list(Bin), " \n") of
+ case string:lexemes(unicode:characters_to_list(Bin), " \n") of
[ErlVsn, RelVsn | _] ->
ErtsBinDir = filename:join([TargetDir2, "erts-" ++ ErlVsn, "bin"]),
BinDir = filename:join([TargetDir2, "bin"]),
@@ -1501,8 +1506,8 @@ subst_src_script(Script, SrcDir, DestDir, Vars, Opts) ->
subst_file(Src, Dest, Vars, Opts) ->
Bin = reltool_utils:read_file(Src),
- Chars = subst(binary_to_list(Bin), Vars),
- reltool_utils:write_file(Dest, Chars),
+ Chars = subst(unicode:characters_to_list(Bin), Vars),
+ reltool_utils:write_file(Dest, unicode:characters_to_binary(Chars)),
case lists:member(preserve, Opts) of
true ->
FileInfo = reltool_utils:read_file_info(Src),
diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl
index 60edc9f3ca..3891b5ae4d 100644
--- a/lib/reltool/src/reltool_utils.erl
+++ b/lib/reltool/src/reltool_utils.erl
@@ -55,7 +55,7 @@ root_dir() ->
code:root_dir().
erl_libs() ->
- string:tokens(os:getenv("ERL_LIBS", ""), ":;").
+ string:lexemes(os:getenv("ERL_LIBS", ""), ":;").
lib_dirs(Dir) ->
case erl_prim_loader:list_dir(Dir) of
@@ -286,7 +286,7 @@ split_app_dir(Dir) ->
{Name, Vsn} = split_app_name(Base),
Vsn2 =
try
- [list_to_integer(N) || N <- string:tokens(Vsn, ".")]
+ [list_to_integer(N) || N <- string:lexemes(Vsn, ".")]
catch
_:_ ->
Vsn
@@ -427,7 +427,7 @@ scroll_size(ObjRef) ->
safe_keysearch(Key, Pos, List, Mod, Line) ->
case lists:keysearch(Key, Pos, List) of
false ->
- io:format("~w(~w): lists:keysearch(~p, ~w, ~p) -> false\n",
+ io:format("~w(~w): lists:keysearch(~tp, ~w, ~tp) -> false\n",
[Mod, Line, Key, Pos, List]),
erlang:error({Mod, Line, lists, keysearch, [Key, Pos, List]});
{value, Val} ->
@@ -498,8 +498,8 @@ read_file(File) ->
throw_error("read file ~ts: ~ts", [File, Text])
end.
-write_file(File, IoList) ->
- case file:write_file(File, IoList) of
+write_file(File, Bin) ->
+ case file:write_file(File, Bin) of
ok ->
ok;
{error, Reason} ->
@@ -601,7 +601,7 @@ do_decode_regexps(Key, [Regexp | Regexps], Acc) ->
Regexps,
[#regexp{source = Regexp, compiled = MP} | Acc]);
_ ->
- Text = lists:flatten(io_lib:format("~p", [{Key, Regexp}])),
+ Text = lists:flatten(io_lib:format("~tp", [{Key, Regexp}])),
throw({error, "Illegal option: " ++ Text})
end;
do_decode_regexps(_Key, [], Acc) ->
diff --git a/lib/reltool/vsn.mk b/lib/reltool/vsn.mk
index 2d07eeb8f0..3617f6e0d9 100644
--- a/lib/reltool/vsn.mk
+++ b/lib/reltool/vsn.mk
@@ -1 +1 @@
-RELTOOL_VSN = 0.7.3
+RELTOOL_VSN = 0.7.4
diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml
index 49615cf077..d50994306b 100644
--- a/lib/runtime_tools/doc/src/notes.xml
+++ b/lib/runtime_tools/doc/src/notes.xml
@@ -32,6 +32,63 @@
<p>This document describes the changes made to the Runtime_Tools
application.</p>
+<section><title>Runtime_Tools 1.12.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ A faulty encoding comment was added when saving trace
+ patterns to file. This is now corrected.</p>
+ <p>
+ Own Id: OTP-14479</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Runtime_Tools 1.12</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Add compile option <c>-compile(no_native)</c> in modules
+ with <c>on_load</c> directive which is not yet supported
+ by HiPE.</p>
+ <p>
+ Own Id: OTP-14316 Aux Id: PR-1390 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ <item>
+ <p> Sockets can now be bound to device (SO_BINDTODEVICE)
+ on platforms where it is supported. </p> <p> This has
+ been implemented e.g to support VRF-Lite under Linux; see
+ <url
+ href="https://www.kernel.org/doc/Documentation/networking/vrf.txt">
+ VRF </url>, and GitHub pull request <url
+ href="https://github.com/erlang/otp/pull/1326">#1326</url>.
+ </p>
+ <p>
+ Own Id: OTP-14357 Aux Id: PR-1326 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Runtime_Tools 1.11.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl
index f17aa528ed..92938ed5c1 100644
--- a/lib/runtime_tools/src/dbg.erl
+++ b/lib/runtime_tools/src/dbg.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.
@@ -50,7 +50,8 @@ fun2ms(ShellFun) when is_function(ShellFun) ->
case ms_transform:transform_from_shell(
?MODULE,Clauses,ImportList) of
{error,[{_,[{_,_,Code}|_]}|_],_} ->
- io:format("Error: ~s~n",
+ Modifier = modifier(),
+ io:format("Error: ~"++Modifier++"s~n",
[ms_transform:format_error(Code)]),
{error,transform_error};
Else ->
@@ -233,8 +234,10 @@ ctpe(Event) when Event =:= send;
%% List saved and built-in trace patterns.
%%
ltp() ->
+ Modifier = modifier(),
+ Format = "~p: ~"++Modifier++"p~n",
pt_doforall(fun({X, El},_Ignore) ->
- io:format("~p: ~p~n", [X,El])
+ io:format(Format, [X,El])
end,[]).
%%
@@ -261,12 +264,13 @@ dtp(_) ->
%%
%% Actually write the built-in trace patterns too.
wtp(FileName) ->
- case file:open(FileName,[write]) of
+ case file:open(FileName,[write,{encoding,utf8}]) of
{error, Reason} ->
{error, Reason};
{ok, File} ->
+ io:format(File, "%% ~s\n", [epp:encoding_to_string(utf8)]),
pt_doforall(fun ({_, Val}, _) when is_list(Val) ->
- io:format(File, "~p.~n", [Val]);
+ io:format(File, "~tp.~n", [Val]);
({_, _}, _) ->
ok
end,
@@ -667,7 +671,9 @@ init(Parent) ->
loop({C,T}=SurviveLinks, Table) ->
receive
{From,i} ->
- reply(From, display_info(lists:map(fun({N,_}) -> N end,get()))),
+ Modifier = modifier(),
+ Reply = display_info(lists:map(fun({N,_}) -> N end,get()), Modifier),
+ reply(From, Reply),
loop(SurviveLinks, Table);
{From,{p,Pid,Flags}} ->
reply(From, trace_process(Pid, Flags)),
@@ -773,7 +779,10 @@ loop({C,T}=SurviveLinks, Table) ->
C ->
case lists:delete(Pid,T) of
T ->
- io:format(user,"** dbg got EXIT - terminating: ~p~n",
+ Modifier = modifier(user),
+ io:format(user,
+ "** dbg got EXIT - terminating: ~"++
+ Modifier++"p~n",
[Reason]),
exit(done);
NewT ->
@@ -784,7 +793,8 @@ loop({C,T}=SurviveLinks, Table) ->
loop({NewC,T}, Table)
end;
Other ->
- io:format(user,"** dbg got garbage: ~p~n",
+ Modifier = modifier(user),
+ io:format(user,"** dbg got garbage: ~"++Modifier++"p~n",
[{Other,SurviveLinks,Table}]),
loop(SurviveLinks, Table)
end.
@@ -836,7 +846,9 @@ recv_all_traces(Suspended0, Traces, Timeout) ->
{done, Suspended0, Traces};
Other ->
%%% Is this really a good idea?
- io:format(user,"** tracer received garbage: ~p~n", [Other]),
+ Modifier = modifier(user),
+ io:format(user,"** tracer received garbage: ~"++Modifier++"p~n",
+ [Other]),
recv_all_traces(Suspended0, Traces, Timeout)
after Timeout ->
{loop, Suspended0, Traces}
@@ -962,165 +974,224 @@ do_relay_1(RelP) ->
RelP ! TraceInfo,
do_relay_1(RelP);
Other ->
- io:format(user,"** relay got garbage: ~p~n", [Other]),
+ Modifier = modifier(user),
+ io:format(user,"** relay got garbage: ~"++Modifier++"p~n", [Other]),
do_relay_1(RelP)
end.
dhandler(end_of_trace, Out) ->
Out;
dhandler(Trace, Out) when element(1, Trace) == trace, tuple_size(Trace) >= 3 ->
- dhandler1(Trace, tuple_size(Trace), Out);
+ dhandler1(Trace, tuple_size(Trace), out(Out));
dhandler(Trace, Out) when element(1, Trace) == trace_ts, tuple_size(Trace) >= 4 ->
- dhandler1(Trace, tuple_size(Trace)-1, element(tuple_size(Trace),Trace), Out);
+ dhandler1(Trace, tuple_size(Trace)-1, element(tuple_size(Trace),Trace)
+ , out(Out));
dhandler(Trace, Out) when element(1, Trace) == drop, tuple_size(Trace) =:= 2 ->
- io:format(Out, "*** Dropped ~p messages.~n", [element(2,Trace)]),
- Out;
-dhandler(Trace, Out) when element(1, Trace) == seq_trace, tuple_size(Trace) >= 3 ->
+ {Device,Modifier} = out(Out),
+ io:format(Device, "*** Dropped ~p messages.~n", [element(2,Trace)]),
+ {Device,Modifier};
+dhandler(Trace, Out) when element(1, Trace) == seq_trace,
+ tuple_size(Trace) >= 3 ->
+ {Device,Modifier} = out(Out),
SeqTraceInfo = case Trace of
{seq_trace, Lbl, STI, TS} ->
- io:format(Out, "SeqTrace ~p [~p]: ",
+ io:format(Device, "SeqTrace ~p [~p]: ",
[TS, Lbl]),
STI;
{seq_trace, Lbl, STI} ->
- io:format(Out, "SeqTrace [~p]: ",
+ io:format(Device, "SeqTrace [~p]: ",
[Lbl]),
STI
end,
case SeqTraceInfo of
{send, Ser, Fr, To, Mes} ->
- io:format(Out, "(~p) ~p ! ~p [Serial: ~p]~n",
+ io:format(Device, "(~p) ~p ! ~"++Modifier++"p [Serial: ~p]~n",
[Fr, To, Mes, Ser]);
{'receive', Ser, Fr, To, Mes} ->
- io:format(Out, "(~p) << ~p [Serial: ~p, From: ~p]~n",
+ io:format(Device, "(~p) << ~"++Modifier++"p [Serial: ~p, From: ~p]~n",
[To, Mes, Ser, Fr]);
{print, Ser, Fr, _, Info} ->
- io:format(Out, "-> ~p [Serial: ~p, From: ~p]~n",
+ io:format(Device, "-> ~"++Modifier++"p [Serial: ~p, From: ~p]~n",
[Info, Ser, Fr]);
Else ->
- io:format(Out, "~p~n", [Else])
+ io:format(Device, "~"++Modifier++"p~n", [Else])
end,
- Out;
+ {Device,Modifier};
dhandler(_Trace, Out) ->
Out.
-dhandler1(Trace, Size, Out) ->
+dhandler1(Trace, Size, {Device,Modifier}) ->
From = element(2, Trace),
case element(3, Trace) of
'receive' ->
case element(4, Trace) of
{dbg,ok} -> ok;
Message ->
- io:format(Out, "(~p) << ~p~n", [From,Message])
+ io:format(Device, "(~p) << ~"++Modifier++"p~n",
+ [From,Message])
end;
'send' ->
Message = element(4, Trace),
To = element(5, Trace),
- io:format(Out, "(~p) ~p ! ~p~n", [From,To,Message]);
+ io:format(Device, "(~p) ~p ! ~"++Modifier++"p~n", [From,To,Message]);
call ->
case element(4, Trace) of
MFA when Size == 5 ->
Message = element(5, Trace),
- io:format(Out, "(~p) call ~s (~p)~n", [From,ffunc(MFA),Message]);
+ io:format(Device,
+ "(~p) call ~"++Modifier++"s (~"++Modifier++"p)~n",
+ [From,ffunc(MFA,Modifier),Message]);
MFA ->
- io:format(Out, "(~p) call ~s~n", [From,ffunc(MFA)])
+ io:format(Device, "(~p) call ~"++Modifier++"s~n",
+ [From,ffunc(MFA,Modifier)])
end;
return -> %% To be deleted...
case element(4, Trace) of
MFA when Size == 5 ->
Ret = element(5, Trace),
- io:format(Out, "(~p) old_ret ~s -> ~p~n", [From,ffunc(MFA),Ret]);
+ io:format(Device,
+ "(~p) old_ret ~"++Modifier++"s -> ~"++Modifier++
+ "p~n",
+ [From,ffunc(MFA,Modifier),Ret]);
MFA ->
- io:format(Out, "(~p) old_ret ~s~n", [From,ffunc(MFA)])
+ io:format(Device, "(~p) old_ret ~"++Modifier++"s~n",
+ [From,ffunc(MFA,Modifier)])
end;
return_from ->
MFA = element(4, Trace),
Ret = element(5, Trace),
- io:format(Out, "(~p) returned from ~s -> ~p~n", [From,ffunc(MFA),Ret]);
+ io:format(Device,
+ "(~p) returned from ~"++Modifier++"s -> ~"++Modifier++"p~n",
+ [From,ffunc(MFA,Modifier),Ret]);
return_to ->
MFA = element(4, Trace),
- io:format(Out, "(~p) returning to ~s~n", [From,ffunc(MFA)]);
+ io:format(Device, "(~p) returning to ~"++Modifier++"s~n",
+ [From,ffunc(MFA,Modifier)]);
spawn when Size == 5 ->
Pid = element(4, Trace),
MFA = element(5, Trace),
- io:format(Out, "(~p) spawn ~p as ~s~n", [From,Pid,ffunc(MFA)]);
+ io:format(Device, "(~p) spawn ~p as ~"++Modifier++"s~n",
+ [From,Pid,ffunc(MFA,Modifier)]);
Op ->
- io:format(Out, "(~p) ~p ~s~n", [From,Op,ftup(Trace,4,Size)])
+ io:format(Device, "(~p) ~p ~"++Modifier++"s~n",
+ [From,Op,ftup(Trace,4,Size,Modifier)])
end,
- Out.
+ {Device,Modifier}.
-dhandler1(Trace, Size, TS, Out) ->
+dhandler1(Trace, Size, TS, {Device,Modifier}) ->
From = element(2, Trace),
case element(3, Trace) of
'receive' ->
case element(4, Trace) of
{dbg,ok} -> ok;
Message ->
- io:format(Out, "(~p) << ~p (Timestamp: ~p)~n", [From,Message,TS])
+ io:format(Device,
+ "(~p) << ~"++Modifier++"p (Timestamp: ~p)~n",
+ [From,Message,TS])
end;
'send' ->
Message = element(4, Trace),
To = element(5, Trace),
- io:format(Out, "(~p) ~p ! ~p (Timestamp: ~p)~n", [From,To,Message,TS]);
+ io:format(Device, "(~p) ~p ! ~"++Modifier++"p (Timestamp: ~p)~n",
+ [From,To,Message,TS]);
call ->
case element(4, Trace) of
MFA when Size == 5 ->
Message = element(5, Trace),
- io:format(Out, "(~p) call ~s (~p) (Timestamp: ~p)~n", [From,ffunc(MFA),Message,TS]);
+ io:format(Device,
+ "(~p) call ~"++Modifier++"s (~"++Modifier++
+ "p) (Timestamp: ~p)~n",
+ [From,ffunc(MFA,Modifier),Message,TS]);
MFA ->
- io:format(Out, "(~p) call ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS])
+ io:format(Device,
+ "(~p) call ~"++Modifier++"s (Timestamp: ~p)~n",
+ [From,ffunc(MFA,Modifier),TS])
end;
return -> %% To be deleted...
case element(4, Trace) of
MFA when Size == 5 ->
Ret = element(5, Trace),
- io:format(Out, "(~p) old_ret ~s -> ~p (Timestamp: ~p)~n", [From,ffunc(MFA),Ret,TS]);
+ io:format(Device,
+ "(~p) old_ret ~"++Modifier++"s -> ~"++Modifier++
+ "p (Timestamp: ~p)~n",
+ [From,ffunc(MFA,Modifier),Ret,TS]);
MFA ->
- io:format(Out, "(~p) old_ret ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS])
+ io:format(Device,
+ "(~p) old_ret ~"++Modifier++"s (Timestamp: ~p)~n",
+ [From,ffunc(MFA,Modifier),TS])
end;
return_from ->
MFA = element(4, Trace),
Ret = element(5, Trace),
- io:format(Out, "(~p) returned from ~s -> ~p (Timestamp: ~p)~n", [From,ffunc(MFA),Ret,TS]);
+ io:format(Device,
+ "(~p) returned from ~"++Modifier++"s -> ~"++Modifier++
+ "p (Timestamp: ~p)~n",
+ [From,ffunc(MFA,Modifier),Ret,TS]);
return_to ->
MFA = element(4, Trace),
- io:format(Out, "(~p) returning to ~s (Timestamp: ~p)~n", [From,ffunc(MFA),TS]);
+ io:format(Device,
+ "(~p) returning to ~"++Modifier++"s (Timestamp: ~p)~n",
+ [From,ffunc(MFA,Modifier),TS]);
spawn when Size == 5 ->
Pid = element(4, Trace),
MFA = element(5, Trace),
- io:format(Out, "(~p) spawn ~p as ~s (Timestamp: ~p)~n", [From,Pid,ffunc(MFA),TS]);
+ io:format(Device,
+ "(~p) spawn ~p as ~"++Modifier++"s (Timestamp: ~p)~n",
+ [From,Pid,ffunc(MFA,Modifier),TS]);
Op ->
- io:format(Out, "(~p) ~p ~s (Timestamp: ~p)~n", [From,Op,ftup(Trace,4,Size),TS])
+ io:format(Device, "(~p) ~p ~"++Modifier++"s (Timestamp: ~p)~n",
+ [From,Op,ftup(Trace,4,Size,Modifier),TS])
end,
- Out.
-
-
+ {Device,Modifier}.
%%% These f* functions returns non-flat strings
%% {M,F,[A1, A2, ..., AN]} -> "M:F(A1, A2, ..., AN)"
%% {M,F,A} -> "M:F/A"
-ffunc({M,F,Argl}) when is_list(Argl) ->
- io_lib:format("~p:~p(~s)", [M, F, fargs(Argl)]);
-ffunc({M,F,Arity}) ->
- io_lib:format("~p:~p/~p", [M,F,Arity]);
-ffunc(X) -> io_lib:format("~p", [X]).
+ffunc({M,F,Argl},Modifier) when is_list(Argl) ->
+ io_lib:format("~p:~"++Modifier++"p(~"++Modifier++"s)",
+ [M, F, fargs(Argl,Modifier)]);
+ffunc({M,F,Arity},Modifier) ->
+ io_lib:format("~p:~"++Modifier++"p/~p", [M,F,Arity]);
+ffunc(X,Modifier) -> io_lib:format("~"++Modifier++"p", [X]).
%% Integer -> "Integer"
%% [A1, A2, ..., AN] -> "A1, A2, ..., AN"
-fargs(Arity) when is_integer(Arity) -> integer_to_list(Arity);
-fargs([]) -> [];
-fargs([A]) -> io_lib:format("~p", [A]); %% last arg
-fargs([A|Args]) -> [io_lib:format("~p,", [A]) | fargs(Args)];
-fargs(A) -> io_lib:format("~p", [A]). % last or only arg
+fargs(Arity,_) when is_integer(Arity) -> integer_to_list(Arity);
+fargs([],_) -> [];
+fargs([A],Modifier) ->
+ io_lib:format("~"++Modifier++"p", [A]); %% last arg
+fargs([A|Args],Modifier) ->
+ [io_lib:format("~"++Modifier++"p,", [A]) | fargs(Args,Modifier)];
+fargs(A,Modifier) ->
+ io_lib:format("~"++Modifier++"p", [A]). % last or only arg
%% {A_1, A_2, ..., A_N} -> "A_Index A_Index+1 ... A_Size"
-ftup(Trace, Index, Index) ->
- io_lib:format("~p", [element(Index, Trace)]);
-ftup(Trace, Index, Size) ->
- [io_lib:format("~p ", [element(Index, Trace)])
- | ftup(Trace, Index+1, Size)].
-
+ftup(Trace, Index, Index, Modifier) ->
+ io_lib:format("~"++Modifier++"p", [element(Index, Trace)]);
+ftup(Trace, Index, Size, Modifier) ->
+ [io_lib:format("~"++Modifier++"p ", [element(Index, Trace)])
+ | ftup(Trace, Index+1, Size, Modifier)].
+out({_,_}=Out) ->
+ Out;
+out(Device) ->
+ {Device,modifier(Device)}.
+
+modifier() ->
+ modifier(group_leader()).
+modifier(Device) ->
+ Encoding =
+ case io:getopts(Device) of
+ List when is_list(List) ->
+ proplists:get_value(encoding,List,latin1);
+ _ ->
+ latin1
+ end,
+ encoding_to_modifier(Encoding).
+
+encoding_to_modifier(latin1) -> "";
+encoding_to_modifier(_) -> "t".
trace_process(Pid, [clear]) ->
trac(Pid, false, all());
@@ -1157,22 +1228,22 @@ all() ->
timestamp,monotonic_timestamp,strict_monotonic_timestamp,
arity,return_to,silent,running_procs,running_ports,exiting].
-display_info([Node|Nodes]) ->
+display_info([Node|Nodes],Modifier) ->
io:format("~nNode ~w:~n",[Node]),
io:format("~-12s ~-21s Trace ~n", ["Pid", "Initial call"]),
List = rpc:call(Node,?MODULE,get_info,[]),
- display_info1(List),
- display_info(Nodes);
-display_info([]) ->
+ display_info1(List,Modifier),
+ display_info(Nodes,Modifier);
+display_info([],_) ->
ok.
-display_info1([{Pid,Call,Flags}|T]) ->
- io:format("~-12s ~-21s ~s~n",
+display_info1([{Pid,Call,Flags}|T],Modifier) ->
+ io:format("~-12s ~-21"++Modifier++"s ~s~n",
[io_lib:format("~w",[Pid]),
- io_lib:format("~p", [Call]),
+ io_lib:format("~"++Modifier++"p", [Call]),
format_trace(Flags)]),
- display_info1(T);
-display_info1([]) ->
+ display_info1(T,Modifier);
+display_info1([],_) ->
ok.
get_info() ->
@@ -1304,7 +1375,8 @@ tc_loop([], Handler, HData) ->
tc_loop(Reader, Handler, HData) when is_function(Reader) ->
tc_loop(Reader(), Handler, HData);
tc_loop(Other, _Handler, _HData) ->
- io:format("~p:tc_loop ~p~n", [?MODULE, Other]),
+ Modifier = modifier(),
+ io:format("~p:tc_loop ~"++Modifier++"p~n", [?MODULE, Other]),
exit({unknown_term_from_reader, Other}).
diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl
index d36af257ce..7f0c1ac6e4 100644
--- a/lib/runtime_tools/src/observer_backend.erl
+++ b/lib/runtime_tools/src/observer_backend.erl
@@ -63,9 +63,7 @@ sys_info() ->
end,
{{_,Input},{_,Output}} = erlang:statistics(io),
- [{process_count, erlang:system_info(process_count)},
- {process_limit, erlang:system_info(process_limit)},
- {uptime, element(1, erlang:statistics(wall_clock))},
+ [{uptime, element(1, erlang:statistics(wall_clock))},
{run_queue, erlang:statistics(run_queue)},
{io_input, Input},
{io_output, Output},
@@ -86,7 +84,17 @@ sys_info() ->
{thread_pool_size, erlang:system_info(thread_pool_size)},
{wordsize_internal, erlang:system_info({wordsize, internal})},
{wordsize_external, erlang:system_info({wordsize, external})},
- {alloc_info, alloc_info()}
+ {alloc_info, alloc_info()},
+ {process_count, erlang:system_info(process_count)},
+ {atom_limit, erlang:system_info(atom_limit)},
+ {atom_count, erlang:system_info(atom_count)},
+ {process_limit, erlang:system_info(process_limit)},
+ {process_count, erlang:system_info(process_count)},
+ {port_limit, erlang:system_info(port_limit)},
+ {port_count, erlang:system_info(port_count)},
+ {ets_limit, erlang:system_info(ets_limit)},
+ {ets_count, length(ets:all())},
+ {dist_buf_busy_limit, erlang:system_info(dist_buf_busy_limit)}
| MemInfo].
alloc_info() ->
diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk
index 8ec532de76..7296221033 100644
--- a/lib/runtime_tools/vsn.mk
+++ b/lib/runtime_tools/vsn.mk
@@ -1 +1 @@
-RUNTIME_TOOLS_VSN = 1.11.1
+RUNTIME_TOOLS_VSN = 1.12.1
diff --git a/lib/sasl/doc/src/notes.xml b/lib/sasl/doc/src/notes.xml
index 8684151b3a..bc35939d7e 100644
--- a/lib/sasl/doc/src/notes.xml
+++ b/lib/sasl/doc/src/notes.xml
@@ -31,6 +31,35 @@
</header>
<p>This document describes the changes made to the SASL application.</p>
+<section><title>SASL 3.0.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Documented default values for the 'mod' and
+ 'start_phases' fields in .app files were not allowed as
+ actual values in a .app file. This is now corrected.</p>
+ <p>
+ Own Id: OTP-14029</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>SASL 3.0.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/sasl/src/format_lib_supp.erl b/lib/sasl/src/format_lib_supp.erl
index 0b474a0232..80dcdc91da 100644
--- a/lib/sasl/src/format_lib_supp.erl
+++ b/lib/sasl/src/format_lib_supp.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.
@@ -25,15 +25,12 @@
%%% tools.
%%% The main parts are:
%%% 1) print_info. Prints information tagged by 'header', 'data',
-%%% 'table', 'items' and 'newline'.
+%%% 'items' and 'newline'.
%%%---------------------------------------------------------------------
%% intermodule exports
-export([print_info/2, print_info/3]).
-%% exports for use within module
--export([maxcol/2]).
-
%%---------------------------------------------------------------------
%% Format is an ordered list of:
%% {header, HeaderString}
@@ -42,10 +39,6 @@
%% (if possible); 'Key: Value'.
%% Elements in the list may also be single terms, which are
%% printed as they are.
-%% {table, {TableName, ColumnNames, Columns}}
-%% ColumnNames is a tuple of names for the columns, and
-%% Columns is a list, where each element is a tuple of
-%% data for that column.
%% {items, {Name, Items}}
%% Items is a list of KeyValue_tuples. Will be printed as:
%% 'Name:
@@ -77,9 +70,6 @@ print_format(Device, _Line, []) ->
print_format(Device, Line, [{data, Data}|T]) ->
print_data(Device, Line, Data),
print_format(Device, Line, T);
-print_format(Device, Line, [{table, Table}|T]) ->
- _ = print_table(Device, Line, Table),
- print_format(Device, Line, T);
print_format(Device, Line, [{items, Items}|T]) ->
print_items(Device, Line, Items),
print_format(Device, Line, T);
@@ -94,51 +84,49 @@ print_data(Device, Line, [{Key, Value}|T]) ->
print_one_line(Device, Line, Key, Value),
print_data(Device, Line, T);
print_data(Device, Line, [Value|T]) ->
- io:format(Device, "~p~n", [Value]),
+ Modifier = misc_supp:modifier(Device),
+ io:format(Device, "~"++Modifier++"p~n", [Value]),
print_data(Device, Line, T).
+
print_items(Device, Line, {Name, Items}) ->
print_items(Device, Line, Name, Items).
-print_table(Device, Line, {TableName, ColumnNames, Columns}) ->
- print_table(Device, Line, TableName, ColumnNames, Columns).
-
print_newlines(_Device, 0) -> ok;
print_newlines(Device, N) when N > 0 ->
io:format(Device, '~n', []),
print_newlines(Device, N-1).
print_one_line(Device, Line, Key, Value) ->
- StrKey = term_to_string(Key),
+ Modifier = misc_supp:modifier(Device),
+ StrKey = term_to_string(Key,Modifier),
KeyLen = lists:min([length(StrKey), Line]),
ValueLen = Line - KeyLen,
- Format1 = lists:concat(["~-", KeyLen, s]),
- Format2 = lists:concat(["~", ValueLen, "s~n"]),
+ Format1 = lists:concat(["~-", KeyLen, Modifier, "s"]),
+ Format2 = lists:concat(["~", ValueLen, Modifier, "s~n"]),
io:format(Device, Format1, [StrKey]),
- Try = term_to_string(Value),
+ Try = term_to_string(Value,Modifier),
Length = length(Try),
if
Length < ValueLen ->
io:format(Device, Format2, [Try]);
true ->
io:format(Device, "~n ", []),
- Format3 = lists:concat(["~", Line, ".9p~n"]),
+ Format3 = lists:concat(["~", Line, ".9", Modifier, "p~n"]),
io:format(Device, Format3, [Value])
end.
-term_to_string(Value) ->
- lists:flatten(io_lib:format(get_format(Value), [Value])).
+term_to_string(Value,Modifier) ->
+ lists:flatten(io_lib:format(get_format(Value,Modifier), [Value])).
-get_format(Value) ->
- case misc_supp:is_string(Value) of
- true -> "~s";
- false -> "~p"
+get_format([],_) ->
+ "~p";
+get_format(Value,Modifier) ->
+ case io_lib:printable_list(Value) of
+ true -> "~"++Modifier++"s";
+ false -> "~"++Modifier++"p"
end.
-make_list(0, _Elem) -> [];
-make_list(N, Elem) -> [Elem|make_list(N-1, Elem)].
-
-
%%-----------------------------------------------------------------
%% Items
%%-----------------------------------------------------------------
@@ -150,76 +138,3 @@ print_item_elements(_Device, _Line, []) -> ok;
print_item_elements(Device, Line, [{Key, Value}|T]) ->
print_one_line(Device, Line, lists:concat([" ", Key]), Value),
print_item_elements(Device, Line, T).
-
-%%-----------------------------------------------------------------
-%% Table handling
-%%-----------------------------------------------------------------
-extra_space_between_columns() -> 3.
-
-find_max_col([Row | T], ColumnSizes) ->
- find_max_col(T, misc_supp:multi_map({format_lib_supp, maxcol},
- [Row, ColumnSizes]));
-
-find_max_col([], ColumnSizes) -> ColumnSizes.
-
-maxcol(Term, OldMax) ->
- lists:max([length(term_to_string(Term)), OldMax]).
-
-make_column_format(With) ->
- lists:concat(["~", With + extra_space_between_columns(), s]).
-
-is_correct_column_length(_Length, []) -> true;
-is_correct_column_length(Length, [Tuple|T]) ->
- case size(Tuple) of
- Length -> is_correct_column_length(Length, T);
- _ -> false
- end;
-is_correct_column_length(_, _) -> false.
-
-print_table(Device, Line, TableName, _TupleOfColumnNames, []) ->
- print_one_line(Device, Line, TableName, "<empty table>"),
- io:format(Device, "~n", []);
-
-print_table(Device, Line, TableName, TupleOfColumnNames, ListOfTuples)
- when is_list(ListOfTuples), is_tuple(TupleOfColumnNames) ->
- case is_correct_column_length(size(TupleOfColumnNames),
- ListOfTuples) of
- true ->
- print_one_line(Device, Line, TableName, " "),
- ListOfColumnNames = tuple_to_list(TupleOfColumnNames),
- ListOfLists = lists:map(fun(Tuple) ->
- tuple_to_list(Tuple)
- end,
- ListOfTuples),
- ColWidths = find_max_col([ListOfColumnNames |
- ListOfLists],
- make_list(length(ListOfColumnNames),0)),
- Format = lists:flatten([lists:map(fun(CW) ->
- make_column_format(CW)
- end,
- ColWidths), "~n"]),
- io:format(Device, Format, ListOfColumnNames),
- io:format(Device,
- lists:concat(['~', extra_space_between_columns(),
- 'c', '~', lists:sum(ColWidths)
- + (length(ColWidths) - 1)
- * extra_space_between_columns(),
- 'c~n']), [$ , $-]),
- lists:foreach(fun(List) ->
- print_row(List, Device, Format)
- end,
- ListOfLists),
- io:format(Device, '~n', []),
- true;
- false ->
- {error, {'a tuple has wrong size',
- {TableName, TupleOfColumnNames, ListOfTuples}}}
- end.
-
-%%--------------------------------------------------
-%% Device MUST be 2nd arg because of extraarg ni foreach...
-%%--------------------------------------------------
-print_row(Row, Device, Format) ->
- io:format(Device, Format,
- lists:map(fun(Term) -> term_to_string(Term) end,
- Row)).
diff --git a/lib/sasl/src/misc_supp.erl b/lib/sasl/src/misc_supp.erl
index 093b337a2c..cbbcba0def 100644
--- a/lib/sasl/src/misc_supp.erl
+++ b/lib/sasl/src/misc_supp.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.
@@ -32,7 +32,7 @@
%%%---------------------------------------------------------------------
-export([format_pdict/3, format_tuples/2, assq/2, passq/2, is_string/1,
- multi_map/2]).
+ multi_map/2, modifier/1]).
%%-----------------------------------------------------------------
%% Uses format_tuples to format the data in process dictionary.
@@ -105,3 +105,19 @@ multi_map(Func, ListOfLists) ->
[apply(Func, lists:map(fun(List) -> hd(List) end, ListOfLists)) |
multi_map(Func,
lists:map(fun(List) -> tl(List) end, ListOfLists))].
+
+%%%-----------------------------------------------------------------
+%%% Check encoding of the given device and return "t" if this format
+%%% modifier should be used.
+modifier(Device) ->
+ Encoding =
+ case io:getopts(Device) of
+ List when is_list(List) ->
+ proplists:get_value(encoding,List,latin1);
+ _ ->
+ latin1
+ end,
+ encoding_to_modifier(Encoding).
+
+encoding_to_modifier(latin1) -> "";
+encoding_to_modifier(_) -> "t".
diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl
index 79df150b41..6595d29a9c 100644
--- a/lib/sasl/src/rb.erl
+++ b/lib/sasl/src/rb.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.
@@ -273,7 +273,7 @@ code_change(_OldVsn, State, _Extra) ->
open_log_file(standard_io) -> standard_io;
open_log_file(Fd) when is_atom(Fd),Fd=/=standard_error ->
case whereis(Fd) of
- undefined -> io:format("rb: Registered name not found '~s'.~n",
+ undefined -> io:format("rb: Registered name not found '~ts'.~n",
[Fd]),
io:format("rb: Using standard_io~n"),
open_log_file(standard_io);
@@ -281,10 +281,10 @@ open_log_file(Fd) when is_atom(Fd),Fd=/=standard_error ->
end;
open_log_file(Fd) when is_pid(Fd)-> Fd;
open_log_file(FileName) when is_list(FileName) ->
- case file:open(FileName, [write,append]) of
+ case file:open(FileName, [write,append,{encoding,utf8}]) of
{ok, Fd} -> Fd;
Error ->
- io:format("rb: Cannot open file '~s' (~w).~n",
+ io:format("rb: Cannot open file '~ts' (~w).~n",
[FileName, Error]),
io:format("rb: Using standard_io~n"),
standard_io
@@ -419,8 +419,8 @@ read_reports(No, Fd, Fname, Max, Type) ->
add_report_data(NewRes, No, Fname);
{error, [Problem | Res]} ->
_ = file:close(Fd),
- io:format("Error: ~p~n",[Problem]),
- io:format("Salvaged ~p entries from corrupt report file ~s...~n",
+ io:format("Error: ~tp~n",[Problem]),
+ io:format("Salvaged ~p entries from corrupt report file ~ts...~n",
[length(Res),Fname]),
NewRes =
if
@@ -431,7 +431,7 @@ read_reports(No, Fd, Fname, Max, Type) ->
end,
add_report_data(NewRes, No, Fname);
Else ->
- io:format("err ~p~n", [Else]),
+ io:format("err ~tp~n", [Else]),
[{No, unknown, "Can't read reports from file " ++ Fname,
"???", Fname, 0}]
end.
@@ -530,21 +530,18 @@ get_short_descr({{Date, Time}, {error_report, Pid, {_, crash_report, Rep}}}) ->
{value, {_Key, N}} -> N;
_ -> Pid
end,
- NameStr = lists:flatten(io_lib:format("~w", [Name])),
- {NameStr, date_str(Date, Time)};
+ {Name, date_str(Date, Time)};
get_short_descr({{Date, Time}, {error_report, Pid, {_, supervisor_report,Rep}}}) ->
Name =
case lists:keysearch(supervisor, 1, Rep) of
{value, {_Key, N}} when is_atom(N) -> N;
_ -> Pid
end,
- NameStr = lists:flatten(io_lib:format("~w", [Name])),
- {NameStr, date_str(Date,Time)};
+ {Name, date_str(Date,Time)};
get_short_descr({{Date, Time}, {_Type, Pid, _}}) ->
- NameStr = lists:flatten(io_lib:format("~w", [Pid])),
- {NameStr, date_str(Date,Time)};
+ {Pid, date_str(Date,Time)};
get_short_descr(_) ->
- {"???", "???"}.
+ {'???', "???"}.
date_str({Y,Mo,D}=Date,{H,Mi,S}=Time) ->
case application:get_env(sasl,utc_log) of
@@ -571,53 +568,57 @@ local_time_to_universal_time({Date,Time}) ->
end.
-print_list(Fd, Data, Type) ->
+print_list(Fd, Data0, Type) ->
+ Modifier = misc_supp:modifier(Fd),
Header = {"No", "Type", "Process", "Date Time"},
- Width = find_width([Header | Data], 0)+1,
- DateWidth = find_date_width([Header | Data], 0) +1,
- Format = lists:concat(["~4s~20s ~", Width, "s~20s~n"]),
+ {DescrWidth,DateWidth,Data} = find_widths(Data0, Modifier, 7, 13, []),
+ Format = lists:concat(["~4s~20s ~", DescrWidth, "s~20s~n"]),
io:format(Fd, Format, tuple_to_list(Header)),
io:format(Fd, Format, ["==", "====", "=======", "==== ===="]),
- print_list(Fd, Data, Type, Width, DateWidth).
-print_list(_, [], _, _, _) -> true;
-print_list(Fd, [H|T], Type, Width, DateWidth) ->
- print_one_report(Fd, H, Type, Width, DateWidth),
- print_list(Fd, T, Type, Width, DateWidth).
-
-find_width([], Width) -> Width;
-find_width([H|T], Width) ->
- Try = length(element(3, H)),
- if
- Try > Width -> find_width(T, Try);
- true -> find_width(T, Width)
- end.
-find_date_width([], Width) -> Width;
-find_date_width([H|T], Width) ->
- Try = length(element(4, H)),
- if
- Try > Width -> find_date_width(T, Try);
- true -> find_date_width(T, Width)
- end.
+ print_list(Fd, Data, Type, DescrWidth, DateWidth, Modifier).
+print_list(_, [], _, _, _, _) -> true;
+print_list(Fd, [H|T], Type, Width, DateWidth, Modifier) ->
+ print_one_report(Fd, H, Type, Width, DateWidth, Modifier),
+ print_list(Fd, T, Type, Width, DateWidth, Modifier).
+
+
+find_widths([], _Modifier, DescrWidth, DateWidth, Data) ->
+ {DescrWidth+1, DateWidth+1, lists:reverse(Data)};
+find_widths([H|T], Modifier, DescrWidth, DateWidth, Data) ->
+ DescrTerm = element(3,H),
+ Descr = lists:flatten(io_lib:format("~"++Modifier++"w", [DescrTerm])),
+ DescrTry = length(Descr),
+ NewDescrWidth =
+ if
+ DescrTry > DescrWidth -> DescrTry;
+ true -> DescrWidth
+ end,
+ DateTry = length(element(4, H)),
+ NewDateWitdh =
+ if
+ DateTry > DateWidth -> DateTry;
+ true -> DateWidth
+ end,
+ NewH = setelement(3,H,Descr),
+ find_widths(T, Modifier, NewDescrWidth, NewDateWitdh, [NewH|Data]).
print_one_report(Fd, {No, RealType, ShortDescr, Date, _Fname, _FilePos},
WantedType,
- Width, DateWidth) ->
+ Width, DateWidth, Modifier) ->
if
WantedType == all ->
print_short_descr(Fd, No, RealType, ShortDescr, Date, Width,
- DateWidth);
+ DateWidth, Modifier);
WantedType == RealType ->
print_short_descr(Fd, No, RealType, ShortDescr, Date, Width,
- DateWidth);
+ DateWidth, Modifier);
true -> ok
end.
-print_short_descr(Fd, No, Type, ShortDescr, Date, Width, DateWidth) ->
- Format = lists:concat(["~4w~20w ~", Width, "s~", DateWidth,"s~n"]),
- io:format(Fd, Format, [No,
- Type,
- io_lib:format("~s", [ShortDescr]),
- Date]).
+print_short_descr(Fd, No, Type, ShortDescr, Date, Width, DateWidth, Modifier) ->
+ Format = lists:concat(["~4w~20", Modifier, "w ~", Width, Modifier, "s~",
+ DateWidth, "s~n"]),
+ io:format(Fd, Format, [No, Type, ShortDescr, Date]).
print_report_by_num(Dir, Data, Number, Device, Abort, Log) ->
{_,Device1} = print_report(Dir, Data, Number, Device, Abort, Log),
@@ -658,7 +659,7 @@ print_report(Dir, Data, Number, Device, Abort, Log) ->
{ok, Fd} ->
read_rep(Fd, FilePosition, Device, Abort, Log);
_ ->
- io:format("rb: can't open file ~p~n", [Fname]),
+ io:format("rb: can't open file ~tp~n", [Fname]),
{proceed,Device}
end;
no_report ->
@@ -691,14 +692,14 @@ print_grep_report(Dir, Data, Number, Device, RegExp, Abort, Log) ->
{ok, Fd} when is_pid(Fd) ->
check_rep(Fd, FilePosition, Device, RegExp, Number, Abort, Log);
_ ->
- io:format("rb: can't open file ~p~n", [Fname]),
+ io:format("rb: can't open file ~tp~n", [Fname]),
{proceed,Device}
end.
check_rep(Fd, FilePosition, Device, RegExp, Number, Abort, Log) ->
case read_rep_msg(Fd, FilePosition) of
{Date, Msg} ->
- MsgStr = lists:flatten(io_lib:format("~p",[Msg])),
+ MsgStr = lists:flatten(io_lib:format("~tp",[Msg])),
case run_re(MsgStr, RegExp) of
match ->
io:format("Found match in report number ~w~n", [Number]),
@@ -722,7 +723,7 @@ run_re(Subject, Regexp) ->
run_re(Subject, Regexp, []).
run_re(Subject, Regexp, Options) ->
- case re:run(Subject, Regexp, Options) of
+ case re:run(Subject, Regexp, [unicode|Options--[unicode]]) of
nomatch ->
nomatch;
_ ->
@@ -748,7 +749,7 @@ filter_report(Dir, Data, Filters, Number, Device, Abort, Log) ->
{ok, Fd} ->
filter_rep(Filters, Fd, FilePosition, Device, Abort, Log);
_ ->
- io:format("rb: can't open file ~p~n", [Fname]),
+ io:format("rb: can't open file ~tp~n", [Fname]),
{proceed,Device}
end;
no_report ->
@@ -800,7 +801,7 @@ filter_report([{Key, RegExp, re}|T], Msg) ->
undefined ->
false;
Value ->
- Subject = lists:flatten(io_lib:format("~p",[Value])),
+ Subject = lists:flatten(io_lib:format("~tp",[Value])),
case run_re(Subject, RegExp) of
match ->
filter_report(T, Msg);
@@ -812,7 +813,7 @@ filter_report([{Key, RegExp, re, no}|T], Msg) ->
undefined ->
true;
Value ->
- Subject = lists:flatten(io_lib:format("~p",[Value])),
+ Subject = lists:flatten(io_lib:format("~tp",[Value])),
case run_re(Subject, RegExp) of
match -> false;
_ -> filter_report(T, Msg)
@@ -890,7 +891,7 @@ read_rep(Fd, FilePosition, Device, Abort, Log) ->
handle_bad_form(Date, Msg, Device, Abort, Log) ->
io:format("rb: ERROR! A report on bad form was encountered. " ++
"It can not be printed to the log.~n~n"),
- io:format("Details:~n~p ~p~n~n", [Date,Msg]),
+ io:format("Details:~n~p ~tp~n~n", [Date,Msg]),
case {Abort,Device,open_log_file(Log)} of
{true,standard_io,standard_io} ->
io:format("rb: Logging aborted.~n"),
@@ -899,7 +900,7 @@ handle_bad_form(Date, Msg, Device, Abort, Log) ->
io:format("rb: Logging resumed...~n~n"),
{proceed,Device};
{_,_,standard_io} ->
- io:format("rb: Can not reopen ~p. Logging aborted.~n", [Log]),
+ io:format("rb: Can not reopen ~tp. Logging aborted.~n", [Log]),
{abort,Device};
{true,_,NewDevice} ->
io:format(NewDevice,
diff --git a/lib/sasl/src/rb_format_supp.erl b/lib/sasl/src/rb_format_supp.erl
index 0004d85af4..1eda43dae4 100644
--- a/lib/sasl/src/rb_format_supp.erl
+++ b/lib/sasl/src/rb_format_supp.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.
@@ -94,13 +94,15 @@ print(Date, Report, Device) ->
[{header, Header}]),
io:format(Device, Format, Args);
{Type, _GL, TypeReport} ->
- io:format(Device, "~nInfo type <~w> ~s~n",
+ Modifier = misc_supp:modifier(Device),
+ io:format(Device, "~nInfo type <~"++Modifier++"w> ~s~n",
[Type, Date]),
- io:format(Device, "~p", [TypeReport]);
+ io:format(Device, "~"++Modifier++"p", [TypeReport]);
_ ->
+ Modifier = misc_supp:modifier(Device),
io:format("~nPrinting info of unknown type... ~s~n",
[Date]),
- io:format(Device, "~p", [Report])
+ io:format(Device, "~"++Modifier++"p", [Report])
% end
end.
diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl
index 669ffd95c0..d0a7c7332d 100644
--- a/lib/sasl/src/release_handler.erl
+++ b/lib/sasl/src/release_handler.erl
@@ -640,8 +640,8 @@ handle_call({install_release, Vsn, ErrorAction, Opts}, From, S) ->
{noreply, NS};
{'EXIT', Reason} ->
io:format("release_handler:"
- "install_release(Vsn=~p Opts=~p) failed, "
- "Reason=~p~n", [Vsn, Opts, Reason]),
+ "install_release(Vsn=~tp Opts=~tp) failed, "
+ "Reason=~tp~n", [Vsn, Opts, Reason]),
gen_server:reply(From, {error, Reason}),
case ErrorAction of
restart ->
@@ -1124,7 +1124,7 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) ->
{ok,[FC]} ->
FC;
{error,Error1} ->
- io:format("Warning: ~w can not read ~p: ~p~n",
+ io:format("Warning: ~w can not read ~tp: ~tp~n",
[?MODULE,FromFile,Error1]),
[]
end,
@@ -1134,7 +1134,7 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) ->
{ok,[ToConfig]} ->
[lists:keyfind(App,1,ToConfig) || App <- [kernel,stdlib,sasl]];
{error,Error2} ->
- io:format("Warning: ~w can not read ~p: ~p~n",
+ io:format("Warning: ~w can not read ~tp: ~tp~n",
[?MODULE,ToFile,Error2]),
[false,false,false]
end,
@@ -1143,8 +1143,9 @@ new_emulator_make_hybrid_config(CurrentVsn,ToVsn,TmpVsn,RelDir,Masters) ->
Config2 = replace_config(stdlib,Config1,Stdlib),
Config3 = replace_config(sasl,Config2,Sasl),
- ConfigStr = io_lib:format("~p.~n",[Config3]),
- write_file(TmpFile,ConfigStr,Masters).
+ ConfigStr = io_lib:format("%% ~s~n~tp.~n",
+ [epp:encoding_to_string(utf8),Config3]),
+ write_file(TmpFile,unicode:characters_to_binary(ConfigStr),Masters).
%% Take the configuration for application App from the new config and
%% insert in the old config.
@@ -1807,7 +1808,7 @@ check_opt_file(FileName, Type, Masters) ->
ok ->
true;
_Error ->
- io:format("Warning: ~p missing (optional)~n", [FileName]),
+ io:format("Warning: ~tp missing (optional)~n", [FileName]),
false
end.
@@ -1874,9 +1875,10 @@ write_releases_1(Dir, NewReleases, Masters) ->
write_releases_m(Dir, NewReleases, Masters).
do_write_release(Dir, RELEASES, NewReleases) ->
- case file:open(filename:join(Dir, RELEASES), [write]) of
+ case file:open(filename:join(Dir, RELEASES), [write,{encoding,utf8}]) of
{ok, Fd} ->
- ok = io:format(Fd, "~p.~n", [NewReleases]),
+ ok = io:format(Fd, "%% ~s~n~tp.~n",
+ [epp:encoding_to_string(utf8),NewReleases]),
ok = file:close(Fd);
{error, Reason} ->
{error, Reason}
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index 654a0acff2..391b1fb5cc 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -1152,10 +1152,10 @@ generate_script(Output, Release, Appls, Flags) ->
},
ScriptFile = Output ++ ".script",
- case file:open(ScriptFile, [write]) of
+ case file:open(ScriptFile, [write,{encoding,utf8}]) of
{ok, Fd} ->
- io:format(Fd, "%% script generated at ~w ~w\n~p.\n",
- [date(), time(), Script]),
+ io:format(Fd, "%% ~s\n%% script generated at ~w ~w\n~tp.\n",
+ [epp:encoding_to_string(utf8), date(), time(), Script]),
case file:close(Fd) of
ok ->
BootFile = Output ++ ".boot",
@@ -2234,9 +2234,9 @@ check_apps(_) ->
format_error(badly_formatted_release) ->
io_lib:format("Syntax error in the release file~n",[]);
format_error({illegal_name, Name}) ->
- io_lib:format("Illegal name (~p) in the release file~n",[Name]);
+ io_lib:format("Illegal name (~tp) in the release file~n",[Name]);
format_error({illegal_form, Form}) ->
- io_lib:format("Illegal tag in the release file: ~p~n",[Form]);
+ io_lib:format("Illegal tag in the release file: ~tp~n",[Form]);
format_error({missing_parameter,Par}) ->
io_lib:format("Missing parameter (~p) in the release file~n",[Par]);
format_error({illegal_applications,Names}) ->
@@ -2251,7 +2251,7 @@ format_error({mandatory_app,Name,Type}) ->
format_error({duplicate_register,Dups}) ->
io_lib:format("Duplicated register names: ~n~ts",
[map(fun({{Reg,App1,_,_},{Reg,App2,_,_}}) ->
- io_lib:format("\t~w registered in ~w and ~w~n",
+ io_lib:format("\t~tw registered in ~w and ~w~n",
[Reg,App1,App2])
end, Dups)]);
format_error({undefined_applications,Apps}) ->
@@ -2275,20 +2275,20 @@ format_error({modules,ModErrs}) ->
format_error({circular_dependencies,Apps}) ->
io_lib:format("Circular dependencies among applications: ~p~n",[Apps]);
format_error({not_found,File}) ->
- io_lib:format("File not found: ~p~n",[File]);
+ io_lib:format("File not found: ~tp~n",[File]);
format_error({parse,File,{Line,Mod,What}}) ->
Str = Mod:format_error(What),
io_lib:format("~ts:~w: ~ts\n",[File, Line, Str]);
format_error({read,File}) ->
- io_lib:format("Cannot read ~p~n",[File]);
+ io_lib:format("Cannot read ~tp~n",[File]);
format_error({open,File,Error}) ->
- io_lib:format("Cannot open ~p - ~ts~n",
+ io_lib:format("Cannot open ~tp - ~ts~n",
[File,file:format_error(Error)]);
format_error({close,File,Error}) ->
- io_lib:format("Cannot close ~p - ~ts~n",
+ io_lib:format("Cannot close ~tp - ~ts~n",
[File,file:format_error(Error)]);
format_error({delete,File,Error}) ->
- io_lib:format("Cannot delete ~p - ~ts~n",
+ io_lib:format("Cannot delete ~tp - ~ts~n",
[File,file:format_error(Error)]);
format_error({tar_error,What}) ->
form_tar_err(What);
@@ -2297,7 +2297,7 @@ format_error({warnings_treated_as_errors,Warnings}) ->
[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]).
+format_error(E) -> io_lib:format("~tp~n",[E]).
format_errors(ListOfErrors) ->
map(fun({error,E}) -> form_err(E);
@@ -2313,19 +2313,19 @@ form_err({module_not_found,App,Mod}) ->
form_err({error_add_appl, {Name, {tar_error, What}}}) ->
io_lib:format("~p: ~ts~n",[Name,form_tar_err(What)]);
form_err(E) ->
- io_lib:format("~p~n",[E]).
+ io_lib:format("~tp~n",[E]).
form_reading({not_found,File}) ->
- io_lib:format("File not found: ~p~n",[File]);
+ io_lib:format("File not found: ~tp~n",[File]);
form_reading({application_vsn, {Name,Vsn}}) ->
- io_lib:format("Application ~ts with version ~p not found~n",[Name, Vsn]);
+ io_lib:format("Application ~ts with version ~tp not found~n",[Name, Vsn]);
form_reading({parse,File,{Line,Mod,What}}) ->
Str = Mod:format_error(What),
io_lib:format("~ts:~w: ~ts\n",[File, Line, Str]);
form_reading({read,File}) ->
- io_lib:format("Cannot read ~p~n",[File]);
+ io_lib:format("Cannot read ~tp~n",[File]);
form_reading({{bad_param, P},_}) ->
- io_lib:format("Bad parameter in .app file: ~p~n",[P]);
+ io_lib:format("Bad parameter in .app file: ~tp~n",[P]);
form_reading({{missing_param,P},_}) ->
io_lib:format("Missing parameter in .app file: ~p~n",[P]);
form_reading({badly_formatted_application,_}) ->
@@ -2334,12 +2334,12 @@ form_reading({override_include,Apps}) ->
io_lib:format("Tried to include not (in .app file) specified applications: ~p~n",
[Apps]);
form_reading({no_valid_version, {{_, SVsn}, {_, File, FVsn}}}) ->
- io_lib:format("No valid version (~p) of .app file found. Found file ~p with version ~p~n",
+ io_lib:format("No valid version (~tp) of .app file found. Found file ~tp with version ~tp~n",
[SVsn, File, FVsn]);
form_reading({parse_error, {File, Line, Error}}) ->
- io_lib:format("Parse error in file: ~p. Line: ~w Error: ~p; ~n", [File, Line, Error]);
+ io_lib:format("Parse error in file: ~tp. Line: ~w Error: ~tp; ~n", [File, Line, Error]);
form_reading(W) ->
- io_lib:format("~p~n",[W]).
+ io_lib:format("~tp~n",[W]).
form_tar_err({open, File, Error}) ->
io_lib:format("Cannot open tar file ~ts - ~ts~n",
@@ -2357,14 +2357,14 @@ 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",
+ io_lib:format("~ts~w: Parse error: ~tp~n",
[Prefix,App,File]);
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}) ->
F = fun({M,F,A}) ->
- io_lib:format("~tsUndefined function ~w:~w/~w~n",
+ io_lib:format("~tsUndefined function ~w:~tw/~w~n",
[Prefix,M,F,A])
end,
map(F, Undef);
@@ -2373,4 +2373,4 @@ form_warn(Prefix, missing_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~tp~n", [Prefix,What]).
diff --git a/lib/sasl/src/systools_rc.erl b/lib/sasl/src/systools_rc.erl
index 7722cef57b..c570ed00ab 100644
--- a/lib/sasl/src/systools_rc.erl
+++ b/lib/sasl/src/systools_rc.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.
@@ -942,41 +942,41 @@ format_error(too_many_point_of_no_return) ->
io_lib:format("Too many point_of_no_return~n", []);
format_error({bad_instruction, X}) ->
- io_lib:format("Bad instruction: ~p~n", [X]);
+ io_lib:format("Bad instruction: ~tp~n", [X]);
format_error({bad_module, X}) ->
- io_lib:format("Bad module: ~p(should be atom())~n", [X]);
+ io_lib:format("Bad module: ~tp(should be atom())~n", [X]);
format_error({bad_code_change, X}) ->
- io_lib:format("Bad code_change: ~p(should be {Mod, Extra})~n", [X]);
+ io_lib:format("Bad code_change: ~tp(should be {Mod, Extra})~n", [X]);
format_error({bad_change, X}) ->
- io_lib:format("Bad change spec: ~p(should be soft | {advanced, E})~n", [X]);
+ io_lib:format("Bad change spec: ~tp(should be soft | {advanced, E})~n", [X]);
format_error({bad_mod_type, X}) ->
- io_lib:format("Bad module type: ~p(should be static | dynamic)~n", [X]);
+ io_lib:format("Bad module type: ~tp(should be static | dynamic)~n", [X]);
format_error({bad_purge_method, X}) ->
- io_lib:format("Bad purge method: ~p(should be soft_purge | brutal_purge)~n",
+ io_lib:format("Bad purge method: ~tp(should be soft_purge | brutal_purge)~n",
[X]);
format_error({bad_list, X}) ->
- io_lib:format("Bad list: ~p~n", [X]);
+ io_lib:format("Bad list: ~tp~n", [X]);
format_error({bad_args_list, X}) ->
- io_lib:format("Bad argument list: ~p~n", [X]);
+ io_lib:format("Bad argument list: ~tp~n", [X]);
format_error({bad_node, X}) ->
- io_lib:format("Bad node: ~p(should be atom())~n", [X]);
+ io_lib:format("Bad node: ~tp(should be atom())~n", [X]);
format_error({bad_application, X}) ->
- io_lib:format("Bad application: ~p(should be atom())~n", [X]);
+ io_lib:format("Bad application: ~tp(should be atom())~n", [X]);
format_error({bad_func, X}) ->
- io_lib:format("Bad function: ~p(should be atom())~n", [X]);
+ io_lib:format("Bad function: ~tp(should be atom())~n", [X]);
format_error({bad_lib, X}) ->
- io_lib:format("Bad library: ~p(should be atom())~n", [X]);
+ io_lib:format("Bad library: ~tp(should be atom())~n", [X]);
format_error({bad_lib_vsn, X}) ->
- io_lib:format("Bad library version: ~p(should be string())~n", [X]);
+ io_lib:format("Bad library version: ~tp(should be string())~n", [X]);
format_error({bad_timeout, X}) ->
- io_lib:format("Bad timeout: ~p(should be infinity | int() > 0)~n", [X]);
+ io_lib:format("Bad timeout: ~tp(should be infinity | int() > 0)~n", [X]);
format_error({undef_module, Mod}) ->
io_lib:format("Undefined module: ~p~n", [Mod]);
format_error({muldef_module, Mod}) ->
io_lib:format("Multiply defined module: ~p~n", [Mod]);
format_error(E) ->
- io_lib:format("~p~n",[E]).
+ io_lib:format("~tp~n",[E]).
%%-----------------------------------------------------------------
diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl
index 6bc26c8cc9..e836d57670 100644
--- a/lib/sasl/src/systools_relup.erl
+++ b/lib/sasl/src/systools_relup.erl
@@ -535,9 +535,9 @@ to_list(X) when is_list(X) -> X.
write_relup_file(Relup, Opts) ->
Filename = filename:join(filename:absname(get_opt(outdir,Opts)),
"relup"),
- case file:open(Filename, [write]) of
+ case file:open(Filename, [write,{encoding,utf8}]) of
{ok, Fd} ->
- io:format(Fd, "~p.~n", [Relup]),
+ io:format(Fd, "%% ~s~n~tp.~n", [epp:encoding_to_string(utf8),Relup]),
case file:close(Fd) of
ok -> ok;
{error,Reason} ->
@@ -589,7 +589,7 @@ print_error({error, Mod, Error}) ->
S = apply(Mod, format_error, [Error]),
io:format(S, []);
print_error(Other) ->
- io:format("Error: ~p~n", [Other]).
+ io:format("Error: ~tp~n", [Other]).
format_error({file_problem, {File, What}}) ->
io_lib:format("Could not ~w file ~ts~n", [get_reason(What), File]);
@@ -606,7 +606,7 @@ 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_lib:format("~p~n", [Error]).
+ io_lib:format("~tp~n", [Error]).
print_warnings(Ws) when is_list(Ws) ->
@@ -621,12 +621,12 @@ format_warning(W) ->
format_warning("*WARNING* ", W).
format_warning(Prefix, {erts_vsn_changed, {Rel1, Rel2}}) ->
- io_lib:format("~tsThe ERTS version changed between ~p and ~p~n",
+ io_lib:format("~tsThe ERTS version changed between ~tp and ~tp~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]).
+ io_lib:format("~ts~tp~n",[Prefix, What]).
get_reason({error, {open, _, _}}) -> open;
diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl
index 7093158502..50932e89e4 100644
--- a/lib/sasl/test/release_handler_SUITE.erl
+++ b/lib/sasl/test/release_handler_SUITE.erl
@@ -66,7 +66,7 @@ cases() ->
supervisor_which_children_timeout,
release_handler_which_releases, install_release_syntax_check,
upgrade_supervisor, upgrade_supervisor_fail, otp_9864,
- otp_10463_upgrade_script_regexp, no_dot_erlang].
+ otp_10463_upgrade_script_regexp, no_dot_erlang, unicode_upgrade].
groups() ->
[{release,[],
@@ -1875,6 +1875,86 @@ no_dot_erlang(Conf) ->
ok
end.
+%%%-----------------------------------------------------------------
+%%% Test unicode handling. Make sure that release name, application
+%%% description, and application environment variables may contain
+%%% unicode characters.
+unicode_upgrade(Conf) ->
+ %% Set some paths
+ DataDir = ?config(data_dir, Conf),
+ PrivDir = priv_dir(Conf),
+ Dir = filename:join(PrivDir,"unicode"),
+ LibDir0 = filename:join(DataDir, "unicode"),
+ LibDir =
+ case {file:native_name_encoding(),os:type()} of
+ {utf8,{Os,_}} when Os =/= win32 ->
+ LD = filename:join(DataDir,"unicode_αβ"),
+ file:make_symlink("unicode",LD),
+ LD;
+ _ ->
+ LibDir0
+ end,
+
+ %% Create the releases
+ RelName = "unicode_rel_αβ",
+ Rel1 = create_and_install_fake_first_release(Dir,{RelName,"1"},
+ [{u,"1.0",LibDir}]),
+ Rel2 = create_fake_upgrade_release(Dir,
+ {RelName,"2"},
+ [{u,"1.1",LibDir}],
+ {[Rel1],[Rel1],[LibDir]}),
+ Rel1Dir = filename:dirname(Rel1),
+ Rel2Dir = filename:dirname(Rel2),
+
+ %% Start a slave node
+ {ok, Node} = t_start_node(unicode_upgrade, Rel1,
+ filename:join(Rel1Dir,"sys.config"), "+pc unicode"),
+
+ %% Check
+ Dir1 = filename:join([LibDir, "u-1.0"]),
+ Dir1 = rpc:call(Node, code, lib_dir, [u]),
+ UBeam1 = filename:join([Dir1,"ebin","u.beam"]),
+ UBeam1 = rpc:call(Node,code,which,[u]),
+ {RelName,"1"} = rpc:call(Node,init,script_id,[]),
+ {Env,state} = rpc:call(Node,u,u,[]),
+ 'val_αβ' = proplists:get_value('key_αβ',Env),
+ [{RelName,"1",_,permanent}|_] =
+ rpc:call(Node,release_handler,which_releases,[]),
+ {ok,ReleasesDir} = rpc:call(Node,application,get_env,[sasl,releases_dir]),
+ {ok,[[{release,RelName,"1",_,_,permanent}|_]]} =
+ file:consult(filename:join(ReleasesDir,"RELEASES")),
+
+ %% Install second release
+ {ok, RelVsn2} =
+ rpc:call(Node, release_handler, set_unpacked,
+ [Rel2++".rel", [{u,"1.1",LibDir}]]),
+ ok = rpc:call(Node, release_handler, install_file,
+ [RelVsn2, filename:join(Rel2Dir, "relup")]),
+ ok = rpc:call(Node, release_handler, install_file,
+ [RelVsn2, filename:join(Rel2Dir, "start.boot")]),
+ ok = rpc:call(Node, release_handler, install_file,
+ [RelVsn2, filename:join(Rel2Dir, "sys.config")]),
+
+ {ok, _RelVsn1, []} =
+ rpc:call(Node, release_handler, install_release, [RelVsn2]),
+
+ %% And check
+ Dir2 = filename:join([LibDir, "u-1.1"]),
+ Dir2 = rpc:call(Node, code, lib_dir, [u]),
+ UBeam2 = filename:join([Dir2,"ebin","u.beam"]),
+ {file,UBeam2} = rpc:call(Node,code,is_loaded,[u]),
+ {RelName,"1"} = rpc:call(Node,init,script_id,[]),
+ {Env,{state,'αβ'}} = rpc:call(Node,u,u,[]),
+ [{RelName,"2",_,current}|_] =
+ rpc:call(Node,release_handler,which_releases,[]),
+ {ok,ReleasesDir2} = rpc:call(Node,application,get_env,[sasl,releases_dir]),
+ {ok,<<"%% coding: utf-8\n[{release,\"unicode_rel_αβ\",\"2\""/utf8,_/binary>>}=
+ file:read_file(filename:join(ReleasesDir2,"RELEASES")),
+ ok.
+
+unicode_upgrade(cleanup,_Conf) ->
+ stop_node(node_name(unicode_upgrade)).
+
%%%=================================================================
%%% Misceleaneous functions
@@ -2002,6 +2082,8 @@ are_names_reg_gg(Node, Names, N) ->
t_start_node(Name, Boot, SysConfig) ->
+ t_start_node(Name, Boot, SysConfig, "").
+t_start_node(Name, Boot, SysConfig, ArgStr) ->
Args =
case Boot of
[] -> [];
@@ -2010,8 +2092,9 @@ t_start_node(Name, Boot, SysConfig) ->
case SysConfig of
[] -> [];
_ -> " -config " ++ SysConfig
- end,
- test_server:start_node(Name, slave, [{args, Args}]).
+ end ++
+ " " ++ ArgStr,
+ test_server:start_node(Name, peer, [{args, Args}]).
stop_node(Node) ->
?t:stop_node(Node).
@@ -2460,7 +2543,9 @@ create_rel_file(RelFile,RelName,RelVsn,Erts,ExtraApps) ->
%% Insert a term in a file, which can be read with file:consult/1.
write_term_file(File,Term) ->
- ok = file:write_file(File,io_lib:format("~p.~n",[Term])).
+ Str = io_lib:format("%% ~s~n~tp.~n",[epp:encoding_to_string(utf8),Term]),
+ Bin = unicode:characters_to_binary(Str),
+ ok = file:write_file(File,Bin).
%% Check that global group info is correct - try again for a maximum of 5 sec
@@ -2719,8 +2804,8 @@ cover_fun(Node,Func) ->
%% and possibly other applications if they are listed in AppDirs =
%% [{App,Vsn,LibDir}]
create_and_install_fake_first_release(Dir,AppDirs) ->
- %% Create the first release
- {RelName,RelVsn} = init:script_id(),
+ create_and_install_fake_first_release(Dir,init:script_id(),AppDirs).
+create_and_install_fake_first_release(Dir,{RelName,RelVsn},AppDirs) ->
{Rel,_} = create_fake_release(Dir,RelName,RelVsn,AppDirs),
ReleasesDir = filename:join(Dir, "releases"),
RelDir = filename:dirname(Rel),
@@ -2744,9 +2829,11 @@ create_and_install_fake_first_release(Dir,AppDirs) ->
%% be upgraded to from the release created by
%% create_and_install_fake_first_release/2. Unpack first by calls to
%% release_handler:set_unpacked and release_handler:install_file.
-create_fake_upgrade_release(Dir,RelVsn,AppDirs,{UpFrom,DownTo,ExtraLibs}) ->
- %% Create a new release
+create_fake_upgrade_release(Dir,RelVsn,AppDirs,UpgrInstr) when not is_tuple(RelVsn) ->
{RelName,_} = init:script_id(),
+ create_fake_upgrade_release(Dir,{RelName,RelVsn},AppDirs,UpgrInstr);
+create_fake_upgrade_release(Dir,{RelName,RelVsn},AppDirs,{UpFrom,DownTo,ExtraLibs}) ->
+ %% Create a new release
{Rel,Paths} = create_fake_release(Dir,RelName,RelVsn,AppDirs),
RelDir = filename:dirname(Rel),
diff --git a/lib/sasl/test/release_handler_SUITE_data/Makefile.src b/lib/sasl/test/release_handler_SUITE_data/Makefile.src
index b794aa0e6f..113d3e2290 100644
--- a/lib/sasl/test/release_handler_SUITE_data/Makefile.src
+++ b/lib/sasl/test/release_handler_SUITE_data/Makefile.src
@@ -76,7 +76,13 @@ SUP= \
release_handler_timeouts/dummy-0.1/ebin/dummy_sup.@EMULATOR@ \
release_handler_timeouts/dummy-0.1/ebin/dummy_sup_2.@EMULATOR@
-all: $(LIB) $(APP) $(OTP2740) $(C) $(SUP)
+UNICODE= \
+ unicode/u-1.0/ebin/u.@EMULATOR@ \
+ unicode/u-1.0/ebin/u_sup.@EMULATOR@ \
+ unicode/u-1.1/ebin/u.@EMULATOR@ \
+ unicode/u-1.1/ebin/u_sup.@EMULATOR@
+
+all: $(LIB) $(APP) $(OTP2740) $(C) $(SUP) $(UNICODE)
lib/a-1.0/ebin/a.@EMULATOR@: lib/a-1.0/src/a.erl
erlc $(EFLAGS) -olib/a-1.0/ebin lib/a-1.0/src/a.erl
@@ -236,3 +242,13 @@ release_handler_timeouts/dummy-0.1/ebin/dummy_sup.@EMULATOR@: release_handler_ti
erlc $(EFLAGS) -orelease_handler_timeouts/dummy-0.1/ebin release_handler_timeouts/dummy-0.1/src/dummy_sup.erl
release_handler_timeouts/dummy-0.1/ebin/dummy_sup_2.@EMULATOR@: release_handler_timeouts/dummy-0.1/src/dummy_sup_2.erl
erlc $(EFLAGS) -orelease_handler_timeouts/dummy-0.1/ebin release_handler_timeouts/dummy-0.1/src/dummy_sup_2.erl
+
+unicode/u-1.0/ebin/u.@EMULATOR@: unicode/u-1.0/src/u.erl
+ erlc $(EFLAGS) -ounicode/u-1.0/ebin unicode/u-1.0/src/u.erl
+unicode/u-1.0/ebin/u_sup.@EMULATOR@: unicode/u-1.0/src/u_sup.erl
+ erlc $(EFLAGS) -ounicode/u-1.0/ebin unicode/u-1.0/src/u_sup.erl
+
+unicode/u-1.1/ebin/u.@EMULATOR@: unicode/u-1.1/src/u.erl
+ erlc $(EFLAGS) -ounicode/u-1.1/ebin unicode/u-1.1/src/u.erl
+unicode/u-1.1/ebin/u_sup.@EMULATOR@: unicode/u-1.1/src/u_sup.erl
+ erlc $(EFLAGS) -ounicode/u-1.1/ebin unicode/u-1.1/src/u_sup.erl
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/ebin/u.app b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/ebin/u.app
new file mode 100644
index 0000000000..fea4f9992e
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/ebin/u.app
@@ -0,0 +1,8 @@
+{application, u,
+ [{description, "This app shall test unicode handling αβ"},
+ {vsn, "1.0"},
+ {modules, [u, u_sup]},
+ {registered, [u_sup]},
+ {applications, [kernel, stdlib]},
+ {env, [{'key_αβ', 'val_αβ'}]},
+ {mod, {u_sup, []}}]}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u.erl b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u.erl
new file mode 100644
index 0000000000..45fe098c0e
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u.erl
@@ -0,0 +1,50 @@
+%% ``Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(u).
+
+
+-behaviour(gen_server).
+
+-vsn(1).
+
+%% External exports
+-export([start_link/0, u/0]).
+%% Internal exports
+-export([init/1, handle_call/3, handle_info/2, terminate/2]).
+
+start_link() -> gen_server:start_link({local, uu}, u, [], []).
+
+u() -> gen_server:call(uu, u).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok, state}.
+
+handle_call(u, _From, State) ->
+ X = application:get_all_env(u),
+ {reply, {X,State}, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u_sup.erl b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u_sup.erl
new file mode 100644
index 0000000000..b0d4a7b58f
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.0/src/u_sup.erl
@@ -0,0 +1,38 @@
+%% ``Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(u_sup).
+
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_, _) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+init([]) ->
+ SupFlags = {one_for_one, 4, 3600},
+ Config = {u,
+ {u, start_link, []},
+ permanent, 2000, worker, [u]},
+ {ok, {SupFlags, [Config]}}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.app b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.app
new file mode 100644
index 0000000000..8fcc3bba42
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.app
@@ -0,0 +1,8 @@
+{application, u,
+ [{description, "This app shall test unicode handling αβ"},
+ {vsn, "1.1"},
+ {modules, [u, u_sup]},
+ {registered, [u_sup]},
+ {applications, [kernel, stdlib]},
+ {env, [{'key_αβ', 'val_αβ'}]},
+ {mod, {u_sup, []}}]}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.appup b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.appup
new file mode 100644
index 0000000000..0344ce92ab
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/ebin/u.appup
@@ -0,0 +1,3 @@
+{"1.1",
+ [{"1.0",[{update,u,{advanced,'αβ'}}]}],
+ [{"1.0",[{update,u,{advanced,'αβ'}}]}]}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u.erl b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u.erl
new file mode 100644
index 0000000000..d2544d6fc1
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u.erl
@@ -0,0 +1,55 @@
+%% ``Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(u).
+
+
+-behaviour(gen_server).
+
+-vsn(1).
+
+%% External exports
+-export([start_link/0, u/0]).
+%% Internal exports
+-export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]).
+
+start_link() -> gen_server:start_link({local, uu}, u, [], []).
+
+u() -> gen_server:call(uu, u).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok, {state,'αβ'}}.
+
+handle_call(u, _From, State) ->
+ X = application:get_all_env(u),
+ {reply, {X,State}, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+code_change({down,_}, {State,_}, _Extra) ->
+ {ok, State};
+code_change(_, State, Extra) ->
+ {ok, {State, Extra}}.
diff --git a/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u_sup.erl b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u_sup.erl
new file mode 100644
index 0000000000..b0d4a7b58f
--- /dev/null
+++ b/lib/sasl/test/release_handler_SUITE_data/unicode/u-1.1/src/u_sup.erl
@@ -0,0 +1,38 @@
+%% ``Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(u_sup).
+
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_, _) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, []).
+
+init([]) ->
+ SupFlags = {one_for_one, 4, 3600},
+ Config = {u,
+ {u, start_link, []},
+ permanent, 2000, worker, [u]},
+ {ok, {SupFlags, [Config]}}.
diff --git a/lib/sasl/test/sasl_report_SUITE.erl b/lib/sasl/test/sasl_report_SUITE.erl
index aa229726ae..53fb614921 100644
--- a/lib/sasl/test/sasl_report_SUITE.erl
+++ b/lib/sasl/test/sasl_report_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2015-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.
@@ -79,7 +79,7 @@ do_gen_server_crash(Config) ->
error_logger:logfile(close),
check_file(KernelLog, 70000, 150000),
- check_file(SaslLog, 50000, 100000),
+ check_file(SaslLog, 100000, 150000),
ok.
diff --git a/lib/sasl/vsn.mk b/lib/sasl/vsn.mk
index 6aa662a743..2608ca5e00 100644
--- a/lib/sasl/vsn.mk
+++ b/lib/sasl/vsn.mk
@@ -1 +1 @@
-SASL_VSN = 3.0.3
+SASL_VSN = 3.0.4
diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml
index f1919a6bb1..b902e421ca 100644
--- a/lib/snmp/doc/src/notes.xml
+++ b/lib/snmp/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -34,7 +34,24 @@
</header>
- <section><title>SNMP 5.2.5</title>
+ <section><title>SNMP 5.2.6</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Internal code change: Calls to <c>catch</c> followed
+ by a call to <c>erlang:get_stacktrace/0</c> has been
+ rewritten to use <c>try</c> instead of <c>catch</c> to
+ make the code future-proof.</p>
+ <p>
+ Own Id: OTP-14400</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>SNMP 5.2.5</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/snmp/src/agent/snmp_generic.erl b/lib/snmp/src/agent/snmp_generic.erl
index 4738525341..e67a1b3c80 100644
--- a/lib/snmp/src/agent/snmp_generic.erl
+++ b/lib/snmp/src/agent/snmp_generic.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.
diff --git a/lib/snmp/test/snmp_manager_test.erl b/lib/snmp/test/snmp_manager_test.erl
index 054e998af4..4bfeb0f8d1 100644
--- a/lib/snmp/test/snmp_manager_test.erl
+++ b/lib/snmp/test/snmp_manager_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.
diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk
index 30b8ee1124..d41b1999cc 100644
--- a/lib/snmp/vsn.mk
+++ b/lib/snmp/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = snmp
-SNMP_VSN = 5.2.5
+SNMP_VSN = 5.2.6
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)"
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index bddae00dd2..f93753f1d2 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -30,6 +30,176 @@
<file>notes.xml</file>
</header>
+<section><title>Ssh 4.5</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ The internal handling of SSH options is re-written.</p>
+ <p>
+ Previously there were no checks if a client option was
+ given to a daemon or vice versa. This is corrected now.
+ If your code has e.g. a client-only option in a call to
+ start a daemon, the call will fail.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-12872</p>
+ </item>
+ <item>
+ <p>
+ Modernization of key exchange algorithms. See
+ draft-ietf-curdle-ssh-kex-sha2 for a discussion.</p>
+ <p>
+ Removed an outdated weak algorithm and added stronger
+ replacements to keep interoperability with other modern
+ ssh clients and servers. The default ordering of the
+ algorithms is also adjusted.</p>
+ <p>
+ Retired: The nowadays unsecure key-exchange
+ <c>diffie-hellman-group1-sha1</c> is not enabled by
+ default, but can be enabled with the option
+ <c>preferred-algorithms</c>.</p>
+ <p>
+ Added: The new stronger key-exchange
+ <c>diffie-hellman-group16-sha512</c>,
+ <c>diffie-hellman-group18-sha512</c> and
+ <c>diffie-hellman-group14-sha256</c> are added and
+ enabled by default.</p>
+ <p>
+ The questionable [RFC 6194] sha1-based algorithms
+ <c>diffie-hellman-group-exchange-sha1</c> and
+ <c>diffie-hellman-group14-sha1</c> are however still kept
+ enabled by default for compatibility with ancient clients
+ and servers that lack modern key-exchange alternatives.
+ When the draft-ietf-curdle-ssh-kex-sha2 becomes an rfc,
+ those sha1-based algorithms and
+ <c>diffie-hellman-group1-sha1</c> will be deprecated by
+ IETF. They might then be removed from the default list in
+ Erlang/OTP.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14110</p>
+ </item>
+ <item>
+ <p>
+ Modernized internal representation of sftp by use of
+ maps.</p>
+ <p>
+ Own Id: OTP-14117</p>
+ </item>
+ <item>
+ <p>
+ The Extension Negotiation Mechanism and the extension
+ <c>server-sig-algs</c> in
+ draft-ietf-curdle-ssh-ext-info-05 are implemented.</p>
+ <p>
+ The related draft-ietf-curdle-rsa-sha2-05 is implemented
+ and introduces the signature algorithms
+ <c>rsa-sha2-256</c> and <c>rsa-sha2-512</c>.</p>
+ <p>
+ Own Id: OTP-14193</p>
+ </item>
+ <item>
+ <p>
+ The 'timeout' and 'connect_timeout' handling in
+ ssh_sftp:start_channel documentation is clarified.</p>
+ <p>
+ Own Id: OTP-14216</p>
+ </item>
+ <item>
+ <p>
+ The functions <c>ssh:connect</c>, <c>ssh:shell</c> and
+ <c>ssh:start_channel</c> now accept an IP-tuple as Host
+ destination argument.</p>
+ <p>
+ Own Id: OTP-14243</p>
+ </item>
+ <item>
+ <p>
+ The function <c>ssh:daemon_info/1</c> now returns Host
+ and Profile as well as the Port info in the property
+ list.</p>
+ <p>
+ Own Id: OTP-14259</p>
+ </item>
+ <item>
+ <p>
+ Removed the option <c>public_key_alg</c> which was
+ deprecated in 18.2. Use <c>pref_public_key_algs</c>
+ instead.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14263</p>
+ </item>
+ <item>
+ <p>
+ The SSH application is refactored regarding daemon
+ starting. The resolution of contradicting <c>Host</c>
+ argument and <c>ip</c> option were not described. There
+ were also strange corner cases when the <c>'any'</c>
+ value was used in <c>Host</c> argument or <c>ip</c>
+ option. This is (hopefully) resolved now, but it may
+ cause incompatibilities for code using both <c>Host</c>
+ and the <c>ip</c> option. The value 'loopback' has been
+ added for a correct way of naming those addresses.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14264</p>
+ </item>
+ <item>
+ <p>
+ The supervisor code is refactored. The naming of
+ listening IP-Port-Profile triples are slightly changed to
+ improve consistency in strange corner cases as resolved
+ by OTP-14264</p>
+ <p>
+ Own Id: OTP-14267 Aux Id: OTP-14266 </p>
+ </item>
+ <item>
+ <p>
+ The <c>idle_time</c> option can now be used in daemons.</p>
+ <p>
+ Own Id: OTP-14312</p>
+ </item>
+ <item>
+ <p>
+ Added test cases for IETF-CURDLE Extension Negotiation
+ (ext-info)</p>
+ <p>
+ Own Id: OTP-14361</p>
+ </item>
+ <item>
+ <p>
+ Testcases for IETF-CURDLE extension
+ <c>server-sig-algs</c> including <c>rsa-sha2-*</c></p>
+ <p>
+ Own Id: OTP-14362 Aux Id: OTP-14361 </p>
+ </item>
+ <item>
+ <p>
+ The option <c>auth_methods</c> can now also be used in
+ clients to select which authentication options that are
+ used and in which order.</p>
+ <p>
+ Own Id: OTP-14399</p>
+ </item>
+ <item>
+ <p>
+ Checks that a ECDSA public key (<c>ecdsa-sha2-nistp*</c>)
+ stored in a file has the correct size.</p>
+ <p>
+ Own Id: OTP-14410</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Ssh 4.4.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index 5c9ce3d5fb..ea7e975ef5 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -320,6 +320,29 @@
attempted.</p>
</item>
+ <!--tag><c><![CDATA[{send_ext_info, boolean()}]]></c></tag>
+ <item>
+ <p>Send a list of extensions to the server if the server has asked for it. See
+ <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details.
+ </p>
+ <p>Currently the client do not react on any extensions.
+ </p>
+ <p>Default value is <c>true</c>.
+ </p>
+ </item-->
+
+ <tag><c><![CDATA[{recv_ext_info, boolean()}]]></c></tag>
+ <item>
+ <p>Tell the server that the client accepts extension negotiation. See
+ <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details.
+ </p>
+ <p>Currently implemented extension is <c>server-sig-algs</c> which is the list of the server's preferred
+ user's public key algorithms.
+ </p>
+ <p>Default value is <c>true</c>.
+ </p>
+ </item>
+
<tag><c><![CDATA[{key_cb, key_cb()}]]></c></tag>
<item>
<p>Module implementing the behaviour <seealso
@@ -685,6 +708,27 @@
</p>
</item>
+ <tag><c><![CDATA[{send_ext_info, boolean()}]]></c></tag>
+ <item>
+ <p>Send a list of extensions to the client if the client has asked for it. See
+ <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details.
+ </p>
+ <p>Currently implemented extension is sending <c>server-sig-algs</c> which is the list of the server's preferred
+ user's public key algorithms.
+ </p>
+ <p>Default value is <c>true</c>.
+ </p>
+ </item>
+
+ <!--tag><c><![CDATA[{recv_ext_info, boolean()}]]></c></tag>
+ <item>
+ <p>Tell the client that the server accepts extension negotiation. See
+ <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url> for details.
+ </p>
+ <p>Default value is <c>true</c>.
+ </p>
+ </item-->
+
<tag><c><![CDATA[{key_cb, key_cb()}]]></c></tag>
<item>
<p>Module implementing the behaviour <seealso
diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml
index 74c4111338..33ec7aaee0 100644
--- a/lib/ssh/doc/src/ssh_app.xml
+++ b/lib/ssh/doc/src/ssh_app.xml
@@ -161,6 +161,8 @@
<item>ecdsa-sha2-nistp521</item>
<item>ssh-rsa</item>
<item>ssh-dss</item>
+ <item>rsa-sha2-256</item>
+ <item>rsa-sha2-512</item>
</list>
</item>
@@ -176,21 +178,23 @@
<tag>Encryption algorithms (ciphers)</tag>
<item>
<list type="bulleted">
- <item>[email protected] (AEAD_AES_128_GCM)</item>
- <item>[email protected] (AEAD_AES_256_GCM)</item>
+ <item>[email protected]</item>
+ <item>[email protected]</item>
<item>aes128-ctr</item>
<item>aes192-ctr</item>
<item>aes256-ctr</item>
<item>aes128-cbc</item>
<item>3des-cbc</item>
+ <item>(AEAD_AES_128_GCM, not enabled per default)</item>
+ <item>(AEAD_AES_256_GCM, not enabled per default)</item>
</list>
+ <p>See the text at the description of <seealso marker="#rfc5647_note">the rfc 5647 further down</seealso>
+ for more information regarding AEAD_AES_*_GCM.
+ </p>
<p>Following the internet de-facto standard, the cipher and mac algorithm AEAD_AES_128_GCM is selected when the
cipher [email protected] is negotiated. The cipher and mac algorithm AEAD_AES_256_GCM is selected when the
cipher [email protected] is negotiated.
</p>
- <p>See the text at the description of <seealso marker="#rfc5647_note">the rfc 5647 further down</seealso>
- for more information.
- </p>
</item>
<tag>Compression algorithms</tag>
@@ -235,7 +239,11 @@
</item>
<item><url href="https://tools.ietf.org/html/rfc4253">RFC 4253</url>, The Secure Shell (SSH) Transport Layer Protocol.
- <p></p>
+ <p>Except</p>
+ <list type="bulleted">
+ <item>8.1. diffie-hellman-group1-sha1. Disabled by default, can be enabled with the <c>preferred_algorithms</c> option.</item>
+ </list>
+ <p/>
</item>
<item><url href="https://tools.ietf.org/html/rfc4254">RFC 4254</url>, The Secure Shell (SSH) Connection Protocol.
@@ -310,7 +318,29 @@
</p>
</item>
- <item>Work in progress: <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-kex-sha2">https://tools.ietf.org/html/draft-ietf-curdle-ssh-kex-sha2-05</url>, Key Exchange (KEX) Method Updates and Recommendations for Secure Shell (SSH)</item>
+ <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-kex-sha2">Draft-ietf-curdle-ssh-kex-sha2 (work in progress)</url>, Key Exchange (KEX) Method Updates and Recommendations for Secure Shell (SSH).
+ <p>Deviations:</p>
+ <list type="bulleted">
+ <item>The <c>diffie-hellman-group1-sha1</c> is not enabled by default, but is still supported and can be enabled
+ with the option <c>preferred-algorithms</c></item>
+ <item>The questionable sha1-based algorithms <c>diffie-hellman-group-exchange-sha1</c> and
+ <c>diffie-hellman-group14-sha1</c> are still enabled by default for compatibility with ancient clients and servers.
+ They can be disabled with the option <c>preferred-algorithms</c></item>
+ </list>
+ <p/>
+ </item>
+
+ <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-rsa-sha2">Draft-ietf-curdle-rsa-sha2 (work in progress)</url>, Use of RSA Keys with SHA-2 256 and 512 in Secure Shell (SSH).
+ </item>
+
+ <item><url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ext-info">Draft-ietf-curdle-ssh-ext-info (work in progress)</url>, Extension Negotiation in Secure Shell (SSH).
+ <p>Implemented are:</p>
+ <list type="bulleted">
+ <item>The Extension Negotiation Mechanism</item>
+ <item>The extension <c>server-sig-algs</c></item>
+ </list>
+ <p/>
+ </item>
</list>
diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml
index eb6f43d417..ed7fbf9cf3 100644
--- a/lib/ssh/doc/src/ssh_sftp.xml
+++ b/lib/ssh/doc/src/ssh_sftp.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2005</year><year>2016</year>
+ <year>2005</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -558,8 +558,14 @@
<taglist>
<tag><c><![CDATA[{timeout, timeout()}]]></c></tag>
<item>
- <p>The time-out is passed to the <c>ssh_channel</c> start function,
- and defaults to <c>infinity</c>.</p>
+ <p>There are two ways to set a timeout for the underlying ssh connection:</p>
+ <list>
+ <item>If the connection timeout option <c>connect_timeout</c> is set, that value
+ is used also for the negotiation timeout and this option (<c>timeout</c>) is ignored.</item>
+ <item>Otherwise, this option (<c>timeout</c>) is used as the negotiation timeout
+ only and there is no connection timeout set</item>
+ </list>
+ <p>The value defaults to <c>infinity</c>.</p>
</item>
<tag>
<c><![CDATA[{sftp_vsn, integer()}]]></c>
diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl
index 6cf659f830..ac64a7bf14 100644
--- a/lib/ssh/src/ssh_auth.erl
+++ b/lib/ssh/src/ssh_auth.erl
@@ -28,7 +28,8 @@
-include("ssh_auth.hrl").
-include("ssh_transport.hrl").
--export([publickey_msg/1, password_msg/1, keyboard_interactive_msg/1,
+-export([get_public_key/2,
+ publickey_msg/1, password_msg/1, keyboard_interactive_msg/1,
service_request_msg/1, init_userauth_request_msg/1,
userauth_request_msg/1, handle_userauth_request/3,
handle_userauth_info_request/2, handle_userauth_info_response/2
@@ -136,41 +137,49 @@ keyboard_interactive_msg([#ssh{user = User,
Ssh)
end.
-publickey_msg([SigAlg, #ssh{user = User,
- session_id = SessionId,
- service = Service,
- opts = Opts} = Ssh]) ->
- Hash = ssh_transport:sha(SigAlg),
+
+get_public_key(SigAlg, #ssh{opts = Opts}) ->
KeyAlg = key_alg(SigAlg),
{KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts),
UserOpts = ?GET_OPT(user_options, Opts),
case KeyCb:user_key(KeyAlg, [{key_cb_private,KeyCbOpts}|UserOpts]) of
- {ok, PrivKey} ->
- SigAlgStr = atom_to_list(SigAlg),
+ {ok, PrivKey} ->
try
Key = ssh_transport:extract_public_key(PrivKey),
public_key:ssh_encode(Key, ssh2_pubkey)
of
- PubKeyBlob ->
- SigData = build_sig_data(SessionId, User, Service,
- PubKeyBlob, SigAlgStr),
- Sig = ssh_transport:sign(SigData, Hash, PrivKey),
- SigBlob = list_to_binary([?string(SigAlgStr),
- ?binary(Sig)]),
- ssh_transport:ssh_packet(
- #ssh_msg_userauth_request{user = User,
- service = Service,
- method = "publickey",
- data = [?TRUE,
- ?string(SigAlgStr),
- ?binary(PubKeyBlob),
- ?binary(SigBlob)]},
- Ssh)
+ PubKeyBlob -> {ok,{PrivKey,PubKeyBlob}}
catch
_:_ ->
- {not_ok, Ssh}
+ not_ok
end;
- _Error ->
+ _Error ->
+ not_ok
+ end.
+
+
+publickey_msg([SigAlg, #ssh{user = User,
+ session_id = SessionId,
+ service = Service} = Ssh]) ->
+ case get_public_key(SigAlg, Ssh) of
+ {ok, {PrivKey,PubKeyBlob}} ->
+ SigAlgStr = atom_to_list(SigAlg),
+ SigData = build_sig_data(SessionId, User, Service,
+ PubKeyBlob, SigAlgStr),
+ Hash = ssh_transport:sha(SigAlg),
+ Sig = ssh_transport:sign(SigData, Hash, PrivKey),
+ SigBlob = list_to_binary([?string(SigAlgStr),
+ ?binary(Sig)]),
+ ssh_transport:ssh_packet(
+ #ssh_msg_userauth_request{user = User,
+ service = Service,
+ method = "publickey",
+ data = [?TRUE,
+ ?string(SigAlgStr),
+ ?binary(PubKeyBlob),
+ ?binary(SigBlob)]},
+ Ssh);
+ _ ->
{not_ok, Ssh}
end.
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index f1ce337947..8d3ddb09a4 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -453,16 +453,20 @@ init_ssh_record(Role, _Socket, PeerAddr, Opts) ->
PeerName0 when is_list(PeerName0) ->
PeerName0
end,
- S0#ssh{c_vsn = Vsn,
- c_version = Version,
- io_cb = case ?GET_OPT(user_interaction, Opts) of
- true -> ssh_io;
- false -> ssh_no_io
- end,
- userauth_pubkeys = ?GET_OPT(pref_public_key_algs, Opts),
- userauth_quiet_mode = ?GET_OPT(quiet_mode, Opts),
- peer = {PeerName, PeerAddr}
- };
+ S1 =
+ S0#ssh{c_vsn = Vsn,
+ c_version = Version,
+ io_cb = case ?GET_OPT(user_interaction, Opts) of
+ true -> ssh_io;
+ false -> ssh_no_io
+ end,
+ userauth_quiet_mode = ?GET_OPT(quiet_mode, Opts),
+ peer = {PeerName, PeerAddr}
+ },
+ S1#ssh{userauth_pubkeys = [K || K <- ?GET_OPT(pref_public_key_algs, Opts),
+ is_usable_user_pubkey(K, S1)
+ ]
+ };
server ->
S0#ssh{s_vsn = Vsn,
@@ -1700,29 +1704,49 @@ handle_ssh_msg_ext_info(#ssh_msg_ext_info{data=Data}, D0) ->
lists:foldl(fun ext_info/2, D0, Data).
-ext_info({"server-sig-algs",SigAlgs}, D0 = #data{ssh_params=#ssh{role=client,
- userauth_pubkeys=ClientSigAlgs}=Ssh0}) ->
- %% Make strings to eliminate risk of beeing bombed with odd strings that fills the atom table:
- SupportedAlgs = lists:map(fun erlang:atom_to_list/1, ssh_transport:supported_algorithms(public_key)),
- ServerSigAlgs = [list_to_atom(SigAlg) || SigAlg <- string:tokens(SigAlgs,","),
- %% length of SigAlg is implicitly checked by the comparison
- %% in member/2:
- lists:member(SigAlg, SupportedAlgs)
- ],
- CommonAlgs = [Alg || Alg <- ServerSigAlgs,
- lists:member(Alg, ClientSigAlgs)],
- SelectedAlgs =
- case CommonAlgs of
- [] -> ClientSigAlgs; % server-sig-algs value is just an advice
- _ -> CommonAlgs
- end,
- D0#data{ssh_params = Ssh0#ssh{userauth_pubkeys = SelectedAlgs} };
+ext_info({"server-sig-algs",SigAlgsStr},
+ D0 = #data{ssh_params=#ssh{role=client,
+ userauth_pubkeys=ClientSigAlgs}=Ssh0}) ->
+ %% ClientSigAlgs are the pub_key algortithms that:
+ %% 1) is usable, that is, the user has such a public key and
+ %% 2) is either the default list or set by the caller
+ %% with the client option 'pref_public_key_algs'
+ %%
+ %% The list is already checked for duplicates.
+
+ SigAlgs = [A || Astr <- string:tokens(SigAlgsStr, ","),
+ A <- try [list_to_existing_atom(Astr)]
+ %% list_to_existing_atom will fail for unknown algorithms
+ catch _:_ -> []
+ end],
+
+ CommonAlgs = [A || A <- SigAlgs,
+ lists:member(A, ClientSigAlgs)],
+
+ %% Re-arrange the client supported public-key algorithms so that the server
+ %% preferred ones are tried first.
+ %% Trying algorithms not mentioned by the server is ok, since the server can't know
+ %% if the client supports 'server-sig-algs' or not.
+
+ D0#data{
+ ssh_params =
+ Ssh0#ssh{
+ userauth_pubkeys =
+ CommonAlgs ++ (ClientSigAlgs -- CommonAlgs)
+ }};
ext_info(_, D0) ->
%% Not implemented
D0.
%%%----------------------------------------------------------------
+is_usable_user_pubkey(A, Ssh) ->
+ case ssh_auth:get_public_key(A, Ssh) of
+ {ok,_} -> true;
+ _ -> false
+ end.
+
+%%%----------------------------------------------------------------
handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, D) ->
case ssh_channel:cache_lookup(cache(D), ChannelId) of
#channel{remote_id = Id} = Channel ->
diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl
index 003b3856e6..3f742ad9b6 100644
--- a/lib/ssh/src/ssh_dbg.erl
+++ b/lib/ssh/src/ssh_dbg.erl
@@ -22,10 +22,8 @@
-module(ssh_dbg).
--export([messages/0, messages/1, messages/2,
- ct_messages/0,
- auth/0, auth/1, auth/2,
- ct_auth/0,
+-export([messages/0, messages/1, messages/2, messages/3,
+ auth/0, auth/1, auth/2, auth/3,
stop/0
]).
@@ -37,50 +35,52 @@
-include("ssh_connect.hrl").
-include("ssh_auth.hrl").
--record(data, {
- writer,
- acc = []}).
%%%================================================================
-messages() ->
- messages(fun(String,_D) -> io:format(String) end).
+messages() -> start(msg).
+messages(F) -> start(msg,F).
+messages(F,X) -> start(msg,F,X).
+messages(F,M,I) -> start(msg,F,M,I).
-ct_messages() ->
- messages(fun(String,_D) -> ct:log(String,[]) end).
+auth() -> start(auth).
+auth(F) -> start(auth,F).
+auth(F,X) -> start(auth,F,X).
+auth(F,M,I) -> start(auth,F,M,I).
-messages(Write) when is_function(Write,2) ->
- messages(Write, fun(X) -> X end).
-
-messages(Write, MangleArg) when is_function(Write,2),
- is_function(MangleArg,1) ->
- cond_start(msg, Write, MangleArg),
- dbg_ssh_messages(),
- dbg_ssh_auth().
+stop() -> dbg:stop().
+%%%----------------------------------------------------------------
+start(Type) -> start(Type, fun io:format/2).
-auth() ->
- auth(fun(String,_D) -> io:format(String) end).
+start(Type, F) when is_function(F,2) -> start(Type, fmt_fun(F));
+start(Type, F) when is_function(F,3) -> start(Type, F, id_fun()).
-ct_auth() ->
- auth(fun(String,_D) -> ct:log(String,[]) end).
+start(Type, WriteFun, MangleArgFun) when is_function(WriteFun, 3),
+ is_function(MangleArgFun, 1) ->
+ start(Type, WriteFun, MangleArgFun, []);
+start(Type, WriteFun, InitValue) ->
+ start(Type, WriteFun, id_fun(), InitValue).
-auth(Write) when is_function(Write,2) ->
- auth(Write, fun(X) -> X end).
+start(Type, WriteFun, MangleArgFun, InitValue) when is_function(WriteFun, 3),
+ is_function(MangleArgFun, 1) ->
+ cond_start(Type, WriteFun, MangleArgFun, InitValue),
+ dbg_ssh(Type).
-auth(Write, MangleArg) when is_function(Write,2),
- is_function(MangleArg,1) ->
- cond_start(auth, Write, MangleArg),
- dbg_ssh_auth().
+%%%----------------------------------------------------------------
+fmt_fun(F) -> fun(Fmt,Args,Data) -> F(Fmt,Args), Data end.
+id_fun() -> fun(X) -> X end.
-dbg_ssh_messages() ->
+%%%----------------------------------------------------------------
+dbg_ssh(msg) ->
+ dbg_ssh(auth),
dbg:tp(ssh_message,encode,1, x),
dbg:tp(ssh_message,decode,1, x),
dbg:tpl(ssh_transport,select_algorithm,4, x),
dbg:tp(ssh_transport,hello_version_msg,1, x),
dbg:tp(ssh_transport,handle_hello_version,1, x),
- dbg:tpl(ssh_connection_handler,ext_info,2, x).
+ dbg:tpl(ssh_connection_handler,ext_info,2, x);
-dbg_ssh_auth() ->
+dbg_ssh(auth) ->
dbg:tp(ssh_transport,hello_version_msg,1, x),
dbg:tp(ssh_transport,handle_hello_version,1, x),
dbg:tp(ssh_message,encode,1, x),
@@ -89,15 +89,11 @@ dbg_ssh_auth() ->
lists:foreach(fun(F) -> dbg:tp(ssh_auth, F, x) end,
[publickey_msg, password_msg, keyboard_interactive_msg]).
-%%%----------------------------------------------------------------
-stop() ->
- dbg:stop().
-
%%%================================================================
-cond_start(Type, Write, MangleArg) ->
+cond_start(Type, WriteFun, MangleArgFun, Init) ->
try
dbg:start(),
- setup_tracer(Type, Write, MangleArg),
+ setup_tracer(Type, WriteFun, MangleArgFun, Init),
dbg:p(new,[c,timestamp])
catch
_:_ -> ok
@@ -136,12 +132,13 @@ msg_formater(_, {trace_ts,Pid,call,{ssh_transport,handle_hello_version,[Hello]},
msg_formater(_, {trace_ts,_Pid,return_from,{ssh_transport,handle_hello_version,1},_,_TS}, D) ->
D;
-msg_formater(_, {trace_ts,Pid,call,{ssh_connection_handler,ext_info,[{"server-sig-algs",_SigAlgs},State]},TS}, D) ->
+msg_formater(_, {trace_ts,Pid,call,{ssh_connection_handler,ext_info,[{"server-sig-algs",SigAlgs},State]},TS}, D) ->
try lists:keyfind(ssh, 1, tuple_to_list(State)) of
false ->
D;
#ssh{userauth_pubkeys = PKs} ->
- fmt("~n~s ~p Client got suggestion to use user public key sig-algs~n ~p~n", [ts(TS),Pid,PKs], D)
+ fmt("~n~s ~p Client got suggestion to use user public key sig-algs~n ~p~n and can use~n ~p~n",
+ [ts(TS),Pid,string:tokens(SigAlgs,","),PKs], D)
catch
_:_ ->
D
@@ -206,21 +203,25 @@ msg_formater(msg, {trace_ts,Pid,'receive',ErlangMsg,TS}, D) ->
msg_formater(_, _, D) ->
D.
+%%%----------------------------------------------------------------
+-record(data, {writer,
+ acc}).
-fmt(Fmt, Args, D=#data{writer=Write,acc=Acc}) ->
- D#data{acc = Write(io_lib:format(Fmt, Args), Acc)}.
+fmt(Fmt, Args, D=#data{writer=Write, acc=Acc}) ->
+ D#data{acc = Write(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(Type, Write, MangleArg) ->
+
+setup_tracer(Type, WriteFun, MangleArgFun, Init) ->
Handler = fun(Arg, D) ->
- msg_formater(Type, MangleArg(Arg), D)
+ msg_formater(Type, MangleArgFun(Arg), D)
end,
- InitialData = #data{writer = Write},
+ InitialData = #data{writer = WriteFun,
+ acc = Init},
{ok,_} = dbg:tracer(process, {Handler, InitialData}),
ok.
diff --git a/lib/ssh/src/ssh_io.erl b/lib/ssh/src/ssh_io.erl
index 8ba759ad60..a7cd1daeec 100644
--- a/lib/ssh/src/ssh_io.erl
+++ b/lib/ssh/src/ssh_io.erl
@@ -31,8 +31,8 @@ read_line(Prompt, Opts) ->
format("~s", [listify(Prompt)]),
?GET_INTERNAL_OPT(user_pid, Opts) ! {self(), question},
receive
- Answer when is_list(Answer) ->
- Answer
+ Answer when is_list(Answer) or is_binary(Answer) ->
+ unicode:characters_to_list(Answer)
end.
yes_no(Prompt, Opts) ->
@@ -44,7 +44,7 @@ yes_no(Prompt, Opts) ->
y -> yes;
n -> no;
- Answer when is_list(Answer) ->
+ Answer when is_list(Answer) or is_binary(Answer) ->
case trim(Answer) of
"y" -> yes;
"n" -> no;
@@ -60,7 +60,7 @@ read_password(Prompt, Opts) ->
format("~s", [listify(Prompt)]),
?GET_INTERNAL_OPT(user_pid, Opts) ! {self(), user_password},
receive
- Answer when is_list(Answer) ->
+ Answer when is_list(Answer) or is_binary(Answer) ->
case trim(Answer) of
"" ->
read_password(Prompt, Opts);
diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl
index aebb5a7062..7eeed70739 100644
--- a/lib/ssh/src/ssh_options.erl
+++ b/lib/ssh/src/ssh_options.erl
@@ -674,7 +674,11 @@ check_pref_public_key_algs(V) ->
PKs = ssh_transport:supported_algorithms(public_key),
CHK = fun(A, Ack) ->
case lists:member(A, PKs) of
- true -> [A|Ack];
+ true ->
+ case lists:member(A,Ack) of
+ false -> [A|Ack];
+ true -> Ack % Remove duplicates
+ end;
false -> error_in_check(A, "Not supported public key")
end
end,
diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl
index 0f69910e40..98964a2c8a 100644
--- a/lib/ssh/test/ssh_algorithms_SUITE.erl
+++ b/lib/ssh/test/ssh_algorithms_SUITE.erl
@@ -131,9 +131,14 @@ init_per_group(public_key=Tag, Alg, Config) ->
ct:log("Init tests for public_key ~p",[Alg]),
PrefAlgs = {preferred_algorithms,[{Tag,[Alg]}]},
%% Daemon started later in init_per_testcase
- [{pref_algs,PrefAlgs},
- {tag_alg,{Tag,Alg}}
- | Config];
+ try
+ setup_pubkey(Alg,
+ [{pref_algs,PrefAlgs},
+ {tag_alg,{Tag,Alg}}
+ | Config])
+ catch
+ _:_ -> {skip, io_lib:format("Unsupported: ~p",[Alg])}
+ end;
init_per_group(Tag, Alg, Config) ->
PA =
@@ -167,18 +172,24 @@ init_per_testcase(TC, Config) ->
init_per_testcase(TC, proplists:get_value(tag_alg,Config), Config).
-init_per_testcase(_, {public_key,Alg}, Config) ->
- Opts = pubkey_opts(Config),
+init_per_testcase(TC, {public_key,Alg}, Config) ->
+ ExtraOpts = case TC of
+ simple_connect ->
+ [{user_dir, proplists:get_value(priv_dir,Config)}];
+ _ ->
+ []
+ end,
+ Opts = pubkey_opts(Config) ++ ExtraOpts,
case {ssh_file:user_key(Alg,Opts), ssh_file:host_key(Alg,Opts)} of
{{ok,_}, {ok,_}} ->
- ssh_dbg:ct_auth(),
- start_pubkey_daemon([proplists:get_value(pref_algs,Config)],
+ start_pubkey_daemon([proplists:get_value(pref_algs,Config)
+ | ExtraOpts],
[{extra_daemon,true}|Config]);
- {{ok,_}, _} ->
- {skip, "No host key"};
+ {{ok,_}, {error,Err}} ->
+ {skip, io_lib:format("No host key: ~p",[Err])};
- {_, {ok,_}} ->
- {skip, "No user key"};
+ {{error,Err}, {ok,_}} ->
+ {skip, io_lib:format("No user key: ~p",[Err])};
_ ->
{skip, "Neither host nor user key"}
@@ -193,7 +204,6 @@ init_per_testcase(_, _, Config) ->
end_per_testcase(_TC, Config) ->
- catch ssh_dbg:stop(),
case proplists:get_value(extra_daemon, Config, false) of
true ->
case proplists:get_value(srvr_pid,Config) of
@@ -223,6 +233,19 @@ simple_exec(Config) ->
ssh_test_lib:std_simple_exec(Host, Port, Config).
%%--------------------------------------------------------------------
+%% A simple exec call
+simple_connect(Config) ->
+ {Host,Port} = proplists:get_value(srvr_addr, Config),
+ Opts =
+ case proplists:get_value(tag_alg, Config) of
+ {public_key,Alg} -> [{pref_public_key_algs,[Alg]}];
+ _ -> []
+ end,
+ ConnectionRef = ssh_test_lib:std_connect(Config, Host, Port, Opts),
+ ct:log("~p:~p connected! ~p",[?MODULE,?LINE,ConnectionRef]),
+ ssh:close(ConnectionRef).
+
+%%--------------------------------------------------------------------
%% Testing if no group matches
simple_exec_groups_no_match_too_small(Config) ->
try_exec_simple_group({400,500,600}, Config).
@@ -304,9 +327,15 @@ sshc_simple_exec_os_cmd(Config) ->
%%--------------------------------------------------------------------
%% Connect to the ssh server of the OS
sshd_simple_exec(Config) ->
+ ClientPubKeyOpts =
+ case proplists:get_value(tag_alg,Config) of
+ {public_key,Alg} -> [{pref_public_key_algs,[Alg]}];
+ _ -> []
+ end,
ConnectionRef = ssh_test_lib:connect(22, [{silently_accept_hosts, true},
proplists:get_value(pref_algs,Config),
- {user_interaction, false}]),
+ {user_interaction, false}
+ | ClientPubKeyOpts]),
{ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity),
success = ssh_connection:exec(ConnectionRef, ChannelId0,
"echo testing", infinity),
@@ -363,8 +392,8 @@ split(Alg) -> ssh_test_lib:to_atoms(string:tokens(atom_to_list(Alg), " + ")).
specific_test_cases(Tag, Alg, SshcAlgos, SshdAlgos, TypeSSH) ->
case Tag of
- public_key -> [];
- _ -> [simple_exec, simple_sftp]
+ public_key -> [simple_connect];
+ _ -> [simple_connect, simple_exec, simple_sftp]
end
++ case supports(Tag, Alg, SshcAlgos) of
true when TypeSSH == openSSH ->
@@ -439,10 +468,26 @@ setup_pubkey(Config) ->
Keys =
[ssh_test_lib:setup_dsa(DataDir, UserDir),
ssh_test_lib:setup_rsa(DataDir, UserDir),
- ssh_test_lib:setup_ecdsa("256", DataDir, UserDir)],
+ ssh_test_lib:setup_ecdsa("256", DataDir, UserDir)
+ ],
ssh_test_lib:write_auth_keys(Keys, UserDir), % 'authorized_keys' shall contain ALL pub keys
Config.
+setup_pubkey(Alg, Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ UserDir = proplists:get_value(priv_dir, Config),
+ ct:log("Setup keys for ~p",[Alg]),
+ case Alg of
+ 'ssh-dss' -> ssh_test_lib:setup_dsa(DataDir, UserDir);
+ 'ssh-rsa' -> ssh_test_lib:setup_rsa(DataDir, UserDir);
+ 'rsa-sha2-256' -> ssh_test_lib:setup_rsa(DataDir, UserDir);
+ 'rsa-sha2-512' -> ssh_test_lib:setup_rsa(DataDir, UserDir);
+ 'ecdsa-sha2-nistp256' -> ssh_test_lib:setup_ecdsa("256", DataDir, UserDir);
+ 'ecdsa-sha2-nistp384' -> ssh_test_lib:setup_ecdsa("384", DataDir, UserDir);
+ 'ecdsa-sha2-nistp521' -> ssh_test_lib:setup_ecdsa("521", DataDir, UserDir)
+ end,
+ Config.
+
simple_exec_group(I, Config) when is_integer(I) ->
simple_exec_group({I,I,I}, Config);
diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa384 b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa384
new file mode 100644
index 0000000000..4c39e916e9
--- /dev/null
+++ b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa384
@@ -0,0 +1,6 @@
+-----BEGIN EC PRIVATE KEY-----
+MIGkAgEBBDAughXu55DNyhxe6x+MNjv4oZKWUDh7bhi4CqjvxhCp9KMpsybltcq+
+lsuKTarzTdKgBwYFK4EEACKhZANiAASu1vvDL0SQoXGtzlltaPHPyDfEVMG/sKLA
+pqv8vfRN5Wcs7+yaRKw92nYEKGXfZLbhVX8ArFPMtXPWHcRHCntvL1Acn2kJQ8Gc
+7iL4NAr8JhTIUBv4YMhHDa9Pv/CH2zk=
+-----END EC PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa384.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa384.pub
new file mode 100644
index 0000000000..caa9604c84
--- /dev/null
+++ b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa384.pub
@@ -0,0 +1 @@
+ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBK7W+8MvRJChca3OWW1o8c/IN8RUwb+wosCmq/y99E3lZyzv7JpErD3adgQoZd9ktuFVfwCsU8y1c9YdxEcKe28vUByfaQlDwZzuIvg0CvwmFMhQG/hgyEcNr0+/8IfbOQ== uabhnil@elxadlj3q32
diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa521 b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa521
new file mode 100644
index 0000000000..1e16fcbd57
--- /dev/null
+++ b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa521
@@ -0,0 +1,7 @@
+-----BEGIN EC PRIVATE KEY-----
+MIHbAgEBBEEWXGoVLiNwQVUwAGZWxOu6uxtU8ntxyZNlcWU4Z8pze9kq3eK7a9XH
+l/wxL75Vk1QdOiR/rE3s/L/zOuChp44o1aAHBgUrgQQAI6GBiQOBhgAEAfCrtwjO
+kQYKr4/F3uanS7Eby1+SYDdRl1ABuDFhNC3CivVBFt4CnRneV+Mf0viDAxD+HEpd
+/GaE2CdsFoVpglN5AVG+fEePY2PiCLHmjc4/pBuR+tWhErzcWAd0KLBCBuc4OAvl
+aLLYV1NAJI6COnnfGTCVvYYE5nKMG4LLX0zaWtWl
+-----END EC PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa521.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa521.pub
new file mode 100644
index 0000000000..069683eba7
--- /dev/null
+++ b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ecdsa521.pub
@@ -0,0 +1 @@
+ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAHwq7cIzpEGCq+Pxd7mp0uxG8tfkmA3UZdQAbgxYTQtwor1QRbeAp0Z3lfjH9L4gwMQ/hxKXfxmhNgnbBaFaYJTeQFRvnxHj2Nj4gix5o3OP6QbkfrVoRK83FgHdCiwQgbnODgL5Wiy2FdTQCSOgjp53xkwlb2GBOZyjBuCy19M2lrVpQ== uabhnil@elxadlj3q32
diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key384
new file mode 100644
index 0000000000..5835bcd74c
--- /dev/null
+++ b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key384
@@ -0,0 +1,6 @@
+-----BEGIN EC PRIVATE KEY-----
+MIGkAgEBBDB+l0+SMLYgQ3ZRzg2Pn5u+1ZwKbEnJzXsTKTJM9QSJbKkbA7uCnjdS
+CvEW+66CoHqgBwYFK4EEACKhZANiAAT6awCCIrcCr9H4wq0bJ/rQou3tpLHyyf33
+c8D6FPn48/hNqinpx7b0le/0D+Rrhdl9edIplAf6oki7yoFFGl4yuzWtv7rag9jB
+vv6w1508ChOmyQ094rFt/xj4KVBhEHI=
+-----END EC PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key384.pub
new file mode 100644
index 0000000000..714fc4eb89
--- /dev/null
+++ b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key384.pub
@@ -0,0 +1 @@
+ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBPprAIIitwKv0fjCrRsn+tCi7e2ksfLJ/fdzwPoU+fjz+E2qKenHtvSV7/QP5GuF2X150imUB/qiSLvKgUUaXjK7Na2/utqD2MG+/rDXnTwKE6bJDT3isW3/GPgpUGEQcg== uabhnil@elxadlj3q32
diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key521
new file mode 100644
index 0000000000..81aa8df39f
--- /dev/null
+++ b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key521
@@ -0,0 +1,7 @@
+-----BEGIN EC PRIVATE KEY-----
+MIHbAgEBBEHHxgYEfDclsu5bW+pZfg+bkaqWpgEpXtuzLVm++FFPjhAPhMkurSRj
+WQ+CuI2TxgYkBbYFNjn9JqgdMF7FzaiojKAHBgUrgQQAI6GBiQOBhgAEAFTM8TKG
+xexxmfAGuyl/Tpk4wytB/OyuVfkF+Q3H1v17HLcpMacA5xUFr80+D5XnjxGttBsS
++X0uexR7QbPbhhPqADgQzFqvTsB1mUNAZnJBD6QNCZkfWwRRwFYQWSmisb43H6G3
+iUTKqiCXMXO8drKLA+Wi+L7VyfoI1CvatBBlDHbV
+-----END EC PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key521.pub
new file mode 100644
index 0000000000..17b9a1d834
--- /dev/null
+++ b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ecdsa_key521.pub
@@ -0,0 +1 @@
+ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBABUzPEyhsXscZnwBrspf06ZOMMrQfzsrlX5BfkNx9b9exy3KTGnAOcVBa/NPg+V548RrbQbEvl9LnsUe0Gz24YT6gA4EMxar07AdZlDQGZyQQ+kDQmZH1sEUcBWEFkporG+Nx+ht4lEyqoglzFzvHayiwPlovi+1cn6CNQr2rQQZQx21Q== uabhnil@elxadlj3q32
diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl
index b710ca8fb7..8b454ffe5d 100644
--- a/lib/ssh/test/ssh_options_SUITE.erl
+++ b/lib/ssh/test/ssh_options_SUITE.erl
@@ -555,14 +555,14 @@ connectfun_disconnectfun_server(Config) ->
{disconnect,Ref,R} ->
ct:log("Disconnect result: ~p",[R]),
ssh:stop_daemon(Pid)
- after 5000 ->
+ after 10000 ->
receive
X -> ct:log("received ~p",[X])
after 0 -> ok
end,
{fail, "No disconnectfun action"}
end
- after 5000 ->
+ after 10000 ->
receive
X -> ct:log("received ~p",[X])
after 0 -> ok
diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl
index 5ea60d8a8f..3318b86d39 100644
--- a/lib/ssh/test/ssh_property_test_SUITE.erl
+++ b/lib/ssh/test/ssh_property_test_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.
diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl
index 0385e30ad1..0837fe7eaf 100644
--- a/lib/ssh/test/ssh_protocol_SUITE.erl
+++ b/lib/ssh/test/ssh_protocol_SUITE.erl
@@ -466,7 +466,7 @@ bad_long_service_name(Config) ->
bad_very_long_service_name(Config) ->
bad_service_name(Config,
- lists:duplicate(4*?SSH_MAX_PACKET_SIZE, $a)).
+ lists:duplicate(?SSH_MAX_PACKET_SIZE+5, $a)).
empty_service_name(Config) ->
bad_service_name(Config, "").
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 48332d2e5a..7208baca6e 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 4.4.2
+SSH_VSN = 4.5
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml
index 29ec3f9d57..5a39cac9bc 100644
--- a/lib/ssl/doc/src/notes.xml
+++ b/lib/ssl/doc/src/notes.xml
@@ -28,6 +28,122 @@
<p>This document describes the changes made to the SSL application.</p>
+<section><title>SSL 8.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ ECDH-ECDSA key exchange supported, was accidently
+ dismissed in earlier versions.</p>
+ <p>
+ Own Id: OTP-14421</p>
+ </item>
+ <item>
+ <p>
+ Correct close semantics for active once connections. This
+ was a timing dependent bug the resulted in the close
+ message not always reaching the ssl user process.</p>
+ <p>
+ Own Id: OTP-14443</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ TLS-1.2 clients will now always send hello messages on
+ its own format, as opposed to earlier versions that will
+ send the hello on the lowest supported version, this is a
+ change supported by the latest RFC.</p>
+ <p>
+ This will make interoperability with some newer servers
+ smoother. Potentially, but unlikely, this could cause a
+ problem with older servers if they do not adhere to the
+ RFC and ignore unknown extensions.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-13820</p>
+ </item>
+ <item>
+ <p>
+ Allow Erlang/OTP to use OpenSSL in FIPS-140 mode, in
+ order to satisfy specific security requirements (mostly
+ by different parts of the US federal government). </p>
+ <p>
+ See the new crypto users guide "FIPS mode" chapter about
+ building and using the FIPS support which is disabled by
+ default.</p>
+ <p>
+ (Thanks to dszoboszlay and legoscia)</p>
+ <p>
+ Own Id: OTP-13921 Aux Id: PR-1180 </p>
+ </item>
+ <item>
+ <p>
+ Implemented DTLS cookie generation, required by spec,
+ instead of using a hardcoded value.</p>
+ <p>
+ Own Id: OTP-14076</p>
+ </item>
+ <item>
+ <p>
+ Implement sliding window replay protection of DTLS
+ records.</p>
+ <p>
+ Own Id: OTP-14077</p>
+ </item>
+ <item>
+ <p>
+ TLS client processes will by default call
+ public_key:pkix_verify_hostname/2 to verify the hostname
+ of the connection with the server certificates specified
+ hostname during certificate path validation. The user may
+ explicitly disables it. Also if the hostname can not be
+ derived from the first argument to connect or is not
+ supplied by the server name indication option, the check
+ will not be performed.</p>
+ <p>
+ Own Id: OTP-14197</p>
+ </item>
+ <item>
+ <p>
+ Extend connection_information/[1,2] . The values
+ session_id, master_secret, client_random and
+ server_random can no be accessed by
+ connection_information/2. Note only session_id will be
+ added to connection_information/1. The rational is that
+ values concerning the connection security should have to
+ be explicitly requested.</p>
+ <p>
+ Own Id: OTP-14291</p>
+ </item>
+ <item>
+ <p>
+ Chacha cipher suites are currently not tested enough to
+ be most preferred ones</p>
+ <p>
+ Own Id: OTP-14382</p>
+ </item>
+ <item>
+ <p>
+ Basic support for DTLS that been tested together with
+ OpenSSL.</p>
+ <p>
+ Test by providing the option {protocol, dtls} to the ssl
+ API functions connect and listen.</p>
+ <p>
+ Own Id: OTP-14388</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>SSL 8.1.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 2940ccb1e7..ca2dcbb761 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -189,6 +189,11 @@
<taglist>
+ <tag><c>{protocol, tls | dtls}</c></tag>
+ <item><p>Choose TLS or DTLS protocol for the transport layer security.
+ Defaults to <c>tls</c> Introduced in OTP 20, DTLS support is considered
+ experimental in this release. DTLS over other transports than UDP are not yet supported.</p></item>
+
<tag><c>{cert, public_key:der_encoded()}</c></tag>
<item><p>The DER-encoded users certificate. If this option
is supplied, it overrides option <c>certfile</c>.</p></item>
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 2de947d8b4..b6aafc3fa4 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -48,7 +48,7 @@
select_sni_extension/1]).
%% Alert and close handling
--export([encode_alert/3,send_alert/2, close/5]).
+-export([encode_alert/3,send_alert/2, close/5, protocol_name/0]).
%% Data handling
@@ -115,7 +115,7 @@ send_handshake_flight(#state{socket = Socket,
{Encoded, ConnectionStates} =
encode_handshake_flight(lists:reverse(Flight), Version, 1400, Epoch, ConnectionStates0),
send(Transport, Socket, Encoded),
- start_flight(State0#state{connection_states = ConnectionStates});
+ {State0#state{connection_states = ConnectionStates}, []};
send_handshake_flight(#state{socket = Socket,
transport_cb = Transport,
@@ -129,7 +129,7 @@ send_handshake_flight(#state{socket = Socket,
{EncChangeCipher, ConnectionStates} = encode_change_cipher(ChangeCipher, Version, Epoch, ConnectionStates1),
send(Transport, Socket, [HsBefore, EncChangeCipher]),
- start_flight(State0#state{connection_states = ConnectionStates});
+ {State0#state{connection_states = ConnectionStates}, []};
send_handshake_flight(#state{socket = Socket,
transport_cb = Transport,
@@ -145,7 +145,7 @@ send_handshake_flight(#state{socket = Socket,
{HsAfter, ConnectionStates} =
encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates2),
send(Transport, Socket, [HsBefore, EncChangeCipher, HsAfter]),
- start_flight(State0#state{connection_states = ConnectionStates});
+ {State0#state{connection_states = ConnectionStates}, []};
send_handshake_flight(#state{socket = Socket,
transport_cb = Transport,
@@ -159,7 +159,7 @@ send_handshake_flight(#state{socket = Socket,
{HsAfter, ConnectionStates} =
encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates1),
send(Transport, Socket, [EncChangeCipher, HsAfter]),
- start_flight(State0#state{connection_states = ConnectionStates}).
+ {State0#state{connection_states = ConnectionStates}, []}.
queue_change_cipher(ChangeCipher, #state{flight_buffer = Flight,
connection_states = ConnectionStates0} = State) ->
@@ -208,6 +208,9 @@ setopts(Transport, Socket, Other) ->
getopts(Transport, Socket, Tag) ->
dtls_socket:getopts(Transport, Socket, Tag).
+protocol_name() ->
+ "DTLS".
+
%%====================================================================
%% tls_connection_sup API
%%====================================================================
@@ -235,12 +238,14 @@ init([Role, Host, Port, Socket, Options, User, CbInfo]) ->
end.
callback_mode() ->
- state_functions.
+ [state_functions, state_enter].
%%--------------------------------------------------------------------
%% State functions
%%--------------------------------------------------------------------
+init(enter, _, State) ->
+ {keep_state, State};
init({call, From}, {start, Timeout},
#state{host = Host, port = Port, role = client,
ssl_options = SslOpts,
@@ -282,6 +287,8 @@ init({call, _} = Type, Event, #state{role = server} = State) ->
init(Type, Event, State) ->
ssl_connection:init(Type, Event, State, ?MODULE).
+error(enter, _, State) ->
+ {keep_state, State};
error({call, From}, {start, _Timeout}, {Error, State}) ->
{stop_and_reply, normal, {reply, From, {error, Error}}, State};
error({call, From}, Msg, State) ->
@@ -295,6 +302,11 @@ error(_, _, _) ->
#state{}) ->
gen_statem:state_function_result().
%%--------------------------------------------------------------------
+hello(enter, _, #state{role = server} = State) ->
+ {keep_state, State};
+hello(enter, _, #state{role = client} = State0) ->
+ {State, Actions} = handle_flight_timer(State0),
+ {keep_state, State, Actions};
hello(internal, #client_hello{cookie = <<>>,
client_version = Version} = Hello, #state{role = server,
transport_cb = Transport,
@@ -302,7 +314,13 @@ hello(internal, #client_hello{cookie = <<>>,
protocol_specific = #{current_cookie_secret := Secret}} = State0) ->
{ok, {IP, Port}} = dtls_socket:peername(Transport, Socket),
Cookie = dtls_handshake:cookie(Secret, IP, Port, Hello),
- VerifyRequest = dtls_handshake:hello_verify_request(Cookie, Version),
+ %% FROM RFC 6347 regarding HelloVerifyRequest message:
+ %% The server_version field has the same syntax as in TLS. However, in
+ %% order to avoid the requirement to do version negotiation in the
+ %% initial handshake, DTLS 1.2 server implementations SHOULD use DTLS
+ %% version 1.0 regardless of the version of TLS that is expected to be
+ %% negotiated.
+ VerifyRequest = dtls_handshake:hello_verify_request(Cookie, ?HELLO_VERIFY_REQUEST_VERSION),
State1 = prepare_flight(State0#state{negotiated_version = Version}),
{State2, Actions} = send_handshake(VerifyRequest, State1),
{Record, State} = next_record(State2),
@@ -374,6 +392,9 @@ hello(state_timeout, Event, State) ->
hello(Type, Event, State) ->
ssl_connection:hello(Type, Event, State, ?MODULE).
+abbreviated(enter, _, State0) ->
+ {State, Actions} = handle_flight_timer(State0),
+ {keep_state, State, Actions};
abbreviated(info, Event, State) ->
handle_info(Event, abbreviated, State);
abbreviated(internal = Type,
@@ -391,6 +412,9 @@ abbreviated(state_timeout, Event, State) ->
abbreviated(Type, Event, State) ->
ssl_connection:abbreviated(Type, Event, State, ?MODULE).
+certify(enter, _, State0) ->
+ {State, Actions} = handle_flight_timer(State0),
+ {keep_state, State, Actions};
certify(info, Event, State) ->
handle_info(Event, certify, State);
certify(internal = Type, #server_hello_done{} = Event, State) ->
@@ -400,6 +424,9 @@ certify(state_timeout, Event, State) ->
certify(Type, Event, State) ->
ssl_connection:certify(Type, Event, State, ?MODULE).
+cipher(enter, _, State0) ->
+ {State, Actions} = handle_flight_timer(State0),
+ {keep_state, State, Actions};
cipher(info, Event, State) ->
handle_info(Event, cipher, State);
cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event,
@@ -417,6 +444,8 @@ cipher(state_timeout, Event, State) ->
cipher(Type, Event, State) ->
ssl_connection:cipher(Type, Event, State, ?MODULE).
+connection(enter, _, State) ->
+ {keep_state, State};
connection(info, Event, State) ->
handle_info(Event, connection, State);
connection(internal, #hello_request{}, #state{host = Host, port = Port,
@@ -449,6 +478,9 @@ connection(internal, #client_hello{}, #state{role = server, allow_renegotiate =
connection(Type, Event, State) ->
ssl_connection:connection(Type, Event, State, ?MODULE).
+%%TODO does this make sense for DTLS ?
+downgrade(enter, _, State) ->
+ {keep_state, State};
downgrade(Type, Event, State) ->
ssl_connection:downgrade(Type, Event, State, ?MODULE).
@@ -695,7 +727,7 @@ next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 ->
next_record(#state{protocol_buffers =
#protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} = CT | Rest]}
= Buffers,
- connection_states = ConnectionStates} = State) ->
+ connection_states = #{current_read := #{epoch := Epoch}} = ConnectionStates} = State) ->
CurrentRead = dtls_record:get_connection_state_by_epoch(Epoch, ConnectionStates, read),
case dtls_record:replay_detect(CT, CurrentRead) of
false ->
@@ -706,6 +738,23 @@ next_record(#state{protocol_buffers =
Buffers#protocol_buffers{dtls_cipher_texts = Rest},
connection_states = ConnectionStates})
end;
+next_record(#state{protocol_buffers =
+ #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} | Rest]}
+ = Buffers,
+ connection_states = #{current_read := #{epoch := CurrentEpoch}} = ConnectionStates} = State)
+ when Epoch > CurrentEpoch ->
+ %% TODO Buffer later Epoch message, drop it for now
+ next_record(State#state{protocol_buffers =
+ Buffers#protocol_buffers{dtls_cipher_texts = Rest},
+ connection_states = ConnectionStates});
+next_record(#state{protocol_buffers =
+ #protocol_buffers{dtls_cipher_texts = [ _ | Rest]}
+ = Buffers,
+ connection_states = ConnectionStates} = State) ->
+ %% Drop old epoch message
+ next_record(State#state{protocol_buffers =
+ Buffers#protocol_buffers{dtls_cipher_texts = Rest},
+ connection_states = ConnectionStates});
next_record(#state{role = server,
socket = {Listener, {Client, _}},
transport_cb = gen_udp} = State) ->
@@ -750,14 +799,16 @@ next_event(connection = StateName, no_record,
{#ssl_tls{epoch = Epoch,
type = ?HANDSHAKE,
version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 ->
- {State, MoreActions} = send_handshake_flight(State1, CurrentEpoch),
- {next_state, StateName, State, Actions ++ MoreActions};
+ {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch),
+ {NextRecord, State} = next_record(State2),
+ next_event(StateName, NextRecord, State, Actions ++ MoreActions);
%% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake
{#ssl_tls{epoch = Epoch,
type = ?CHANGE_CIPHER_SPEC,
version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 ->
- {State, MoreActions} = send_handshake_flight(State1, CurrentEpoch),
- {next_state, StateName, State, Actions ++ MoreActions};
+ {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch),
+ {NextRecord, State} = next_record(State2),
+ next_event(StateName, NextRecord, State, Actions ++ MoreActions);
{#ssl_tls{epoch = _Epoch,
version = _Version}, State1} ->
%% TODO maybe buffer later epoch
@@ -774,14 +825,16 @@ next_event(connection = StateName, Record,
#ssl_tls{epoch = Epoch,
type = ?HANDSHAKE,
version = _Version} when Epoch == CurrentEpoch-1 ->
- {State, MoreActions} = send_handshake_flight(State0, CurrentEpoch),
- {next_state, StateName, State, Actions ++ MoreActions};
+ {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch),
+ {NextRecord, State} = next_record(State1),
+ next_event(StateName, NextRecord, State, Actions ++ MoreActions);
%% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake
#ssl_tls{epoch = Epoch,
type = ?CHANGE_CIPHER_SPEC,
version = _Version} when Epoch == CurrentEpoch-1 ->
- {State, MoreActions} = send_handshake_flight(State0, CurrentEpoch),
- {next_state, StateName, State, Actions ++ MoreActions};
+ {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch),
+ {NextRecord, State} = next_record(State1),
+ next_event(StateName, NextRecord, State, Actions ++ MoreActions);
_ ->
next_event(StateName, no_record, State0, Actions)
end;
@@ -841,13 +894,13 @@ next_flight(Flight) ->
change_cipher_spec => undefined,
handshakes_after_change_cipher_spec => []}.
-start_flight(#state{transport_cb = gen_udp,
- flight_state = {retransmit, Timeout}} = State) ->
+handle_flight_timer(#state{transport_cb = gen_udp,
+ flight_state = {retransmit, Timeout}} = State) ->
start_retransmision_timer(Timeout, State);
-start_flight(#state{transport_cb = gen_udp,
+handle_flight_timer(#state{transport_cb = gen_udp,
flight_state = connection} = State) ->
{State, []};
-start_flight(State) ->
+handle_flight_timer(State) ->
%% No retransmision needed i.e DTLS over SCTP
{State#state{flight_state = reliable}, []}.
diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl
index 0a980c5f31..50e92027d2 100644
--- a/lib/ssl/src/dtls_handshake.hrl
+++ b/lib/ssl/src/dtls_handshake.hrl
@@ -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.
@@ -29,6 +29,7 @@
-include("ssl_handshake.hrl"). %% Common TLS and DTLS records and Constantes
-define(HELLO_VERIFY_REQUEST, 3).
+-define(HELLO_VERIFY_REQUEST_VERSION, {254, 255}).
-record(client_hello, {
client_version,
diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl
index 2a746d97f0..fbbd479428 100644
--- a/lib/ssl/src/dtls_socket.erl
+++ b/lib/ssl/src/dtls_socket.erl
@@ -79,30 +79,31 @@ socket(Pid, Transport, Socket, ConnectionCb) ->
#sslsocket{pid = Pid,
%% "The name "fd" is keept for backwards compatibility
fd = {Transport, Socket, ConnectionCb}}.
-%% Vad göra med emulerade
-setopts(gen_udp, #sslsocket{pid = {Socket, _}}, Options) ->
- {SockOpts, _} = tls_socket:split_options(Options),
- inet:setopts(Socket, SockOpts);
-setopts(_, #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_}}}}, Options) ->
- {SockOpts, _} = tls_socket:split_options(Options),
- Transport:setopts(ListenSocket, SockOpts);
+setopts(_, #sslsocket{pid = {udp, #config{udp_handler = {ListenPid, _}}}}, Options) ->
+ SplitOpts = tls_socket:split_options(Options),
+ dtls_udp_listener:set_sock_opts(ListenPid, SplitOpts);
%%% Following clauses will not be called for emulated options, they are handled in the connection process
setopts(gen_udp, Socket, Options) ->
inet:setopts(Socket, Options);
setopts(Transport, Socket, Options) ->
Transport:setopts(Socket, Options).
+getopts(_, #sslsocket{pid = {udp, #config{udp_handler = {ListenPid, _}}}}, Options) ->
+ SplitOpts = tls_socket:split_options(Options),
+ dtls_udp_listener:get_sock_opts(ListenPid, SplitOpts);
getopts(gen_udp, #sslsocket{pid = {Socket, #config{emulated = EmOpts}}}, Options) ->
{SockOptNames, EmulatedOptNames} = tls_socket:split_options(Options),
EmulatedOpts = get_emulated_opts(EmOpts, EmulatedOptNames),
SocketOpts = tls_socket:get_socket_opts(Socket, SockOptNames, inet),
{ok, EmulatedOpts ++ SocketOpts};
-getopts(Transport, #sslsocket{pid = {ListenSocket, #config{emulated = EmOpts}}}, Options) ->
+getopts(_Transport, #sslsocket{pid = {Socket, #config{emulated = EmOpts}}}, Options) ->
{SockOptNames, EmulatedOptNames} = tls_socket:split_options(Options),
EmulatedOpts = get_emulated_opts(EmOpts, EmulatedOptNames),
- SocketOpts = tls_socket:get_socket_opts(ListenSocket, SockOptNames, Transport),
+ SocketOpts = tls_socket:get_socket_opts(Socket, SockOptNames, inet),
{ok, EmulatedOpts ++ SocketOpts};
%%% Following clauses will not be called for emulated options, they are handled in the connection process
+getopts(gen_udp, {_,{{_, _},Socket}}, Options) ->
+ inet:getopts(Socket, Options);
getopts(gen_udp, {_,Socket}, Options) ->
inet:getopts(Socket, Options);
getopts(Transport, Socket, Options) ->
diff --git a/lib/ssl/src/dtls_udp_listener.erl b/lib/ssl/src/dtls_udp_listener.erl
index 29380e3008..c789a32087 100644
--- a/lib/ssl/src/dtls_udp_listener.erl
+++ b/lib/ssl/src/dtls_udp_listener.erl
@@ -23,9 +23,11 @@
-behaviour(gen_server).
+-include("ssl_internal.hrl").
+
%% API
-export([start_link/4, active_once/3, accept/2, sockname/1, close/1,
- get_all_opts/1]).
+ get_all_opts/1, get_sock_opts/2, set_sock_opts/2]).
%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
@@ -61,8 +63,12 @@ sockname(UDPConnection) ->
call(UDPConnection, sockname).
close(UDPConnection) ->
call(UDPConnection, close).
+get_sock_opts(UDPConnection, SplitSockOpts) ->
+ call(UDPConnection, {get_sock_opts, SplitSockOpts}).
get_all_opts(UDPConnection) ->
call(UDPConnection, get_all_opts).
+set_sock_opts(UDPConnection, Opts) ->
+ call(UDPConnection, {set_sock_opts, Opts}).
%%%===================================================================
%%% gen_server callbacks
@@ -108,9 +114,21 @@ handle_call(close, _, #state{dtls_processes = Processes,
end, queue:to_list(Accepters)),
{reply, ok, State#state{close = true, accepters = queue:new()}}
end;
+handle_call({get_sock_opts, {SocketOptNames, EmOptNames}}, _, #state{listner = Socket,
+ emulated_options = EmOpts} = State) ->
+ case get_socket_opts(Socket, SocketOptNames) of
+ {ok, Opts} ->
+ {reply, {ok, emulated_opts_list(EmOpts, EmOptNames, []) ++ Opts}, State};
+ {error, Reason} ->
+ {reply, {error, Reason}, State}
+ end;
handle_call(get_all_opts, _, #state{dtls_options = DTLSOptions,
emulated_options = EmOpts} = State) ->
- {reply, {ok, EmOpts, DTLSOptions}, State}.
+ {reply, {ok, EmOpts, DTLSOptions}, State};
+handle_call({set_sock_opts, {SocketOpts, NewEmOpts}}, _, #state{listner = Socket, emulated_options = EmOpts0} = State) ->
+ set_socket_opts(Socket, SocketOpts),
+ EmOpts = do_set_emulated_opts(NewEmOpts, EmOpts0),
+ {reply, ok, State#state{emulated_options = EmOpts}}.
handle_cast({active_once, Client, Pid}, State0) ->
State = handle_active_once(Client, Pid, State0),
@@ -259,3 +277,28 @@ call(Server, Msg) ->
exit:{{shutdown, _},_} ->
{error, closed}
end.
+
+set_socket_opts(_, []) ->
+ ok;
+set_socket_opts(Socket, SocketOpts) ->
+ inet:setopts(Socket, SocketOpts).
+
+get_socket_opts(_, []) ->
+ {ok, []};
+get_socket_opts(Socket, SocketOpts) ->
+ inet:getopts(Socket, SocketOpts).
+
+do_set_emulated_opts([], Opts) ->
+ Opts;
+do_set_emulated_opts([{mode, Value} | Rest], Opts) ->
+ do_set_emulated_opts(Rest, Opts#socket_options{mode = Value});
+do_set_emulated_opts([{active, Value} | Rest], Opts) ->
+ do_set_emulated_opts(Rest, Opts#socket_options{active = Value}).
+
+emulated_opts_list(_,[], Acc) ->
+ Acc;
+emulated_opts_list( Opts, [mode | Rest], Acc) ->
+ emulated_opts_list(Opts, Rest, [{mode, Opts#socket_options.mode} | Acc]);
+emulated_opts_list(Opts, [active | Rest], Acc) ->
+ emulated_opts_list(Opts, Rest, [{active, Opts#socket_options.active} | Acc]).
+
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 5421bdef99..801aa8f256 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -427,6 +427,16 @@ eccs_filter_supported(Curves) ->
%%--------------------------------------------------------------------
getopts(#sslsocket{pid = Pid}, OptionTags) when is_pid(Pid), is_list(OptionTags) ->
ssl_connection:get_opts(Pid, OptionTags);
+getopts(#sslsocket{pid = {udp, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, OptionTags) when is_list(OptionTags) ->
+ try dtls_socket:getopts(Transport, ListenSocket, OptionTags) of
+ {ok, _} = Result ->
+ Result;
+ {error, InetError} ->
+ {error, {options, {socket_options, OptionTags, InetError}}}
+ catch
+ _:Error ->
+ {error, {options, {socket_options, OptionTags, Error}}}
+ end;
getopts(#sslsocket{pid = {_, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket,
OptionTags) when is_list(OptionTags) ->
try tls_socket:getopts(Transport, ListenSocket, OptionTags) of
@@ -455,7 +465,7 @@ setopts(#sslsocket{pid = Pid}, Options0) when is_pid(Pid), is_list(Options0) ->
_:_ ->
{error, {options, {not_a_proplist, Options0}}}
end;
-setopts(#sslsocket{pid = {{udp, _}, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) ->
+setopts(#sslsocket{pid = {udp, #config{transport_info = {Transport,_,_,_}}}} = ListenSocket, Options) when is_list(Options) ->
try dtls_socket:setopts(Transport, ListenSocket, Options) of
ok ->
ok;
@@ -559,7 +569,7 @@ renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) ->
%%--------------------------------------------------------------------
-spec prf(#sslsocket{}, binary() | 'master_secret', binary(),
- binary() | prf_random(), non_neg_integer()) ->
+ [binary() | prf_random()], non_neg_integer()) ->
{ok, binary()} | {error, reason()}.
%%
%% Description: use a ssl sessions TLS PRF to generate key material
diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl
index 696a55e4b9..b923785e17 100644
--- a/lib/ssl/src/ssl_alert.erl
+++ b/lib/ssl/src/ssl_alert.erl
@@ -57,16 +57,16 @@ decode(Bin) ->
reason_code(#alert{description = ?CLOSE_NOTIFY}, _) ->
closed;
reason_code(#alert{description = Description}, _) ->
- {tls_alert, description_txt(Description)}.
+ {tls_alert, string:to_lower(description_txt(Description))}.
%%--------------------------------------------------------------------
-spec alert_txt(#alert{}) -> string().
%%
%% Description: Returns the error string for given alert.
%%--------------------------------------------------------------------
-alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}, reason = undefined}) ->
- Mod ++ ":" ++ integer_to_list(Line) ++ ":" ++
- level_txt(Level) ++" "++ description_txt(Description);
+alert_txt(#alert{level = Level, description = Description, where = {Mod,Line}, reason = undefined, role = Role}) ->
+ "at " ++ Mod ++ ":" ++ integer_to_list(Line) ++ " " ++ string:to_upper(atom_to_list(Role)) ++ " ALERT: " ++
+ level_txt(Level) ++ description_txt(Description);
alert_txt(#alert{reason = Reason} = Alert) ->
BaseTxt = alert_txt(Alert#alert{reason = undefined}),
FormatDepth = 9, % Some limit on printed representation of an error
@@ -93,73 +93,73 @@ decode(<<>>, Acc, _) ->
lists:reverse(Acc, []).
level_txt(?WARNING) ->
- "Warning:";
+ "Warning - ";
level_txt(?FATAL) ->
- "Fatal error:".
+ "Fatal - ".
description_txt(?CLOSE_NOTIFY) ->
- "close notify";
+ "Close Notify";
description_txt(?UNEXPECTED_MESSAGE) ->
- "unexpected message";
+ "Unexpected Message";
description_txt(?BAD_RECORD_MAC) ->
- "bad record mac";
+ "Bad Record MAC";
description_txt(?DECRYPTION_FAILED) ->
- "decryption failed";
+ "Decryption Failed";
description_txt(?RECORD_OVERFLOW) ->
- "record overflow";
+ "Record Overflow";
description_txt(?DECOMPRESSION_FAILURE) ->
- "decompression failure";
+ "Decompression Failure";
description_txt(?HANDSHAKE_FAILURE) ->
- "handshake failure";
+ "Handshake Failure";
description_txt(?NO_CERTIFICATE_RESERVED) ->
- "No certificate reserved";
+ "No Certificate Reserved";
description_txt(?BAD_CERTIFICATE) ->
- "bad certificate";
+ "Bad Certificate";
description_txt(?UNSUPPORTED_CERTIFICATE) ->
- "unsupported certificate";
+ "Unsupported Certificate";
description_txt(?CERTIFICATE_REVOKED) ->
- "certificate revoked";
+ "Certificate Revoked";
description_txt(?CERTIFICATE_EXPIRED) ->
- "certificate expired";
+ "Certificate Expired";
description_txt(?CERTIFICATE_UNKNOWN) ->
- "certificate unknown";
+ "Certificate Unknown";
description_txt(?ILLEGAL_PARAMETER) ->
- "illegal parameter";
+ "Illegal Parameter";
description_txt(?UNKNOWN_CA) ->
- "unknown ca";
+ "Unknown CA";
description_txt(?ACCESS_DENIED) ->
- "access denied";
+ "Access Denied";
description_txt(?DECODE_ERROR) ->
- "decode error";
+ "Decode Error";
description_txt(?DECRYPT_ERROR) ->
- "decrypt error";
+ "Decrypt Error";
description_txt(?EXPORT_RESTRICTION) ->
- "export restriction";
+ "Export Restriction";
description_txt(?PROTOCOL_VERSION) ->
- "protocol version";
+ "Protocol Version";
description_txt(?INSUFFICIENT_SECURITY) ->
- "insufficient security";
+ "Insufficient Security";
description_txt(?INTERNAL_ERROR) ->
- "internal error";
+ "Internal Error";
description_txt(?USER_CANCELED) ->
- "user canceled";
+ "User Canceled";
description_txt(?NO_RENEGOTIATION) ->
- "no renegotiation";
+ "No Renegotiation";
description_txt(?UNSUPPORTED_EXTENSION) ->
- "unsupported extension";
+ "Unsupported Extension";
description_txt(?CERTIFICATE_UNOBTAINABLE) ->
- "certificate unobtainable";
+ "Certificate Unobtainable";
description_txt(?UNRECOGNISED_NAME) ->
- "unrecognised name";
+ "Unrecognised Name";
description_txt(?BAD_CERTIFICATE_STATUS_RESPONSE) ->
- "bad certificate status response";
+ "Bad Certificate Status Response";
description_txt(?BAD_CERTIFICATE_HASH_VALUE) ->
- "bad certificate hash value";
+ "Bad Certificate Hash Value";
description_txt(?UNKNOWN_PSK_IDENTITY) ->
- "unknown psk identity";
+ "Unknown Psk Identity";
description_txt(?INAPPROPRIATE_FALLBACK) ->
- "inappropriate fallback";
+ "Inappropriate Fallback";
description_txt(?NO_APPLICATION_PROTOCOL) ->
- "no application protocol";
+ "No application protocol";
description_txt(Enum) ->
lists:flatten(io_lib:format("unsupported/unknown alert: ~p", [Enum])).
diff --git a/lib/ssl/src/ssl_alert.hrl b/lib/ssl/src/ssl_alert.hrl
index f3743ba0f0..1aabb6c55a 100644
--- a/lib/ssl/src/ssl_alert.hrl
+++ b/lib/ssl/src/ssl_alert.hrl
@@ -118,6 +118,7 @@
level,
description,
where = {?FILE, ?LINE},
+ role,
reason
}).
-endif. % -ifdef(ssl_alert).
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index bd60197c88..50c5f0d755 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -335,7 +335,9 @@ all_suites(Version) ->
anonymous_suites({3, N}) ->
anonymous_suites(N);
-
+anonymous_suites({254, _} = Version) ->
+ anonymous_suites(dtls_v1:corresponding_tls_version(Version))
+ -- [?TLS_DH_anon_WITH_RC4_128_MD5];
anonymous_suites(N)
when N >= 3 ->
[?TLS_DH_anon_WITH_AES_128_GCM_SHA256,
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index fb87662c7b..1afc4ad2af 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -264,7 +264,7 @@ renegotiation(ConnectionPid) ->
%%--------------------------------------------------------------------
-spec prf(pid(), binary() | 'master_secret', binary(),
- binary() | ssl:prf_random(), non_neg_integer()) ->
+ [binary() | ssl:prf_random()], non_neg_integer()) ->
{ok, binary()} | {error, reason()} | {'EXIT', term()}.
%%
%% Description: use a ssl sessions TLS PRF to generate key material
@@ -1143,7 +1143,7 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName,
port = Port, session = Session, user_application = {_Mon, Pid},
role = Role, socket_options = Opts, tracker = Tracker}) ->
invalidate_session(Role, Host, Port, Session),
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection),
{stop, normal};
@@ -1153,15 +1153,16 @@ handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
{stop, {shutdown, peer_close}};
handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
- #state{ssl_options = SslOpts, renegotiation = {true, internal}} = State) ->
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) ->
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
handle_normal_shutdown(Alert, StateName, State),
{stop, {shutdown, peer_close}};
handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
- #state{ssl_options = SslOpts, renegotiation = {true, From},
+ #state{role = Role,
+ ssl_options = SslOpts, renegotiation = {true, From},
protocol_cb = Connection} = State0) ->
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
gen_statem:reply(From, {error, renegotiation_rejected}),
{Record, State} = Connection:next_record(State0),
%% Go back to connection!
@@ -1169,8 +1170,8 @@ handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert,
%% Gracefully log and ignore all other warning alerts
handle_alert(#alert{level = ?WARNING} = Alert, StateName,
- #state{ssl_options = SslOpts, protocol_cb = Connection} = State0) ->
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ #state{ssl_options = SslOpts, protocol_cb = Connection, role = Role} = State0) ->
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
{Record, State} = Connection:next_record(State0),
Connection:next_event(StateName, Record, State).
@@ -2370,18 +2371,19 @@ alert_user(Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Connectio
Transport, Socket, Connection, Tracker), ReasonCode})
end.
-log_alert(true, Info, Alert) ->
+log_alert(true, ProtocolName, StateName, Alert) ->
Txt = ssl_alert:alert_txt(Alert),
- error_logger:format("SSL: ~p: ~s\n", [Info, Txt]);
-log_alert(false, _, _) ->
+ error_logger:format("~s: In state ~p ~s\n", [ProtocolName, StateName, Txt]);
+log_alert(false, _, _, _) ->
ok.
handle_own_alert(Alert, Version, StateName,
- #state{transport_cb = Transport,
- socket = Socket,
- protocol_cb = Connection,
- connection_states = ConnectionStates,
- ssl_options = SslOpts} = State) ->
+ #state{role = Role,
+ transport_cb = Transport,
+ socket = Socket,
+ protocol_cb = Connection,
+ connection_states = ConnectionStates,
+ ssl_options = SslOpts} = State) ->
try %% Try to tell the other side
{BinMsg, _} =
Connection:encode_alert(Alert, Version, ConnectionStates),
@@ -2390,7 +2392,7 @@ handle_own_alert(Alert, Version, StateName,
ignore
end,
try %% Try to tell the local user
- log_alert(SslOpts#ssl_options.log_alert, StateName, Alert),
+ log_alert(SslOpts#ssl_options.log_alert, Connection:protocol_name(), StateName, Alert#alert{role = Role}),
handle_normal_shutdown(Alert,StateName, State)
catch _:_ ->
ok
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 3cf466e78f..b1661624b5 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -415,9 +415,11 @@ certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef,
path_validation_alert(Reason)
end
catch
- error:_ ->
+ error:{badmatch,{asn1, Asn1Reason}} ->
%% ASN-1 decode of certificate somehow failed
- ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, failed_to_decode_certificate)
+ ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, {failed_to_decode_certificate, Asn1Reason});
+ error:OtherReason ->
+ ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {unexpected_error, OtherReason})
end.
%%--------------------------------------------------------------------
@@ -1611,8 +1613,11 @@ path_validation_alert({bad_cert, unknown_critical_extension}) ->
?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE);
path_validation_alert({bad_cert, {revoked, _}}) ->
?ALERT_REC(?FATAL, ?CERTIFICATE_REVOKED);
-path_validation_alert({bad_cert, revocation_status_undetermined}) ->
- ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
+%%path_validation_alert({bad_cert, revocation_status_undetermined}) ->
+%% ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
+path_validation_alert({bad_cert, {revocation_status_undetermined, Details}}) ->
+ Alert = ?ALERT_REC(?FATAL, ?BAD_CERTIFICATE),
+ Alert#alert{reason = Details};
path_validation_alert({bad_cert, selfsigned_peer}) ->
?ALERT_REC(?FATAL, ?BAD_CERTIFICATE);
path_validation_alert({bad_cert, unknown_ca}) ->
@@ -2189,7 +2194,8 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, C
ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath,
DBInfo})
end, {CertDbHandle, CertDbRef}}},
- {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end}
+ {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end},
+ {undetermined_details, true}
],
case dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) of
no_dps ->
@@ -2199,7 +2205,7 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, C
DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed
%% but could not be retrived, will result in {bad_cert, revocation_status_undetermined}
case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of
- {bad_cert, revocation_status_undetermined} ->
+ {bad_cert, {revocation_status_undetermined, _}} ->
crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback,
CRLDbHandle, same_issuer), Options);
Other ->
@@ -2209,7 +2215,7 @@ crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, C
crl_check_same_issuer(OtpCert, best_effort, Dps, Options) ->
case public_key:pkix_crls_validate(OtpCert, Dps, Options) of
- {bad_cert, revocation_status_undetermined} ->
+ {bad_cert, {revocation_status_undetermined, _}} ->
valid;
Other ->
Other
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 96c3ab86e9..e3ffbea3d3 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -56,7 +56,7 @@
reinit_handshake_data/1, select_sni_extension/1]).
%% Alert and close handling
--export([send_alert/2, close/5]).
+-export([send_alert/2, close/5, protocol_name/0]).
%% Data handling
-export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3,
@@ -164,6 +164,8 @@ encode_data(Data, Version, ConnectionStates0)->
encode_alert(#alert{} = Alert, Version, ConnectionStates) ->
tls_record:encode_alert_record(Alert, Version, ConnectionStates).
+protocol_name() ->
+ "TLS".
%%====================================================================
%% tls_connection_sup API
%%====================================================================
@@ -600,8 +602,12 @@ next_record(#state{protocol_buffers =
next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []},
socket = Socket,
transport_cb = Transport} = State) ->
- tls_socket:setopts(Transport, Socket, [{active,once}]),
- {no_record, State};
+ case tls_socket:setopts(Transport, Socket, [{active,once}]) of
+ ok ->
+ {no_record, State};
+ _ ->
+ {socket_closed, State}
+ end;
next_record(State) ->
{no_record, State}.
@@ -626,10 +632,15 @@ passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) ->
next_event(StateName, Record, State) ->
next_event(StateName, Record, State, []).
+next_event(StateName, socket_closed, State, _) ->
+ ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
+ {stop, {shutdown, transport_closed}, State};
next_event(connection = StateName, no_record, State0, Actions) ->
case next_record_if_active(State0) of
{no_record, State} ->
ssl_connection:hibernate_after(StateName, State, Actions);
+ {socket_closed, State} ->
+ next_event(StateName, socket_closed, State, Actions);
{#ssl_tls{} = Record, State} ->
{next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
{#alert{} = Alert, State} ->
@@ -710,7 +721,7 @@ close(downgrade, _,_,_,_) ->
%% Other
close(_, Socket, Transport, _,_) ->
Transport:close(Socket).
-
+
convert_state(#state{ssl_options = Options} = State, up, "5.3.5", "5.3.6") ->
State#state{ssl_options = convert_options_partial_chain(Options, up)};
convert_state(#state{ssl_options = Options} = State, down, "5.3.6", "5.3.5") ->
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 558be6d642..c7e2f402af 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -56,7 +56,6 @@ MODULES = \
ssl_upgrade_SUITE\
ssl_sni_SUITE \
make_certs\
- erl_make_certs\
x509_test
diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl
deleted file mode 100644
index 3ab6222780..0000000000
--- a/lib/ssl/test/erl_make_certs.erl
+++ /dev/null
@@ -1,477 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2011-2017. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%% Create test certificates
-
--module(erl_make_certs).
--include_lib("public_key/include/public_key.hrl").
-
--export([make_cert/1, gen_rsa/1, verify_signature/3, write_pem/3]).
--compile(export_all).
-
-%%--------------------------------------------------------------------
-%% @doc Create and return a der encoded certificate
-%% Option Default
-%% -------------------------------------------------------
-%% digest sha1
-%% validity {date(), date() + week()}
-%% version 3
-%% subject [] list of the following content
-%% {name, Name}
-%% {email, Email}
-%% {city, City}
-%% {state, State}
-%% {org, Org}
-%% {org_unit, OrgUnit}
-%% {country, Country}
-%% {serial, Serial}
-%% {title, Title}
-%% {dnQualifer, DnQ}
-%% issuer = {Issuer, IssuerKey} true (i.e. a ca cert is created)
-%% (obs IssuerKey migth be {Key, Password}
-%% key = KeyFile|KeyBin|rsa|dsa|ec Subject PublicKey rsa, dsa or ec generates key
-%%
-%%
-%% (OBS: The generated keys are for testing only)
-%% @spec ([{::atom(), ::term()}]) -> {Cert::binary(), Key::binary()}
-%% @end
-%%--------------------------------------------------------------------
-
-make_cert(Opts) ->
- SubjectPrivateKey = get_key(Opts),
- {TBSCert, IssuerKey} = make_tbs(SubjectPrivateKey, Opts),
- Cert = public_key:pkix_sign(TBSCert, IssuerKey),
- true = verify_signature(Cert, IssuerKey, undef), %% verify that the keys where ok
- {Cert, encode_key(SubjectPrivateKey)}.
-
-%%--------------------------------------------------------------------
-%% @doc Writes pem files in Dir with FileName ++ ".pem" and FileName ++ "_key.pem"
-%% @spec (::string(), ::string(), {Cert,Key}) -> ok
-%% @end
-%%--------------------------------------------------------------------
-write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) ->
- ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"),
- [{'Certificate', Cert, not_encrypted}]),
- ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]).
-
-%%--------------------------------------------------------------------
-%% @doc Creates a rsa key (OBS: for testing only)
-%% the size are in bytes
-%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
-%% @end
-%%--------------------------------------------------------------------
-gen_rsa(Size) when is_integer(Size) ->
- Key = gen_rsa2(Size),
- {Key, encode_key(Key)}.
-
-%%--------------------------------------------------------------------
-%% @doc Creates a dsa key (OBS: for testing only)
-%% the sizes are in bytes
-%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
-%% @end
-%%--------------------------------------------------------------------
-gen_dsa(LSize,NSize) when is_integer(LSize), is_integer(NSize) ->
- Key = gen_dsa2(LSize, NSize),
- {Key, encode_key(Key)}.
-
-%%--------------------------------------------------------------------
-%% @doc Creates a ec key (OBS: for testing only)
-%% the sizes are in bytes
-%% @spec (::integer()) -> {::atom(), ::binary(), ::opaque()}
-%% @end
-%%--------------------------------------------------------------------
-gen_ec(Curve) when is_atom(Curve) ->
- Key = gen_ec2(Curve),
- {Key, encode_key(Key)}.
-
-%%--------------------------------------------------------------------
-%% @doc Verifies cert signatures
-%% @spec (::binary(), ::tuple()) -> ::boolean()
-%% @end
-%%--------------------------------------------------------------------
-verify_signature(DerEncodedCert, DerKey, _KeyParams) ->
- Key = decode_key(DerKey),
- case Key of
- #'RSAPrivateKey'{modulus=Mod, publicExponent=Exp} ->
- public_key:pkix_verify(DerEncodedCert,
- #'RSAPublicKey'{modulus=Mod, publicExponent=Exp});
- #'DSAPrivateKey'{p=P, q=Q, g=G, y=Y} ->
- public_key:pkix_verify(DerEncodedCert, {Y, #'Dss-Parms'{p=P, q=Q, g=G}});
- #'ECPrivateKey'{version = _Version, privateKey = _PrivKey,
- parameters = Params, publicKey = PubKey} ->
- public_key:pkix_verify(DerEncodedCert, {#'ECPoint'{point = PubKey}, Params})
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%% Implementation %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-get_key(Opts) ->
- case proplists:get_value(key, Opts) of
- undefined -> make_key(rsa, Opts);
- rsa -> make_key(rsa, Opts);
- dsa -> make_key(dsa, Opts);
- ec -> make_key(ec, Opts);
- Key ->
- Password = proplists:get_value(password, Opts, no_passwd),
- decode_key(Key, Password)
- end.
-
-decode_key({Key, Pw}) ->
- decode_key(Key, Pw);
-decode_key(Key) ->
- decode_key(Key, no_passwd).
-
-
-decode_key(#'RSAPublicKey'{} = Key,_) ->
- Key;
-decode_key(#'RSAPrivateKey'{} = Key,_) ->
- Key;
-decode_key(#'DSAPrivateKey'{} = Key,_) ->
- Key;
-decode_key(#'ECPrivateKey'{} = Key,_) ->
- Key;
-decode_key(PemEntry = {_,_,_}, Pw) ->
- public_key:pem_entry_decode(PemEntry, Pw);
-decode_key(PemBin, Pw) ->
- [KeyInfo] = public_key:pem_decode(PemBin),
- decode_key(KeyInfo, Pw).
-
-encode_key(Key = #'RSAPrivateKey'{}) ->
- {ok, Der} = 'OTP-PUB-KEY':encode('RSAPrivateKey', Key),
- {'RSAPrivateKey', Der, not_encrypted};
-encode_key(Key = #'DSAPrivateKey'{}) ->
- {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key),
- {'DSAPrivateKey', Der, not_encrypted};
-encode_key(Key = #'ECPrivateKey'{}) ->
- {ok, Der} = 'OTP-PUB-KEY':encode('ECPrivateKey', Key),
- {'ECPrivateKey', Der, not_encrypted}.
-
-make_tbs(SubjectKey, Opts) ->
- Version = list_to_atom("v"++integer_to_list(proplists:get_value(version, Opts, 3))),
-
- IssuerProp = proplists:get_value(issuer, Opts, true),
- {Issuer, IssuerKey} = issuer(IssuerProp, Opts, SubjectKey),
-
- {Algo, Parameters} = sign_algorithm(IssuerKey, Opts),
-
- SignAlgo = #'SignatureAlgorithm'{algorithm = Algo,
- parameters = Parameters},
- Subject = case IssuerProp of
- true -> %% Is a Root Ca
- Issuer;
- _ ->
- subject(proplists:get_value(subject, Opts),false)
- end,
-
- {#'OTPTBSCertificate'{serialNumber = trunc(rand:uniform()*100000000)*10000 + 1,
- signature = SignAlgo,
- issuer = Issuer,
- validity = validity(Opts),
- subject = Subject,
- subjectPublicKeyInfo = publickey(SubjectKey),
- version = Version,
- extensions = extensions(Opts)
- }, IssuerKey}.
-
-issuer(true, Opts, SubjectKey) ->
- %% Self signed
- {subject(proplists:get_value(subject, Opts), true), SubjectKey};
-issuer({Issuer, IssuerKey}, _Opts, _SubjectKey) when is_binary(Issuer) ->
- {issuer_der(Issuer), decode_key(IssuerKey)};
-issuer({File, IssuerKey}, _Opts, _SubjectKey) when is_list(File) ->
- {ok, [{cert, Cert, _}|_]} = pem_to_der(File),
- {issuer_der(Cert), decode_key(IssuerKey)}.
-
-issuer_der(Issuer) ->
- Decoded = public_key:pkix_decode_cert(Issuer, otp),
- #'OTPCertificate'{tbsCertificate=Tbs} = Decoded,
- #'OTPTBSCertificate'{subject=Subject} = Tbs,
- Subject.
-
-subject(undefined, IsRootCA) ->
- User = if IsRootCA -> "RootCA"; true -> os:getenv("USER", "test_user") end,
- Opts = [{email, User ++ "@erlang.org"},
- {name, User},
- {city, "Stockholm"},
- {country, "SE"},
- {org, "erlang"},
- {org_unit, "testing dep"}],
- subject(Opts);
-subject(Opts, _) ->
- subject(Opts).
-
-subject(SubjectOpts) when is_list(SubjectOpts) ->
- Encode = fun(Opt) ->
- {Type,Value} = subject_enc(Opt),
- [#'AttributeTypeAndValue'{type=Type, value=Value}]
- end,
- {rdnSequence, [Encode(Opt) || Opt <- SubjectOpts]}.
-
-%% Fill in the blanks
-subject_enc({name, Name}) -> {?'id-at-commonName', {printableString, Name}};
-subject_enc({email, Email}) -> {?'id-emailAddress', Email};
-subject_enc({city, City}) -> {?'id-at-localityName', {printableString, City}};
-subject_enc({state, State}) -> {?'id-at-stateOrProvinceName', {printableString, State}};
-subject_enc({org, Org}) -> {?'id-at-organizationName', {printableString, Org}};
-subject_enc({org_unit, OrgUnit}) -> {?'id-at-organizationalUnitName', {printableString, OrgUnit}};
-subject_enc({country, Country}) -> {?'id-at-countryName', Country};
-subject_enc({serial, Serial}) -> {?'id-at-serialNumber', Serial};
-subject_enc({title, Title}) -> {?'id-at-title', {printableString, Title}};
-subject_enc({dnQualifer, DnQ}) -> {?'id-at-dnQualifier', DnQ};
-subject_enc(Other) -> Other.
-
-
-extensions(Opts) ->
- case proplists:get_value(extensions, Opts, []) of
- false ->
- asn1_NOVALUE;
- Exts ->
- lists:flatten([extension(Ext) || Ext <- default_extensions(Exts)])
- end.
-
-default_extensions(Exts) ->
- Def = [{key_usage,undefined},
- {subject_altname, undefined},
- {issuer_altname, undefined},
- {basic_constraints, default},
- {name_constraints, undefined},
- {policy_constraints, undefined},
- {ext_key_usage, undefined},
- {inhibit_any, undefined},
- {auth_key_id, undefined},
- {subject_key_id, undefined},
- {policy_mapping, undefined}],
- Filter = fun({Key, _}, D) -> lists:keydelete(Key, 1, D) end,
- Exts ++ lists:foldl(Filter, Def, Exts).
-
-extension({_, undefined}) -> [];
-extension({basic_constraints, Data}) ->
- case Data of
- default ->
- #'Extension'{extnID = ?'id-ce-basicConstraints',
- extnValue = #'BasicConstraints'{cA=true},
- critical=true};
- false ->
- [];
- Len when is_integer(Len) ->
- #'Extension'{extnID = ?'id-ce-basicConstraints',
- extnValue = #'BasicConstraints'{cA=true, pathLenConstraint=Len},
- critical=true};
- _ ->
- #'Extension'{extnID = ?'id-ce-basicConstraints',
- extnValue = Data}
- end;
-extension({Id, Data, Critical}) ->
- #'Extension'{extnID = Id, extnValue = Data, critical = Critical}.
-
-
-publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) ->
- Public = #'RSAPublicKey'{modulus=N, publicExponent=E},
- Algo = #'PublicKeyAlgorithm'{algorithm= ?rsaEncryption, parameters='NULL'},
- #'OTPSubjectPublicKeyInfo'{algorithm = Algo,
- subjectPublicKey = Public};
-publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) ->
- Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa',
- parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}},
- #'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y};
-publickey(#'ECPrivateKey'{version = _Version,
- privateKey = _PrivKey,
- parameters = Params,
- publicKey = PubKey}) ->
- Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-ecPublicKey', parameters=Params},
- #'OTPSubjectPublicKeyInfo'{algorithm = Algo,
- subjectPublicKey = #'ECPoint'{point = PubKey}}.
-
-validity(Opts) ->
- DefFrom0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())-1),
- DefTo0 = calendar:gregorian_days_to_date(calendar:date_to_gregorian_days(date())+7),
- {DefFrom, DefTo} = proplists:get_value(validity, Opts, {DefFrom0, DefTo0}),
- Format = fun({Y,M,D}) -> lists:flatten(io_lib:format("~w~2..0w~2..0w000000Z",[Y,M,D])) end,
- #'Validity'{notBefore={generalTime, Format(DefFrom)},
- notAfter ={generalTime, Format(DefTo)}}.
-
-sign_algorithm(#'RSAPrivateKey'{}, Opts) ->
- Type = case proplists:get_value(digest, Opts, sha1) of
- sha1 -> ?'sha1WithRSAEncryption';
- sha512 -> ?'sha512WithRSAEncryption';
- sha384 -> ?'sha384WithRSAEncryption';
- sha256 -> ?'sha256WithRSAEncryption';
- md5 -> ?'md5WithRSAEncryption';
- md2 -> ?'md2WithRSAEncryption'
- end,
- {Type, 'NULL'};
-sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) ->
- {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}};
-sign_algorithm(#'ECPrivateKey'{parameters = Parms}, Opts) ->
- Type = case proplists:get_value(digest, Opts, sha1) of
- sha1 -> ?'ecdsa-with-SHA1';
- sha512 -> ?'ecdsa-with-SHA512';
- sha384 -> ?'ecdsa-with-SHA384';
- sha256 -> ?'ecdsa-with-SHA256'
- end,
- {Type, Parms}.
-
-make_key(rsa, _Opts) ->
- %% (OBS: for testing only)
- gen_rsa2(64);
-make_key(dsa, _Opts) ->
- gen_dsa2(128, 20); %% Bytes i.e. {1024, 160}
-make_key(ec, _Opts) ->
- %% (OBS: for testing only)
- CurveOid = hd(tls_v1:ecc_curves(0)),
- NamedCurve = pubkey_cert_records:namedCurves(CurveOid),
- gen_ec2(NamedCurve).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% RSA key generation (OBS: for testing only)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--define(SMALL_PRIMES, [65537,97,89,83,79,73,71,67,61,59,53,
- 47,43,41,37,31,29,23,19,17,13,11,7,5,3]).
-
-gen_rsa2(Size) ->
- P = prime(Size),
- Q = prime(Size),
- N = P*Q,
- Tot = (P - 1) * (Q - 1),
- [E|_] = lists:dropwhile(fun(Candidate) -> (Tot rem Candidate) == 0 end, ?SMALL_PRIMES),
- {D1,D2} = extended_gcd(E, Tot),
- D = erlang:max(D1,D2),
- case D < E of
- true ->
- gen_rsa2(Size);
- false ->
- {Co1,Co2} = extended_gcd(Q, P),
- Co = erlang:max(Co1,Co2),
- #'RSAPrivateKey'{version = 'two-prime',
- modulus = N,
- publicExponent = E,
- privateExponent = D,
- prime1 = P,
- prime2 = Q,
- exponent1 = D rem (P-1),
- exponent2 = D rem (Q-1),
- coefficient = Co
- }
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% DSA key generation (OBS: for testing only)
-%% See http://en.wikipedia.org/wiki/Digital_Signature_Algorithm
-%% and the fips_186-3.pdf
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-gen_dsa2(LSize, NSize) ->
- Q = prime(NSize), %% Choose N-bit prime Q
- X0 = prime(LSize),
- P0 = prime((LSize div 2) +1),
-
- %% Choose L-bit prime modulus P such that p-1 is a multiple of q.
- case dsa_search(X0 div (2*Q*P0), P0, Q, 1000) of
- error ->
- gen_dsa2(LSize, NSize);
- P ->
- G = crypto:mod_pow(2, (P-1) div Q, P), % Choose G a number whose multiplicative order modulo p is q.
- %% such that This may be done by setting g = h^(p-1)/q mod p, commonly h=2 is used.
-
- X = prime(20), %% Choose x by some random method, where 0 < x < q.
- Y = crypto:mod_pow(G, X, P), %% Calculate y = g^x mod p.
-
- #'DSAPrivateKey'{version=0, p = P, q = Q,
- g = crypto:bytes_to_integer(G), y = crypto:bytes_to_integer(Y), x = X}
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% EC key generation (OBS: for testing only)
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-gen_ec2(CurveId) ->
- {PubKey, PrivKey} = crypto:generate_key(ecdh, CurveId),
-
- #'ECPrivateKey'{version = 1,
- privateKey = PrivKey,
- parameters = {namedCurve, pubkey_cert_records:namedCurves(CurveId)},
- publicKey = PubKey}.
-
-%% See fips_186-3.pdf
-dsa_search(T, P0, Q, Iter) when Iter > 0 ->
- P = 2*T*Q*P0 + 1,
- case is_prime(P, 50) of
- true -> P;
- false -> dsa_search(T+1, P0, Q, Iter-1)
- end;
-dsa_search(_,_,_,_) ->
- error.
-
-
-%%%%%%% Crypto Math %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-prime(ByteSize) ->
- Rand = odd_rand(ByteSize),
- prime_odd(Rand, 0).
-
-prime_odd(Rand, N) ->
- case is_prime(Rand, 50) of
- true ->
- Rand;
- false ->
- prime_odd(Rand+2, N+1)
- end.
-
-%% see http://en.wikipedia.org/wiki/Fermat_primality_test
-is_prime(_, 0) -> true;
-is_prime(Candidate, Test) ->
- CoPrime = odd_rand(10000, Candidate),
- Result = crypto:mod_pow(CoPrime, Candidate, Candidate) ,
- is_prime(CoPrime, crypto:bytes_to_integer(Result), Candidate, Test).
-
-is_prime(CoPrime, CoPrime, Candidate, Test) ->
- is_prime(Candidate, Test-1);
-is_prime(_,_,_,_) ->
- false.
-
-odd_rand(Size) ->
- Min = 1 bsl (Size*8-1),
- Max = (1 bsl (Size*8))-1,
- odd_rand(Min, Max).
-
-odd_rand(Min,Max) ->
- Rand = crypto:rand_uniform(Min,Max),
- case Rand rem 2 of
- 0 ->
- Rand + 1;
- _ ->
- Rand
- end.
-
-extended_gcd(A, B) ->
- case A rem B of
- 0 ->
- {0, 1};
- N ->
- {X, Y} = extended_gcd(B, N),
- {Y, X-Y*(A div B)}
- end.
-
-pem_to_der(File) ->
- {ok, PemBin} = file:read_file(File),
- public_key:pem_decode(PemBin).
-
-der_to_pem(File, Entries) ->
- PemBin = public_key:pem_encode(Entries),
- file:write_file(File, PemBin).
-
diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl
index 74505169a0..ecbacc1590 100644
--- a/lib/ssl/test/make_certs.erl
+++ b/lib/ssl/test/make_certs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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.
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 58870a3419..aeb4897d7e 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -119,7 +119,6 @@ options_tests() ->
[der_input,
ssl_options_not_proplist,
raw_ssl_option,
- socket_options,
invalid_inet_get_option,
invalid_inet_get_option_not_list,
invalid_inet_get_option_improper_list,
@@ -163,7 +162,8 @@ api_tests() ->
ssl_recv_timeout,
server_name_indication_option,
accept_pool,
- prf
+ prf,
+ socket_options
].
api_tests_tls() ->
@@ -178,6 +178,7 @@ api_tests_tls() ->
tls_shutdown_error,
peername,
sockname,
+ tls_socket_options,
new_options_in_accept
].
@@ -240,6 +241,7 @@ error_handling_tests()->
error_handling_tests_tls()->
[controller_dies,
tls_client_closes_socket,
+ tls_closed_in_active_once,
tls_tcp_error_propagation_in_active_mode,
tls_tcp_connect,
tls_tcp_connect_big,
@@ -358,6 +360,8 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites;
TestCase == psk_with_hint_cipher_suites;
TestCase == ciphers_rsa_signed_certs;
TestCase == ciphers_rsa_signed_certs_openssl_names;
+ TestCase == ciphers_ecdh_rsa_signed_certs_openssl_names;
+ TestCase == ciphers_ecdh_rsa_signed_certs;
TestCase == ciphers_dsa_signed_certs;
TestCase == ciphers_dsa_signed_certs_openssl_names;
TestCase == anonymous_cipher_suites;
@@ -366,6 +370,11 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites;
TestCase == anonymous_cipher_suites;
TestCase == psk_anon_cipher_suites;
TestCase == psk_anon_with_hint_cipher_suites;
+ TestCase == srp_cipher_suites,
+ TestCase == srp_anon_cipher_suites,
+ TestCase == srp_dsa_cipher_suites,
+ TestCase == des_rsa_cipher_suites,
+ TestCase == des_ecdh_rsa_cipher_suites,
TestCase == versions_option,
TestCase == tls_tcp_connect_big ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
@@ -384,22 +393,27 @@ init_per_testcase(reuse_session, Config) ->
init_per_testcase(rizzo, Config) ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
- ct:timetrap({seconds, 40}),
+ ct:timetrap({seconds, 60}),
+ Config;
+
+init_per_testcase(no_rizzo_rc4, Config) ->
+ ssl_test_lib:ct_log_supported_protocol_versions(Config),
+ ct:timetrap({seconds, 60}),
Config;
init_per_testcase(rizzo_one_n_minus_one, Config) ->
ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]),
- ct:timetrap({seconds, 40}),
+ ct:timetrap({seconds, 60}),
rizzo_add_mitigation_option(one_n_minus_one, Config);
init_per_testcase(rizzo_zero_n, Config) ->
ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]),
- ct:timetrap({seconds, 40}),
+ ct:timetrap({seconds, 60}),
rizzo_add_mitigation_option(zero_n, Config);
init_per_testcase(rizzo_disabled, Config) ->
ct:log("TLS/SSL version ~p~n ", [tls_record:supported_protocol_versions()]),
- ct:timetrap({seconds, 40}),
+ ct:timetrap({seconds, 60}),
rizzo_add_mitigation_option(disabled, Config);
init_per_testcase(prf, Config) ->
@@ -430,6 +444,7 @@ init_per_testcase(prf, Config) ->
init_per_testcase(TestCase, Config) when TestCase == tls_ssl_accept_timeout;
TestCase == tls_client_closes_socket;
+ TestCase == tls_closed_in_active_once;
TestCase == tls_downgrade ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
ct:timetrap({seconds, 15}),
@@ -961,6 +976,48 @@ tls_client_closes_socket(Config) when is_list(Config) ->
ssl_test_lib:check_result(Server, {error,closed}).
%%--------------------------------------------------------------------
+tls_closed_in_active_once() ->
+ [{doc, "Test that ssl_closed is delivered in active once with non-empty buffer, check ERL-420."}].
+
+tls_closed_in_active_once(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),
+ TcpOpts = [binary, {reuseaddr, true}],
+ Port = ssl_test_lib:inet_port(node()),
+ Server = fun() ->
+ {ok, Listen} = gen_tcp:listen(Port, TcpOpts),
+ {ok, TcpServerSocket} = gen_tcp:accept(Listen),
+ {ok, ServerSocket} = ssl:ssl_accept(TcpServerSocket, ServerOpts),
+ lists:foreach(
+ fun(_) ->
+ ssl:send(ServerSocket, "some random message\r\n")
+ end, lists:seq(1, 20)),
+ %% Close TCP instead of SSL socket to trigger the bug:
+ gen_tcp:close(TcpServerSocket),
+ gen_tcp:close(Listen)
+ end,
+ spawn_link(Server),
+ {ok, Socket} = ssl:connect(Hostname, Port, [{active, false} | ClientOpts]),
+ Result = tls_closed_in_active_once_loop(Socket),
+ ssl:close(Socket),
+ case Result of
+ ok -> ok;
+ _ -> ct:fail(Result)
+ end.
+
+tls_closed_in_active_once_loop(Socket) ->
+ ssl:setopts(Socket, [{active, once}]),
+ receive
+ {ssl, Socket, _} ->
+ tls_closed_in_active_once_loop(Socket);
+ {ssl_closed, Socket} ->
+ ok
+ after 5000 ->
+ no_ssl_closed_received
+ end.
+
+%%--------------------------------------------------------------------
connect_dist() ->
[{doc,"Test a simple connect as is used by distribution"}].
@@ -1242,10 +1299,10 @@ cipher_suites_mix(Config) when is_list(Config) ->
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
-socket_options() ->
+tls_socket_options() ->
[{doc,"Test API function getopts/2 and setopts/2"}].
-socket_options(Config) when is_list(Config) ->
+tls_socket_options(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),
@@ -1260,14 +1317,14 @@ socket_options(Config) when is_list(Config) ->
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
- {mfa, {?MODULE, socket_options_result,
+ {mfa, {?MODULE, tls_socket_options_result,
[Options, Values, NewOptions, NewValues]}},
{options, ServerOpts}]),
Port = ssl_test_lib:inet_port(Server),
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
{from, self()},
- {mfa, {?MODULE, socket_options_result,
+ {mfa, {?MODULE, tls_socket_options_result,
[Options, Values, NewOptions, NewValues]}},
{options, ClientOpts}]),
@@ -1282,7 +1339,7 @@ socket_options(Config) when is_list(Config) ->
{ok,[{recbuf, _}]} = ssl:getopts(Listen, [recbuf]),
ssl:close(Listen).
-socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) ->
+tls_socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) ->
%% Test get/set emulated opts
{ok, DefaultValues} = ssl:getopts(Socket, Options),
ssl:setopts(Socket, NewValues),
@@ -1297,6 +1354,59 @@ socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) ->
%%--------------------------------------------------------------------
+socket_options() ->
+ [{doc,"Test API function getopts/2 and setopts/2"}].
+
+socket_options(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),
+ Values = [{mode, list}, {active, true}],
+ %% Shall be the reverse order of Values!
+ Options = [active, mode],
+
+ NewValues = [{mode, binary}, {active, once}],
+ %% Shall be the reverse order of NewValues!
+ NewOptions = [active, mode],
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, socket_options_result,
+ [Options, Values, NewOptions, NewValues]}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, socket_options_result,
+ [Options, Values, NewOptions, NewValues]}},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+
+ ssl_test_lib:close(Server),
+
+ {ok, Listen} = ssl:listen(0, ServerOpts),
+ {ok,[{mode,list}]} = ssl:getopts(Listen, [mode]),
+ ok = ssl:setopts(Listen, [{mode, binary}]),
+ {ok,[{mode, binary}]} = ssl:getopts(Listen, [mode]),
+ {ok,[{recbuf, _}]} = ssl:getopts(Listen, [recbuf]),
+ ssl:close(Listen).
+
+
+socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) ->
+ %% Test get/set emulated opts
+ {ok, DefaultValues} = ssl:getopts(Socket, Options),
+ ssl:setopts(Socket, NewValues),
+ {ok, NewValues} = ssl:getopts(Socket, NewOptions),
+ %% Test get/set inet opts
+ {ok,[{reuseaddr, _}]} = ssl:getopts(Socket, [reuseaddr]),
+ {ok, All} = ssl:getopts(Socket, []),
+ ct:log("All opts ~p~n", [All]),
+ ok.
+
+
+%%--------------------------------------------------------------------
invalid_inet_get_option() ->
[{doc,"Test handling of invalid inet options in getopts"}].
@@ -2210,20 +2320,16 @@ tls_shutdown_error(Config) when is_list(Config) ->
ciphers_rsa_signed_certs() ->
[{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}].
-ciphers_rsa_signed_certs(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
+ciphers_rsa_signed_certs(Config) when is_list(Config) ->
Ciphers = ssl_test_lib:rsa_suites(crypto),
- ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
- run_suites(Ciphers, Version, Config, rsa).
+ run_suites(Ciphers, Config, rsa).
%%-------------------------------------------------------------------
ciphers_rsa_signed_certs_openssl_names() ->
[{doc,"Test all rsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_rsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:openssl_rsa_suites(crypto),
- ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
- run_suites(Ciphers, Version, Config, rsa).
+ Ciphers = ssl_test_lib:openssl_rsa_suites(),
+ run_suites(Ciphers, Config, rsa).
%%-------------------------------------------------------------------
ciphers_dsa_signed_certs() ->
@@ -2231,120 +2337,104 @@ ciphers_dsa_signed_certs() ->
ciphers_dsa_signed_certs(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:dsa_suites(NVersion),
- ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
- run_suites(Ciphers, Version, Config, dsa).
+ run_suites(Ciphers, Config, dsa).
%%-------------------------------------------------------------------
ciphers_dsa_signed_certs_openssl_names() ->
[{doc,"Test all dsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:openssl_dsa_suites(),
- ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
- run_suites(Ciphers, Version, Config, dsa).
+ run_suites(Ciphers, Config, dsa).
%%-------------------------------------------------------------------
anonymous_cipher_suites()->
[{doc,"Test the anonymous ciphersuites"}].
anonymous_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
- Ciphers = ssl_test_lib:anonymous_suites(Version),
- run_suites(Ciphers, Version, Config, anonymous).
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Ciphers = ssl_test_lib:anonymous_suites(NVersion),
+ run_suites(Ciphers, Config, anonymous).
%%-------------------------------------------------------------------
psk_cipher_suites() ->
[{doc, "Test the PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = ssl_test_lib:protocol_version(Config),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Ciphers = ssl_test_lib:psk_suites(NVersion),
- run_suites(Ciphers, Version, Config, psk).
+ run_suites(Ciphers, Config, psk).
%%-------------------------------------------------------------------
psk_with_hint_cipher_suites()->
[{doc, "Test the PSK ciphersuites WITH server supplied identity hint"}].
psk_with_hint_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = ssl_test_lib:protocol_version(Config),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Ciphers = ssl_test_lib:psk_suites(NVersion),
- run_suites(Ciphers, Version, Config, psk_with_hint).
+ run_suites(Ciphers, Config, psk_with_hint).
%%-------------------------------------------------------------------
psk_anon_cipher_suites() ->
[{doc, "Test the anonymous PSK ciphersuites WITHOUT server supplied identity hint"}].
psk_anon_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = ssl_test_lib:protocol_version(Config),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
- run_suites(Ciphers, Version, Config, psk_anon).
+ run_suites(Ciphers, Config, psk_anon).
%%-------------------------------------------------------------------
psk_anon_with_hint_cipher_suites()->
[{doc, "Test the anonymous PSK ciphersuites WITH server supplied identity hint"}].
psk_anon_with_hint_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = ssl_test_lib:protocol_version(Config),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
Ciphers = ssl_test_lib:psk_anon_suites(NVersion),
- run_suites(Ciphers, Version, Config, psk_anon_with_hint).
+ run_suites(Ciphers, Config, psk_anon_with_hint).
%%-------------------------------------------------------------------
srp_cipher_suites()->
[{doc, "Test the SRP ciphersuites"}].
srp_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:srp_suites(),
- run_suites(Ciphers, Version, Config, srp).
+ run_suites(Ciphers, Config, srp).
%%-------------------------------------------------------------------
srp_anon_cipher_suites()->
[{doc, "Test the anonymous SRP ciphersuites"}].
srp_anon_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:srp_anon_suites(),
- run_suites(Ciphers, Version, Config, srp_anon).
+ run_suites(Ciphers, Config, srp_anon).
%%-------------------------------------------------------------------
srp_dsa_cipher_suites()->
[{doc, "Test the SRP DSA ciphersuites"}].
srp_dsa_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:srp_dss_suites(),
- run_suites(Ciphers, Version, Config, srp_dsa).
+ run_suites(Ciphers, Config, srp_dsa).
%%-------------------------------------------------------------------
rc4_rsa_cipher_suites()->
[{doc, "Test the RC4 ciphersuites"}].
rc4_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
- Ciphers = ssl_test_lib:rc4_suites(NVersion),
- run_suites(Ciphers, Version, Config, rc4_rsa).
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
+ run_suites(Ciphers, Config, rc4_rsa).
%-------------------------------------------------------------------
rc4_ecdh_rsa_cipher_suites()->
[{doc, "Test the RC4 ciphersuites"}].
rc4_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
- NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
- Ciphers = ssl_test_lib:rc4_suites(NVersion),
- run_suites(Ciphers, Version, Config, rc4_ecdh_rsa).
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Ciphers = [S || {ecdh_rsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
+ run_suites(Ciphers, Config, rc4_ecdh_rsa).
%%-------------------------------------------------------------------
rc4_ecdsa_cipher_suites()->
[{doc, "Test the RC4 ciphersuites"}].
rc4_ecdsa_cipher_suites(Config) when is_list(Config) ->
NVersion = tls_record:highest_protocol_version([]),
- Version = tls_record:protocol_version(NVersion),
- Ciphers = ssl_test_lib:rc4_suites(NVersion),
- run_suites(Ciphers, Version, Config, rc4_ecdsa).
+ Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:rc4_suites(NVersion)],
+ run_suites(Ciphers, Config, rc4_ecdsa).
%%-------------------------------------------------------------------
des_rsa_cipher_suites()->
[{doc, "Test the des_rsa ciphersuites"}].
des_rsa_cipher_suites(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:des_suites(Config),
- run_suites(Ciphers, Version, Config, des_rsa).
+ run_suites(Ciphers, Config, des_rsa).
%-------------------------------------------------------------------
des_ecdh_rsa_cipher_suites()->
[{doc, "Test ECDH rsa signed ciphersuites"}].
des_ecdh_rsa_cipher_suites(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:des_suites(NVersion),
- run_suites(Ciphers, Version, Config, des_dhe_rsa).
+ run_suites(Ciphers, Config, des_dhe_rsa).
%%--------------------------------------------------------------------
default_reject_anonymous()->
@@ -2378,38 +2468,30 @@ ciphers_ecdsa_signed_certs() ->
ciphers_ecdsa_signed_certs(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:ecdsa_suites(NVersion),
- ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
- run_suites(Ciphers, Version, Config, ecdsa).
+ run_suites(Ciphers, Config, ecdsa).
%%--------------------------------------------------------------------
ciphers_ecdsa_signed_certs_openssl_names() ->
[{doc, "Test all ecdsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:openssl_ecdsa_suites(),
- ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
- run_suites(Ciphers, Version, Config, ecdsa).
+ run_suites(Ciphers, Config, ecdsa).
%%--------------------------------------------------------------------
ciphers_ecdh_rsa_signed_certs() ->
[{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) ->
NVersion = ssl_test_lib:protocol_version(Config, tuple),
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:ecdh_rsa_suites(NVersion),
- ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]),
- run_suites(Ciphers, Version, Config, ecdh_rsa).
+ run_suites(Ciphers, Config, ecdh_rsa).
%%--------------------------------------------------------------------
ciphers_ecdh_rsa_signed_certs_openssl_names() ->
[{doc, "Test all ecdh_rsa ssl cipher suites in highest support ssl/tls version"}].
ciphers_ecdh_rsa_signed_certs_openssl_names(Config) when is_list(Config) ->
- Version = ssl_test_lib:protocol_version(Config),
Ciphers = ssl_test_lib:openssl_ecdh_rsa_suites(),
- ct:log("tls1 openssl cipher suites ~p~n", [Ciphers]),
- run_suites(Ciphers, Version, Config, ecdh_rsa).
+ run_suites(Ciphers, Config, ecdh_rsa).
%%--------------------------------------------------------------------
reuse_session() ->
[{doc,"Test reuse of sessions (short handshake)"}].
@@ -2926,37 +3008,6 @@ der_input_opts(Opts) ->
{Cert, {Asn1Type, Key}, CaCerts, DHParams}.
%%--------------------------------------------------------------------
-%% different_ca_peer_sign() ->
-%% ["Check that a CA can have a different signature algorithm than the peer cert."];
-
-%% different_ca_peer_sign(Config) when is_list(Config) ->
-%% ClientOpts = ssl_test_lib:ssl_options(client_mix_opts, Config),
-%% ServerOpts = ssl_test_lib:ssl_options(server_mix_verify_opts, Config),
-
-%% {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
-%% Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
-%% {from, self()},
-%% {mfa, {ssl_test_lib, send_recv_result_active_once, []}},
-%% {options, [{active, once},
-%% {verify, verify_peer} | ServerOpts]}]),
-%% Port = ssl_test_lib:inet_port(Server),
-
-%% Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
-%% {host, Hostname},
-%% {from, self()},
-%% {mfa, {ssl_test_lib,
-%% send_recv_result_active_once,
-%% []}},
-%% {options, [{active, once},
-%% {verify, verify_peer}
-%% | ClientOpts]}]),
-
-%% ssl_test_lib:check_result(Server, ok, Client, ok),
-%% ssl_test_lib:close(Server),
-%% ssl_test_lib:close(Client).
-
-
-%%--------------------------------------------------------------------
no_reuses_session_server_restart_new_cert() ->
[{doc,"Check that a session is not reused if the server is restarted with a new cert."}].
no_reuses_session_server_restart_new_cert(Config) when is_list(Config) ->
@@ -3024,14 +3075,14 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) ->
DsaServerOpts = ssl_test_lib:ssl_options(server_dsa_opts, Config),
PrivDir = proplists:get_value(priv_dir, Config),
- NewServerOpts = new_config(PrivDir, ServerOpts),
+ NewServerOpts0 = new_config(PrivDir, ServerOpts),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server =
ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()},
{mfa, {ssl_test_lib, session_info_result, []}},
- {options, NewServerOpts}]),
+ {options, NewServerOpts0}]),
Port = ssl_test_lib:inet_port(Server),
Client0 =
ssl_test_lib:start_client([{node, ClientNode},
@@ -3052,13 +3103,13 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) ->
ssl:clear_pem_cache(),
- NewServerOpts = new_config(PrivDir, DsaServerOpts),
+ NewServerOpts1 = new_config(PrivDir, DsaServerOpts),
Server1 =
ssl_test_lib:start_server([{node, ServerNode}, {port, Port},
{from, self()},
{mfa, {ssl_test_lib, no_result, []}},
- {options, NewServerOpts}]),
+ {options, NewServerOpts1}]),
Client1 =
ssl_test_lib:start_client([{node, ClientNode},
{port, Port}, {host, Hostname},
@@ -3709,8 +3760,10 @@ no_rizzo_rc4() ->
no_rizzo_rc4(Config) when is_list(Config) ->
Prop = proplists:get_value(tc_group_properties, Config),
Version = proplists:get_value(name, Prop),
- Ciphers = [ssl_cipher:erl_suite_definition(Suite) ||
- Suite <- ssl_test_lib:rc4_suites(tls_record:protocol_version(Version))],
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ %% Test uses RSA certs
+ Ciphers = ssl_test_lib:rc4_suites(NVersion) -- [{ecdhe_ecdsa,rc4_128,sha},
+ {ecdh_ecdsa,rc4_128,sha}],
run_send_recv_rizzo(Ciphers, Config, Version,
{?MODULE, send_recv_result_active_no_rizzo, []}).
@@ -3720,7 +3773,8 @@ rizzo_one_n_minus_one() ->
rizzo_one_n_minus_one(Config) when is_list(Config) ->
Prop = proplists:get_value(tc_group_properties, Config),
Version = proplists:get_value(name, Prop),
- AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ AllSuites = ssl_test_lib:available_suites(NVersion),
Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128],
run_send_recv_rizzo(Ciphers, Config, Version,
{?MODULE, send_recv_result_active_rizzo, []}).
@@ -3731,7 +3785,8 @@ rizzo_zero_n() ->
rizzo_zero_n(Config) when is_list(Config) ->
Prop = proplists:get_value(tc_group_properties, Config),
Version = proplists:get_value(name, Prop),
- AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)),
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ AllSuites = ssl_test_lib:available_suites(NVersion),
Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128],
run_send_recv_rizzo(Ciphers, Config, Version,
{?MODULE, send_recv_result_active_no_rizzo, []}).
@@ -4533,7 +4588,10 @@ client_server_opts({KeyAlgo,_,_}, Config) when KeyAlgo == ecdh_rsa ->
{ssl_test_lib:ssl_options(client_opts, Config),
ssl_test_lib:ssl_options(server_ecdh_rsa_opts, Config)}.
-run_suites(Ciphers, Version, Config, Type) ->
+run_suites(Ciphers, Config, Type) ->
+ NVersion = ssl_test_lib:protocol_version(Config, tuple),
+ Version = ssl_test_lib:protocol_version(Config),
+ ct:log("Running cipher suites ~p~n", [Ciphers]),
{ClientOpts, ServerOpts} =
case Type of
rsa ->
@@ -4545,23 +4603,24 @@ run_suites(Ciphers, Version, Config, Type) ->
anonymous ->
%% No certs in opts!
{ssl_test_lib:ssl_options(client_verification_opts, Config),
- [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(Version)}]};
+ [{reuseaddr, true}, {ciphers, ssl_test_lib:anonymous_suites(NVersion)} |
+ ssl_test_lib:ssl_options([], Config)]};
psk ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_suites(Version)} |
+ [{ciphers, ssl_test_lib:psk_suites(NVersion)} |
ssl_test_lib:ssl_options(server_psk, Config)]};
psk_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_suites(Version)} |
+ [{ciphers, ssl_test_lib:psk_suites(NVersion)} |
ssl_test_lib:ssl_options(server_psk_hint, Config)
]};
psk_anon ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_anon_suites(Version)} |
+ [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} |
ssl_test_lib:ssl_options(server_psk_anon, Config)]};
psk_anon_with_hint ->
{ssl_test_lib:ssl_options(client_psk, Config),
- [{ciphers, ssl_test_lib:psk_anon_suites(Version)} |
+ [{ciphers, ssl_test_lib:psk_anon_suites(NVersion)} |
ssl_test_lib:ssl_options(server_psk_anon_hint, Config)]};
srp ->
{ssl_test_lib:ssl_options(client_srp, Config),
diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl
index e293d183f7..668c76e38d 100644
--- a/lib/ssl/test/ssl_crl_SUITE.erl
+++ b/lib/ssl/test/ssl_crl_SUITE.erl
@@ -155,9 +155,15 @@ init_per_testcase(Case, Config0) ->
DataDir = proplists:get_value(data_dir, Config),
CertDir = filename:join(proplists:get_value(priv_dir, Config0), idp_crl),
{CertOpts, Config} = init_certs(CertDir, idp_crl, Config),
- {ok, _} = make_certs:all(DataDir, CertDir, CertOpts),
- ct:timetrap({seconds, 6}),
- [{cert_dir, CertDir} | Config];
+ case make_certs:all(DataDir, CertDir, CertOpts) of
+ {ok, _} ->
+ ct:timetrap({seconds, 6}),
+ [{cert_dir, CertDir} | Config];
+ _ ->
+ end_per_testcase(Case, Config0),
+ ssl_test_lib:clean_start(),
+ {skip, "Unable to create IDP crls"}
+ end;
false ->
end_per_testcase(Case, Config0),
ssl_test_lib:clean_start(),
diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl
index 4e916a7f03..4a8027edda 100644
--- a/lib/ssl/test/ssl_sni_SUITE.erl
+++ b/lib/ssl/test/ssl_sni_SUITE.erl
@@ -42,9 +42,18 @@ init_per_suite(Config0) ->
try crypto:start() of
ok ->
ssl_test_lib:clean_start(),
- {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0),
- proplists:get_value(priv_dir, Config0)),
- ssl_test_lib:cert_options(Config0)
+ Config = ssl_test_lib:make_rsa_cert(Config0),
+ RsaOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ [{sni_server_opts, [{sni_hosts, [
+ {"a.server", [
+ {certfile, proplists:get_value(certfile, RsaOpts)},
+ {keyfile, proplists:get_value(keyfile, RsaOpts)}
+ ]},
+ {"b.server", [
+ {certfile, proplists:get_value(certfile, RsaOpts)},
+ {keyfile, proplists:get_value(keyfile, RsaOpts)}
+ ]}
+ ]}]} | Config]
catch _:_ ->
{skip, "Crypto did not start"}
end.
@@ -66,22 +75,22 @@ end_per_testcase(_TestCase, Config) ->
%% Test Cases --------------------------------------------------------
%%--------------------------------------------------------------------
no_sni_header(Config) ->
- run_handshake(Config, undefined, undefined, "server").
+ run_handshake(Config, undefined, undefined, "server Peer cert").
no_sni_header_fun(Config) ->
- run_sni_fun_handshake(Config, undefined, undefined, "server").
+ run_sni_fun_handshake(Config, undefined, undefined, "server Peer cert").
sni_match(Config) ->
- run_handshake(Config, "a.server", "a.server", "a.server").
+ run_handshake(Config, "a.server", "a.server", "server Peer cert").
sni_match_fun(Config) ->
- run_sni_fun_handshake(Config, "a.server", "a.server", "a.server").
+ run_sni_fun_handshake(Config, "a.server", "a.server", "server Peer cert").
sni_no_match(Config) ->
- run_handshake(Config, "c.server", undefined, "server").
+ run_handshake(Config, "c.server", undefined, "server Peer cert").
sni_no_match_fun(Config) ->
- run_sni_fun_handshake(Config, "c.server", undefined, "server").
+ run_sni_fun_handshake(Config, "c.server", undefined, "server Peer cert").
%%--------------------------------------------------------------------
@@ -141,13 +150,13 @@ run_sni_fun_handshake(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) ->
[Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
[{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config),
SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end,
- ServerOptions = proplists:get_value(server_opts, Config) ++ [{sni_fun, SNIFun}],
+ ServerOptions = ssl_test_lib:ssl_options(server_rsa_opts, Config) ++ [{sni_fun, SNIFun}],
ClientOptions =
case SNIHostname of
undefined ->
- proplists:get_value(client_opts, Config);
+ proplists:get_value(client_rsa_opts, Config);
_ ->
- [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_opts, Config)
+ [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_rsa_opts, Config)
end,
ct:log("Options: ~p", [[ServerOptions, ClientOptions]]),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -167,14 +176,14 @@ run_handshake(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) ->
ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, "
"ExpectedSNIHostname: ~p, ExpectedCN: ~p",
[Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
- ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_opts, Config),
+ ServerOptions = proplists:get_value(sni_server_opts, Config) ++ ssl_test_lib:ssl_options(server_rsa_opts, Config),
ClientOptions =
- case SNIHostname of
- undefined ->
- proplists:get_value(client_opts, Config);
- _ ->
- [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_opts, Config)
- end,
+ case SNIHostname of
+ undefined ->
+ proplists:get_value(client_rsa_opts, Config);
+ _ ->
+ [{server_name_indication, SNIHostname}] ++ proplists:get_value(client_rsa_opts, Config)
+ end,
ct:log("Options: ~p", [[ServerOptions, ClientOptions]]),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 77c21d9b57..f627ebce2e 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -384,10 +384,6 @@ cert_options(Config) ->
"badkey.pem"]),
PskSharedSecret = <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>,
- SNIServerACertFile = filename:join([proplists:get_value(priv_dir, Config), "a.server", "cert.pem"]),
- SNIServerAKeyFile = filename:join([proplists:get_value(priv_dir, Config), "a.server", "key.pem"]),
- SNIServerBCertFile = filename:join([proplists:get_value(priv_dir, Config), "b.server", "cert.pem"]),
- SNIServerBKeyFile = filename:join([proplists:get_value(priv_dir, Config), "b.server", "key.pem"]),
[{client_opts, [{cacertfile, ClientCaCertFile},
{certfile, ClientCertFile},
{keyfile, ClientKeyFile}]},
@@ -445,46 +441,34 @@ cert_options(Config) ->
{server_bad_cert, [{ssl_imp, new},{cacertfile, ServerCaCertFile},
{certfile, BadCertFile}, {keyfile, ServerKeyFile}]},
{server_bad_key, [{ssl_imp, new},{cacertfile, ServerCaCertFile},
- {certfile, ServerCertFile}, {keyfile, BadKeyFile}]},
- {sni_server_opts, [{sni_hosts, [
- {"a.server", [
- {certfile, SNIServerACertFile},
- {keyfile, SNIServerAKeyFile}
- ]},
- {"b.server", [
- {certfile, SNIServerBCertFile},
- {keyfile, SNIServerBKeyFile}
- ]}
- ]}]}
+ {certfile, ServerCertFile}, {keyfile, BadKeyFile}]}
| Config].
-make_dsa_cert(Config) ->
- {ServerCaCertFile, ServerCertFile, ServerKeyFile} =
- make_cert_files("server", Config, dsa, dsa, "", []),
- {ClientCaCertFile, ClientCertFile, ClientKeyFile} =
- make_cert_files("client", Config, dsa, dsa, "", []),
- [{server_dsa_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ServerCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
- {server_dsa_verify_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ClientCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile},
- {verify, verify_peer}]},
- {client_dsa_opts, [{ssl_imp, new},
- {cacertfile, ClientCaCertFile},
- {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]},
- {server_srp_dsa, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ServerCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile},
- {user_lookup_fun, {fun user_lookup/3, undefined}},
- {ciphers, srp_dss_suites()}]},
- {client_srp_dsa, [{ssl_imp, new},
- {srp_identity, {"Test-User", "secret"}},
- {cacertfile, ClientCaCertFile},
- {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
- | Config].
-
+make_dsa_cert(Config) ->
+ CryptoSupport = crypto:supports(),
+ case proplists:get_bool(dss, proplists:get_value(public_keys, CryptoSupport)) of
+ true ->
+ ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa"]),
+ ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "dsa"]),
+ KeyGenSpec = key_gen_info(dsa, dsa),
+
+ GenCertData = x509_test:gen_test_certs([{digest, sha} | KeyGenSpec]),
+ [{server_config, ServerConf},
+ {client_config, ClientConf}] =
+ x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase),
+
+ [{server_dsa_opts, ServerConf},
+ {server_dsa_verify_opts, [{verify, verify_peer} | ServerConf]},
+ {client_dsa_opts, ClientConf},
+ {server_srp_dsa, [{user_lookup_fun, {fun user_lookup/3, undefined}},
+ {ciphers, srp_dss_suites()} | ServerConf]},
+ {client_srp_dsa, [{srp_identity, {"Test-User", "secret"}}
+ | ClientConf]}
+ | Config];
+ false ->
+ Config
+ end.
make_rsa_cert_chains(ChainConf, Config, Suffix) ->
CryptoSupport = crypto:supports(),
KeyGenSpec = key_gen_info(rsa, rsa),
@@ -541,6 +525,11 @@ key_gen_spec(Role, rsa) ->
[{list_to_atom(Role ++ "_key_gen"), hardcode_rsa_key(1)},
{list_to_atom(Role ++ "_key_gen_chain"), [hardcode_rsa_key(2),
hardcode_rsa_key(3)]}
+ ];
+key_gen_spec(Role, dsa) ->
+ [{list_to_atom(Role ++ "_key_gen"), hardcode_dsa_key(1)},
+ {list_to_atom(Role ++ "_key_gen_chain"), [hardcode_dsa_key(2),
+ hardcode_dsa_key(3)]}
].
make_ecdsa_cert(Config) ->
CryptoSupport = crypto:supports(),
@@ -638,41 +627,6 @@ make_ecdh_rsa_cert(Config) ->
Config
end.
-make_mix_cert(Config) ->
- {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa,
- rsa, "mix", []),
- {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa,
- rsa, "mix", []),
- [{server_mix_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ServerCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
- {server_mix_verify_opts, [{ssl_imp, new},{reuseaddr, true},
- {cacertfile, ClientCaCertFile},
- {certfile, ServerCertFile}, {keyfile, ServerKeyFile},
- {verify, verify_peer}]},
- {client_mix_opts, [{ssl_imp, new},
- {cacertfile, ClientCaCertFile},
- {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]}
- | Config].
-
-make_cert_files(RoleStr, Config, Alg1, Alg2, Prefix, Opts) ->
- Alg1Str = atom_to_list(Alg1),
- Alg2Str = atom_to_list(Alg2),
- CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, Alg1}| Opts]),
- {Cert, CertKey} = erl_make_certs:make_cert([{key, Alg2}, {issuer, CaInfo} | Opts]),
- CaCertFile = filename:join([proplists:get_value(priv_dir, Config),
- RoleStr, Prefix ++ Alg1Str ++ "_cacerts.pem"]),
- CertFile = filename:join([proplists:get_value(priv_dir, Config),
- RoleStr, Prefix ++ Alg2Str ++ "_cert.pem"]),
- KeyFile = filename:join([proplists:get_value(priv_dir, Config),
- RoleStr, Prefix ++ Alg2Str ++ "_key.pem"]),
-
- der_to_pem(CaCertFile, [{'Certificate', CaCert, not_encrypted}]),
- der_to_pem(CertFile, [{'Certificate', Cert, not_encrypted}]),
- der_to_pem(KeyFile, [CertKey]),
- {CaCertFile, CertFile, KeyFile}.
-
-
start_upgrade_server(Args) ->
Result = spawn_link(?MODULE, run_upgrade_server, [Args]),
receive
@@ -983,16 +937,10 @@ ecdh_rsa_suites(Version) ->
end,
available_suites(Version)).
-openssl_rsa_suites(CounterPart) ->
+openssl_rsa_suites() ->
Ciphers = ssl:cipher_suites(openssl),
- Names = case is_sane_ecc(CounterPart) of
- true ->
- "DSS | ECDSA";
- false ->
- "DSS | ECDHE | ECDH"
- end,
- lists:filter(fun(Str) -> string_regex_filter(Str, Names)
- end, Ciphers).
+ lists:filter(fun(Str) -> string_regex_filter(Str, "RSA")
+ end, Ciphers) -- openssl_ecdh_rsa_suites().
openssl_dsa_suites() ->
Ciphers = ssl:cipher_suites(openssl),
@@ -1026,11 +974,11 @@ string_regex_filter(_Str, _Search) ->
false.
anonymous_suites(Version) ->
- Suites = ssl_cipher:anonymous_suites(Version),
+ Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:anonymous_suites(Version)],
ssl_cipher:filter_suites(Suites).
psk_suites(Version) ->
- Suites = ssl_cipher:psk_suites(Version),
+ Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:psk_suites(Version)],
ssl_cipher:filter_suites(Suites).
psk_anon_suites(Version) ->
@@ -1062,7 +1010,7 @@ srp_dss_suites() ->
ssl_cipher:filter_suites(Suites).
rc4_suites(Version) ->
- Suites = ssl_cipher:rc4_suites(Version),
+ Suites = [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:rc4_suites(Version)],
ssl_cipher:filter_suites(Suites).
des_suites(Version) ->
@@ -1294,6 +1242,8 @@ check_sane_openssl_version(Version) ->
case supports_ssl_tls_version(Version) of
true ->
case {Version, os:cmd("openssl version")} of
+ {'sslv3', "OpenSSL 1.0.2" ++ _} ->
+ false;
{_, "OpenSSL 1.0.2" ++ _} ->
true;
{_, "OpenSSL 1.0.1" ++ _} ->
@@ -1365,6 +1315,12 @@ version_flag('dtlsv1.2') ->
version_flag('dtlsv1') ->
"-dtls1".
+filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_list(Cipher)->
+ filter_suites([ssl_cipher:openssl_suite(S) || S <- Ciphers],
+ AtomVersion);
+filter_suites([Cipher | _] = Ciphers, AtomVersion) when is_binary(Cipher)->
+ filter_suites([ssl_cipher:erl_suite_definition(S) || S <- Ciphers],
+ AtomVersion);
filter_suites(Ciphers0, AtomVersion) ->
Version = tls_version(AtomVersion),
Supported0 = ssl_cipher:suites(Version)
@@ -1419,12 +1375,15 @@ supports_ssl_tls_version(sslv2 = Version) ->
case os:cmd("openssl version") of
"OpenSSL 1" ++ _ ->
false;
+ %% Appears to be broken
+ "OpenSSL 0.9.8.o" ++ _ ->
+ false;
_ ->
VersionFlag = version_flag(Version),
Exe = "openssl",
Args = ["s_client", VersionFlag],
Port = ssl_test_lib:portable_open_port(Exe, Args),
- do_supports_ssl_tls_version(Port)
+ do_supports_ssl_tls_version(Port, "")
end;
supports_ssl_tls_version(Version) ->
@@ -1432,23 +1391,26 @@ supports_ssl_tls_version(Version) ->
Exe = "openssl",
Args = ["s_client", VersionFlag],
Port = ssl_test_lib:portable_open_port(Exe, Args),
- do_supports_ssl_tls_version(Port).
+ do_supports_ssl_tls_version(Port, "").
-do_supports_ssl_tls_version(Port) ->
+do_supports_ssl_tls_version(Port, Acc) ->
receive
- {Port, {data, "u"}} ->
- false;
- {Port, {data, "unknown option" ++ _}} ->
- false;
- {Port, {data, Data}} ->
- case lists:member("error", string:tokens(Data, ":")) of
- true ->
- false;
- false ->
- do_supports_ssl_tls_version(Port)
- end
+ {Port, {data, Data}} ->
+ case Acc ++ Data of
+ "unknown option" ++ _ ->
+ false;
+ Error when length(Error) >= 11 ->
+ case lists:member("error", string:tokens(Data, ":")) of
+ true ->
+ false;
+ false ->
+ do_supports_ssl_tls_version(Port, Error)
+ end;
+ _ ->
+ do_supports_ssl_tls_version(Port, Acc ++ Data)
+ end
after 1000 ->
- true
+ true
end.
ssl_options(Option, Config) when is_atom(Option) ->
@@ -1535,7 +1497,7 @@ tls_version(Atom) ->
tls_record:protocol_version(Atom).
hardcode_rsa_key(1) ->
- {'RSAPrivateKey',0,
+ {'RSAPrivateKey', 'two-prime',
23995666614853919027835084074500048897452890537492185072956789802729257783422306095699263934587064480357348855732149402060270996295002843755712064937715826848741191927820899197493902093529581182351132392364214171173881547273475904587683433713767834856230531387991145055273426806331200574039205571401702219159773947658558490957010003143162250693492642996408861265758000254664396313741422909188635443907373976005987612936763564996605457102336549804831742940035613780926178523017685712710473543251580072875247250504243621640157403744718833162626193206685233710319205099867303242759099560438381385658382486042995679707669,
17,
11292078406990079542510627799764728892919007311761028269626724613049062486316379339152594792746853873109340637991599718616598115903530750002688030558925094987642913848386305504703012749896273497577003478759630198199473669305165131570674557041773098755873191241407597673069847908861741446606684974777271632545629600685952292605647052193819136445675100211504432575554351515262198132231537860917084269870590492135731720141577986787033006338680118008484613510063003323516659048210893001173583018220214626635609151105287049126443102976056146630518124476470236027123782297108342869049542023328584384300970694412006494684657,
@@ -1547,7 +1509,7 @@ hardcode_rsa_key(1) ->
asn1_NOVALUE};
hardcode_rsa_key(2) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
21343679768589700771839799834197557895311746244621307033143551583788179817796325695589283169969489517156931770973490560582341832744966317712674900833543896521418422508485833901274928542544381247956820115082240721897193055368570146764204557110415281995205343662628196075590438954399631753508888358737971039058298703003743872818150364935790613286541190842600031570570099801682794056444451081563070538409720109449780410837763602317050353477918147758267825417201591905091231778937606362076129350476690460157227101296599527319242747999737801698427160817755293383890373574621116766934110792127739174475029121017282777887777,
17,
18832658619343853622211588088997845201745658451136447382185486691577805721584993260814073385267196632785528033211903435807948675951440868570007265441362261636545666919252206383477878125774454042314841278013741813438699754736973658909592256273895837054592950290554290654932740253882028017801960316533503857992358685308186680144968293076156011747178275038098868263178095174694099811498968993700538293188879611375604635940554394589807673542938082281934965292051746326331046224291377703201248790910007232374006151098976879987912446997911775904329728563222485791845480864283470332826504617837402078265424772379987120023773,
@@ -1559,7 +1521,7 @@ hardcode_rsa_key(2) ->
asn1_NOVALUE};
hardcode_rsa_key(3) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
25089040456112869869472694987833070928503703615633809313972554887193090845137746668197820419383804666271752525807484521370419854590682661809972833718476098189250708650325307850184923546875260207894844301992963978994451844985784504212035958130279304082438876764367292331581532569155681984449177635856426023931875082020262146075451989132180409962870105455517050416234175675478291534563995772675388370042873175344937421148321291640477650173765084699931690748536036544188863178325887393475703801759010864779559318631816411493486934507417755306337476945299570726975433250753415110141783026008347194577506976486290259135429,
17,
8854955455098659953931539407470495621824836570223697404931489960185796768872145882893348383311931058684147950284994536954265831032005645344696294253579799360912014817761873358888796545955974191021709753644575521998041827642041589721895044045980930852625485916835514940558187965584358347452650930302268008446431977397918214293502821599497633970075862760001650736520566952260001423171553461362588848929781360590057040212831994258783694027013289053834376791974167294527043946669963760259975273650548116897900664646809242902841107022557239712438496384819445301703021164043324282687280801738470244471443835900160721870265,
@@ -1570,7 +1532,7 @@ hardcode_rsa_key(3) ->
15068630434698373319269196003209754243798959461311186548759287649485250508074064775263867418602372588394608558985183294561315208336731894947137343239541687540387209051236354318837334154993136528453613256169847839789803932725339395739618592522865156272771578671216082079933457043120923342632744996962853951612,
asn1_NOVALUE};
hardcode_rsa_key(4) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
28617237755030755643854803617273584643843067580642149032833640135949799721163782522787597288521902619948688786051081993247908700824196122780349730169173433743054172191054872553484065655968335396052034378669869864779940355219732200954630251223541048434478476115391643898092650304645086338265930608997389611376417609043761464100338332976874588396803891301015812818307951159858145399281035705713082131199940309445719678087542976246147777388465712394062188801177717719764254900022006288880246925156931391594131839991579403409541227225173269459173129377291869028712271737734702830877034334838181789916127814298794576266389,
17,
26933870828264240605980991639786903194205240075898493207372837775011576208154148256741268036255908348187001210401018346586267012540419880263858569570986761169933338532757527109161473558558433313931326474042230460969355628442100895016122589386862163232450330461545076609969553227901257730132640573174013751883368376011370428995523268034111482031427024082719896108094847702954695363285832195666458915142143884210891427766607838346722974883433132513540317964796373298134261669479023445911856492129270184781873446960437310543998533283339488055776892320162032014809906169940882070478200435536171854883284366514852906334641,
@@ -1581,7 +1543,7 @@ hardcode_rsa_key(4) ->
34340318160575773065401929915821192439103777558577109939078671096408836197675640654693301707202885840826672396546056002756167635035389371579540325327619480512374920136684787633921441576901246290213545161954865184290700344352088099063404416346968182170720521708773285279884132629954461545103181082503707725012,
asn1_NOVALUE};
hardcode_rsa_key(5) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
26363170152814518327068346871197765236382539835597898797762992537312221863402655353436079974302838986536256364057947538018476963115004626096654613827403121905035011992899481598437933532388248462251770039307078647864188314916665766359828262009578648593031111569685489178543405615478739906285223620987558499488359880003693226535420421293716164794046859453204135383236667988765227190694994861629971618548127529849059769249520775574008363789050621665120207265361610436965088511042779948238320901918522125988916609088415989475825860046571847719492980547438560049874493788767083330042728150253120940100665370844282489982633,
17,
10855423004100095781734025182257903332628104638187370093196526338893267826106975733767797636477639582691399679317978398007608161282648963686857782164224814902073240232370374775827384395689278778574258251479385325591136364965685903795223402003944149420659869469870495544106108194608892902588033255700759382142132115013969680562678811046675523365751498355532768935784747314021422035957153013494814430893022253205880275287307995039363642554998244274484818208792520243113824379110193356010059999642946040953102866271737127640405568982049887176990990501963784502429481034227543991366980671390566584211881030995602076468001,
@@ -1592,7 +1554,7 @@ hardcode_rsa_key(5) ->
40624877259097915043489529504071755460170951428490878553842519165800720914888257733191322215286203357356050737713125202129282154441426952501134581314792133018830748896123382106683994268028624341502298766844710276939303555637478596035491641473828661569958212421472263269629366559343208764012473880251174832392,
asn1_NOVALUE};
hardcode_rsa_key(6) ->
-{'RSAPrivateKey',0,
+{'RSAPrivateKey', 'two-prime',
22748888494866396715768692484866595111939200209856056370972713870125588774286266397044592487895293134537316190976192161177144143633669641697309689280475257429554879273045671863645233402796222694405634510241820106743648116753479926387434021380537483429927516962909367257212902212159798399531316965145618774905828756510318897899298783143203190245236381440043169622358239226123652592179006905016804587837199618842875361941208299410035232803124113612082221121192550063791073372276763648926636149384299189072950588522522800393261949880796214514243704858378436010975184294077063518776479282353562934591448646412389762167039,
17,
6690849557313646092873144848490175032923294179369428344403739373566349639495960705013115437616262686628622409110644753287395336362844012263914614494257428655751435080307550548130951000822418439531068973600535325512837681398082331290421770994275730420566916753796872722709677121223470117509210872101652580854566448661533030419787125312956120661097410038933324613372774190658239039998357548275441758790939430824924502690997433186652165055694361752689819209062683281242276039100201318203707142383491769671330743466041394101421674581185260900666085723130684175548215193875544802254923825103844262661010117443222587769713,
@@ -1603,6 +1565,27 @@ hardcode_rsa_key(6) ->
81173034184183681160439870161505779100040258708276674532866007896310418779840630960490793104541748007902477778658270784073595697910785917474138815202903114440800310078464142273778315781957021015333260021813037604142367434117205299831740956310682461174553260184078272196958146289378701001596552915990080834227,
asn1_NOVALUE}.
+hardcode_dsa_key(1) ->
+ {'DSAPrivateKey',0,
+ 99438313664986922963487511141216248076486724382260996073922424025828494981416579966171753999204426907349400798052572573634137057487829150578821328280864500098312146772602202702021153757550650696224643730869835650674962433068943942837519621267815961566259265204876799778977478160416743037274938277357237615491,
+ 1454908511695148818053325447108751926908854531909,
+ 20302424198893709525243209250470907105157816851043773596964076323184805650258390738340248469444700378962907756890306095615785481696522324901068493502141775433048117442554163252381401915027666416630898618301033737438756165023568220631119672502120011809327566543827706483229480417066316015458225612363927682579,
+ 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358,
+ 1457508827177594730669011716588605181448418352823};
+hardcode_dsa_key(2) ->
+ {'DSAPrivateKey',0,
+ 145447354557382582722944332987784622105075065624518040072393858097520305927329240484963764783346271194321683798321743658303478090647837211867389721684646254999291098347011037298359107547264573476540026676832159205689428125157386525591130716464335426605521884822982379206842523670736739023467072341958074788151,
+ 742801637799670234315651916144768554943688916729,
+ 79727684678125120155622004643594683941478642656111969487719464672433839064387954070113655822700268007902716505761008423792735229036965034283173483862273639257533568978482104785033927768441235063983341565088899599358397638308472931049309161811156189887217888328371767967629005149630676763492409067382020352505,
+ 35853727034965131665219275925554159789667905059030049940938124723126925435403746979702929280654735557166864135215989313820464108440192507913554896358611966877432546584986661291483639036057475682547385322659469460385785257933737832719745145778223672383438466035853830832837226950912832515496378486927322864228,
+ 801315110178350279541885862867982846569980443911};
+hardcode_dsa_key(3) ->
+ {'DSAPrivateKey',0,
+ 99438313664986922963487511141216248076486724382260996073922424025828494981416579966171753999204426907349400798052572573634137057487829150578821328280864500098312146772602202702021153757550650696224643730869835650674962433068943942837519621267815961566259265204876799778977478160416743037274938277357237615491,
+ 1454908511695148818053325447108751926908854531909,
+ 20302424198893709525243209250470907105157816851043773596964076323184805650258390738340248469444700378962907756890306095615785481696522324901068493502141775433048117442554163252381401915027666416630898618301033737438756165023568220631119672502120011809327566543827706483229480417066316015458225612363927682579,
+ 48598545580251057979126570873881530215432219542526130654707948736559463436274835406081281466091739849794036308281564299754438126857606949027748889019480936572605967021944405048011118039171039273602705998112739400664375208228641666852589396502386172780433510070337359132965412405544709871654840859752776060358,
+ 1457508827177594730669011716588605181448418352823}.
dtls_hello() ->
[1,
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index 5093ef3728..c9a1b8c735 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -142,12 +142,11 @@ init_per_suite(Config0) ->
catch crypto:stop(),
try crypto:start() of
ok ->
- ssl_test_lib:clean_start(),
- {ok, _} = make_certs:all(proplists:get_value(data_dir, Config0),
- proplists:get_value(priv_dir, Config0)),
- Config1 = ssl_test_lib:make_dsa_cert(Config0),
- Config = ssl_test_lib:cert_options(Config1),
- ssl_test_lib:cipher_restriction(Config)
+ ssl_test_lib:clean_start(),
+
+ Config1 = ssl_test_lib:make_rsa_cert(Config0),
+ Config2 = ssl_test_lib:make_dsa_cert(Config1),
+ ssl_test_lib:cipher_restriction(Config2)
catch _:_ ->
{skip, "Crypto did not start"}
end
@@ -196,7 +195,7 @@ init_per_testcase(expired_session, Config) ->
init_per_testcase(TestCase, Config) when TestCase == ciphers_rsa_signed_certs;
TestCase == ciphers_dsa_signed_certs ->
- ct:timetrap({seconds, 45}),
+ ct:timetrap({seconds, 60}),
special_init(TestCase, Config);
init_per_testcase(TestCase, Config) ->
@@ -270,13 +269,24 @@ special_init(TestCase, Config)
check_openssl_npn_support(Config)
end;
-special_init(TestCase, Config)
+special_init(TestCase, Config0)
when TestCase == erlang_server_openssl_client_sni_match;
TestCase == erlang_server_openssl_client_sni_no_match;
TestCase == erlang_server_openssl_client_sni_no_header;
TestCase == erlang_server_openssl_client_sni_match_fun;
TestCase == erlang_server_openssl_client_sni_no_match_fun;
TestCase == erlang_server_openssl_client_sni_no_header_fun ->
+ RsaOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config0),
+ Config = [{sni_server_opts, [{sni_hosts,
+ [{"a.server", [
+ {certfile, proplists:get_value(certfile, RsaOpts)},
+ {keyfile, proplists:get_value(keyfile, RsaOpts)}
+ ]},
+ {"b.server", [
+ {certfile, proplists:get_value(certfile, RsaOpts)},
+ {keyfile, proplists:get_value(keyfile, RsaOpts)}
+ ]}
+ ]}]} | Config0],
check_openssl_sni_support(Config);
special_init(_, Config) ->
@@ -295,8 +305,8 @@ basic_erlang_client_openssl_server() ->
[{doc,"Test erlang client with openssl server"}].
basic_erlang_client_openssl_server(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -335,10 +345,10 @@ basic_erlang_server_openssl_client() ->
[{doc,"Test erlang server with openssl client"}].
basic_erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
V2Compat = proplists:get_value(v2_hello_compatible, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
ct:pal("v2_hello_compatible: ~p", [V2Compat]),
@@ -351,7 +361,8 @@ basic_erlang_server_openssl_client(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost:" ++ integer_to_list(Port) | workaround_openssl_s_clinent()],
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++
+ ":" ++ integer_to_list(Port) | workaround_openssl_s_clinent()],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, Data),
@@ -368,8 +379,8 @@ erlang_client_openssl_server() ->
[{doc,"Test erlang client with openssl server"}].
erlang_client_openssl_server(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -408,9 +419,9 @@ erlang_server_openssl_client() ->
[{doc,"Test erlang server with openssl client"}].
erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -422,7 +433,7 @@ erlang_server_openssl_client(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost: " ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -441,7 +452,7 @@ erlang_client_openssl_server_dsa_cert() ->
erlang_client_openssl_server_dsa_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
ClientOpts = ssl_test_lib:ssl_options(client_dsa_opts, Config),
- ServerOpts = ssl_test_lib:ssl_options(server_dsa_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_dsa_verify_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -486,7 +497,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_dsa_opts, Config),
ServerOpts = ssl_test_lib:ssl_options(server_dsa_verify_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
CaCertFile = proplists:get_value(cacertfile, ClientOpts),
@@ -500,7 +511,7 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost: " ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version),
"-cert", CertFile,
"-CAfile", CaCertFile,
@@ -523,9 +534,9 @@ erlang_server_openssl_client_reuse_session() ->
"same session id, to test reusing of sessions."}].
erlang_server_openssl_client_reuse_session(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -538,7 +549,8 @@ erlang_server_openssl_client_reuse_session(Config) when is_list(Config) ->
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost:" ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname)
+ ++ ":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version),
"-reconnect"],
@@ -560,8 +572,8 @@ erlang_client_openssl_server_renegotiate() ->
[{doc,"Test erlang client when openssl server issuses a renegotiate"}].
erlang_client_openssl_server_renegotiate(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -610,8 +622,8 @@ erlang_client_openssl_server_nowrap_seqnum() ->
" to lower treashold substantially."}].
erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -653,9 +665,9 @@ erlang_server_openssl_client_nowrap_seqnum() ->
" to lower treashold substantially."}].
erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -669,7 +681,7 @@ erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client","-connect", "localhost: " ++ integer_to_list(Port),
+ Args = ["s_client","-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version),
"-msg"],
@@ -692,8 +704,8 @@ erlang_client_openssl_server_no_server_ca_cert() ->
"implicitly tested eleswhere."}].
erlang_client_openssl_server_no_server_ca_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -733,8 +745,8 @@ erlang_client_openssl_server_client_cert() ->
[{doc,"Test erlang client with openssl server when client sends cert"}].
erlang_client_openssl_server_client_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -776,10 +788,10 @@ erlang_server_openssl_client_client_cert() ->
[{doc,"Test erlang server with openssl client when client sends cert"}].
erlang_server_openssl_client_client_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_verify_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_verify_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -799,7 +811,7 @@ erlang_server_openssl_client_client_cert(Config) when is_list(Config) ->
Exe = "openssl",
Args = ["s_client", "-cert", CertFile,
"-CAfile", CaCertFile,
- "-key", KeyFile,"-connect", "localhost:" ++ integer_to_list(Port),
+ "-key", KeyFile,"-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -817,8 +829,8 @@ erlang_server_erlang_client_client_cert() ->
[{doc,"Test erlang server with erlang client when client sends cert"}].
erlang_server_erlang_client_client_cert(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = proplists:get_value(server_verification_opts, Config),
- ClientOpts = proplists:get_value(client_verification_opts, Config),
+ ServerOpts = proplists:get_value(server_rsa_verify_opts, Config),
+ ClientOpts = proplists:get_value(client_rsa_verify_opts, Config),
Version = ssl_test_lib:protocol_version(Config),
{ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -871,8 +883,8 @@ erlang_client_bad_openssl_server() ->
[{doc,"Test what happens if openssl server sends garbage to erlang ssl client"}].
erlang_client_bad_openssl_server(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
- ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -926,8 +938,8 @@ expired_session() ->
"better code coverage of the ssl_manager module"}].
expired_session(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
Port = ssl_test_lib:inet_port(node()),
@@ -980,9 +992,9 @@ ssl2_erlang_server_openssl_client() ->
ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
{from, self()},
@@ -990,7 +1002,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost:" ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
"-ssl2", "-msg"],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -1005,12 +1017,12 @@ ssl2_erlang_server_openssl_client_comp() ->
ssl2_erlang_server_openssl_client_comp(Config) when is_list(Config) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
V2Compat = proplists:get_value(v2_hello_compatible, Config),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Data = "From openssl to erlang",
@@ -1020,7 +1032,7 @@ ssl2_erlang_server_openssl_client_comp(Config) when is_list(Config) ->
Port = ssl_test_lib:inet_port(Server),
Exe = "openssl",
- Args = ["s_client", "-connect", "localhost:" ++ integer_to_list(Port),
+ Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
"-ssl2", "-msg"],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -1248,22 +1260,22 @@ erlang_server_openssl_client_npn_only_client(Config) when is_list(Config) ->
ok.
%--------------------------------------------------------------------------
erlang_server_openssl_client_sni_no_header(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test(Config, undefined, undefined, "server").
+ erlang_server_openssl_client_sni_test(Config, undefined, undefined, "server Peer cert").
erlang_server_openssl_client_sni_no_header_fun(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test_sni_fun(Config, undefined, undefined, "server").
+ erlang_server_openssl_client_sni_test_sni_fun(Config, undefined, undefined, "server Peer cert").
-erlang_server_openssl_client_sni_match(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test(Config, "a.server", "a.server", "a.server").
+erlang_server_openssl_client_sni_match(Config) when is_list(Config) ->
+ erlang_server_openssl_client_sni_test(Config, "a.server", "a.server", "server Peer cert").
erlang_server_openssl_client_sni_match_fun(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test_sni_fun(Config, "a.server", "a.server", "a.server").
+ erlang_server_openssl_client_sni_test_sni_fun(Config, "a.server", "a.server", "server Peer cert").
erlang_server_openssl_client_sni_no_match(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test(Config, "c.server", undefined, "server").
+ erlang_server_openssl_client_sni_test(Config, "c.server", undefined, "server Peer cert").
erlang_server_openssl_client_sni_no_match_fun(Config) when is_list(Config) ->
- erlang_server_openssl_client_sni_test_sni_fun(Config, "c.server", undefined, "server").
+ erlang_server_openssl_client_sni_test_sni_fun(Config, "c.server", undefined, "server Peer cert").
%%--------------------------------------------------------------------
@@ -1273,11 +1285,11 @@ run_suites(Ciphers, Version, Config, Type) ->
{ClientOpts, ServerOpts} =
case Type of
rsa ->
- {ssl_test_lib:ssl_options(client_opts, Config),
- ssl_test_lib:ssl_options(server_opts, Config)};
+ {ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ ssl_test_lib:ssl_options(server_rsa_opts, Config)};
dsa ->
- {ssl_test_lib:ssl_options(client_opts, Config),
- ssl_test_lib:ssl_options(server_dsa_opts, Config)}
+ {ssl_test_lib:ssl_options(client_dsa_opts, Config),
+ ssl_test_lib:ssl_options(server_dsa_verify_opts, Config)}
end,
Result = lists:map(fun(Cipher) ->
@@ -1330,7 +1342,7 @@ send_and_hostname(SSLSocket) ->
erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) ->
ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
- ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_opts, Config),
+ ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_rsa_opts, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()}, {mfa, {?MODULE, send_and_hostname, []}},
@@ -1344,11 +1356,7 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname,
openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname)
end,
ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs),
-
- %% Client check needs to be done befor server check,
- %% or server check might consume client messages
- ExpectedClientOutput = ["OK", "/CN=" ++ ExpectedCN ++ "/"],
- client_check_result(ClientPort, ExpectedClientOutput),
+
ssl_test_lib:check_result(Server, ExpectedSNIHostname),
ssl_test_lib:close_port(ClientPort),
ssl_test_lib:close(Server),
@@ -1359,7 +1367,7 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo
ct:log("Start running handshake for sni_fun, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
[{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config),
SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end,
- ServerOptions = proplists:get_value(server_opts, Config) ++ [{sni_fun, SNIFun}],
+ ServerOptions = proplists:get_value(server_rsa_opts, Config) ++ [{sni_fun, SNIFun}],
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
{from, self()}, {mfa, {?MODULE, send_and_hostname, []}},
@@ -1375,10 +1383,6 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo
ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs),
- %% Client check needs to be done befor server check,
- %% or server check might consume client messages
- ExpectedClientOutput = ["OK", "/CN=" ++ ExpectedCN ++ "/"],
- client_check_result(ClientPort, ExpectedClientOutput),
ssl_test_lib:check_result(Server, ExpectedSNIHostname),
ssl_test_lib:close_port(ClientPort),
ssl_test_lib:close(Server).
@@ -1442,8 +1446,8 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, OpensslServerOpts, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
ClientOpts = ErlangClientOpts ++ ClientOpts0,
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -1488,8 +1492,8 @@ start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, Opens
start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts = proplists:get_value(server_opts, Config),
- ClientOpts0 = proplists:get_value(client_opts, Config),
+ ServerOpts = proplists:get_value(server_rsa_opts, Config),
+ ClientOpts0 = proplists:get_value(client_rsa_opts, Config),
ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]} | ClientOpts0],
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -1524,7 +1528,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba
start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts0 = proplists:get_value(server_opts, Config),
+ ServerOpts0 = proplists:get_value(server_rsa_opts, Config),
ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]} | ServerOpts0],
{_, ServerNode, _} = ssl_test_lib:run_where(Config),
@@ -1553,8 +1557,8 @@ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callba
start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts = proplists:get_value(server_opts, Config),
- ClientOpts0 = proplists:get_value(client_opts, Config),
+ ServerOpts = proplists:get_value(server_rsa_opts, Config),
+ ClientOpts0 = proplists:get_value(client_rsa_opts, Config),
ClientOpts = [{alpn_advertised_protocols, [<<"spdy/2">>]},
{client_preferred_next_protocols, {client, [<<"spdy/3">>, <<"http/1.1">>]}} | ClientOpts0],
@@ -1593,7 +1597,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca
start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts0 = proplists:get_value(server_opts, Config),
+ ServerOpts0 = proplists:get_value(server_rsa_opts, Config),
ServerOpts = [{alpn_preferred_protocols, [<<"spdy/2">>]},
{next_protocols_advertised, [<<"spdy/3">>, <<"http/1.1">>]} | ServerOpts0],
@@ -1620,8 +1624,8 @@ start_erlang_server_and_openssl_client_for_alpn_npn_negotiation(Config, Data, Ca
start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
- ClientOpts0 = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
ClientOpts = [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}} | ClientOpts0],
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -1658,10 +1662,10 @@ start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callbac
start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
ServerOpts = [{next_protocols_advertised, [<<"spdy/2">>]}, ServerOpts0],
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
@@ -1672,7 +1676,8 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-nextprotoneg", "http/1.0,spdy/2", "-msg", "-connect", "localhost:"
+ Args = ["s_client", "-nextprotoneg", "http/1.0,spdy/2", "-msg", "-connect",
+ hostname_format(Hostname) ++ ":"
++ integer_to_list(Port), ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -1687,10 +1692,10 @@ start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callbac
start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenSSLClientOpts, Data, Callback) ->
process_flag(trap_exit, true),
- ServerOpts0 = ssl_test_lib:ssl_options(server_opts, Config),
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
ServerOpts = ErlangServerOpts ++ ServerOpts0,
- {_, ServerNode, _} = ssl_test_lib:run_where(Config),
+ {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
@@ -1701,8 +1706,9 @@ start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenS
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client"] ++ OpenSSLClientOpts ++ ["-msg", "-connect", "localhost:" ++ integer_to_list(Port),
- ssl_test_lib:version_flag(Version)],
+ Args = ["s_client"] ++ OpenSSLClientOpts ++ ["-msg", "-connect",
+ hostname_format(Hostname) ++ ":" ++ integer_to_list(Port),
+ ssl_test_lib:version_flag(Version)],
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
@@ -1854,3 +1860,11 @@ consume_port_exit(OpenSSLPort) ->
{'EXIT', OpenSSLPort, _} ->
ok
end.
+
+hostname_format(Hostname) ->
+ case lists:member($., Hostname) of
+ true ->
+ Hostname;
+ false ->
+ "localhost"
+ end.
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index 342be80f98..f6f3d18d6a 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -49,13 +49,22 @@
associated with each key. A <c>bag</c> or <c>duplicate_bag</c> table can
have many objects associated with each key.</p>
- <p>The number of tables stored at one Erlang node is limited.
- The current default limit is about 1400 tables. The upper
- limit can be increased by setting environment variable
- <c>ERL_MAX_ETS_TABLES</c> before starting the Erlang runtime
- system (that is, with option <c>-env</c> to
- <c>erl</c>/<c>werl</c>). The actual limit can be slightly higher
- than the one specified, but never lower.</p>
+ <note>
+ <p>
+ The number of tables stored at one Erlang node <em>used</em> to
+ be limited. This is no longer the case (except by memory usage).
+ The previous default limit was about 1400 tables and
+ could be increased by setting the environment variable
+ <c>ERL_MAX_ETS_TABLES</c> before starting the Erlang runtime
+ system. This hard limit has been removed, but it is currently
+ useful to set the <c>ERL_MAX_ETS_TABLES</c> anyway. It should be
+ set to an approximate of the maximum amount of tables used. This since
+ an internal table for named tables is sized using this value. If
+ large amounts of named tables are used and <c>ERL_MAX_ETS_TABLES</c>
+ hasn't been increased, the performance of named table lookup will
+ degrade.
+ </p>
+ </note>
<p>Notice that there is no automatic garbage collection for tables.
Even if there are no references to a table from any process, it
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index ad7f2f2e95..a7caa71dcb 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -1098,7 +1098,7 @@ handle_event(_, _, State, Data) ->
<seealso marker="#Module:init/1"><c>Module:init/1</c></seealso>
or
<seealso marker="#enter_loop/5"><c>enter_loop/5,6</c></seealso>
- would be weird on the border of whichcraft
+ would be weird on the border of witchcraft
since there has been no earlier call to a
<seealso marker="#state callback">state callback</seealso>
in this server.
diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml
index 60dbae70c2..7efafedc82 100644
--- a/lib/stdlib/doc/src/lists.xml
+++ b/lib/stdlib/doc/src/lists.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -187,7 +187,7 @@
<desc>
<p>Calls <c><anno>Fun</anno>(<anno>Elem</anno>)</c> on successive
elements <c>Elem</c> of <c><anno>List1</anno></c>.
- <c><anno>Fun</anno>/2</c> must return either a Boolean or a tuple
+ <c><anno>Fun</anno>/1</c> must return either a Boolean or a tuple
<c>{true, <anno>Value</anno>}</c>. The function returns the list of
elements for which <c><anno>Fun</anno></c> returns a new value, where
a value of <c>true</c> is synonymous with
diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml
index a8a252cb35..bdd5b39cd3 100644
--- a/lib/stdlib/doc/src/notes.xml
+++ b/lib/stdlib/doc/src/notes.xml
@@ -31,6 +31,476 @@
</header>
<p>This document describes the changes made to the STDLIB application.</p>
+<section><title>STDLIB 3.4.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> A bug in <c>proc_lib:format()</c> introduced in
+ Erlang/OTP 20.0 is corrected. </p>
+ <p>
+ Own Id: OTP-14482 Aux Id: PR-1488 </p>
+ </item>
+ <item>
+ <p>
+ Fix string:len/1 to be compatible with previous versions.</p>
+ <p>
+ Own Id: OTP-14487 Aux Id: ERIERL-40 </p>
+ </item>
+ <item>
+ <p>
+ In OTP-20.0, the behavior of c, make, and ct_make was
+ changed so that in some cases the beam files by default
+ would be written to the directory where the source files
+ were found. This is now changed back to the old behavior
+ so beam files are by default written to current
+ directory.</p>
+ <p>
+ Own Id: OTP-14489 Aux Id: ERL-438 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>STDLIB 3.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>For many releases, it has been legal to override a BIF
+ with a local function having the same name. However,
+ calling a local function with the same name as guard BIF
+ as filter in a list comprehension was not allowed.</p>
+ <p>
+ Own Id: OTP-13690</p>
+ </item>
+ <item>
+ <p> A new (default) pseudo-random number generator
+ algorithm Xoroshiro116+ has been implemented in the
+ <c>rand</c> module. </p><p> The old algorithm
+ implementations had a number of flaws so they are all
+ deprecated, but corrected versions of two of them have
+ been added. See the documentation. </p>
+ <p>
+ Own Id: OTP-14295 Aux Id: PR-1372 </p>
+ </item>
+ <item>
+ <p> The Erlang shell, <c>qlc:string_to_handle()</c>, and
+ the Debugger (the Evaluator area and Edit variable window
+ of the Bindings area) can parse pids, ports, references,
+ and external funs, as long as they can be created in the
+ running system. </p>
+ <p>
+ Own Id: OTP-14296</p>
+ </item>
+ <item>
+ <p>Internal code change: Calls to <c>catch</c> followed
+ by a call to <c>erlang:get_stacktrace/0</c> has been
+ rewritten to use <c>try</c> instead of <c>catch</c> to
+ make the code future-proof.</p>
+ <p>
+ Own Id: OTP-14400</p>
+ </item>
+ <item>
+ <p> The <c>ms_transform</c> module, used by
+ <c>ets:fun2ms/1</c> and <c>dbg:fun2ms/1</c>, evaluates
+ constant arithmetic expressions. This is necessary since
+ the Erlang compiler, which normally evaluates constant
+ expressions, does not recognize the format generated by
+ <c>ms_transform</c>. </p>
+ <p>
+ Own Id: OTP-14454 Aux Id: ERIERL-29 </p>
+ </item>
+ <item>
+ <p> The state machine engine <c>gen_statem</c> can now
+ handle generic time-outs (multiple named) as well as
+ absolute time-out time. See the documentation. </p><p>
+ The <c>gen_statem</c> callback <c>Module:init/1</c> has
+ become mandatory to harmonize with other <c>gen_*</c>
+ modules. This may be an incompatibility for
+ <c>gen_statem</c> callback modules that use
+ <c>gen_statem:enter_loop/4-6</c>. </p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14531</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Improved unicode support for strings. Added normalization
+ functions in the <c>unicode</c> module. Extended the
+ <c>string</c> module API with new functions with improved
+ unicode handling and that works on grapheme clusters. The
+ new functions operates on the <c>unicode:chardata()</c>
+ type, thus they also accept <c>UTF-8 binaries</c> as
+ input. </p>
+ <p>
+ The old string API have been marked as obsolete. The
+ return values have been changed for some error cases.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-10289 Aux Id: OTP-10309 </p>
+ </item>
+ <item>
+ <p>There are two new guard BIFs '<c>floor/1</c>' and
+ '<c>ceil/1</c>'. They both return integers. In the
+ '<c>math</c>' module, there are two new BIFs with the
+ same names that return floating point values.</p>
+ <p>
+ Own Id: OTP-13692</p>
+ </item>
+ <item>
+ <p>
+ Making code_change, terminate and handle_info callbacks
+ optional in the OTP behaviours.</p>
+ <p>
+ Own Id: OTP-13801</p>
+ </item>
+ <item>
+ <p> The support for Dets files created with Erlang/OTP R7
+ and earlier is removed. </p>
+ <p>
+ Own Id: OTP-13830</p>
+ </item>
+ <item>
+ <p>Replaced usage of deprecated symbolic <seealso
+ marker="erts:erlang#type-time_unit"><c>time
+ unit</c></seealso> representations.</p>
+ <p>
+ Own Id: OTP-13831 Aux Id: OTP-13735 </p>
+ </item>
+ <item>
+ <p>The function <c>fmod/2</c> has been added to the
+ <c>math</c> module.</p>
+ <p>
+ Own Id: OTP-14000</p>
+ </item>
+ <item>
+ <p>The EXIT signals received from processes using
+ <c>proc_lib</c> now looks like EXIT signals from
+ processes that were spawned using <c>spawn_link</c>. In
+ particular, that means that the stack trace is now
+ included in the EXIT signal so that it can see where the
+ process crashed.</p>
+ <p>
+ Own Id: OTP-14001</p>
+ </item>
+ <item>
+ <p><c>sets:add_element/2</c> is faster when adding an
+ element that is already present, and
+ <c>sets:del_element/2</c> is faster when the element to
+ be deleted is not present. This optimization can make
+ certain operations, such as sets:union/2 with many
+ overlapping elements, up to two orders of magnitude
+ faster.</p>
+ <p>
+ Own Id: OTP-14035</p>
+ </item>
+ <item>
+ <p>
+ Add information in doc about supervisor shutdown reason
+ when maximum restart frequency is reached.</p>
+ <p>
+ Own Id: OTP-14037 Aux Id: PR-1233 </p>
+ </item>
+ <item>
+ <p>
+ Added <c>rand:jump/[0|1]</c> functions.</p>
+ <p>
+ Own Id: OTP-14038 Aux Id: PR-1235 </p>
+ </item>
+ <item>
+ <p>Functions for detecting changed code has been added.
+ <c>code:modified_modules/0</c> returns all currently
+ loaded modules that have changed on disk.
+ <c>code:module_status/1</c> returns the status for a
+ module. In the shell and in <c>c</c> module, <c>mm/0</c>
+ is short for <c>code:modified_modules/0</c>, and
+ <c>lm/0</c> reloads all currently loaded modules that
+ have changed on disk.</p>
+ <p>
+ Own Id: OTP-14059</p>
+ </item>
+ <item>
+ <p>Each assert macro in <c>assert.hrl</c> now has a
+ corresponding version with an extra argument, for adding
+ comments to assertions. These can for example be printed
+ as part of error reports, to clarify the meaning of the
+ check that failed.</p>
+ <p>
+ Own Id: OTP-14066</p>
+ </item>
+ <item>
+ <p><c>error_logger_tty_h</c> and
+ <c>error_logger_file_h</c> now inserts the node
+ information for nonlocal messages before the message
+ itself instead of after, both for readability and so as
+ not to change the line termination property at the end of
+ the message.</p>
+ <p>
+ Own Id: OTP-14068</p>
+ </item>
+ <item>
+ <p>The Erlang code linter checks for badly formed type
+ constraints. </p>
+ <p>
+ Own Id: OTP-14070 Aux Id: PR-1214 </p>
+ </item>
+ <item>
+ <p>By default, there will now be a warning when
+ <c>export_all</c> is used. The warning can be disabled
+ using <c>nowarn_export_all</c>.</p>
+ <p>
+ Own Id: OTP-14071</p>
+ </item>
+ <item>
+ <p>When a <c>gen_server</c> process crashes, the
+ stacktrace for the client will be printed to facilitate
+ debugging.</p>
+ <p>
+ Own Id: OTP-14089</p>
+ </item>
+ <item>
+ <p>Optimized ETS operations by changing table identifier
+ type from integer to reference. The reference enables a
+ more direct mapping to the table with less potential lock
+ contention and makes especially creation and deletion of
+ tables scale much better.</p> <p>The change of the opaque
+ type for the ETS table identifiers may cause failure in
+ code that make faulty assumptions about this opaque
+ type.</p> <note> <p> The number of tables stored at one
+ Erlang node <em>used</em> to be limited. This is no
+ longer the case (except by memory usage). The previous
+ default limit was about 1400 tables and could be
+ increased by setting the environment variable
+ <c>ERL_MAX_ETS_TABLES</c> before starting the Erlang
+ runtime system. This hard limit has been removed, but it
+ is currently useful to set the <c>ERL_MAX_ETS_TABLES</c>
+ anyway. It should be set to an approximate of the maximum
+ amount of tables used. This since an internal table for
+ named tables is sized using this value. If large amounts
+ of named tables are used and <c>ERL_MAX_ETS_TABLES</c>
+ hasn't been increased, the performance of named table
+ lookup will degrade. </p> </note>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14094</p>
+ </item>
+ <item>
+ <p><c>take/2</c> has been added to <c>dict</c>,
+ <c>orddict</c>, and <c>gb_trees</c>. <c>take_any/2</c>
+ has been added to <c>gb_trees</c>.</p>
+ <p>
+ Own Id: OTP-14102</p>
+ </item>
+ <item>
+ <p>
+ Extend gen_event API to handle options as well.</p>
+ <p>
+ Own Id: OTP-14123</p>
+ </item>
+ <item>
+ <p>
+ Advice on how to tune the supervisor restart frequency
+ (intensity and period) is added to System Documentation -
+ Design Principles - Supervisor Behaviour.</p>
+ <p>
+ Own Id: OTP-14168 Aux Id: PR-1289 </p>
+ </item>
+ <item>
+ <p>
+ gen_fsm is deprecated and is replaced by gen_statem,
+ however for backwards compatibility reasons gen_fsm may
+ continue to exist as an undocumented feature for quite
+ some time.</p>
+ <p>
+ Own Id: OTP-14183</p>
+ </item>
+ <item>
+ <p>The shell functions <c>c/1</c> and <c>c/2</c> have
+ been extended so that if the argument is a module name
+ instead of a file name, it automatically locates the
+ .beam file and the corresponding source file, and then
+ recompiles the module using the same compiler options
+ (plus any options passed to c/2). If compilation fails,
+ the old beam file is preserved. Also adds <c>c(Mod, Opts,
+ Filter)</c>, where the Filter argument allows you to
+ remove old compiler options before the new options are
+ added.</p> <p>New utility functions <c>file_find/2/3</c>
+ and <c>find_source/1/2/3</c> have been added to
+ <c>filelib</c>.</p>
+ <p>
+ Own Id: OTP-14190</p>
+ </item>
+ <item>
+ <p><c>erl_tar</c> in previous versions of OTP only
+ supports the USTAR format. That limited path names to at
+ most 255 bytes, and did not support Unicode characters in
+ names in a portable way.</p>
+ <p><c>erl_tar</c> now has support for reading tar
+ archives in the formats currently in common use, such as
+ v7, STAR, USTAR, PAX, and GNU tar's extensions to the
+ STAR/USTAR format. When writing tar archives,
+ <c>erl_tar</c> can now write them in the <c>PAX</c>
+ format if necessary (for example, to support very long
+ filenames or filenames with Unicode characters). If
+ possible, <c>erl_tar</c> will still write tar archives in
+ the USTAR for maximum portability.</p>
+ <p>
+ Own Id: OTP-14226</p>
+ </item>
+ <item>
+ <p><c>base64:mime_decode/1</c> has been optimized so that
+ it is now almost as fast as<c>base64:decode/1</c>; it
+ used be noticeably slower.</p>
+ <p>
+ Own Id: OTP-14245</p>
+ </item>
+ <item>
+ <p><c>erl_tar</c> will now strip any leading '<c>/</c>'
+ from pathnames when extracting files from a tar archive
+ and write a message to the error logger. There is also
+ new check for directory traversal attacks; if a relative
+ path points above the current working directory the
+ extraction will be aborted.</p>
+ <p>
+ Own Id: OTP-14278</p>
+ </item>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ <item>
+ <p>
+ The Crypto application now supports generation of
+ cryptographically strong random numbers (floats &lt; 1.0
+ and integer arbitrary ranges) as a plugin to the 'rand'
+ module.</p>
+ <p>
+ Own Id: OTP-14317 Aux Id: PR-1372 </p>
+ </item>
+ <item>
+ <p>
+ Add new function <c>ets:select_replace/2</c> which
+ performs atomic "compare-and-swap" operations for ETS
+ objects using match specifications.</p>
+ <p>
+ Own Id: OTP-14319 Aux Id: PR-1076 </p>
+ </item>
+ <item>
+ <p> The Erlang code linter checks for bad <c>dialyzer</c>
+ attributes. It also checks for bad type variables in type
+ declarations. </p>
+ <p>
+ Own Id: OTP-14323</p>
+ </item>
+ <item>
+ <p> Two new functions has been implemented in the
+ <c>rand</c> module; <c>normal/2</c> and
+ <c>normal_s/3</c>, that both produce normal distribution
+ (pseudo) random numbers with mean value and variance
+ according to arguments. </p>
+ <p>
+ Own Id: OTP-14328 Aux Id: PR-1382 </p>
+ </item>
+ <item>
+ <p>
+ Upgraded the OTP internal PCRE library from version 8.33
+ to version 8.40. This library is used for implementation
+ of the <seealso marker="stdlib:re"><c>re</c></seealso>
+ regular expressions module.</p>
+ <p>
+ Besides various bug fixes, the new version allows for
+ better stack protection. In order to utilize this
+ feature, the stack size of normal scheduler threads is
+ now by default set to 128 kilo words on all platforms.
+ The stack size of normal scheduler threads can be set
+ upon system start by passing the <seealso
+ marker="erts:erl#sched_thread_stack_size"><c>+sss</c></seealso>
+ command line argument to the <seealso
+ marker="erts:erl"><c>erl</c></seealso> command.</p>
+ <p>
+ See <url
+ href="http://pcre.org/original/changelog.txt"><c>http://pcre.org/original/changelog.txt</c></url>
+ for information about changes made to PCRE between the
+ versions 8.33 and 8.40.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-14331 Aux Id: ERL-208 </p>
+ </item>
+ <item>
+ <p>
+ Added function <c>re:version/0</c> which returns
+ information about the OTP internal PCRE version used for
+ implementation of the <c>re</c> module.</p>
+ <p>
+ Own Id: OTP-14347 Aux Id: PR-1412 </p>
+ </item>
+ <item>
+ <p>The format of debug information that is stored in BEAM
+ files (when <c>debug_info</c> is used) has been changed.
+ The purpose of the change is to better support other
+ BEAM-based languages such as Elixir or LFE.</p>
+ <p>All tools included in OTP (dialyzer, debugger, cover,
+ and so on) will handle both the new format and the
+ previous format. Tools that retrieve the debug
+ information using <c>beam_lib:chunk(Beam,
+ [abstract_code])</c> will continue to work with both the
+ new and old format. Tools that call
+ <c>beam_lib:chunk(Beam, ["Abst"])</c> will not work with
+ the new format.</p>
+ <p>For more information, see the description of
+ <c>debug_info</c> in the documentation for
+ <c>beam_lib</c> and the description of the
+ <c>{debug_info,{Backend,Data}}</c> option in the
+ documentation for <c>compile</c>.</p>
+ <p>
+ Own Id: OTP-14369 Aux Id: PR-1367 </p>
+ </item>
+ <item>
+ <p>
+ Add option hibernate_after to gen_server, gen_statem and
+ gen_event. Also added to the deprecated gen_fsm
+ behaviour.</p>
+ <p>
+ Own Id: OTP-14405</p>
+ </item>
+ <item>
+ <p> The size of crash reports created by
+ <c>gen_server</c>, <c>gen_statem</c> and <c>proc_lib</c>
+ is limited with aid of the Kernel application variable
+ <c>error_logger_format_depth</c>. The purpose is to limit
+ the size of the messages sent to the <c>error_logger</c>
+ process when processes with huge message queues or states
+ crash. </p> <p>The crash report generated by
+ <c>proc_lib</c> includes the new tag
+ <c>message_queue_len</c>. The neighbour report also
+ includes the new tag <c>current_stacktrace</c>. Finally,
+ the neighbour report no longer includes the tags
+ <c>messages</c> and <c>dictionary</c>. </p> <p> The new
+ function <c>error_logger:get_format_depth/0</c> can be
+ used to retrieve the value of the Kernel application
+ variable <c>error_logger_format_depth</c>. </p>
+ <p>
+ Own Id: OTP-14417</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>STDLIB 3.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml
index e06d7e467d..a68fb7d55f 100644
--- a/lib/stdlib/doc/src/rand.xml
+++ b/lib/stdlib/doc/src/rand.xml
@@ -66,7 +66,7 @@
<p>Jump function: equivalent to 2^64 calls</p>
<p>
This is a corrected version of the previous default algorithm,
- that now has been superseeded by Xoroshiro116+ (<c>exrop</c>).
+ that now has been superseded by Xoroshiro116+ (<c>exrop</c>).
Since there is no native 58 bit rotate instruction this
algorithm executes a little (say &lt; 15%) faster than <c>exrop</c>.
See the
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index f24e42bcee..64d8789016 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -308,7 +308,7 @@
format to the file. The events are formatted with a function that is
defined by the process that generated the event (with a call to
<seealso marker="#handle_debug/4"><c>handle_debug/4</c></seealso>).
- </p>
+ The file is opened with encoding UTF-8.</p>
</desc>
</func>
diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl
index 079b761463..a237eaa489 100644
--- a/lib/stdlib/src/array.erl
+++ b/lib/stdlib/src/array.erl
@@ -1603,7 +1603,7 @@ foldl_2(I, E, A, Ix, F, D, N, R, S) ->
Ix + S, F, D, N, R, S).
-spec foldl_3(pos_integer(), _, A, array_indx(),
- fun((array_indx, _, A) -> B), integer()) -> B.
+ fun((array_indx(), _, A) -> B), integer()) -> B.
foldl_3(I, E, A, Ix, F, N) when I =< N ->
foldl_3(I+1, E, F(Ix, element(I, E), A), Ix+1, F, N);
diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index bb7b485490..c04a201ce1 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -144,7 +144,7 @@ c(SrcFile, NewOpts, Filter, BeamFile, Info) ->
F = fun (Opt) -> not is_outdir_opt(Opt) andalso Filter(Opt) end,
Options = (NewOpts ++ [{outdir,filename:dirname(BeamFile)}]
++ lists:filter(F, old_options(Info))),
- format("Recompiling ~s\n", [SrcFile]),
+ format("Recompiling ~ts\n", [SrcFile]),
safe_recompile(SrcFile, Options, BeamFile).
old_options(Info) ->
@@ -255,7 +255,7 @@ safe_recompile(File, Options, BeamFile) ->
compile_and_load(File, Opts0) when is_list(Opts0) ->
Opts = [report_errors, report_warnings
| ensure_from(filename:extension(File),
- ensure_outdir(filename:dirname(File), Opts0))],
+ ensure_outdir(".", Opts0))],
case compile:file(File, Opts) of
{ok,Mod} -> %Listing file.
purge_and_load(Mod, File, Opts);
@@ -548,7 +548,7 @@ mfa_string(Fun) when is_function(Fun) ->
{arity,A} = erlang:fun_info(Fun, arity),
mfa_string({M,F,A});
mfa_string({M,F,A}) ->
- io_lib:format("~w:~w/~w", [M,F,A]);
+ io_lib:format("~w:~tw/~w", [M,F,A]);
mfa_string(X) ->
w(X).
@@ -572,7 +572,7 @@ display_info(Pid) ->
w(Reds), w(LM)),
iformat(case fetch(registered_name, Info) of
0 -> "";
- X -> w(X)
+ X -> io_lib:format("~tw", [X])
end,
mfa_string(Curr),
w(SS),
@@ -594,7 +594,7 @@ initial_call(Info) ->
end.
iformat(A1, A2, A3, A4, A5) ->
- format("~-21s ~-33s ~8s ~8s ~4s~n", [A1,A2,A3,A4,A5]).
+ format("~-21ts ~-33ts ~8s ~8s ~4s~n", [A1,A2,A3,A4,A5]).
all_procs() ->
case is_alive() of
@@ -767,7 +767,7 @@ print_exports(X) when length(X) > 16 ->
split_print_exports(X);
print_exports([]) -> ok;
print_exports([{F, A} |Tail]) ->
- format(" ~w/~w~n",[F, A]),
+ format(" ~tw/~w~n",[F, A]),
print_exports(Tail).
split_print_exports(L) ->
@@ -779,11 +779,11 @@ split_print_exports(L) ->
split_print_exports([], [{F, A}|T]) ->
Str = " ",
- format("~-30s~w/~w~n", [Str, F, A]),
+ format("~-30ts~tw/~w~n", [Str, F, A]),
split_print_exports([], T);
split_print_exports([{F1, A1}|T1], [{F2, A2} | T2]) ->
- Str = flatten(io_lib:format("~w/~w", [F1, A1])),
- format("~-30s~w/~w~n", [Str, F2, A2]),
+ Str = flatten(io_lib:format("~tw/~w", [F1, A1])),
+ format("~-30ts~tw/~w~n", [Str, F2, A2]),
split_print_exports(T1, T2);
split_print_exports([], []) -> ok.
@@ -883,22 +883,22 @@ procline(Name, Info, Pid) ->
Call = initial_call(Info),
Reds = fetch(reductions, Info),
LM = length(fetch(messages, Info)),
- procformat(io_lib:format("~w",[Name]),
+ procformat(io_lib:format("~tw",[Name]),
io_lib:format("~w",[Pid]),
- io_lib:format("~s",[mfa_string(Call)]),
+ io_lib:format("~ts",[mfa_string(Call)]),
integer_to_list(Reds), integer_to_list(LM)).
procformat(Name, Pid, Call, Reds, LM) ->
- format("~-21s ~-12s ~-25s ~12s ~4s~n", [Name,Pid,Call,Reds,LM]).
+ format("~-21ts ~-12s ~-25ts ~12s ~4s~n", [Name,Pid,Call,Reds,LM]).
portline(Name, Info, Id) ->
Cmd = fetch(name, Info),
- portformat(io_lib:format("~w",[Name]),
+ portformat(io_lib:format("~tw",[Name]),
erlang:port_to_list(Id),
Cmd).
portformat(Name, Id, Cmd) ->
- format("~-21s ~-15s ~-40s~n", [Name,Id,Cmd]).
+ format("~-21ts ~-15s ~-40ts~n", [Name,Id,Cmd]).
%% pwd()
%% cd(Directory)
diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl
index b35e9575a4..31d0d499e3 100644
--- a/lib/stdlib/src/epp.erl
+++ b/lib/stdlib/src/epp.erl
@@ -194,27 +194,27 @@ format_error(missing_parenthesis) ->
format_error(premature_end) ->
"premature end";
format_error({call,What}) ->
- io_lib:format("illegal macro call '~s'",[What]);
+ io_lib:format("illegal macro call '~ts'",[What]);
format_error({undefined,M,none}) ->
- io_lib:format("undefined macro '~s'", [M]);
+ io_lib:format("undefined macro '~ts'", [M]);
format_error({undefined,M,A}) ->
- io_lib:format("undefined macro '~s/~p'", [M,A]);
+ io_lib:format("undefined macro '~ts/~p'", [M,A]);
format_error({depth,What}) ->
io_lib:format("~s too deep",[What]);
format_error({mismatch,M}) ->
- io_lib:format("argument mismatch for macro '~s'", [M]);
+ io_lib:format("argument mismatch for macro '~ts'", [M]);
format_error({arg_error,M}) ->
- io_lib:format("badly formed argument for macro '~s'", [M]);
+ io_lib:format("badly formed argument for macro '~ts'", [M]);
format_error({redefine,M}) ->
- io_lib:format("redefining macro '~s'", [M]);
+ io_lib:format("redefining macro '~ts'", [M]);
format_error({redefine_predef,M}) ->
io_lib:format("redefining predefined macro '~s'", [M]);
format_error({circular,M,none}) ->
- io_lib:format("circular macro '~s'", [M]);
+ io_lib:format("circular macro '~ts'", [M]);
format_error({circular,M,A}) ->
- io_lib:format("circular macro '~s/~p'", [M,A]);
+ io_lib:format("circular macro '~ts/~p'", [M,A]);
format_error({include,W,F}) ->
- io_lib:format("can't find include ~s \"~s\"", [W,F]);
+ io_lib:format("can't find include ~s \"~ts\"", [W,F]);
format_error({illegal,How,What}) ->
io_lib:format("~s '-~s'", [How,What]);
format_error({illegal_function,Macro}) ->
@@ -224,9 +224,9 @@ format_error({illegal_function_usage,Macro}) ->
format_error({'NYI',What}) ->
io_lib:format("not yet implemented '~s'", [What]);
format_error({error,Term}) ->
- io_lib:format("-error(~p).", [Term]);
+ io_lib:format("-error(~tp).", [Term]);
format_error({warning,Term}) ->
- io_lib:format("-warning(~p).", [Term]);
+ io_lib:format("-warning(~tp).", [Term]);
format_error(E) -> file:format_error(E).
-spec parse_file(FileName, IncludePath, PredefMacros) ->
@@ -1307,7 +1307,7 @@ expand_macros([{'?',_Lq},Token|_Toks], _St) ->
Text;
undefined ->
Symbol = erl_scan:symbol(Token),
- io_lib:write(Symbol)
+ io_lib:fwrite(<<"~tp">>, [Symbol])
end,
throw({error,loc(Token),{call,[$?|T]}});
expand_macros([T|Ts], St) ->
diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl
index 76db2eeacd..18d7548fdc 100644
--- a/lib/stdlib/src/erl_compile.erl
+++ b/lib/stdlib/src/erl_compile.erl
@@ -181,7 +181,7 @@ parse_generic_option("P", T, #options{specific=Spec}=Opts) ->
parse_generic_option("S", T, #options{specific=Spec}=Opts) ->
compile1(T, Opts#options{specific=['S'|Spec]});
parse_generic_option(Option, _T, _Opts) ->
- io:format(?STDERR, "Unknown option: -~s\n", [Option]),
+ io:format(?STDERR, "Unknown option: -~ts\n", [Option]),
usage().
parse_dep_option("", T) ->
@@ -202,7 +202,7 @@ parse_dep_option("T"++Opt, T0) ->
{Target,T} = get_option("MT", Opt, T0),
{[{makedep_target,Target}],T};
parse_dep_option(Opt, _T) ->
- io:format(?STDERR, "Unknown option: -M~s\n", [Opt]),
+ io:format(?STDERR, "Unknown option: -M~ts\n", [Opt]),
usage().
usage() ->
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index d53a31db0d..65ba343368 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -175,49 +175,48 @@ format_error(invalid_record) ->
"invalid record expression";
format_error({attribute,A}) ->
- io_lib:format("attribute '~w' after function definitions", [A]);
+ io_lib:format("attribute ~tw after function definitions", [A]);
format_error({missing_qlc_hrl,A}) ->
io_lib:format("qlc:q/~w called, but \"qlc.hrl\" not included", [A]);
format_error({redefine_import,{{F,A},M}}) ->
- io_lib:format("function ~w/~w already imported from ~w", [F,A,M]);
+ io_lib:format("function ~tw/~w already imported from ~w", [F,A,M]);
format_error({bad_inline,{F,A}}) ->
- io_lib:format("inlined function ~w/~w undefined", [F,A]);
+ io_lib:format("inlined function ~tw/~w undefined", [F,A]);
format_error({invalid_deprecated,D}) ->
- io_lib:format("badly formed deprecated attribute ~w", [D]);
+ io_lib:format("badly formed deprecated attribute ~tw", [D]);
format_error({bad_deprecated,{F,A}}) ->
- io_lib:format("deprecated function ~w/~w undefined or not exported", [F,A]);
+ io_lib:format("deprecated function ~tw/~w undefined or not exported",
+ [F,A]);
format_error({bad_nowarn_unused_function,{F,A}}) ->
- io_lib:format("function ~w/~w undefined", [F,A]);
+ io_lib:format("function ~tw/~w undefined", [F,A]);
format_error({bad_nowarn_bif_clash,{F,A}}) ->
- io_lib:format("function ~w/~w undefined", [F,A]);
+ io_lib:format("function ~tw/~w undefined", [F,A]);
format_error(disallowed_nowarn_bif_clash) ->
io_lib:format("compile directive nowarn_bif_clash is no longer allowed,~n"
" - use explicit module names or -compile({no_auto_import, [F/A]})", []);
-format_error({bad_nowarn_deprecated_function,{M,F,A}}) ->
- io_lib:format("~w:~w/~w is not a deprecated function", [M,F,A]);
format_error({bad_on_load,Term}) ->
- io_lib:format("badly formed on_load attribute: ~w", [Term]);
+ io_lib:format("badly formed on_load attribute: ~tw", [Term]);
format_error(multiple_on_loads) ->
"more than one on_load attribute";
format_error({bad_on_load_arity,{F,A}}) ->
- io_lib:format("function ~w/~w has wrong arity (must be 0)", [F,A]);
+ io_lib:format("function ~tw/~w has wrong arity (must be 0)", [F,A]);
format_error({undefined_on_load,{F,A}}) ->
- io_lib:format("function ~w/~w undefined", [F,A]);
+ io_lib:format("function ~tw/~w undefined", [F,A]);
format_error(export_all) ->
"export_all flag enabled - all functions will be exported";
format_error({duplicated_export, {F,A}}) ->
- io_lib:format("function ~w/~w already exported", [F,A]);
+ io_lib:format("function ~tw/~w already exported", [F,A]);
format_error({unused_import,{{F,A},M}}) ->
- io_lib:format("import ~w:~w/~w is unused", [M,F,A]);
+ io_lib:format("import ~w:~tw/~w is unused", [M,F,A]);
format_error({undefined_function,{F,A}}) ->
- io_lib:format("function ~w/~w undefined", [F,A]);
+ io_lib:format("function ~tw/~w undefined", [F,A]);
format_error({redefine_function,{F,A}}) ->
- io_lib:format("function ~w/~w already defined", [F,A]);
+ io_lib:format("function ~tw/~w already defined", [F,A]);
format_error({define_import,{F,A}}) ->
- io_lib:format("defining imported function ~w/~w", [F,A]);
+ io_lib:format("defining imported function ~tw/~w", [F,A]);
format_error({unused_function,{F,A}}) ->
- io_lib:format("function ~w/~w is unused", [F,A]);
+ io_lib:format("function ~tw/~w is unused", [F,A]);
format_error({call_to_redefined_bif,{F,A}}) ->
io_lib:format("ambiguous call of overridden auto-imported BIF ~w/~w~n"
" - use erlang:~w/~w or \"-compile({no_auto_import,[~w/~w]}).\" "
@@ -273,7 +272,7 @@ format_error(illegal_bin_pattern) ->
"binary patterns cannot be matched in parallel using '='";
format_error(illegal_expr) -> "illegal expression";
format_error({illegal_guard_local_call, {F,A}}) ->
- io_lib:format("call to local/imported function ~w/~w is illegal in guard",
+ io_lib:format("call to local/imported function ~tw/~w is illegal in guard",
[F,A]);
format_error(illegal_guard_expr) -> "illegal guard expression";
%% --- maps ---
@@ -281,23 +280,23 @@ format_error(illegal_map_construction) ->
"only association operators '=>' are allowed in map construction";
%% --- records ---
format_error({undefined_record,T}) ->
- io_lib:format("record ~w undefined", [T]);
+ io_lib:format("record ~tw undefined", [T]);
format_error({redefine_record,T}) ->
- io_lib:format("record ~w already defined", [T]);
+ io_lib:format("record ~tw already defined", [T]);
format_error({redefine_field,T,F}) ->
- io_lib:format("field ~w already defined in record ~w", [F,T]);
+ io_lib:format("field ~tw already defined in record ~tw", [F,T]);
format_error({undefined_field,T,F}) ->
- io_lib:format("field ~w undefined in record ~w", [F,T]);
+ io_lib:format("field ~tw undefined in record ~tw", [F,T]);
format_error(illegal_record_info) ->
"illegal record info";
format_error({field_name_is_variable,T,F}) ->
- io_lib:format("field ~w is not an atom or _ in record ~w", [F,T]);
+ io_lib:format("field ~tw is not an atom or _ in record ~tw", [F,T]);
format_error({wildcard_in_update,T}) ->
- io_lib:format("meaningless use of _ in update of record ~w", [T]);
+ io_lib:format("meaningless use of _ in update of record ~tw", [T]);
format_error({unused_record,T}) ->
- io_lib:format("record ~w is unused", [T]);
+ io_lib:format("record ~tw is unused", [T]);
format_error({untyped_record,T}) ->
- io_lib:format("record ~w has field(s) without type information", [T]);
+ io_lib:format("record ~tw has field(s) without type information", [T]);
%% --- variables ----
format_error({unbound_var,V}) ->
io_lib:format("variable ~w is unbound", [V]);
@@ -315,7 +314,7 @@ format_error({variable_in_record_def,V}) ->
io_lib:format("variable ~w in record definition", [V]);
%% --- binaries ---
format_error({undefined_bittype,Type}) ->
- io_lib:format("bit type ~w undefined", [Type]);
+ io_lib:format("bit type ~tw undefined", [Type]);
format_error({bittype_mismatch,Val1,Val2,What}) ->
io_lib:format("conflict in ~s specification for bit field: '~p' and '~p'",
[What,Val1,Val2]);
@@ -335,13 +334,13 @@ format_error(unsized_binary_in_bin_gen_pattern) ->
"binary fields without size are not allowed in patterns of bit string generators";
%% --- behaviours ---
format_error({conflicting_behaviours,{Name,Arity},B,FirstL,FirstB}) ->
- io_lib:format("conflicting behaviours - callback ~w/~w required by both '~p' "
+ io_lib:format("conflicting behaviours - callback ~tw/~w required by both '~p' "
"and '~p' ~s", [Name,Arity,B,FirstB,format_where(FirstL)]);
format_error({undefined_behaviour_func, {Func,Arity}, Behaviour}) ->
- io_lib:format("undefined callback function ~w/~w (behaviour '~w')",
+ io_lib:format("undefined callback function ~tw/~w (behaviour '~w')",
[Func,Arity,Behaviour]);
format_error({undefined_behaviour,Behaviour}) ->
- io_lib:format("behaviour ~w undefined", [Behaviour]);
+ io_lib:format("behaviour ~tw undefined", [Behaviour]);
format_error({undefined_behaviour_callbacks,Behaviour}) ->
io_lib:format("behaviour ~w callback functions are undefined",
[Behaviour]);
@@ -352,23 +351,23 @@ format_error({ill_defined_optional_callbacks,Behaviour}) ->
io_lib:format("behaviour ~w optional callback functions erroneously defined",
[Behaviour]);
format_error({behaviour_info, {_M,F,A}}) ->
- io_lib:format("cannot define callback attibute for ~w/~w when "
+ io_lib:format("cannot define callback attibute for ~tw/~w when "
"behaviour_info is defined",[F,A]);
format_error({redefine_optional_callback, {F, A}}) ->
- io_lib:format("optional callback ~w/~w duplicated", [F, A]);
+ io_lib:format("optional callback ~tw/~w duplicated", [F, A]);
format_error({undefined_callback, {_M, F, A}}) ->
- io_lib:format("callback ~w/~w is undefined", [F, A]);
+ io_lib:format("callback ~tw/~w is undefined", [F, A]);
%% --- types and specs ---
format_error({singleton_typevar, Name}) ->
io_lib:format("type variable ~w is only used once (is unbound)", [Name]);
format_error({bad_export_type, _ETs}) ->
io_lib:format("bad export_type declaration", []);
format_error({duplicated_export_type, {T, A}}) ->
- io_lib:format("type ~w/~w already exported", [T, A]);
+ io_lib:format("type ~tw/~w already exported", [T, A]);
format_error({undefined_type, {TypeName, Arity}}) ->
- io_lib:format("type ~w~s undefined", [TypeName, gen_type_paren(Arity)]);
+ io_lib:format("type ~tw~s undefined", [TypeName, gen_type_paren(Arity)]);
format_error({unused_type, {TypeName, Arity}}) ->
- io_lib:format("type ~w~s is unused", [TypeName, gen_type_paren(Arity)]);
+ io_lib:format("type ~tw~s is unused", [TypeName, gen_type_paren(Arity)]);
format_error({new_builtin_type, {TypeName, Arity}}) ->
io_lib:format("type ~w~s is a new builtin type; "
"its (re)definition is allowed only until the next release",
@@ -380,25 +379,26 @@ format_error({renamed_type, OldName, NewName}) ->
io_lib:format("type ~w() is now called ~w(); "
"please use the new name instead", [OldName, NewName]);
format_error({redefine_type, {TypeName, Arity}}) ->
- io_lib:format("type ~w~s already defined",
+ io_lib:format("type ~tw~s already defined",
[TypeName, gen_type_paren(Arity)]);
format_error({type_syntax, Constr}) ->
- io_lib:format("bad ~w type", [Constr]);
+ io_lib:format("bad ~tw type", [Constr]);
format_error(old_abstract_code) ->
io_lib:format("abstract code generated before Erlang/OTP 19.0 and "
"having typed record fields cannot be compiled", []);
format_error({redefine_spec, {M, F, A}}) ->
- io_lib:format("spec for ~w:~w/~w already defined", [M, F, A]);
+ io_lib:format("spec for ~tw:~tw/~w already defined", [M, F, A]);
format_error({redefine_spec, {F, A}}) ->
- io_lib:format("spec for ~w/~w already defined", [F, A]);
+ io_lib:format("spec for ~tw/~w already defined", [F, A]);
format_error({redefine_callback, {F, A}}) ->
- io_lib:format("callback ~w/~w already defined", [F, A]);
+ io_lib:format("callback ~tw/~w already defined", [F, A]);
format_error({bad_callback, {M, F, A}}) ->
- io_lib:format("explicit module not allowed for callback ~w:~w/~w ", [M, F, A]);
+ io_lib:format("explicit module not allowed for callback ~tw:~tw/~w",
+ [M, F, A]);
format_error({spec_fun_undefined, {F, A}}) ->
- io_lib:format("spec for undefined function ~w/~w", [F, A]);
+ io_lib:format("spec for undefined function ~tw/~w", [F, A]);
format_error({missing_spec, {F,A}}) ->
- io_lib:format("missing specification for function ~w/~w", [F, A]);
+ io_lib:format("missing specification for function ~tw/~w", [F, A]);
format_error(spec_wrong_arity) ->
"spec has wrong arity";
format_error(callback_wrong_arity) ->
@@ -417,15 +417,15 @@ format_error({deprecated_builtin_type, {Name, Arity},
"removed in ~s; use ~s",
[Name, Arity, Rel, UseS]);
format_error({not_exported_opaque, {TypeName, Arity}}) ->
- io_lib:format("opaque type ~w~s is not exported",
+ io_lib:format("opaque type ~tw~s is not exported",
[TypeName, gen_type_paren(Arity)]);
format_error({underspecified_opaque, {TypeName, Arity}}) ->
- io_lib:format("opaque type ~w~s is underspecified and therefore meaningless",
+ io_lib:format("opaque type ~tw~s is underspecified and therefore meaningless",
[TypeName, gen_type_paren(Arity)]);
format_error({bad_dialyzer_attribute,Term}) ->
- io_lib:format("badly formed dialyzer attribute: ~w", [Term]);
+ io_lib:format("badly formed dialyzer attribute: ~tw", [Term]);
format_error({bad_dialyzer_option,Term}) ->
- io_lib:format("unknown dialyzer warning option: ~w", [Term]);
+ io_lib:format("unknown dialyzer warning option: ~tw", [Term]);
%% --- obsolete? unused? ---
format_error({format_error, {Fmt, Args}}) ->
io_lib:format(Fmt, Args).
@@ -763,12 +763,7 @@ start_state({attribute,Line,module,{_,_}}=Form, St0) ->
start_state({attribute,Line,module,M}, St0) ->
St1 = St0#lint{module=M},
St2 = St1#lint{state=attribute},
- case is_non_latin1_name(M) of
- true ->
- add_error(Line, non_latin1_module_unsupported, St2);
- false ->
- St2
- end;
+ check_module_name(M, Line, St2);
start_state(Form, St) ->
Anno = case Form of
{eof, L} -> erl_anno:new(L);
@@ -778,9 +773,6 @@ start_state(Form, St) ->
St1 = add_error(Anno, undefined_module, St),
attribute_state(Form, St1#lint{state=attribute}).
-is_non_latin1_name(Name) ->
- lists:any(fun(C) -> C > 255 end, atom_to_list(Name)).
-
%% attribute_state(Form, State) ->
%% State'
@@ -862,9 +854,10 @@ not_deprecated(Forms, St0) ->
{nowarn_deprecated_function, MFAs0} <- lists:flatten([Args]),
MFA <- lists:flatten([MFAs0])],
Nowarn = [MFA || {MFA,_L} <- MFAsL],
- Bad = [MFAL || {{M,F,A},_L}=MFAL <- MFAsL,
- otp_internal:obsolete(M, F, A) =:= no],
- St1 = func_line_warning(bad_nowarn_deprecated_function, Bad, St0),
+ ML = [{M,L} || {{M,_F,_A},L} <- MFAsL, is_atom(M)],
+ St1 = foldl(fun ({M,L}, St2) ->
+ check_module_name(M, L, St2)
+ end, St0, ML),
St1#lint{not_deprecated = ordsets:from_list(Nowarn)}.
%% The nowarn_bif_clash directive is not only deprecated, it's actually an error from R14A
@@ -972,7 +965,8 @@ behaviour_callbacks(Line, B, St0) ->
catch
_:_ ->
St1 = add_warning(Line, {undefined_behaviour, B}, St0),
- {[], [], St1}
+ St2 = check_module_name(B, Line, St1),
+ {[], [], St2}
end.
behaviour_missing_callbacks([{{Line,B},Bfs0,OBfs}|T], St0) ->
@@ -1310,7 +1304,8 @@ exports(#lint{compile = Opts, defined = Defs, exports = Es}) ->
-type import() :: {module(), [fa()]} | module().
-spec import(line(), import(), lint_state()) -> lint_state().
-import(Line, {Mod,Fs}, St) ->
+import(Line, {Mod,Fs}, St00) ->
+ St = check_module_name(Mod, Line, St00),
Mfs = ordsets:from_list(Fs),
case check_imports(Line, Mfs, St#lint.imports) of
[] ->
@@ -2294,11 +2289,18 @@ expr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,is_record}]},As}, Vt, St) ->
expr({call,Line,{remote,_Lr,{atom,_Lm,M},{atom,Lf,F}},As}, Vt, St0) ->
St1 = keyword_warning(Lf, F, St0),
St2 = check_remote_function(Line, M, F, As, St1),
- expr_list(As, Vt, St2);
+ St3 = check_module_name(M, Line, St2),
+ expr_list(As, Vt, St3);
expr({call,Line,{remote,_Lr,M,F},As}, Vt, St0) ->
St1 = keyword_warning(Line, M, St0),
St2 = keyword_warning(Line, F, St1),
- expr_list([M,F|As], Vt, St2);
+ St3 = case M of
+ {atom,Lm,Mod} ->
+ check_module_name(Mod, Lm, St2);
+ _ ->
+ St2
+ end,
+ expr_list([M,F|As], Vt, St3);
expr({call,Line,{atom,La,F},As}, Vt, St0) ->
St1 = keyword_warning(La, F, St0),
{Asvt,St2} = expr_list(As, Vt, St1),
@@ -2814,7 +2816,8 @@ check_type(Types, St) ->
check_type({ann_type, _L, [_Var, Type]}, SeenVars, St) ->
check_type(Type, SeenVars, St);
check_type({remote_type, L, [{atom, _, Mod}, {atom, _, Name}, Args]},
- SeenVars, St0) ->
+ SeenVars, St00) ->
+ St0 = check_module_name(Mod, L, St00),
St = deprecated_type(L, Mod, Name, Args, St0),
CurrentMod = St#lint.module,
case Mod =:= CurrentMod of
@@ -2973,11 +2976,12 @@ obsolete_builtin_type({Name, A}) when is_atom(Name), is_integer(A) -> no.
%% spec_decl(Line, Fun, Types, State) -> State.
-spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) ->
+spec_decl(Line, MFA0, TypeSpecs, St00 = #lint{specs = Specs, module = Mod}) ->
MFA = case MFA0 of
{F, Arity} -> {Mod, F, Arity};
{_M, _F, Arity} -> MFA0
end,
+ St0 = check_module_name(element(1, MFA), Line, St00),
St1 = St0#lint{specs = dict:store(MFA, Line, Specs)},
case dict:is_key(MFA, Specs) of
true -> add_error(Line, {redefine_spec, MFA0}, St1);
@@ -2989,7 +2993,9 @@ spec_decl(Line, MFA0, TypeSpecs, St0 = #lint{specs = Specs, module = Mod}) ->
callback_decl(Line, MFA0, TypeSpecs,
St0 = #lint{callbacks = Callbacks, module = Mod}) ->
case MFA0 of
- {_M, _F, _A} -> add_error(Line, {bad_callback, MFA0}, St0);
+ {M, _F, _A} ->
+ St1 = check_module_name(M, Line, St0),
+ add_error(Line, {bad_callback, MFA0}, St1);
{F, Arity} ->
MFA = {Mod, F, Arity},
St1 = St0#lint{callbacks = dict:store(MFA, Line, Callbacks)},
@@ -3033,6 +3039,16 @@ is_fa({FuncName, Arity})
when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true;
is_fa(_) -> false.
+check_module_name(M, Line, St) ->
+ case is_latin1_name(M) of
+ true -> St;
+ false ->
+ add_error(Line, non_latin1_module_unsupported, St)
+ end.
+
+is_latin1_name(Name) ->
+ io_lib:latin1_char_list(atom_to_list(Name)).
+
check_specs([FunType|Left], ETag, Arity, St0) ->
{FunType1, CTypes} =
case FunType of
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 733932e711..6e72d64acc 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -1097,12 +1097,12 @@ build_compat_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) ->
build_compat_constraint({atom, _, is_subtype}, [LHS, _Type]) ->
ret_err(?anno(LHS), "bad type variable");
build_compat_constraint({atom, A, Atom}, _Types) ->
- ret_err(A, io_lib:format("unsupported constraint ~w", [Atom])).
+ ret_err(A, io_lib:format("unsupported constraint ~tw", [Atom])).
build_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) ->
build_constraint(LHS, Type);
build_constraint({atom, A, Atom}, _Foo) ->
- ret_err(A, io_lib:format("unsupported constraint ~w", [Atom]));
+ ret_err(A, io_lib:format("unsupported constraint ~tw", [Atom]));
build_constraint({var, A, '_'}, _Types) ->
ret_err(A, "bad type variable");
build_constraint(LHS, Type) ->
@@ -1220,7 +1220,7 @@ attribute_farity_map(Args) ->
-spec error_bad_decl(erl_anno:anno(), attributes()) -> no_return().
error_bad_decl(Anno, S) ->
- ret_err(Anno, io_lib:format("bad ~w declaration", [S])).
+ ret_err(Anno, io_lib:format("bad ~tw declaration", [S])).
farity_list({cons,_Ac,{op,_Ao,'/',{atom,_Aa,A},{integer,_Ai,I}},Tail}) ->
[{A,I}|farity_list(Tail)];
diff --git a/lib/stdlib/src/error_logger_file_h.erl b/lib/stdlib/src/error_logger_file_h.erl
index 76f89841b9..b7c193f965 100644
--- a/lib/stdlib/src/error_logger_file_h.erl
+++ b/lib/stdlib/src/error_logger_file_h.erl
@@ -55,7 +55,7 @@ init(File) ->
init(File, PrevHandler) ->
process_flag(trap_exit, true),
- case file:open(File, [write]) of
+ case file:open(File, [write,{encoding,utf8}]) of
{ok,Fd} ->
Depth = error_logger:get_format_depth(),
State = #st{fd=Fd,filename=File,prev_handler=PrevHandler,
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index f2629a47c2..2093916a7c 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -281,12 +281,12 @@ start(EscriptOptions) ->
end
catch
throw:Str ->
- io:format("escript: ~s\n", [Str]),
+ io:format("escript: ~ts\n", [Str]),
my_halt(127);
_:Reason ->
Stk = erlang:get_stacktrace(),
- io:format("escript: Internal error: ~p\n", [Reason]),
- io:format("~p\n", [Stk]),
+ io:format("escript: Internal error: ~tp\n", [Reason]),
+ io:format("~tp\n", [Stk]),
my_halt(127)
end.
diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 257c829801..32f43fc706 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.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.
diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl
index 14d925bacf..4b2d15c8b3 100644
--- a/lib/stdlib/src/io_lib_format.erl
+++ b/lib/stdlib/src/io_lib_format.erl
@@ -335,7 +335,7 @@ base(B) when is_integer(B) ->
term(T, none, _Adj, none, _Pad) -> T;
term(T, none, Adj, P, Pad) -> term(T, P, Adj, P, Pad);
term(T, F, Adj, P0, Pad) ->
- L = lists:flatlength(T),
+ L = string:length(T),
P = erlang:min(L, case P0 of none -> F; _ -> min(P0, F) end),
if
L > P ->
@@ -675,11 +675,11 @@ cdata_to_chars(B) when is_binary(B) ->
string(S, none, _Adj, none, _Pad) -> S;
string(S, F, Adj, none, Pad) ->
- string_field(S, F, Adj, lists:flatlength(S), Pad);
+ string_field(S, F, Adj, string:length(S), Pad);
string(S, none, _Adj, P, Pad) ->
- string_field(S, P, left, lists:flatlength(S), Pad);
+ string_field(S, P, left, string:length(S), Pad);
string(S, F, Adj, P, Pad) when F >= P ->
- N = lists:flatlength(S),
+ N = string:length(S),
if F > P ->
if N > P ->
adjust(flat_trunc(S, P), chars(Pad, F-P), Adj);
@@ -749,18 +749,7 @@ adjust(Data, Pad, right) -> [Pad|Data].
%% Flatten and truncate a deep list to at most N elements.
flat_trunc(List, N) when is_integer(N), N >= 0 ->
- flat_trunc(List, N, [], []).
-
-flat_trunc(L, 0, _, R) when is_list(L) ->
- lists:reverse(R);
-flat_trunc([H|T], N, S, R) when is_list(H) ->
- flat_trunc(H, N, [T|S], R);
-flat_trunc([H|T], N, S, R) ->
- flat_trunc(T, N-1, S, [H|R]);
-flat_trunc([], N, [H|S], R) ->
- flat_trunc(H, N, S, R);
-flat_trunc([], _, [], R) ->
- lists:reverse(R).
+ string:slice(List, 0, N).
%% A deep version of string:chars/2,3
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index ff368d02da..505613b80e 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -473,7 +473,7 @@ print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) ->
print_length(Term, _D, _RF, _Enc, _Str) ->
S = io_lib:write(Term),
%% S can contain unicode, so iolist_size(S) cannot be used here
- {S, lists:flatlength(S)}.
+ {S, string:length(S)}.
print_length_map(_Map, 1, _RF, _Enc, _Str) ->
{"#{...}", 6};
diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl
index aa6797bce6..c6eb0d7915 100644
--- a/lib/stdlib/src/lib.erl
+++ b/lib/stdlib/src/lib.erl
@@ -27,7 +27,7 @@
-export([format_exception/6, format_exception/7,
format_stacktrace/4, format_stacktrace/5,
- format_call/4, format_call/5, format_fun/1]).
+ format_call/4, format_call/5, format_fun/1, format_fun/2]).
-spec flush_receive() -> 'ok'.
@@ -400,7 +400,11 @@ format_call(I, ForMForFun, As, FormatFun, Enc)
format_call("", n_spaces(I-1), ForMForFun, As, FormatFun, Enc).
%% -> iolist() (no \n at end)
-format_fun(Fun) when is_function(Fun) ->
+format_fun(Fun) ->
+ format_fun(Fun, latin1).
+
+%% -> iolist() (no \n at end)
+format_fun(Fun, Enc) when is_function(Fun) ->
{module, M} = erlang:fun_info(Fun, module),
{name, F} = erlang:fun_info(Fun, name),
{arity, A} = erlang:fun_info(Fun, arity),
@@ -410,9 +414,9 @@ format_fun(Fun) when is_function(Fun) ->
{type, local} when M =:= erl_eval ->
io_lib:fwrite(<<"interpreted function with arity ~w">>, [A]);
{type, local} ->
- mfa_to_string(M, F, A);
+ mfa_to_string(M, F, A, Enc);
{type, external} ->
- mfa_to_string(M, F, A)
+ mfa_to_string(M, F, A, Enc)
end.
analyze_exception(error, Term, Stack) ->
@@ -454,11 +458,11 @@ explain_reason({badarg,V}, error=Cl, [], PF, S, _Enc) -> % orelse, andalso
format_value(V, <<"bad argument: ">>, Cl, PF, S);
explain_reason(badarith, error, [], _PF, _S, _Enc) ->
<<"an error occurred when evaluating an arithmetic expression">>;
-explain_reason({badarity,{Fun,As}}, error, [], _PF, _S, _Enc)
+explain_reason({badarity,{Fun,As}}, error, [], _PF, _S, Enc)
when is_function(Fun) ->
%% Only the arity is displayed, not the arguments As.
- io_lib:fwrite(<<"~s called with ~s">>,
- [format_fun(Fun), argss(length(As))]);
+ io_lib:fwrite(<<"~ts called with ~s">>,
+ [format_fun(Fun, Enc), argss(length(As))]);
explain_reason({badfun,Term}, error=Cl, [], PF, S, _Enc) ->
format_value(Term, <<"bad function ">>, Cl, PF, S);
explain_reason({badmatch,Term}, error=Cl, [], PF, S, _Enc) ->
@@ -489,14 +493,15 @@ explain_reason({try_clause,V}, error=Cl, [], PF, S, _Enc) ->
%% "there is no try clause with a true guard sequence and a
%% pattern matching..."
format_value(V, <<"no try clause matching ">>, Cl, PF, S);
-explain_reason(undef, error, [{M,F,A,_}], _PF, _S, _Enc) ->
+explain_reason(undef, error, [{M,F,A,_}], _PF, _S, Enc) ->
%% Only the arity is displayed, not the arguments, if there are any.
- io_lib:fwrite(<<"undefined function ~s">>,
- [mfa_to_string(M, F, n_args(A))]);
-explain_reason({shell_undef,F,A,_}, error, [], _PF, _S, _Enc) ->
+ io_lib:fwrite(<<"undefined function ~ts">>,
+ [mfa_to_string(M, F, n_args(A), Enc)]);
+explain_reason({shell_undef,F,A,_}, error, [], _PF, _S, Enc) ->
%% Give nicer reports for undefined shell functions
%% (but not when the user actively calls shell_default:F(...)).
- io_lib:fwrite(<<"undefined shell command ~s/~w">>, [F, n_args(A)]);
+ FS = to_string(F, Enc),
+ io_lib:fwrite(<<"undefined shell command ~ts/~w">>, [FS, n_args(A)]);
%% Exit codes returned by erl_eval only:
explain_reason({argument_limit,_Fun}, error, [], _PF, _S, _Enc) ->
io_lib:fwrite(<<"limit of number of arguments to interpreted function"
@@ -546,17 +551,18 @@ format_stacktrace1(S0, Stack0, PF, SF, Enc) ->
format_stacktrace2(S, Stack, 1, PF, Enc).
format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF, Enc) when is_integer(A) ->
- [io_lib:fwrite(<<"~s~s ~s ~s">>,
+ [io_lib:fwrite(<<"~s~s ~ts ~s">>,
[sep(N, S), origin(N, M, F, A),
- mfa_to_string(M, F, A),
+ mfa_to_string(M, F, A, Enc),
location(L)])
| format_stacktrace2(S, Fs, N + 1, PF, Enc)];
format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF, Enc) when is_list(As) ->
A = length(As),
CalledAs = [S,<<" called as ">>],
C = format_call("", CalledAs, {M,F}, As, PF, Enc),
- [io_lib:fwrite(<<"~s~s ~s\n~s~ts">>,
- [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A),
+ [io_lib:fwrite(<<"~s~s ~ts\n~s~ts">>,
+ [sep(N, S), origin(N, M, F, A),
+ mfa_to_string(M, F, A, Enc),
CalledAs, C])
| format_stacktrace2(S, Fs, N + 1, PF, Enc)];
format_stacktrace2(_S, [], _N, _PF, _Enc) ->
@@ -594,10 +600,10 @@ format_call(ErrStr, Pre1, ForMForFun, As, PF, Enc) ->
{yes,Op} ->
format_op(ErrStr, Pre1, Op, As, PF, Enc);
no ->
- MFs = mf_to_string(ForMForFun, Arity),
- I1 = iolist_size([Pre1,ErrStr|MFs]),
+ MFs = mf_to_string(ForMForFun, Arity, Enc),
+ I1 = string:length([Pre1,ErrStr|MFs]),
S1 = pp_arguments(PF, As, I1, Enc),
- S2 = pp_arguments(PF, As, iolist_size([Pre1|MFs]), Enc),
+ S2 = pp_arguments(PF, As, string:length([Pre1|MFs]), Enc),
Long = count_nl(pp_arguments(PF, [a2345,b2345], I1, Enc)) > 0,
case Long or (count_nl(S2) < count_nl(S1)) of
true ->
@@ -656,10 +662,10 @@ printable_list(latin1, As) ->
printable_list(_, As) ->
io_lib:printable_list(As).
-mfa_to_string(M, F, A) ->
- io_lib:fwrite(<<"~s/~w">>, [mf_to_string({M, F}, A), A]).
+mfa_to_string(M, F, A, Enc) ->
+ io_lib:fwrite(<<"~ts/~w">>, [mf_to_string({M, F}, A, Enc), A]).
-mf_to_string({M, F}, A) ->
+mf_to_string({M, F}, A, Enc) ->
case erl_internal:bif(M, F, A) of
true ->
io_lib:fwrite(<<"~w">>, [F]);
@@ -670,13 +676,15 @@ mf_to_string({M, F}, A) ->
{yes, F} ->
atom_to_list(F);
no ->
- io_lib:fwrite(<<"~w:~w">>, [M, F])
+ FS = to_string(F, Enc),
+ io_lib:fwrite(<<"~w:~ts">>, [M, FS])
end
end;
-mf_to_string(Fun, _A) when is_function(Fun) ->
- format_fun(Fun);
-mf_to_string(F, _A) ->
- io_lib:fwrite(<<"~w">>, [F]).
+mf_to_string(Fun, _A, Enc) when is_function(Fun) ->
+ format_fun(Fun, Enc);
+mf_to_string(F, _A, Enc) ->
+ FS = to_string(F, Enc),
+ io_lib:fwrite(<<"~ts">>, [FS]).
format_value(V, ErrStr, Class, PF, S) ->
Pre1Sz = exited_size(Class),
@@ -725,9 +733,14 @@ exited(exit) ->
exited(throw) ->
<<"exception throw: ">>.
+to_string(A, latin1) ->
+ io_lib:write_atom_as_latin1(A);
+to_string(A, _) ->
+ io_lib:write_atom(A).
+
size(latin1, S) ->
{iolist_size(S),S};
size(_, S0) ->
S = unicode:characters_to_list(S0, unicode),
true = is_list(S),
- {length(S),S}.
+ {string:length(S),S}.
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index 98745b13f3..6616e957c0 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2002-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.
@@ -91,12 +91,12 @@ format_error(?ERR_GUARDMATCH) ->
"fun with guard matching ('=' in guard) is illegal as match_spec as well";
format_error({?ERR_GUARDLOCALCALL, Name, Arithy}) ->
lists:flatten(io_lib:format("fun containing the local function call "
- "'~w/~w' (called in guard) "
+ "'~tw/~w' (called in guard) "
"cannot be translated into match_spec",
[Name, Arithy]));
format_error({?ERR_GUARDREMOTECALL, Module, Name, Arithy}) ->
lists:flatten(io_lib:format("fun containing the remote function call "
- "'~w:~w/~w' (called in guard) "
+ "'~w:~tw/~w' (called in guard) "
"cannot be translated into match_spec",
[Module,Name,Arithy]));
format_error({?ERR_GUARDELEMENT, Str}) ->
@@ -117,12 +117,12 @@ format_error(?ERR_BODYMATCH) ->
"fun with body matching ('=' in body) is illegal as match_spec";
format_error({?ERR_BODYLOCALCALL, Name, Arithy}) ->
lists:flatten(io_lib:format("fun containing the local function "
- "call '~w/~w' (called in body) "
+ "call '~tw/~w' (called in body) "
"cannot be translated into match_spec",
[Name,Arithy]));
format_error({?ERR_BODYREMOTECALL, Module, Name, Arithy}) ->
lists:flatten(io_lib:format("fun containing the remote function call "
- "'~w:~w/~w' (called in body) "
+ "'~w:~tw/~w' (called in body) "
"cannot be translated into match_spec",
[Module,Name,Arithy]));
format_error({?ERR_BODYELEMENT, Str}) ->
@@ -147,15 +147,15 @@ format_error({?ERR_UNBOUND_VARIABLE, Str}) ->
"into match_spec", [Str]));
format_error({?ERR_HEADBADREC,Name}) ->
lists:flatten(
- io_lib:format("fun head contains unknown record type ~w",[Name]));
+ io_lib:format("fun head contains unknown record type ~tw",[Name]));
format_error({?ERR_HEADBADFIELD,RName,FName}) ->
lists:flatten(
- io_lib:format("fun head contains reference to unknown field ~w in "
- "record type ~w",[FName, RName]));
+ io_lib:format("fun head contains reference to unknown field ~tw in "
+ "record type ~tw",[FName, RName]));
format_error({?ERR_HEADMULTIFIELD,RName,FName}) ->
lists:flatten(
- io_lib:format("fun head contains already defined field ~w in "
- "record type ~w",[FName, RName]));
+ io_lib:format("fun head contains already defined field ~tw in "
+ "record type ~tw",[FName, RName]));
format_error({?ERR_HEADDOLLARATOM,Atom}) ->
lists:flatten(
io_lib:format("fun head contains atom ~w, which conflics with reserved "
@@ -166,28 +166,28 @@ format_error({?ERR_HEADBINMATCH,Atom}) ->
"which cannot be translated into match_spec", [Atom]));
format_error({?ERR_GUARDBADREC,Name}) ->
lists:flatten(
- io_lib:format("fun guard contains unknown record type ~w",[Name]));
+ io_lib:format("fun guard contains unknown record type ~tw",[Name]));
format_error({?ERR_GUARDBADFIELD,RName,FName}) ->
lists:flatten(
- io_lib:format("fun guard contains reference to unknown field ~w in "
- "record type ~w",[FName, RName]));
+ io_lib:format("fun guard contains reference to unknown field ~tw in "
+ "record type ~tw",[FName, RName]));
format_error({?ERR_GUARDMULTIFIELD,RName,FName}) ->
lists:flatten(
- io_lib:format("fun guard contains already defined field ~w in "
- "record type ~w",[FName, RName]));
+ io_lib:format("fun guard contains already defined field ~tw in "
+ "record type ~tw",[FName, RName]));
format_error({?ERR_BODYBADREC,Name}) ->
lists:flatten(
- io_lib:format("fun body contains unknown record type ~w",[Name]));
+ io_lib:format("fun body contains unknown record type ~tw",[Name]));
format_error({?ERR_BODYBADFIELD,RName,FName}) ->
lists:flatten(
- io_lib:format("fun body contains reference to unknown field ~w in "
- "record type ~w",[FName, RName]));
+ io_lib:format("fun body contains reference to unknown field ~tw in "
+ "record type ~tw",[FName, RName]));
format_error({?ERR_BODYMULTIFIELD,RName,FName}) ->
lists:flatten(
- io_lib:format("fun body contains already defined field ~w in "
- "record type ~w",[FName, RName]));
+ io_lib:format("fun body contains already defined field ~tw in "
+ "record type ~tw",[FName, RName]));
format_error(Else) ->
- lists:flatten(io_lib:format("Unknown error code ~w",[Else])).
+ lists:flatten(io_lib:format("Unknown error code ~tw",[Else])).
%%
%% Called when translating in shell
@@ -501,10 +501,20 @@ tg0(Line,[H|T],B) ->
tg({match,Line,_,_},B) ->
throw({error,Line,?ERR_GENMATCH+B#tgd.eb});
-tg({op, Line, Operator, O1, O2}, B) ->
- {tuple, Line, [{atom, Line, Operator}, tg(O1,B), tg(O2,B)]};
-tg({op, Line, Operator, O1}, B) ->
- {tuple, Line, [{atom, Line, Operator}, tg(O1,B)]};
+tg({op, Line, Operator, O1, O2}=Expr, B) ->
+ case erl_eval:partial_eval(Expr) of
+ Expr ->
+ {tuple, Line, [{atom, Line, Operator}, tg(O1, B), tg(O2, B)]};
+ Value ->
+ Value
+ end;
+tg({op, Line, Operator, O1}=Expr, B) ->
+ case erl_eval:partial_eval(Expr) of
+ Expr ->
+ {tuple, Line, [{atom, Line, Operator}, tg(O1, B)]};
+ Value ->
+ Value
+ end;
tg({call, _Line, {atom, Line2, bindings},[]},_B) ->
{atom, Line2, '$*'};
tg({call, _Line, {atom, Line2, object},[]},_B) ->
@@ -723,7 +733,7 @@ tg(T,B) when is_tuple(T), tuple_size(T) >= 2 ->
throw({error,Line,{?ERR_GENELEMENT+B#tgd.eb,
translate_language_element(Element)}});
tg(Other,B) ->
- Element = io_lib:format("unknown element ~w", [Other]),
+ Element = io_lib:format("unknown element ~tw", [Other]),
throw({error,unknown,{?ERR_GENELEMENT+B#tgd.eb,Element}}).
transform_head([V],OuterBound) ->
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 9e9c0dc413..24e6ef619c 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -63,9 +63,9 @@ obsolete_1(gen_fsm, start, 4) ->
{deprecated, {gen_statem, start, 4}};
obsolete_1(gen_fsm, start_link, 3) ->
- {deprecated, {gen_statem, start, 3}};
+ {deprecated, {gen_statem, start_link, 3}};
obsolete_1(gen_fsm, start_link, 4) ->
- {deprecated, {gen_statem, start, 4}};
+ {deprecated, {gen_statem, start_link, 4}};
obsolete_1(gen_fsm, stop, 1) ->
{deprecated, {gen_statem, stop, 1}};
@@ -83,9 +83,9 @@ obsolete_1(gen_fsm, reply, 2) ->
{deprecated, {gen_statem, reply, 2}};
obsolete_1(gen_fsm, send_event, 2) ->
- {deprecated, {gen_statem, cast, 1}};
+ {deprecated, {gen_statem, cast, 2}};
obsolete_1(gen_fsm, send_all_state_event, 2) ->
- {deprecated, {gen_statem, cast, 1}};
+ {deprecated, {gen_statem, cast, 2}};
obsolete_1(gen_fsm, sync_send_event, 2) ->
{deprecated, {gen_statem, call, 2}};
@@ -98,11 +98,11 @@ obsolete_1(gen_fsm, sync_send_all_state_event, 3) ->
{deprecated, {gen_statem, call, 3}};
obsolete_1(gen_fsm, start_timer, 2) ->
- {deprecated, {erlang, start_timer, 2}};
+ {deprecated, {erlang, start_timer, 3}};
obsolete_1(gen_fsm, cancel_timer, 1) ->
{deprecated, {erlang, cancel_timer, 1}};
obsolete_1(gen_fsm, send_event_after, 2) ->
- {deprecated, {erlang, send_after, 2}};
+ {deprecated, {erlang, send_after, 3}};
%% *** CRYPTO added in OTP 20 ***
@@ -112,7 +112,7 @@ obsolete_1(crypto, rand_uniform, 2) ->
%% *** CRYPTO added in OTP 19 ***
obsolete_1(crypto, rand_bytes, 1) ->
- {deprecated, {crypto, strong_rand_bytes, 1}};
+ {removed, {crypto, strong_rand_bytes, 1}, "20.0"};
%% *** CRYPTO added in R16B01 ***
diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl
index 3fa54cd0d5..d4d1bdccec 100644
--- a/lib/stdlib/src/proc_lib.erl
+++ b/lib/stdlib/src/proc_lib.erl
@@ -779,11 +779,13 @@ format_link_report([Link|Reps], Indent, Extra) ->
LinkIndent = [" ",Indent],
[Indent,"neighbour:\n",format_report(Rep, LinkIndent, Extra)|
format_link_report(Reps, Indent, Extra)];
-format_link_report([], _, _) ->
- [].
+format_link_report(Rep, Indent, Extra) ->
+ format_report(Rep, Indent, Extra).
format_report(Rep, Indent, Extra) when is_list(Rep) ->
format_rep(Rep, Indent, Extra);
+format_report(Rep, Indent, {Enc,unlimited}) ->
+ io_lib:format("~s~"++modifier(Enc)++"p~n", [Indent, Rep]);
format_report(Rep, Indent, {Enc,Depth}) ->
io_lib:format("~s~"++modifier(Enc)++"P~n", [Indent, Rep, Depth]).
@@ -805,16 +807,21 @@ format_exception(Class, Reason, StackTrace, {Enc,_}=Extra) ->
[EI, lib:format_exception(1+length(EI), Class, Reason,
StackTrace, StackFun, PF, Enc), "\n"].
-format_mfa(Indent, {M,F,Args}=StartF, Extra) ->
+format_mfa(Indent, {M,F,Args}=StartF, {Enc,_}=Extra) ->
try
A = length(Args),
- [Indent,"initial call: ",atom_to_list(M),$:,atom_to_list(F),$/,
+ [Indent,"initial call: ",atom_to_list(M),$:,to_string(F, Enc),$/,
integer_to_list(A),"\n"]
catch
error:_ ->
format_tag(Indent, initial_call, StartF, Extra)
end.
+to_string(A, latin1) ->
+ io_lib:write_atom_as_latin1(A);
+to_string(A, _) ->
+ io_lib:write_atom(A).
+
pp_fun({Enc,Depth}) ->
{Letter,Tl} = case Depth of
unlimited -> {"p",[]};
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index 76a2789406..26b3960f4f 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -727,7 +727,7 @@ result_will_be_saved() ->
used_record_defs(E, RT) ->
%% Be careful to return a list where used records come before
%% records that use them. The linter wants them ordered that way.
- UR = case used_records(E, [], RT) of
+ UR = case used_records(E, [], RT, []) of
[] ->
[];
L0 ->
@@ -737,13 +737,19 @@ used_record_defs(E, RT) ->
end,
record_defs(RT, UR).
-used_records(E, U0, RT) ->
+used_records(E, U0, RT, Skip) ->
case used_records(E) of
{name,Name,E1} ->
- U = used_records(ets:lookup(RT, Name), [Name | U0], RT),
- used_records(E1, U, RT);
+ U = case lists:member(Name, Skip) of
+ true ->
+ U0;
+ false ->
+ R = ets:lookup(RT, Name),
+ used_records(R, [Name | U0], RT, [Name | Skip])
+ end,
+ used_records(E1, U, RT, Skip);
{expr,[E1 | Es]} ->
- used_records(Es, used_records(E1, U0, RT), RT);
+ used_records(Es, used_records(E1, U0, RT, Skip), RT, Skip);
_ ->
U0
end.
@@ -1238,22 +1244,22 @@ read_file_records(File, Opts) ->
end.
%% This is how the debugger searches for source files. See int.erl.
-try_source(Beam, CB) ->
- Os = case lists:keyfind(options, 1, binary_to_term(CB)) of
- false -> [];
- {_, Os0} -> Os0
- end,
+try_source(Beam, RawCB) ->
+ EbinDir = filename:dirname(Beam),
+ CB = binary_to_term(RawCB),
+ Os = proplists:get_value(options,CB, []),
Src0 = filename:rootname(Beam) ++ ".erl",
- case is_file(Src0) of
- true -> parse_file(Src0, Os);
- false ->
- EbinDir = filename:dirname(Beam),
- Src = filename:join([filename:dirname(EbinDir), "src",
- filename:basename(Src0)]),
- case is_file(Src) of
- true -> parse_file(Src, Os);
- false -> {error, nofile}
- end
+ Src1 = filename:join([filename:dirname(EbinDir), "src",
+ filename:basename(Src0)]),
+ Src2 = proplists:get_value(source, CB, []),
+ try_sources([Src0,Src1,Src2], Os).
+
+try_sources([], _) ->
+ {error, nofile};
+try_sources([Src|Rest], Os) ->
+ case is_file(Src) of
+ true -> parse_file(Src, Os);
+ false -> try_sources(Rest, Os)
end.
is_file(Name) ->
diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl
index 6f7009b5d9..4972da297d 100644
--- a/lib/stdlib/src/string.erl
+++ b/lib/stdlib/src/string.erl
@@ -384,7 +384,7 @@ to_float(String) ->
end.
to_number(String, Number, Rest, List, _Tail) when is_binary(String) ->
- BSz = length(List)-length(Rest),
+ BSz = erlang:length(List)-erlang:length(Rest),
<<_:BSz/binary, Cont/binary>> = String,
{Number, Cont};
to_number(_, Number, Rest, _, Tail) ->
@@ -1344,7 +1344,7 @@ bin_search_str(Bin0, Start, Cont, [CP|_]=SearchCPs) ->
String :: string(),
Length :: non_neg_integer().
-len(S) -> length(S).
+len(S) -> erlang:length(S).
%% equal(String1, String2)
%% Test if 2 strings are equal.
@@ -1689,7 +1689,7 @@ left(String, Len) when is_integer(Len) -> left(String, Len, $\s).
Character :: char().
left(String, Len, Char) when is_integer(Char) ->
- Slen = length(String),
+ Slen = erlang:length(String),
if
Slen > Len -> substr(String, 1, Len);
Slen < Len -> l_pad(String, Len-Slen, Char);
@@ -1714,7 +1714,7 @@ right(String, Len) when is_integer(Len) -> right(String, Len, $\s).
Character :: char().
right(String, Len, Char) when is_integer(Char) ->
- Slen = length(String),
+ Slen = erlang:length(String),
if
Slen > Len -> substr(String, Slen-Len+1);
Slen < Len -> r_pad(String, Len-Slen, Char);
@@ -1741,7 +1741,7 @@ centre(String, Len) when is_integer(Len) -> centre(String, Len, $\s).
centre(String, 0, Char) when is_list(String), is_integer(Char) ->
[]; % Strange cases to centre string
centre(String, Len, Char) when is_integer(Char) ->
- Slen = length(String),
+ Slen = erlang:length(String),
if
Slen > Len -> substr(String, (Slen-Len) div 2 + 1, Len);
Slen < Len ->
diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl
index a6ecf03716..1f966411c5 100644
--- a/lib/stdlib/src/sys.erl
+++ b/lib/stdlib/src/sys.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.
@@ -525,7 +525,7 @@ debug_cmd({log_to_file, false}, Debug) ->
{ok, NDebug};
debug_cmd({log_to_file, FileName}, Debug) ->
NDebug = close_log_file(Debug),
- case file:open(FileName, [write]) of
+ case file:open(FileName, [write,{encoding,utf8}]) of
{ok, Fd} ->
{ok, install_debug(log_to_file, Fd, NDebug)};
_Error ->
@@ -648,7 +648,7 @@ debug_options([{log, N} | T], Debug) when is_integer(N), N > 0 ->
debug_options([statistics | T], Debug) ->
debug_options(T, install_debug(statistics, init_stat(), Debug));
debug_options([{log_to_file, FileName} | T], Debug) ->
- case file:open(FileName, [write]) of
+ case file:open(FileName, [write,{encoding,utf8}]) of
{ok, Fd} ->
debug_options(T, install_debug(log_to_file, Fd, Debug));
_Error ->
diff --git a/lib/stdlib/test/c_SUITE.erl b/lib/stdlib/test/c_SUITE.erl
index 4bd32a30f8..f01988478c 100644
--- a/lib/stdlib/test/c_SUITE.erl
+++ b/lib/stdlib/test/c_SUITE.erl
@@ -21,7 +21,9 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2]).
-export([c_1/1, c_2/1, c_3/1, c_4/1, nc_1/1, nc_2/1, nc_3/1, nc_4/1,
- ls/1, memory/1]).
+ c_default_outdir_1/1, c_default_outdir_2/1,
+ nc_default_outdir_1/1, nc_default_outdir_2/1,
+ ls/1, memory/1]).
-include_lib("common_test/include/ct.hrl").
@@ -30,7 +32,10 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [c_1, c_2, c_3, c_4, nc_1, nc_2, nc_3, nc_4, ls, memory].
+ [c_1, c_2, c_3, c_4, nc_1, nc_2, nc_3, nc_4,
+ c_default_outdir_1, c_default_outdir_2,
+ nc_default_outdir_1, nc_default_outdir_2,
+ ls, memory].
groups() ->
[].
@@ -124,6 +129,50 @@ nc_4(Config) when is_list(Config) ->
Result = nc(R,[{outdir,W}]),
{ok, m} = Result.
+c_default_outdir_1(Config) ->
+ R = filename:join(proplists:get_value(data_dir, Config), "m.erl"),
+ W = proplists:get_value(priv_dir, Config),
+ file:set_cwd(W),
+ Obj = "m" ++ code:objfile_extension(),
+ _ = file:delete(Obj),
+ false = filelib:is_file(Obj),
+ Result = c:c(R),
+ {ok, m} = Result,
+ true = filelib:is_file(Obj).
+
+c_default_outdir_2(Config) ->
+ R = filename:join(proplists:get_value(data_dir, Config), "m"),
+ W = proplists:get_value(priv_dir, Config),
+ file:set_cwd(W),
+ Obj = "m" ++ code:objfile_extension(),
+ _ = file:delete(Obj),
+ false = filelib:is_file(Obj),
+ Result = c:c(R),
+ {ok, m} = Result,
+ true = filelib:is_file(Obj).
+
+nc_default_outdir_1(Config) ->
+ R = filename:join(proplists:get_value(data_dir, Config), "m.erl"),
+ W = proplists:get_value(priv_dir, Config),
+ file:set_cwd(W),
+ Obj = "m" ++ code:objfile_extension(),
+ _ = file:delete(Obj),
+ false = filelib:is_file(Obj),
+ Result = c:nc(R),
+ {ok, m} = Result,
+ true = filelib:is_file(Obj).
+
+nc_default_outdir_2(Config) ->
+ R = filename:join(proplists:get_value(data_dir, Config), "m"),
+ W = proplists:get_value(priv_dir, Config),
+ file:set_cwd(W),
+ Obj = "m" ++ code:objfile_extension(),
+ _ = file:delete(Obj),
+ false = filelib:is_file(Obj),
+ Result = c:nc(R),
+ {ok, m} = Result,
+ true = filelib:is_file(Obj).
+
ls(Config) when is_list(Config) ->
Directory = proplists:get_value(data_dir, Config),
ok = c:ls(Directory),
diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl
index 71d6820c47..915f478dfa 100644
--- a/lib/stdlib/test/epp_SUITE.erl
+++ b/lib/stdlib/test/epp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-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.
@@ -28,7 +28,7 @@
otp_8130/1, overload_mac/1, otp_8388/1, otp_8470/1,
otp_8562/1, otp_8665/1, otp_8911/1, otp_10302/1, otp_10820/1,
otp_11728/1, encoding/1, extends/1, function_macro/1,
- test_error/1, test_warning/1]).
+ test_error/1, test_warning/1, otp_14285/1]).
-export([epp_parse_erl_form/2]).
@@ -68,7 +68,8 @@ all() ->
not_circular, skip_header, otp_6277, otp_7702, otp_8130,
overload_mac, otp_8388, otp_8470, otp_8562,
otp_8665, otp_8911, otp_10302, otp_10820, otp_11728,
- encoding, extends, function_macro, test_error, test_warning].
+ encoding, extends, function_macro, test_error, test_warning,
+ otp_14285].
groups() ->
[{upcase_mac, [], [upcase_mac_1, upcase_mac_2]},
@@ -677,7 +678,7 @@ otp_8130(Config) when is_list(Config) ->
{otp_8130_c6,
<<"-define(M3(), A).\n"
"t() -> A = 1, ?3.14159}.\n">>,
- {errors,[{{2,16},epp,{call,"?3.14159"}}],[]}},
+ {errors,[{{2,16},epp,{call,[$?,"3.14159"]}}],[]}},
{otp_8130_c7,
<<"\nt() -> ?A.\n">>,
@@ -1384,6 +1385,26 @@ do_otp_10820(File, C, PC) ->
true = test_server:stop_node(Node),
ok.
+%% OTP_14285: Unicode atoms.
+otp_14285(Config) when is_list(Config) ->
+ %% This is just a sample of errors.
+ Cs = [{otp_8562,
+ <<"-export([f/0]).
+ -define('a\x{400}b', 'a\x{400}d').
+ f() ->
+ ?'a\x{400}b'.
+ g() ->
+ ?\"a\x{400}b\".
+ h() ->
+ ?'a\x{400}no'().
+ "/utf8>>,
+ {errors,[{6,epp,{call,[63,[91,["97",44,"1024",44,"98"],93]]}},
+ {8,epp,{undefined,'a\x{400}no',0}}],
+ []}}
+ ],
+ [] = compile(Config, Cs),
+ ok.
+
%% OTP-11728. Bugfix circular macro.
otp_11728(Config) when is_list(Config) ->
Dir = proplists:get_value(priv_dir, Config),
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index cc3d605840..cb1cceb8db 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -66,7 +66,7 @@
otp_11851/1,otp_11879/1,otp_13230/1,
record_errors/1, otp_11879_cont/1,
non_latin1_module/1, otp_14323/1,
- get_stacktrace/1]).
+ get_stacktrace/1, otp_14285/1, otp_14378/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -87,7 +87,7 @@ all() ->
maps, maps_type, maps_parallel_match,
otp_11851, otp_11879, otp_13230,
record_errors, otp_11879_cont, non_latin1_module, otp_14323,
- get_stacktrace].
+ get_stacktrace, otp_14285, otp_14378].
groups() ->
[{unused_vars_warn, [],
@@ -2054,12 +2054,10 @@ otp_5362(Config) when is_list(Config) ->
spawn(A).
">>,
{[nowarn_unused_function]},
- {error,[{3,erl_lint,disallowed_nowarn_bif_clash},
- {4,erl_lint,disallowed_nowarn_bif_clash},
- {4,erl_lint,{bad_nowarn_bif_clash,{spawn,2}}}],
- [{5,erl_lint,{bad_nowarn_deprecated_function,{3,now,-1}}},
- {5,erl_lint,{bad_nowarn_deprecated_function,{erlang,now,-1}}},
- {5,erl_lint,{bad_nowarn_deprecated_function,{{a,b,c},now,-1}}}]}
+ {errors,[{3,erl_lint,disallowed_nowarn_bif_clash},
+ {4,erl_lint,disallowed_nowarn_bif_clash},
+ {4,erl_lint,{bad_nowarn_bif_clash,{spawn,2}}}],
+ []}
},
{otp_5362_8,
@@ -3922,10 +3920,63 @@ otp_11879_cont(Config) ->
%% OTP-14285: We currently don't support non-latin1 module names.
-non_latin1_module(_Config) ->
+non_latin1_module(Config) ->
do_non_latin1_module('юникод'),
do_non_latin1_module(list_to_atom([256,$a,$b,$c])),
do_non_latin1_module(list_to_atom([$a,$b,256,$c])),
+
+ "module names with non-latin1 characters are not supported" =
+ format_error(non_latin1_module_unsupported),
+ BadCallback =
+ {bad_callback,{'кирилли́ческий атом','кирилли́ческий атом',0}},
+ "explicit module not allowed for callback "
+ "'кирилли́ческий атом':'кирилли́ческий атом'/0" =
+ format_error(BadCallback),
+ UndefBehav = {undefined_behaviour,'кирилли́ческий атом'},
+ "behaviour 'кирилли́ческий атом' undefined" =
+ format_error(UndefBehav),
+ Ts = [{non_latin1_module,
+ <<"
+ %% Report uses of module names with non-Latin-1 characters.
+
+ -import('кирилли́ческий атом', []).
+ -behaviour('кирилли́ческий атом').
+ -behavior('кирилли́ческий атом').
+
+ -callback 'кирилли́ческий атом':'кирилли́ческий атом'() -> a.
+
+ %% erl_lint:gexpr/3 is not extended to check module name here:
+ t1() when 'кирилли́ческий атом':'кирилли́ческий атом'(1) ->
+ b.
+
+ t2() ->
+ 'кирилли́ческий атом':'кирилли́ческий атом'().
+
+ -spec 'кирилли́ческий атом':'кирилли́ческий атом'() -> atom().
+
+ -spec 'кирилли́ческий атом'(integer()) ->
+ 'кирилли́ческий атом':'кирилли́ческий атом'().
+
+ 'кирилли́ческий атом'(1) ->
+ 'кирилли́ческий атом':f(),
+ F = f,
+ 'кирилли́ческий атом':F()."/utf8>>,
+ [],
+ {error,
+ [{4,erl_lint,non_latin1_module_unsupported},
+ {5,erl_lint,non_latin1_module_unsupported},
+ {6,erl_lint,non_latin1_module_unsupported},
+ {8,erl_lint,non_latin1_module_unsupported},
+ {8,erl_lint,BadCallback},
+ {11,erl_lint,illegal_guard_expr},
+ {15,erl_lint,non_latin1_module_unsupported},
+ {17,erl_lint,non_latin1_module_unsupported},
+ {20,erl_lint,non_latin1_module_unsupported},
+ {23,erl_lint,non_latin1_module_unsupported},
+ {25,erl_lint,non_latin1_module_unsupported}],
+ [{5,erl_lint,UndefBehav},
+ {6,erl_lint,UndefBehav}]}}],
+ run(Config, Ts),
ok.
do_non_latin1_module(Mod) ->
@@ -3938,6 +3989,22 @@ do_non_latin1_module(Mod) ->
ok.
+otp_14378(Config) ->
+ Ts = [
+ {otp_14378_1,
+ <<"-export([t/0]).
+ -compile({nowarn_deprecated_function,{erlang,now,1}}).
+ t() ->
+ erlang:now().">>,
+ [],
+ {warnings,[{4,erl_lint,
+ {deprecated,{erlang,now,0},
+ "Deprecated BIF. See the \"Time and Time Correction"
+ " in Erlang\" chapter of the ERTS User's Guide"
+ " for more information."}}]}}],
+ [] = run(Config, Ts),
+ ok.
+
%% OTP-14323: Check the dialyzer attribute.
otp_14323(Config) ->
Ts = [
@@ -4042,6 +4109,53 @@ get_stacktrace(Config) ->
run(Config, Ts),
ok.
+%% Unicode atoms.
+otp_14285(Config) ->
+ %% A small sample of all the errors and warnings in module erl_lint.
+ E1 = {redefine_function,{'кирилли́ческий атом',0}},
+ E2 = {attribute,'кирилли́ческий атом'},
+ E3 = {undefined_record,'кирилли́ческий атом'},
+ E4 = {undefined_bittype,'кирилли́ческий атом'},
+ "function 'кирилли́ческий атом'/0 already defined" = format_error(E1),
+ "attribute 'кирилли́ческий атом' after function definitions" =
+ format_error(E2),
+ "record 'кирилли́ческий атом' undefined" = format_error(E3),
+ "bit type 'кирилли́ческий атом' undefined" = format_error(E4),
+ Ts = [{otp_14285_1,
+ <<"'кирилли́ческий атом'() -> a.
+ 'кирилли́ческий атом'() -> a.
+ "/utf8>>,
+ [],
+ {errors,
+ [{2,erl_lint,E1}],
+ []}},
+ {otp_14285_2,
+ <<"'кирилли́ческий атом'() -> a.
+ -'кирилли́ческий атом'(a).
+ "/utf8>>,
+ [],
+ {errors,
+ [{2,erl_lint,E2}],
+ []}},
+ {otp_14285_3,
+ <<"'кирилли́ческий атом'() -> #'кирилли́ческий атом'{}.
+ "/utf8>>,
+ [],
+ {errors,
+ [{1,erl_lint,E3}],
+ []}},
+ {otp_14285_4,
+ <<"t() -> <<34/'кирилли́ческий атом'>>.
+ "/utf8>>,
+ [],
+ {errors,
+ [{1,erl_lint,E4}],
+ []}}],
+ run(Config, Ts),
+ ok.
+
+format_error(E) ->
+ lists:flatten(erl_lint:format_error(E)).
run(Config, Tests) ->
F = fun({N,P,Ws,E}, BadL) ->
diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl
index f35013b1b2..d1e6faf863 100644
--- a/lib/stdlib/test/ms_transform_SUITE.erl
+++ b/lib/stdlib/test/ms_transform_SUITE.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.
@@ -43,6 +43,7 @@
-export([warnings/1]).
-export([no_warnings/1]).
-export([eep37/1]).
+-export([otp_14454/1]).
init_per_testcase(_Func, Config) ->
Config.
@@ -59,7 +60,7 @@ all() ->
record_index, multipass, bitsyntax, record_defaults,
andalso_orelse, float_1_function, action_function,
warnings, no_warnings, top_match, old_guards, autoimported,
- semicolon, eep37].
+ semicolon, eep37, otp_14454].
groups() ->
[].
@@ -771,6 +772,16 @@ eep37(Config) when is_list(Config) ->
"F()">>).
+otp_14454(Config) when is_list(Config) ->
+ setup(Config),
+ [{'$1',[],[{'band','$1',136}]}] =
+ compile_and_run(
+ <<"ets:fun2ms(fun(A) -> A band ( -(-17) bsl 3) end)">>),
+ [{'$1',[],[{'band','$1',136}]}] =
+ compile_and_run(
+ <<"ets:fun2ms(fun(A) -> A band ( erlang:'bsl'(-(-17), 3)) end)">>),
+ ok.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Helpers
diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl
index a53e99afc9..c4fafe82a4 100644
--- a/lib/stdlib/test/proc_lib_SUITE.erl
+++ b/lib/stdlib/test/proc_lib_SUITE.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.
@@ -27,8 +27,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
crash/1, stacktrace/1, sync_start_nolink/1, sync_start_link/1,
- spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1,
- hibernate/1, stop/1, t_format/1]).
+ spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1, '\x{447}'/0,
+ hibernate/1, stop/1, t_format/1, t_format_arbitrary/1]).
-export([ otp_6345/1, init_dont_hang/1]).
-export([hib_loop/1, awaken/1]).
@@ -51,7 +51,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[crash, stacktrace, {group, sync_start}, spawn_opt, hibernate,
- {group, tickets}, stop, t_format].
+ {group, tickets}, stop, t_format, t_format_arbitrary].
groups() ->
[{tickets, [], [otp_6345, init_dont_hang]},
@@ -78,6 +78,14 @@ end_per_group(_GroupName, Config) ->
%% synchronous, and we want to test that the crash report is ok.
%%-----------------------------------------------------------------
crash(Config) when is_list(Config) ->
+ ok = application:unset_env(kernel, error_logger_format_depth),
+ crash_1(Config),
+ ok = application:set_env(kernel, error_logger_format_depth, 30),
+ crash_1(Config),
+ ok = application:unset_env(kernel, error_logger_format_depth),
+ ok.
+
+crash_1(_Config) ->
error_logger:add_report_handler(?MODULE, self()),
%% Make sure that we don't get a crash report if a process
@@ -139,6 +147,14 @@ crash(Config) when is_list(Config) ->
{error_info,{exit,abnormal,{stacktrace}}}],
analyse_crash(Pid5, Exp5, []),
+ %% Unicode atom
+ Pid6 = proc_lib:spawn(?MODULE, '\x{447}', []),
+ Pid6 ! die,
+ Exp6 = [{initial_call,{?MODULE,'\x{447}',[]}},
+ {ancestors,[self()]},
+ {error_info,{exit,die,{stacktrace}}}],
+ analyse_crash(Pid6, Exp6, []),
+
error_logger:delete_report_handler(?MODULE),
ok.
@@ -304,6 +320,12 @@ sp4(Parent, Tester) ->
end,
proc_lib:init_ack(Parent, self()).
+'\x{447}'() ->
+ receive
+ die -> exit(die);
+ _ -> sp1()
+ end.
+
hibernate(Config) when is_list(Config) ->
Ref = make_ref(),
Self = self(),
@@ -548,9 +570,32 @@ t_format() ->
ok.
+t_format_arbitrary(_Config) ->
+ error_logger:tty(false),
+ try
+ t_format_arbitrary()
+ after
+ error_logger:tty(true)
+ end,
+ ok.
+
+t_format_arbitrary() ->
+ A = list_to_atom([1024]),
+ do_test_format([fake_report, A], unlimited),
+ do_test_format([fake_report, A], 20),
+
+ do_test_format([fake_report, foo], unlimited),
+ do_test_format([fake_report, foo], 20),
+ do_test_format([fake_report, []], unlimited),
+ do_test_format([fake_report, []], 20).
+
do_test_format(Report, Depth) ->
- io:format("*** Depth = ~p", [Depth]),
- S0 = proc_lib:format(Report, latin1, Depth),
+ do_test_format(Report, latin1, Depth),
+ do_test_format(Report, unicode, Depth).
+
+do_test_format(Report, Encoding, Depth) ->
+ io:format("*** Depth = ~p, Encoding = ~p", [Depth, Encoding]),
+ S0 = proc_lib:format(Report, Encoding, Depth),
S = lists:flatten(S0),
io:put_chars(S),
length(S).
@@ -570,7 +615,7 @@ init(Tester) ->
{ok, Tester}.
handle_event({error_report, _GL, {Pid, crash_report, Report}}, Tester) ->
- io:format("~s\n", [proc_lib:format(Report)]),
+ io:format("~ts\n", [proc_lib:format(Report)]),
Tester ! {crash_report, Pid, Report},
{ok, Tester};
handle_event(_Event, State) ->
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index 99411bc8fd..217e8cc252 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -31,7 +31,7 @@
progex_lc/1, progex_funs/1,
otp_5990/1, otp_6166/1, otp_6554/1,
otp_7184/1, otp_7232/1, otp_8393/1, otp_10302/1, otp_13719/1,
- otp_14285/1, otp_14296/1]).
+ otp_14285/1, otp_14296/1, typed_records/1]).
-export([ start_restricted_from_shell/1,
start_restricted_on_command_line/1,restricted_local/1]).
@@ -74,10 +74,10 @@ suite() ->
{timetrap,{minutes,10}}].
all() ->
- [forget, records, known_bugs, otp_5226, otp_5327,
+ [forget, known_bugs, otp_5226, otp_5327,
otp_5435, otp_5195, otp_5915, otp_5916, {group, bits},
{group, refman}, {group, progex}, {group, tickets},
- {group, restricted}].
+ {group, restricted}, {group, records}].
groups() ->
[{restricted, [],
@@ -86,6 +86,8 @@ groups() ->
{bits, [],
[bs_match_misc_SUITE, bs_match_tail_SUITE,
bs_match_bin_SUITE, bs_construct_SUITE]},
+ {records, [],
+ [records, typed_records]},
{refman, [], [refman_bit_syntax]},
{progex, [],
[progex_bit_syntax, progex_records, progex_lc,
@@ -376,6 +378,9 @@ records(Config) when is_list(Config) ->
[[state]] = scan(RR4),
Test = filename:join(proplists:get_value(priv_dir, Config), "test.erl"),
+ BeamDir = filename:join(proplists:get_value(priv_dir, Config), "beam"),
+ BeamFile = filename:join(BeamDir, "test"),
+ ok = file:make_dir(BeamDir),
Contents = <<"-module(test).
-record(state, {bin :: binary(),
reply = no,
@@ -387,8 +392,10 @@ records(Config) when is_list(Config) ->
-ifdef(test2).
-record(test2, {g}).
- -endif.">>,
+ -endif.
+ ">>,
ok = file:write_file(Test, Contents),
+ {ok, test} = compile:file(Test, [{outdir, BeamDir}]),
RR5 = "rr(\"" ++ Test ++ "\", '_', {d,test1}), rl([test1,test2]).",
A1 = erl_anno:new(1),
@@ -404,7 +411,11 @@ records(Config) when is_list(Config) ->
Dir = filename:join(proplists:get_value(priv_dir, Config), "*.erl"),
RR8 = "rp(rr(\"" ++ Dir ++ "\")).",
[_,ok] = scan(RR8),
+
+ {module, test} = code:load_abs(BeamFile),
+ [[state]] = scan(<<"rr(test).">>),
file:delete(Test),
+ file:delete(BeamFile++".beam"),
RR1000 = "begin rr(" ++ MS ++ ") end.",
[_] = scan(RR1000),
@@ -477,6 +488,48 @@ records(Config) when is_list(Config) ->
ok.
+%% Test of typed record support.
+typed_records(Config) when is_list(Config) ->
+ Test = filename:join(proplists:get_value(priv_dir, Config), "test.hrl"),
+ Contents = <<"-module(test).
+ -record(r0,{f :: any()}).
+ -record(r1,{f1 :: #r1{} | undefined, f2 :: #r0{} | atom()}).
+ -record(r2,{f :: #r2{} | undefined}).
+ ">>,
+ ok = file:write_file(Test, Contents),
+
+ RR1 = "rr(\"" ++ Test ++ "\"),
+ #r1{} = (#r1{f1=#r1{f1=undefined, f2=x}, f2 = #r0{}})#r1.f1,
+ ok.",
+ RR2 = "rr(\"" ++ Test ++ "\"),
+ #r0{} = (#r1{f1=#r1{f1=undefined, f2=x}, f2 = #r0{}})#r1.f2,
+ ok. ",
+ RR3 = "rr(\"" ++ Test ++ "\"),
+ #r1{f2=#r0{}} = (#r1{f1=#r1{f1=undefined, f2=#r0{}}, f2 = x})#r1.f1,
+ ok.",
+ RR4 = "rr(\"" ++ Test ++ "\"),
+ (#r1{f2 = #r0{}})#r1{f2 = x},
+ ok. ",
+ RR5 = "rr(\"" ++ Test ++ "\"),
+ (#r1{f2 = #r0{}})#r1{f1 = #r1{}},
+ ok. ",
+ RR6 = "rr(\"" ++ Test ++ "\"),
+ (#r2{f=#r2{f=undefined}})#r2.f,
+ ok.",
+ RR7 = "rr(\"" ++ Test ++ "\"),
+ #r2{} = (#r2{f=#r2{f=undefined}})#r2.f,
+ ok.",
+ [ok] = scan(RR1),
+ [ok] = scan(RR2),
+ [ok] = scan(RR3),
+ [ok] = scan(RR4),
+ [ok] = scan(RR5),
+ [ok] = scan(RR6),
+ [ok] = scan(RR7),
+
+ file:delete(Test),
+ ok.
+
%% Known bugs.
known_bugs(Config) when is_list(Config) ->
%% erl_eval:merge_bindings/2 cannot handle _removal_ of bindings.
@@ -2671,7 +2724,7 @@ prompt_err(B) ->
S = string:strip(S2, both, $"),
string:strip(S, right, $.).
-%% OTP-10302. Unicode.
+%% OTP-10302. Unicode. Also OTP-14285, Unicode atoms.
otp_10302(Config) when is_list(Config) ->
{ok,Node} = start_node(shell_suite_helper_2,
"-pa "++proplists:get_value(priv_dir,Config)++
@@ -2809,6 +2862,22 @@ otp_10302(Config) when is_list(Config) ->
" erl_eval:'-inside-an-interpreted-fun-'(65,\"\x{441}\")"
" .\n" = t({Node,Test13}),
+ %% Unicode atoms.
+ Test14 = <<"'\\x{447}\\x{435}'().">>,
+ "** exception error: undefined shell command '\\x{447}\\x{435}'/0.\n" =
+ t(Test14),
+ Test15 = <<"io:setopts([{encoding,utf8}]).
+ '\\x{447}\\x{435}'().">>,
+ "ok.\n** exception error: undefined shell command '\x{447}\x{435}'/0.\n" =
+ t({Node,Test15}),
+ Test16 = <<"shell_SUITE:'\\x{447}\\x{435}'().">>,
+ "** exception error: undefined function "
+ "shell_SUITE:'\\x{447}\\x{435}'/0.\n" = t(Test16),
+ Test17 = <<"io:setopts([{encoding,utf8}]).
+ shell_SUITE:'\\x{447}\\x{435}'().">>,
+ "ok.\n** exception error: undefined function "
+ "shell_SUITE:'\x{447}\x{435}'/0.\n" =
+ t({Node,Test17}),
test_server:stop_node(Node),
ok.
diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk
index f7bd21472c..8a83cdec1e 100644
--- a/lib/stdlib/vsn.mk
+++ b/lib/stdlib/vsn.mk
@@ -1 +1 @@
-STDLIB_VSN = 3.3
+STDLIB_VSN = 3.4.1
diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml
index e8de0ffce2..f85d963919 100644
--- a/lib/syntax_tools/doc/src/notes.xml
+++ b/lib/syntax_tools/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2007</year><year>2016</year>
+ <year>2007</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -32,6 +32,21 @@
<p>This document describes the changes made to the Syntax_Tools
application.</p>
+<section><title>Syntax_Tools 2.1.2</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Syntax_Tools 2.1.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl
index 1ca60ea73b..888cb71f51 100644
--- a/lib/syntax_tools/src/erl_tidy.erl
+++ b/lib/syntax_tools/src/erl_tidy.erl
@@ -301,6 +301,8 @@ file(Name, Opts) ->
{Child, ok} ->
ok;
{Child, {error, Reason}} ->
+ exit(Reason);
+ {'EXIT', Child, Reason} ->
exit(Reason)
end.
diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl
index 868f43b8ee..ae2c67c03e 100644
--- a/lib/syntax_tools/test/syntax_tools_SUITE.erl
+++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl
@@ -239,6 +239,12 @@ t_erl_tidy(Config) when is_list(Config) ->
DataDir = ?config(data_dir, Config),
File = filename:join(DataDir,"erl_tidy_tilde.erl"),
ok = erl_tidy:file(File, [{stdout, true}]),
+
+ %% OTP-14471.
+ Old = process_flag(trap_exit, true),
+ NonExisting = filename:join(DataDir,"non_existing_file.erl"),
+ {'EXIT',{error,{0,file,enoent}}} = (catch erl_tidy:file(NonExisting)),
+ true = process_flag(trap_exit, Old),
ok.
test_comment_scan([],_) -> ok;
diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk
index c5e363112b..9b33f1e1f4 100644
--- a/lib/syntax_tools/vsn.mk
+++ b/lib/syntax_tools/vsn.mk
@@ -1 +1 @@
-SYNTAX_TOOLS_VSN = 2.1.1
+SYNTAX_TOOLS_VSN = 2.1.2
diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml
index 6e66a957ab..922c2ac0f4 100644
--- a/lib/tools/doc/src/lcnt.xml
+++ b/lib/tools/doc/src/lcnt.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2009</year>
- <year>2016</year>
+ <year>2017</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
@@ -109,14 +109,6 @@
statistics. If the server held any lock statistics data before the collect then
that data is lost.
</p>
- <note>
- <p>
- When collection occurs the runtime system transitions to a single thread,
- blocking all other threads. No other tasks will be scheduled during this
- operation. Depending on the size of the data this might take a long time
- (several seconds) and cause timeouts in the system.
- </p>
- </note>
</desc>
</func>
@@ -322,24 +314,22 @@
<func>
<name>apply(Fun) -> term()</name>
<fsummary>Same as <c>apply(Fun, [])</c>.</fsummary>
+ <type>
+ <v>Fun = fun()</v>
+ </type>
<desc>
<p>Same as <c>apply(Fun, [])</c>.</p>
</desc>
</func>
<func>
<name>apply(Fun, Args) -> term()</name>
- <fsummary>Clears counters, applies function and collects the profiling results.</fsummary>
+ <fsummary>Same as <c>apply(Module, Function, Args)</c>.</fsummary>
<type>
<v>Fun = fun()</v>
<v>Args = [term()]</v>
</type>
<desc>
- <p> Clears the lock counters and then setups the instrumentation to save all destroyed locks.
- After setup the fun is called, passing the elements in <c>Args</c> as arguments.
- When the fun returns the statistics are immediately collected to the server. After the
- collection the instrumentation is returned to its previous behavior.
- The result of the applied fun is returned.
- </p>
+ <p>Same as <c>apply(Module, Function, Args)</c>.</p>
</desc>
</func>
<func>
@@ -357,6 +347,13 @@
collection the instrumentation is returned to its previous behavior.
The result of the applied function is returned.
</p>
+ <warning>
+ <p>
+ This function should only be used for micro-benchmarks; it sets <c>copy_save</c>
+ to <c>true</c> for the duration of the call, which can quickly lead to running
+ out of memory.
+ </p>
+ </warning>
</desc>
</func>
@@ -429,6 +426,68 @@
<desc> <p>Clear the internal counters. Same as <c>lcnt:clear(Node)</c>.</p></desc>
</func>
+ <func>
+ <name>rt_mask() -> [category_atom()]</name>
+ <fsummary>Same as <c>rt_mask(node())</c>.</fsummary>
+ <desc><p>Same as <c>rt_mask(node())</c>.</p></desc>
+ </func>
+
+ <func>
+ <name>rt_mask(Node) -> [category_atom()]</name>
+ <fsummary>Returns the current lock category mask.</fsummary>
+ <type>
+ <v>Node = node()</v>
+ </type>
+ <desc>
+ <p>
+ Refer to <c>rt_mask/2</c> for a list of valid categories. All
+ categories are enabled by default.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>rt_mask(Categories) -> ok | {error, copy_save_enabled}</name>
+ <fsummary>Same as <c>rt_mask(node(), Categories)</c>.</fsummary>
+ <type>
+ <v>Categories = [atom()]</v>
+ </type>
+ <desc><p>Same as <c>rt_mask(node(), Categories)</c>.</p></desc>
+ </func>
+
+ <func>
+ <name>rt_mask(Node, Categories) -> ok | {error, copy_save_enabled}</name>
+ <fsummary>Changes the lock category mask.</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Categories = [atom()]</v>
+ </type>
+ <desc>
+ <p>
+ Sets the lock category mask to the given categories.
+ </p>
+ <p>
+ This will fail if the <c>copy_save</c> option is enabled; see
+ <c>lcnt:rt_opt/2</c>.
+ </p>
+ <p>Valid categories are:</p>
+ <taglist>
+ <item><c>allocator</c></item>
+ <item><c>db</c> (ETS tables)</item>
+ <item><c>debug</c></item>
+ <item><c>distribution</c></item>
+ <item><c>generic</c></item>
+ <item><c>io</c></item>
+ <item><c>process</c></item>
+ <item><c>scheduler</c></item>
+ </taglist>
+ <p>
+ This list is subject to change at any time, as is the category any given lock
+ may belong to.
+ </p>
+ </desc>
+ </func>
+
<func>
<name>rt_opt({Type, bool()}) -> bool()</name>
<fsummary>Same as <c>rt_opt(node(), {Type, Opt})</c>.</fsummary>
@@ -442,16 +501,25 @@
<v>Type = copy_save | process_locks</v>
</type>
<desc>
- <p>Changes the lock counter behavior and returns the previous behaviour.</p>
<p>Option description:</p>
<taglist>
<tag><c>{copy_save, bool()}</c></tag>
- <item>Enable statistics saving from destroyed locks by copying. This might consume a lot of memory.
+ <item>Retains the statistics of destroyed locks.
<br/>Default: <c>false</c>
+ <warning>
+ <p>
+ This option will use a lot of memory when enabled, which must be
+ reclaimed with <c>lcnt:rt_clear</c>. Note that it makes no distinction
+ between locks that were destroyed and locks for which counting was
+ disabled, so enabling this option will disable changes to the lock
+ category mask.
+ </p>
+ </warning>
</item>
<tag><c>{process_locks, bool()}</c></tag>
- <item>Profile process locks.
+ <item>Profile process locks, equal to adding <c>process</c> to the lock category mask;
+ see <c>lcnt:rt_mask/2</c>
<br/>Default: <c>true</c>
</item>
</taglist>
diff --git a/lib/tools/doc/src/lcnt_chapter.xml b/lib/tools/doc/src/lcnt_chapter.xml
index 1981d66117..24b58136aa 100644
--- a/lib/tools/doc/src/lcnt_chapter.xml
+++ b/lib/tools/doc/src/lcnt_chapter.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2009</year><year>2016</year>
+ <year>2009</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -29,7 +29,7 @@
<approved>nobody</approved>
<checked>no</checked>
<date>2009-11-26</date>
- <rev>PA1</rev>
+ <rev>PA2</rev>
<file>lcnt_chapter.xml</file>
</header>
<p>
@@ -97,8 +97,11 @@ ok
ok
</pre>
<p>
- Another way to to profile a specific function is to use <c>lcnt:apply/3</c> or <c>lcnt:apply/1</c> which does <c>lcnt:clear/0</c> before the function and <c>lcnt:collect/0</c> after its invocation.
- It also sets <c>copy_save</c> to <c>true</c> for the duration of the function call
+ Another way to to profile a specific function is to use <c>lcnt:apply/3</c> or <c>lcnt:apply/1</c>
+ which does <c>lcnt:clear/0</c> before the function and <c>lcnt:collect/0</c> after its invocation.
+ This method should only be used in micro-benchmarks since it sets <c>copy_save</c> to <c>true</c>
+ for the duration of the function call, which may cause the emulator to run out of memory if
+ attempted under load.
</p>
<pre>
Erlang R13B03 (erts-5.7.4) [source] [smp:8:8] [rq:8] [async-threads:0] [hipe]
diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml
index bc17fd5307..f0df43bf2b 100644
--- a/lib/tools/doc/src/notes.xml
+++ b/lib/tools/doc/src/notes.xml
@@ -31,6 +31,61 @@
</header>
<p>This document describes the changes made to the Tools application.</p>
+<section><title>Tools 2.10.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ In OTP-20.0, the behavior of c, make, and ct_make was
+ changed so that in some cases the beam files by default
+ would be written to the directory where the source files
+ were found. This is now changed back to the old behavior
+ so beam files are by default written to current
+ directory.</p>
+ <p>
+ Own Id: OTP-14489 Aux Id: ERL-438 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Tools 2.10</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ In some situations, <c>make:all()</c> and friends did not
+ detect changes in include files located in the current
+ directory. This is now corrected.</p>
+ <p>
+ Own Id: OTP-14339 Aux Id: ERL-395 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>The <c>make</c> module now accepts the
+ <c>{emake,Emake}</c> option.</p>
+ <p>
+ Own Id: OTP-14253</p>
+ </item>
+ <item>
+ <p> Miscellaneous updates due to atoms containing
+ arbitrary Unicode characters. </p>
+ <p>
+ Own Id: OTP-14285</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Tools 2.9.1</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
index e2db4f0148..5517882ffa 100644
--- a/lib/tools/src/cover.erl
+++ b/lib/tools/src/cover.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-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.
@@ -2414,8 +2414,8 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) ->
{ok, InFd} ->
case file:open(OutFile, [write,raw,delayed_write]) of
{ok, OutFd} ->
+ Enc = encoding(ErlFile),
if HTML ->
- Encoding = encoding(ErlFile),
Header =
["<!DOCTYPE HTML PUBLIC "
"\"-//W3C//DTD HTML 3.2 Final//EN\">\n"
@@ -2423,13 +2423,14 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) ->
"<head>\n"
"<meta http-equiv=\"Content-Type\""
" content=\"text/html; charset=",
- Encoding,"\"/>\n"
+ html_encoding(Enc),"\"/>\n"
"<title>",OutFile,"</title>\n"
"</head>"
"<body style='background-color: white;"
" color: black'>\n"
"<pre>\n"],
- ok = file:write(OutFd,Header);
+ H1Bin = unicode:characters_to_binary(Header,Enc,Enc),
+ ok = file:write(OutFd,H1Bin);
true -> ok
end,
@@ -2443,12 +2444,15 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) ->
string:right(integer_to_list(H), 2, $0),
string:right(integer_to_list(Mi), 2, $0),
string:right(integer_to_list(S), 2, $0)]),
- ok = file:write(OutFd,
- ["File generated from ",ErlFile," by COVER ",
+
+ H2Bin = unicode:characters_to_binary(
+ ["File generated from ",ErlFile," by COVER ",
Timestamp,"\n\n"
"**************************************"
"**************************************"
- "\n\n"]),
+ "\n\n"],
+ Enc, Enc),
+ ok = file:write(OutFd, H2Bin),
Pattern = {#bump{module=Module,line='$1',_='_'},'$2'},
MS = [{Pattern,[{is_integer,'$1'},{'>','$1',0}],[{{'$1','$2'}}]}],
@@ -2752,16 +2756,22 @@ pmap_collect(Mons,Acc) ->
end.
%%%-----------------------------------------------------------------
-%%% Read encoding from source file
+%%% Decide which encoding to use when analyzing to file.
+%%% The target file contains the file path, so if either the file name
+%%% encoding or the encoding of the source file is utf8, then we need
+%%% to use utf8.
encoding(File) ->
- Encoding =
- case epp:read_encoding(File) of
- none ->
- epp:default_encoding();
- E ->
- E
- end,
- html_encoding(Encoding).
+ case file:native_name_encoding() of
+ latin1 ->
+ case epp:read_encoding(File) of
+ none ->
+ epp:default_encoding();
+ E ->
+ E
+ end;
+ utf8 ->
+ utf8
+ end.
html_encoding(latin1) ->
"iso-8859-1";
diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl
index d881fedbd5..139b3d8a4a 100644
--- a/lib/tools/src/lcnt.erl
+++ b/lib/tools/src/lcnt.erl
@@ -34,8 +34,11 @@
-export([start/0,
stop/0]).
-%% erts_debug:lock_counters api
--export([rt_collect/0,
+%% erts_debug:lcnt_xxx api
+-export([rt_mask/0,
+ rt_mask/1,
+ rt_mask/2,
+ rt_collect/0,
rt_collect/1,
rt_clear/0,
rt_clear/1,
@@ -134,27 +137,61 @@ start_internal() ->
%% -------------------------------------------------------------------- %%
%%
-%% API erts_debug:lock_counters
+%% API erts_debug:lcnt_xxx
%%
%% -------------------------------------------------------------------- %%
-rt_collect() ->
- erts_debug:lock_counters(info).
+rt_mask(Node, Categories) when is_atom(Node), is_list(Categories) ->
+ rpc:call(Node, lcnt, rt_mask, [Categories]).
+
+rt_mask(Node) when is_atom(Node) ->
+ rpc:call(Node, lcnt, rt_mask, []);
+
+rt_mask(Categories) when is_list(Categories) ->
+ case erts_debug:lcnt_control(copy_save) of
+ false ->
+ erts_debug:lcnt_control(mask, Categories);
+ true ->
+ {error, copy_save_enabled}
+ end.
+
+rt_mask() ->
+ erts_debug:lcnt_control(mask).
rt_collect(Node) ->
- rpc:call(Node, erts_debug, lock_counters, [info]).
+ rpc:call(Node, lcnt, rt_collect, []).
+rt_collect() ->
+ erts_debug:lcnt_collect().
+rt_clear(Node) ->
+ rpc:call(Node, lcnt, rt_clear, []).
rt_clear() ->
- erts_debug:lock_counters(clear).
+ erts_debug:lcnt_clear().
-rt_clear(Node) ->
- rpc:call(Node, erts_debug, lock_counters, [clear]).
+rt_opt(Node, Arg) ->
+ rpc:call(Node, lcnt, rt_opt, [Arg]).
-rt_opt({Type, Opt}) ->
- erts_debug:lock_counters({Type, Opt}).
+%% Compatibility shims for the "process/port_locks" options mentioned in the
+%% manual.
+rt_opt({process_locks, Enable}) ->
+ toggle_category(process, Enable);
+rt_opt({port_locks, Enable}) ->
+ toggle_category(io, Enable);
-rt_opt(Node, {Type, Opt}) ->
- rpc:call(Node, erts_debug, lock_counters, [{Type, Opt}]).
+rt_opt({Type, NewVal}) ->
+ PreviousVal = erts_debug:lcnt_control(Type),
+ erts_debug:lcnt_control(Type, NewVal),
+ PreviousVal.
+
+toggle_category(Category, true) ->
+ PreviousMask = erts_debug:lcnt_control(mask),
+ erts_debug:lcnt_control(mask, [Category | PreviousMask]),
+ lists:member(Category, PreviousMask);
+
+toggle_category(Category, false) ->
+ PreviousMask = erts_debug:lcnt_control(mask),
+ erts_debug:lcnt_control(mask, lists:delete(Category, PreviousMask)),
+ lists:member(Category, PreviousMask).
%% -------------------------------------------------------------------- %%
%%
@@ -192,13 +229,9 @@ call(Msg) -> gen_server:call(?MODULE, Msg, infinity).
%% -------------------------------------------------------------------- %%
apply(M,F,As) when is_atom(M), is_atom(F), is_list(As) ->
- ok = start_internal(),
- Opt = lcnt:rt_opt({copy_save, true}),
- lcnt:clear(),
- Res = erlang:apply(M,F,As),
- lcnt:collect(),
- lcnt:rt_opt({copy_save, Opt}),
- Res.
+ apply(fun() ->
+ erlang:apply(M,F,As)
+ end).
apply(Fun) when is_function(Fun) ->
lcnt:apply(Fun, []).
@@ -209,7 +242,9 @@ apply(Fun, As) when is_function(Fun) ->
lcnt:clear(),
Res = erlang:apply(Fun, As),
lcnt:collect(),
- lcnt:rt_opt({copy_save, Opt}),
+ %% _ is bound to silence a dialyzer warning; it used to fail silently and
+ %% we don't want to change the error semantics.
+ _ = lcnt:rt_opt({copy_save, Opt}),
Res.
all_conflicts() -> all_conflicts(time).
diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl
index ce30156db6..6554d338af 100644
--- a/lib/tools/src/make.erl
+++ b/lib/tools/src/make.erl
@@ -267,15 +267,47 @@ include_opt([]) ->
recompile(File, true, _Load, _Opts) ->
io:format("Out of date: ~ts\n",[File]);
-recompile(File, false, noload, Opts) ->
+recompile(File, false, Load, Opts) ->
io:format("Recompile: ~ts\n",[File]),
- compile:file(File, [report_errors, report_warnings, error_summary |Opts]);
-recompile(File, false, load, Opts) ->
- io:format("Recompile: ~ts\n",[File]),
- c:c(File, Opts);
-recompile(File, false, netload, Opts) ->
- io:format("Recompile: ~ts\n",[File]),
- c:nc(File, Opts).
+ case compile:file(File, [report_errors, report_warnings |Opts]) of
+ Ok when is_tuple(Ok), element(1,Ok)==ok ->
+ maybe_load(element(2,Ok), Load, Opts);
+ _Error ->
+ error
+ end.
+
+maybe_load(_Mod, noload, _Opts) ->
+ ok;
+maybe_load(Mod, Load, Opts) ->
+ %% We have compiled File with options Opts. Find out where the
+ %% output file went to, and load it.
+ case compile:output_generated(Opts) of
+ true ->
+ Dir = proplists:get_value(outdir,Opts,"."),
+ do_load(Dir, Mod, Load);
+ false ->
+ io:format("** Warning: No object file created - nothing loaded **~n"),
+ ok
+ end.
+
+do_load(Dir, Mod, load) ->
+ code:purge(Mod),
+ case code:load_abs(filename:join(Dir, Mod),Mod) of
+ {module,Mod} ->
+ {ok,Mod};
+ Other ->
+ Other
+ end;
+do_load(Dir, Mod, netload) ->
+ Obj = atom_to_list(Mod) ++ code:objfile_extension(),
+ Fname = filename:join(Dir, Obj),
+ case file:read_file(Fname) of
+ {ok,Bin} ->
+ rpc:eval_everywhere(code,load_binary,[Mod,Fname,Bin]),
+ {ok,Mod};
+ Other ->
+ Other
+ end.
exists(File) ->
case file:read_file_info(File) of
diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src
index 12f0cfd2df..8beef49bf9 100644
--- a/lib/tools/src/tools.app.src
+++ b/lib/tools/src/tools.app.src
@@ -41,6 +41,6 @@
]
},
{runtime_dependencies, ["stdlib-3.1","runtime_tools-1.8.14",
- "kernel-3.0","erts-7.0","compiler-5.0"]}
+ "kernel-5.4","erts-9.1","compiler-5.0"]}
]
}.
diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl
index 2e48b11740..146c915087 100644
--- a/lib/tools/test/lcnt_SUITE.erl
+++ b/lib/tools/test/lcnt_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.
@@ -151,10 +151,9 @@ t_swap_keys_file([File|Files]) ->
%% Simple smoke test of actual lock-counting, if running on
%% a run-time with lock-counting enabled.
-
smoke_lcnt(Config) ->
- case erlang:system_info(build_type) of
- lcnt ->
+ case catch erlang:system_info(lock_counting) of
+ true ->
do_smoke_lcnt(Config);
_ ->
{skip,"Lock counting is not enabled"}
diff --git a/lib/tools/test/make_SUITE.erl b/lib/tools/test/make_SUITE.erl
index 2f6fe1c732..02da4f4ace 100644
--- a/lib/tools/test/make_SUITE.erl
+++ b/lib/tools/test/make_SUITE.erl
@@ -36,7 +36,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [make_all, make_files, recompile_on_changed_include,
+ [make_all, make_files, load, netload, recompile_on_changed_include,
emake_opts, {group, otp_6057}].
groups() ->
@@ -55,6 +55,21 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
otp_6057_end(Config).
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(netload,_Config) ->
+ %% Stop slave - in case of failure
+ Nodes = nodes(),
+ case [N || N <- Nodes,
+ "make_SUITE_netload" == hd(string:lexemes(atom_to_list(N),"@"))] of
+ [Node] ->
+ ct_slave:stop(Node);
+ _ ->
+ ok
+ end;
+end_per_testcase(_,_Config) ->
+ ok.
test_files() -> ["test1", "test2", "test3", "test4"].
@@ -83,6 +98,32 @@ make_files(Config) when is_list(Config) ->
ensure_no_messages(),
ok.
+load(Config) ->
+ Current = prepare_data_dir(Config),
+ code:purge(test1),
+ code:delete(test1),
+ false = code:is_loaded(test1),
+ up_to_date = make:files([test1], [load]),
+ {file,_} = code:is_loaded(test1),
+ file:set_cwd(Current),
+ ensure_no_messages(),
+ ok.
+
+netload(Config) ->
+ Current = prepare_data_dir(Config),
+ code:purge(test1),
+ code:delete(test1),
+ false = code:is_loaded(test1),
+ {ok,Node} = ct_slave:start(make_SUITE_netload),
+ up_to_date = make:files([test1], [netload]),
+ timer:sleep(1000), % async, so give some time
+ {file,F} = code:is_loaded(test1),
+ {file,F} = rpc:call(Node,code,is_loaded,[test1]),
+ ct_slave:stop(Node),
+ file:set_cwd(Current),
+ ensure_no_messages(),
+ ok.
+
recompile_on_changed_include(Config) ->
Current = prepare_data_dir(Config),
diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk
index f60da27c44..831d850217 100644
--- a/lib/tools/vsn.mk
+++ b/lib/tools/vsn.mk
@@ -1 +1 @@
-TOOLS_VSN = 2.9.1
+TOOLS_VSN = 2.10.1
diff --git a/lib/wx/c_src/egl_impl.h b/lib/wx/c_src/egl_impl.h
index 7ecd484de5..f52f68c84a 100644
--- a/lib/wx/c_src/egl_impl.h
+++ b/lib/wx/c_src/egl_impl.h
@@ -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.
diff --git a/lib/wx/doc/src/notes.xml b/lib/wx/doc/src/notes.xml
index 9086117c81..d300ab5128 100644
--- a/lib/wx/doc/src/notes.xml
+++ b/lib/wx/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2009</year><year>2016</year>
+ <year>2009</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -32,6 +32,21 @@
<p>This document describes the changes made to the wxErlang
application.</p>
+<section><title>Wx 1.8.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix a livelock that could be caused by <c>wx:batch/1</c>.</p>
+ <p>
+ Own Id: OTP-14289</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Wx 1.8</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk
index cfa256fb12..b9100e7c87 100644
--- a/lib/wx/vsn.mk
+++ b/lib/wx/vsn.mk
@@ -1 +1 @@
-WX_VSN = 1.8
+WX_VSN = 1.8.1
diff --git a/lib/xmerl/doc/src/notes.xml b/lib/xmerl/doc/src/notes.xml
index ef4831e6ec..1162561225 100644
--- a/lib/xmerl/doc/src/notes.xml
+++ b/lib/xmerl/doc/src/notes.xml
@@ -32,6 +32,46 @@
<p>This document describes the changes made to the Xmerl application.</p>
+<section><title>Xmerl 1.3.15</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Improves accumulator fun in xmerl_scan so that only one
+ #xmlText record is returned for strings which have
+ character references.</p>
+ <p>
+ (Thanks to Jimmy Zöger)</p>
+ <p>
+ Own Id: OTP-14377 Aux Id: PR-1369 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Xmerl 1.3.14</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> A couple of bugs are fixed in the sax parser
+ (xmerl_sax_parser). </p> <list> <item>The continuation
+ function was not called correctly when the XML directive
+ was fragmented. </item> <item>When the event callback
+ modules (xmerl_sax_old_dom and xmerl_sax_simple) got an
+ endDocument event at certain conditions the parser
+ crashed.</item> <item>Replaced internal ets table with
+ map to avoid table leakage.</item> </list>
+ <p>
+ Own Id: OTP-14430</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Xmerl 1.3.13</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/xmerl/src/xmerl_sax_old_dom.erl b/lib/xmerl/src/xmerl_sax_old_dom.erl
index fefcf03fce..6d0d836487 100644
--- a/lib/xmerl/src/xmerl_sax_old_dom.erl
+++ b/lib/xmerl/src/xmerl_sax_old_dom.erl
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -127,9 +127,10 @@ build_dom(endDocument,
State#xmerl_sax_old_dom_state{dom=[Decl, Current#xmlElement{
content=lists:reverse(C)
}]};
- _ ->
- %%?dbg("~p\n", [D]),
- ?error("we're not at end the document when endDocument event is encountered.")
+ _ ->
+ %% endDocument is also sent by the parser when a fault occur to tell
+ %% the event receiver that no more input will be sent
+ State
end;
%% Element
diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl
index 1aef6c58c4..e383c4c349 100644
--- a/lib/xmerl/src/xmerl_sax_parser.erl
+++ b/lib/xmerl/src/xmerl_sax_parser.erl
@@ -64,7 +64,7 @@
%% Description: Parse file containing an XML document.
%%----------------------------------------------------------------------
file(Name,Options) ->
- case file:open(Name, [raw, read,binary]) of
+ case file:open(Name, [raw, read_ahead, read,binary]) of
{error, Reason} ->
{error,{Name, file:format_error(Reason)}};
{ok, FD} ->
@@ -120,21 +120,22 @@ stream(Xml, Options, InputType) when is_binary(Xml), is_list(Options) ->
normal ->
parse
end,
- case detect_charset(Xml, State) of
- {error, Reason} -> {fatal_error,
- {
- State#xmerl_sax_parser_state.current_location,
- State#xmerl_sax_parser_state.entity,
- 1
- },
- Reason,
- [],
- State#xmerl_sax_parser_state.event_state};
- {Xml1, State1} ->
- parse_binary(Xml1,
- State1#xmerl_sax_parser_state{input_type = InputType},
- ParseFunction)
- end
+ try
+ {Xml1, State1} = detect_charset(Xml, State),
+ parse_binary(Xml1,
+ State1#xmerl_sax_parser_state{input_type = InputType},
+ ParseFunction)
+ catch
+ throw:{fatal_error, {State2, Reason}} ->
+ {fatal_error,
+ {
+ State2#xmerl_sax_parser_state.current_location,
+ State2#xmerl_sax_parser_state.entity,
+ 1
+ },
+ Reason, [],
+ State2#xmerl_sax_parser_state.event_state}
+ end
end.
%%----------------------------------------------------------------------
@@ -156,8 +157,8 @@ parse_binary(Xml, #xmerl_sax_parser_state{encoding={utf16,big}}=State, F) ->
xmerl_sax_parser_utf16be:F(Xml, State);
parse_binary(Xml, #xmerl_sax_parser_state{encoding=latin1}=State, F) ->
xmerl_sax_parser_latin1:F(Xml, State);
-parse_binary(_, #xmerl_sax_parser_state{encoding=Enc}, _) ->
- {error, lists:flatten(io_lib:format("Charcter set ~p not supported", [Enc]))}.
+parse_binary(_, #xmerl_sax_parser_state{encoding=Enc}, State) ->
+ ?fatal_error(State, lists:flatten(io_lib:format("Charcter set ~p not supported", [Enc]))).
%%----------------------------------------------------------------------
%% Function: initial_state/0
@@ -211,8 +212,7 @@ parse_options([{entity, Entity} |Options], State) ->
parse_options([skip_external_dtd |Options], State) ->
parse_options(Options, State#xmerl_sax_parser_state{skip_external_dtd = true});
parse_options([O |_], _State) ->
- {error,
- lists:flatten(io_lib:format("Option: ~p not supported", [O]))}.
+ {error, lists:flatten(io_lib:format("Option: ~p not supported", [O]))}.
check_encoding_option(E) when E==utf8; E=={utf16,little}; E=={utf16,big};
@@ -230,16 +230,10 @@ check_encoding_option(E) ->
%% Output: {utf8|utf16le|utf16be|iso8859, Xml, State}
%% Description: Detects which character set is used in a binary stream.
%%----------------------------------------------------------------------
-detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = _) ->
- {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
- {<<>>, _} ->
- {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;
+detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = State) ->
+ ?fatal_error(State, "Can't detect character encoding due to lack of indata");
+detect_charset(<<>>, State) ->
+ cf(<<>>, State, fun detect_charset/2);
detect_charset(Bytes, State) ->
case unicode:bom_to_encoding(Bytes) of
{latin1, 0} ->
@@ -249,25 +243,47 @@ detect_charset(Bytes, State) ->
{RealBytes, State#xmerl_sax_parser_state{encoding=Enc}}
end.
+detect_charset_1(<<16#00>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
+detect_charset_1(<<16#00, 16#3C>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
+detect_charset_1(<<16#00, 16#3C, 16#00>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
detect_charset_1(<<16#00, 16#3C, 16#00, 16#3F, _/binary>> = Xml, State) ->
{Xml, State#xmerl_sax_parser_state{encoding={utf16, big}}};
+detect_charset_1(<<16#3C>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
+detect_charset_1(<<16#3C, 16#00>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
+detect_charset_1(<<16#3C, 16#00, 16#3F>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
detect_charset_1(<<16#3C, 16#00, 16#3F, 16#00, _/binary>> = Xml, State) ->
{Xml, State#xmerl_sax_parser_state{encoding={utf16, little}}};
-detect_charset_1(<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml2/binary>> = Xml, State) ->
- case parse_xml_directive(Xml2) of
+detect_charset_1(<<16#3C>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
+detect_charset_1(<<16#3C, 16#3F>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
+detect_charset_1(<<16#3C, 16#3F, 16#78>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
+detect_charset_1(<<16#3C, 16#3F, 16#78, 16#6D>> = Xml, State) ->
+ cf(Xml, State, fun detect_charset_1/2);
+detect_charset_1(<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml2/binary>>, State) ->
+ {Xml3, State1} = read_until_end_of_xml_directive(Xml2, State),
+ case parse_xml_directive(Xml3) of
{error, Reason} ->
- {error, Reason};
+ ?fatal_error(State, Reason);
AttrList ->
case lists:keysearch("encoding", 1, AttrList) of
{value, {_, E}} ->
case convert_encoding(E) of
{error, Reason} ->
- {error, Reason};
+ ?fatal_error(State, Reason);
Enc ->
- {Xml, State#xmerl_sax_parser_state{encoding=Enc}}
+ {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>,
+ State1#xmerl_sax_parser_state{encoding=Enc}}
end;
_ ->
- {Xml, State}
+ {<<16#3C, 16#3F, 16#78, 16#6D, 16#6C, Xml3/binary>>, State1}
end
end;
detect_charset_1(Xml, State) ->
@@ -377,7 +393,7 @@ parse_value_1(<<C, Rest/binary>>, Stop, Acc) ->
parse_value_1(Rest, Stop, [C |Acc]).
%%======================================================================
-%%Default functions
+%% Default functions
%%======================================================================
%%----------------------------------------------------------------------
%% Function: default_event_cb(Event, LineNo, State) -> Result
@@ -393,7 +409,7 @@ default_event_cb(_Event, _LineNo, State) ->
%%----------------------------------------------------------------------
%% Function: default_continuation_cb(IoDevice) -> Result
%% IoDevice = iodevice()
-%% Output: Result = {[char()], State}
+%% Output: Result = {binary(), IoDevice}
%% Description: Default continuation callback reading blocks.
%%----------------------------------------------------------------------
default_continuation_cb(IoDevice) ->
@@ -403,3 +419,82 @@ default_continuation_cb(IoDevice) ->
{ok, FileBin} ->
{FileBin, IoDevice}
end.
+
+%%----------------------------------------------------------------------
+%% Function: read_until_end_of_xml_directive(Rest, State) -> Result
+%% Rest = binary()
+%% Output: Result = {binary(), State}
+%% Description: Reads a utf8 or latin1 until it finds '?>'
+%%----------------------------------------------------------------------
+read_until_end_of_xml_directive(Rest, State) ->
+ case binary:match(Rest, <<"?>">>) of
+ nomatch ->
+ case cf(Rest, State) of
+ {<<>>, _} ->
+ ?fatal_error(State, "Can't detect character encoding due to lack of indata");
+ {NewBytes, NewState} ->
+ read_until_end_of_xml_directive(NewBytes, NewState)
+ end;
+ _ ->
+ {Rest, State}
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Function : cf(Rest, State) -> Result
+%% Parameters: Rest = binary()
+%% State = #xmerl_sax_parser_state{}
+%% NextCall = fun()
+%% Result : {Rest, State}
+%% Description: Function that uses provided fun to read another chunk from
+%% input stream and calls the fun in NextCall.
+%%----------------------------------------------------------------------
+cf(_Rest, #xmerl_sax_parser_state{continuation_fun = undefined} = State) ->
+ ?fatal_error(State, "Continuation function undefined");
+cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State) ->
+ Result =
+ try
+ CFun(CState)
+ catch
+ throw:ErrorTerm ->
+ ?fatal_error(State, ErrorTerm);
+ exit:Reason ->
+ ?fatal_error(State, {'EXIT', Reason})
+ end,
+ case Result of
+ {<<>>, _} ->
+ ?fatal_error(State, "Can't detect character encoding due to lack of indata");
+ {NewBytes, NewContState} ->
+ {<<Rest/binary, NewBytes/binary>>,
+ State#xmerl_sax_parser_state{continuation_state = NewContState}}
+ end.
+
+%%----------------------------------------------------------------------
+%% Function : cf(Rest, State, NextCall) -> Result
+%% Parameters: Rest = binary()
+%% State = #xmerl_sax_parser_state{}
+%% NextCall = fun()
+%% Result : {Rest, State}
+%% Description: Function that uses provided fun to read another chunk from
+%% input stream and calls the fun in NextCall.
+%%----------------------------------------------------------------------
+cf(_Rest, #xmerl_sax_parser_state{continuation_fun = undefined} = State, _) ->
+ ?fatal_error(State, "Continuation function undefined");
+cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = CState} = State,
+ NextCall) ->
+ Result =
+ try
+ CFun(CState)
+ catch
+ throw:ErrorTerm ->
+ ?fatal_error(State, ErrorTerm);
+ exit:Reason ->
+ ?fatal_error(State, {'EXIT', Reason})
+ end,
+ case Result of
+ {<<>>, _} ->
+ ?fatal_error(State, "Can't detect character encoding due to lack of indata");
+ {NewBytes, NewContState} ->
+ NextCall(<<Rest/binary, NewBytes/binary>>,
+ State#xmerl_sax_parser_state{continuation_state = NewContState})
+ end.
diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
index f3470b2809..1dca9608cb 100644
--- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
@@ -64,38 +64,42 @@
%% Description: Parsing XML from input stream.
%%----------------------------------------------------------------------
parse(Xml, State) ->
- RefTable = ets:new(xmerl_sax_entity_refs, [private]),
-
- State1 = event_callback(startDocument, State),
-
- case catch parse_document(Xml, State1#xmerl_sax_parser_state{ref_table=RefTable}) of
- {ok, Rest, State2} ->
- State3 = event_callback(endDocument, State2),
- ets:delete(RefTable),
- 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),
- format_error(fatal_error, State3, Reason);
- {event_receiver_error, State2, {Tag, Reason}} ->
- 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),
- {fatal_error, Other}
+ RefTable = maps:new(),
+
+ try
+ State1 = event_callback(startDocument, State),
+ Result = parse_document(Xml, State1#xmerl_sax_parser_state{ref_table=RefTable}),
+ handle_end_document(Result)
+ catch
+ throw:Exception ->
+ handle_end_document(Exception);
+ _:OtherError ->
+ handle_end_document({other, OtherError, State})
end.
+ % case catch parse_document(Xml, State1#xmerl_sax_parser_state{ref_table=RefTable}) of
+ % {ok, Rest, State2} ->
+ % State3 = event_callback(endDocument, State2),
+ % 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),
+ % format_error(fatal_error, State3, Reason);
+ % {event_receiver_error, State2, {Tag, Reason}} ->
+ % State3 = event_callback(endDocument, State2),
+ % format_error(Tag, State3, Reason);
+ % {endDocument, Rest, State2} ->
+ % State3 = event_callback(endDocument, State2),
+ % {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ % Other ->
+ % _State2 = event_callback(endDocument, State1),
+ % {fatal_error, Other}
+ % end.
+
%%----------------------------------------------------------------------
%% Function: parse_dtd(Xml, State) -> Result
%% Input: Xml = string() | binary()
@@ -105,38 +109,120 @@ parse(Xml, State) ->
%% Description: Parsing XML DTD from input stream.
%%----------------------------------------------------------------------
parse_dtd(Xml, State) ->
- RefTable = ets:new(xmerl_sax_entity_refs, [private]),
-
- State1 = event_callback(startDocument, State),
-
- case catch parse_external_entity_1(Xml, State1#xmerl_sax_parser_state{ref_table=RefTable}) of
- {fatal_error, {State2, Reason}} ->
- State3 = event_callback(endDocument, State2),
- ets:delete(RefTable),
- format_error(fatal_error, State3, Reason);
- {event_receiver_error, State2, {Tag, Reason}} ->
- State3 = event_callback(endDocument, State2),
- format_error(Tag, State3, Reason);
- {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};
- {endDocument, 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};
- Other ->
- _State2 = event_callback(endDocument, State1),
- ets:delete(RefTable),
- {fatal_error, Other}
+ RefTable = maps:new(),
+
+ try
+ State1 = event_callback(startDocument, State),
+ Result = parse_external_entity_1(Xml, State1#xmerl_sax_parser_state{ref_table=RefTable}),
+ handle_end_document(Result)
+ catch
+ throw:Exception ->
+ handle_end_document(Exception);
+ _:OtherError ->
+ handle_end_document({other, OtherError, State})
end.
+ % case catch parse_external_entity_1(Xml, State1#xmerl_sax_parser_state{ref_table=RefTable}) of
+ % {fatal_error, {State2, Reason}} ->
+ % State3 = event_callback(endDocument, State2),
+ % format_error(fatal_error, State3, Reason);
+ % {event_receiver_error, State2, {Tag, Reason}} ->
+ % State3 = event_callback(endDocument, State2),
+ % format_error(Tag, State3, Reason);
+ % {Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
+ % State3 = event_callback(endDocument, State2),
+ % {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),
+ % {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ % Other ->
+ % _State2 = event_callback(endDocument, State1),
+ % {fatal_error, Other}
+ % end.
+
+
%%======================================================================
%% Internal functions
%%======================================================================
%%----------------------------------------------------------------------
+%% Function: handle_end_document(ParserResult) -> Result
+%% Input: ParseResult = term()
+%% Output: Result = {ok, Rest, EventState} |
+%% EventState = term()
+%% Description: Ends the parsing and formats output
+%%----------------------------------------------------------------------
+handle_end_document({ok, Rest, State}) ->
+ %%ok case from parse
+ try
+ State1 = event_callback(endDocument, State),
+ case check_if_rest_ok(State1#xmerl_sax_parser_state.input_type, Rest) of
+ true ->
+ {ok, State1#xmerl_sax_parser_state.event_state, Rest};
+ false ->
+ format_error(fatal_error, State1, "Input found after legal document")
+ end
+ catch
+ throw:{event_receiver_error, State2, {Tag, Reason}} ->
+ format_error(Tag, State2, Reason);
+ _:Other ->
+ {fatal_error, Other}
+ end;
+handle_end_document({endDocument, Rest, State}) ->
+ %% ok case from parse and parse_dtd
+ try
+ State1 = event_callback(endDocument, State),
+ {ok, State1#xmerl_sax_parser_state.event_state, Rest}
+ catch
+ throw:{event_receiver_error, State2, {Tag, Reason}} ->
+ format_error(Tag, State2, Reason);
+ _:Other ->
+ {fatal_error, Other}
+ end;
+handle_end_document({fatal_error, {State, Reason}}) ->
+ try
+ State1 = event_callback(endDocument, State),
+ format_error(fatal_error, State1, Reason)
+ catch
+ throw:{event_receiver_error, State2, {Tag, Reason}} ->
+ format_error(Tag, State2, Reason);
+ _:Other ->
+ {fatal_error, Other}
+ end;
+handle_end_document({event_receiver_error, State, {Tag, Reason}}) ->
+ try
+ State1 = event_callback(endDocument, State),
+ format_error(Tag, State1, Reason)
+ catch
+ throw:{event_receiver_error, State2, {Tag, Reason}} ->
+ format_error(Tag, State2, Reason);
+ _:Other ->
+ {fatal_error, Other}
+ end;
+handle_end_document({Rest, State}) when is_record(State, xmerl_sax_parser_state) ->
+ %%ok case from parse_dtd
+ try
+ State1 = event_callback(endDocument, State),
+ {ok, State1#xmerl_sax_parser_state.event_state, Rest}
+ catch
+ throw:{event_receiver_error, State2, {Tag, Reason}} ->
+ format_error(Tag, State2, Reason);
+ _:Other ->
+ {fatal_error, Other}
+ end;
+handle_end_document({other, Error, State}) ->
+ try
+ _State1 = event_callback(endDocument, State),
+ {fatal_error, Error}
+ catch
+ throw:{event_receiver_error, State2, {Tag, Reason}} ->
+ format_error(Tag, State2, Reason);
+ _:Other ->
+ {fatal_error, Other}
+ end.
+
+%%----------------------------------------------------------------------
%% Function: parse_document(Rest, State) -> Result
%% Input: Rest = string() | binary()
%% State = #xmerl_sax_parser_state{}
@@ -439,6 +525,7 @@ check_if_rest_ok(stream, _) ->
check_if_rest_ok(_, _) ->
false.
+
%%----------------------------------------------------------------------
%% Function: parse_pi_1(Rest, State) -> Result
%% Input: Rest = string() | binary()
@@ -883,11 +970,11 @@ send_end_prefix_mapping_event([{Prefix, _Uri} |Ns], State) ->
parse_eq(?STRING_EMPTY, State) ->
cf(?STRING_EMPTY, State, fun parse_eq/2);
parse_eq(?STRING_REST("=", Rest), State) ->
- {Rest, State};
+ {Rest, State};
parse_eq(?STRING_UNBOUND_REST(C, _) = Bytes, State) when ?is_whitespace(C) ->
- {_WS, Rest, State1} =
- whitespace(Bytes, State, []),
- parse_eq(Rest, State1);
+ {_WS, Rest, State1} =
+ whitespace(Bytes, State, []),
+ parse_eq(Rest, State1);
parse_eq(Bytes, State) ->
unicode_incomplete_check([Bytes, State, fun parse_eq/2],
"expecting = or whitespace").
@@ -905,11 +992,11 @@ parse_eq(Bytes, State) ->
parse_att_value(?STRING_EMPTY, State) ->
cf(?STRING_EMPTY, State, fun parse_att_value/2);
parse_att_value(?STRING_UNBOUND_REST(C, Rest), State) when C == $'; C == $" ->
- parse_att_value(Rest, State, C, []);
+ parse_att_value(Rest, State, C, []);
parse_att_value(?STRING_UNBOUND_REST(C, _) = Bytes, State) when ?is_whitespace(C) ->
- {_WS, Rest, State1} =
- whitespace(Bytes, State, []),
- parse_att_value(Rest, State1);
+ {_WS, Rest, State1} =
+ whitespace(Bytes, State, []),
+ parse_att_value(Rest, State1);
parse_att_value(Bytes, State) ->
unicode_incomplete_check([Bytes, State, fun parse_att_value/2],
"\', \" or whitespace expected").
@@ -1360,17 +1447,20 @@ parse_pe_reference_1(Bytes, State, Name) ->
%%----------------------------------------------------------------------
-%% Function: insert_reference(Reference, State) -> Result
-%% Parameters: Reference = string()
+%% Function: insert_reference(Name, Ref, State) -> Result
+%% Parameters: Name = string()
+%% Ref = {Type, Value}
+%% Type = atom()
+%% Value = term()
%% State = #xmerl_sax_parser_state{}
%% Result :
%%----------------------------------------------------------------------
-insert_reference({Name, Type, Value}, Table) ->
- case ets:lookup(Table, Name) of
- [{Name, _, _}] ->
- ok;
+insert_reference(Name, Value, #xmerl_sax_parser_state{ref_table = Map} = State) ->
+ case maps:find(Name, Map) of
+ error ->
+ State#xmerl_sax_parser_state{ref_table = maps:put(Name, Value, Map)};
_ ->
- ets:insert(Table, {Name, Type, Value})
+ State
end.
@@ -1391,8 +1481,8 @@ look_up_reference("apos", _, _) ->
look_up_reference("quot", _, _) ->
{internal_general, "quot", "\""};
look_up_reference(Name, HaveToExist, State) ->
- case ets:lookup(State#xmerl_sax_parser_state.ref_table, Name) of
- [{Name, Type, Value}] ->
+ case maps:find(Name, State#xmerl_sax_parser_state.ref_table) of
+ {ok, {Type, Value}} ->
{Type, Name, Value};
_ ->
case HaveToExist of
@@ -1474,7 +1564,7 @@ parse_system_litteral(?STRING_EMPTY, State, Stop, Acc) ->
parse_system_litteral(?STRING_UNBOUND_REST(Stop, Rest), State, Stop, Acc) ->
{lists:reverse(Acc), Rest, State};
parse_system_litteral(?STRING_UNBOUND_REST(C, Rest), State, Stop, Acc) ->
- parse_system_litteral(Rest, State, Stop, [C |Acc]);
+ parse_system_litteral(Rest, State, Stop, [C |Acc]);
parse_system_litteral(Bytes, State, Stop, Acc) ->
unicode_incomplete_check([Bytes, State, Stop, Acc, fun parse_system_litteral/4],
undefined).
@@ -1646,9 +1736,11 @@ parse_external_entity(State, _PubId, SysId) ->
end_tags = []},
- EventState = handle_external_entity(ExtRef, State1),
+ {EventState, RefTable} = handle_external_entity(ExtRef, State1),
- NewState = event_callback({endEntity, SysId}, SaveState#xmerl_sax_parser_state{event_state=EventState}),
+ NewState = event_callback({endEntity, SysId},
+ SaveState#xmerl_sax_parser_state{event_state=EventState,
+ ref_table=RefTable}),
NewState#xmerl_sax_parser_state{file_type=normal}.
@@ -1675,7 +1767,8 @@ handle_external_entity({file, FileToOpen}, State) ->
entity=filename:basename(FileToOpen),
input_type=file}),
ok = file:close(FD),
- EntityState#xmerl_sax_parser_state.event_state
+ {EntityState#xmerl_sax_parser_state.event_state,
+ EntityState#xmerl_sax_parser_state.ref_table}
end;
handle_external_entity({http, Url}, State) ->
@@ -1695,7 +1788,9 @@ handle_external_entity({http, Url}, State) ->
input_type=file}),
ok = file:close(FD),
ok = file:delete(TmpFile),
- EntityState#xmerl_sax_parser_state.event_state
+ {EntityState#xmerl_sax_parser_state.event_state,
+ EntityState#xmerl_sax_parser_state.ref_table}
+
end
catch
throw:{error, Error} ->
@@ -1716,7 +1811,7 @@ handle_external_entity({Tag, _Url}, State) ->
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) ->
- {Rest, State};
+ {Rest, State1};
{fatal_error, {State1, "No more bytes"}} when Type == dtd; Type == entity ->
{?STRING_EMPTY, State1};
Other ->
@@ -2442,24 +2537,24 @@ parse_entity_def(?STRING_EMPTY, State, Name) ->
cf(?STRING_EMPTY, State, Name, fun parse_entity_def/3);
parse_entity_def(?STRING_UNBOUND_REST(C, Rest), State, Name) when C == $'; C == $" ->
{Value, Rest1, State1} = parse_entity_value(Rest, State, C, []),
- insert_reference({Name, internal_general, Value}, State1#xmerl_sax_parser_state.ref_table),
- State2 = event_callback({internalEntityDecl, Name, Value}, State1),
- {_WS, Rest2, State3} = whitespace(Rest1, State2, []),
- parse_def_end(Rest2, State3);
+ State2 = insert_reference(Name, {internal_general, Value}, State1),
+ State3 = event_callback({internalEntityDecl, Name, Value}, State2),
+ {_WS, Rest2, State4} = whitespace(Rest1, State3, []),
+ parse_def_end(Rest2, State4);
parse_entity_def(?STRING_UNBOUND_REST(C, _) = Rest, State, Name) when C == $S; C == $P ->
{PubId, SysId, Rest1, State1} = parse_external_id(Rest, State, false),
{Ndata, Rest2, State2} = parse_ndata(Rest1, State1),
case Ndata of
undefined ->
- insert_reference({Name, external_general, {PubId, SysId}},
- State2#xmerl_sax_parser_state.ref_table),
- State3 = event_callback({externalEntityDecl, Name, PubId, SysId}, State2),
- {Rest2, State3};
+ State3 = insert_reference(Name, {external_general, {PubId, SysId}},
+ State2),
+ State4 = event_callback({externalEntityDecl, Name, PubId, SysId}, State3),
+ {Rest2, State4};
_ ->
- insert_reference({Name, unparsed, {PubId, SysId, Ndata}},
- State2#xmerl_sax_parser_state.ref_table),
- State3 = event_callback({unparsedEntityDecl, Name, PubId, SysId, Ndata}, State2),
- {Rest2, State3}
+ State3 = insert_reference(Name, {unparsed, {PubId, SysId, Ndata}},
+ State2),
+ State4 = event_callback({unparsedEntityDecl, Name, PubId, SysId, Ndata}, State3),
+ {Rest2, State4}
end;
parse_entity_def(Bytes, State, Name) ->
unicode_incomplete_check([Bytes, State, Name, fun parse_entity_def/3],
@@ -2636,19 +2731,19 @@ parse_pe_def(?STRING_EMPTY, State, Name) ->
parse_pe_def(?STRING_UNBOUND_REST(C, Rest), State, Name) when C == $'; C == $" ->
{Value, Rest1, State1} = parse_entity_value(Rest, State, C, []),
Name1 = "%" ++ Name,
- insert_reference({Name1, internal_parameter, Value},
- State1#xmerl_sax_parser_state.ref_table),
- State2 = event_callback({internalEntityDecl, Name1, Value}, State1),
- {_WS, Rest2, State3} = whitespace(Rest1, State2, []),
- parse_def_end(Rest2, State3);
+ State2 = insert_reference(Name1, {internal_parameter, Value},
+ State1),
+ State3 = event_callback({internalEntityDecl, Name1, Value}, State2),
+ {_WS, Rest2, State4} = whitespace(Rest1, State3, []),
+ parse_def_end(Rest2, State4);
parse_pe_def(?STRING_UNBOUND_REST(C, _) = Bytes, State, Name) when C == $S; C == $P ->
{PubId, SysId, Rest1, State1} = parse_external_id(Bytes, State, false),
Name1 = "%" ++ Name,
- insert_reference({Name1, external_parameter, {PubId, SysId}},
- State1#xmerl_sax_parser_state.ref_table),
- State2 = event_callback({externalEntityDecl, Name1, PubId, SysId}, State1),
- {_WS, Rest2, State3} = whitespace(Rest1, State2, []),
- parse_def_end(Rest2, State3);
+ State2 = insert_reference(Name1, {external_parameter, {PubId, SysId}},
+ State1),
+ State3 = event_callback({externalEntityDecl, Name1, PubId, SysId}, State2),
+ {_WS, Rest2, State4} = whitespace(Rest1, State3, []),
+ parse_def_end(Rest2, State4);
parse_pe_def(Bytes, State, Name) ->
unicode_incomplete_check([Bytes, State, Name, fun parse_pe_def/3],
"\", \', SYSTEM or PUBLIC expected").
diff --git a/lib/xmerl/src/xmerl_sax_simple_dom.erl b/lib/xmerl/src/xmerl_sax_simple_dom.erl
index 7eb3afd499..7b15cd92dc 100644
--- a/lib/xmerl/src/xmerl_sax_simple_dom.erl
+++ b/lib/xmerl/src/xmerl_sax_simple_dom.erl
@@ -2,7 +2,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2009-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.
@@ -129,8 +129,9 @@ build_dom(endDocument,
State#xmerl_sax_simple_dom_state{dom=[Decl, {Tag, Attributes,
lists:reverse(Content)}]};
_ ->
- ?dbg("~p\n", [D]),
- ?error("we're not at end the document when endDocument event is encountered.")
+ %% endDocument is also sent by the parser when a fault occur to tell
+ %% the event receiver that no more input will be sent
+ State
end;
%% Element
diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile
index e5c89f84b9..3204f081ba 100644
--- a/lib/xmerl/test/Makefile
+++ b/lib/xmerl/test/Makefile
@@ -126,5 +126,6 @@ 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_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_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl
index eb9cefe0df..68b9bcc4a2 100644
--- a/lib/xmerl/test/xmerl_sax_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_SUITE.erl
@@ -33,7 +33,6 @@
%%======================================================================
%% External functions
%%======================================================================
-
%%----------------------------------------------------------------------
%% Initializations
%%----------------------------------------------------------------------
@@ -42,12 +41,15 @@ all() ->
[{group, bugs}].
groups() ->
- [{bugs, [], [ticket_8213, ticket_8214, ticket_11551]}].
+ [{bugs, [], [ticket_8213, ticket_8214, ticket_11551,
+ fragmented_xml_directive,
+ old_dom_event_fun_endDocument_bug,
+ event_fun_endDocument_error_test,
+ event_fun_startDocument_error_test]}].
-%%----------------------------------------------------------------------
+%%======================================================================
%% Tests
-%%----------------------------------------------------------------------
-
+%%======================================================================
%%----------------------------------------------------------------------
%% Test Case
%% ID: ticket_8213
@@ -56,7 +58,6 @@ ticket_8213(_Config) ->
{ok,ok,[]} = xmerl_sax_parser:stream("<elem/>", [{event_fun, fun (_E,_,_) -> ok end}]),
ok.
-
%%----------------------------------------------------------------------
%% Test Case
%% ID: ticket_8214
@@ -99,3 +100,66 @@ ticket_11551(_Config) ->
<a>hej</a>">>,
{ok, undefined, <<"\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
ok.
+
+%%----------------------------------------------------------------------
+%% Test Case
+%% ID: fragmented_xml_directive
+%% Test of fragmented xml directive by reading one byte per continuation ca
+fragmented_xml_directive(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ Name = filename:join(DataDir, "test_data_1.xml"),
+ {ok, Fd} = file:open(Name, [raw, read,binary]),
+ Cf = fun cf_fragmented_xml_directive/1,
+ {ok, undefined, _} = xmerl_sax_parser:stream(<<>>,
+ [{continuation_fun, Cf},
+ {continuation_state, Fd}]),
+ ok.
+
+%%----------------------------------------------------------------------
+%% Test Case
+%% ID: old_dom_event_fun_endDocument_bug
+%% The old_dom backend previous generateded an uncatched exception
+%% instead of the correct fatal_error from the parser.
+old_dom_event_fun_endDocument_bug(_Config) ->
+ %% Stream contains bad characters,
+ {fatal_error, _, _, _, _} =
+ xmerl_sax_parser:stream([60,63,120,109,108,32,118,101,114,115,105,111,110,61,39,49,46,48,39,32,101,110,99,111,100,105,110,103,61,39,117,116,102,45,56,39,63,62,60,
+ 99,111,109,109,97,110,100,62,60,104,101,97,100,101,114,62,60,116,114,97,110,115,97,99,116,105,111,110,73,100,62,49,60,47,116,114,97,110,
+ 115,97,99,116,105,111,110,73,100,62,60,47,104,101,97,100,101,114,62,60,98,111,100,121,62,95,226,130,172,59,60,60,47,98,111,100,121,62,60,
+ 47,99,111,109,109,97,110,100,62,60,47,120,49,95,49,62],
+ [{event_fun,fun xmerl_sax_old_dom:event/3},
+ {event_state,xmerl_sax_old_dom:initial_state()}]),
+ ok.
+
+%%----------------------------------------------------------------------
+%% Test Case
+%% ID: event_fun_endDocument_error_test
+event_fun_endDocument_error_test(_Config) ->
+ Stream = <<"<?xml version=\"1.0\" encoding=\"utf-8\"?><a>hej</a>">>,
+ Ef = fun(endDocument, _ , _) -> throw({event_error, "endDocument error"});
+ (_, _, S) -> S
+ end,
+ {event_error, _, _, _, _} = xmerl_sax_parser:stream(Stream, [{event_fun, Ef}]),
+ ok.
+
+%%----------------------------------------------------------------------
+%% Test Case
+%% ID: event_fun_startDocument_error_test
+event_fun_startDocument_error_test(_Config) ->
+ Stream = <<"<?xml version=\"1.0\" encoding=\"utf-8\"?><a>hej</a>">>,
+ Ef = fun(startDocument, _ , _) -> throw({event_error, "endDocument error"});
+ (_, _, S) -> S
+ end,
+ {event_error, _, _, _, _} = xmerl_sax_parser:stream(Stream, [{event_fun, Ef}]),
+ ok.
+
+%%======================================================================
+%% Internal functions
+%%======================================================================
+cf_fragmented_xml_directive(IoDevice) ->
+ case file:read(IoDevice, 1) of
+ eof ->
+ {<<>>, IoDevice};
+ {ok, FileBin} ->
+ {FileBin, IoDevice}
+ end.
diff --git a/lib/xmerl/test/xmerl_sax_SUITE_data/test_data_1.xml b/lib/xmerl/test/xmerl_sax_SUITE_data/test_data_1.xml
new file mode 100644
index 0000000000..efbaee6b81
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_SUITE_data/test_data_1.xml
@@ -0,0 +1,4 @@
+<?xml version="1.0" encoding="utf-8"?>
+<a>
+Hej
+</a>
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE.erl b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
index a306eb66a2..7315f67374 100644
--- a/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
@@ -40,7 +40,8 @@ all() ->
[
one_document,
two_documents,
- one_document_and_junk
+ one_document_and_junk,
+ end_of_stream
].
%%----------------------------------------------------------------------
@@ -62,6 +63,9 @@ end_per_testcase(_Func, _Config) ->
%%----------------------------------------------------------------------
%% Tests
%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Send One doc over stream
one_document(Config) ->
Port = 11111,
@@ -107,6 +111,8 @@ one_document(Config) ->
end,
ok.
+%%----------------------------------------------------------------------
+%% Send Two doc over stream
two_documents(Config) ->
Port = 11111,
@@ -152,6 +158,8 @@ two_documents(Config) ->
end,
ok.
+%%----------------------------------------------------------------------
+%% Send one doc and then junk on stream
one_document_and_junk(Config) ->
Port = 11111,
@@ -196,6 +204,13 @@ one_document_and_junk(Config) ->
ct:fail("Timeout")
end,
ok.
+
+%%----------------------------------------------------------------------
+%% Test of continuation when end of stream
+end_of_stream(Config) ->
+ Stream = <<"<?xml version=\"1.0\" encoding=\"utf-8\"?><a>hej</a>">>,
+ {ok, undefined, <<>>} = xmerl_sax_parser:stream(Stream, []),
+ ok.
%%----------------------------------------------------------------------
%% Utility functions
diff --git a/lib/xmerl/vsn.mk b/lib/xmerl/vsn.mk
index 1515a4e37d..2e9c9061d9 100644
--- a/lib/xmerl/vsn.mk
+++ b/lib/xmerl/vsn.mk
@@ -1 +1 @@
-XMERL_VSN = 1.3.13
+XMERL_VSN = 1.3.15