diff options
494 files changed, 10257 insertions, 6048 deletions
diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam Binary files differnew file mode 100644 index 0000000000..fd53a2e0f9 --- /dev/null +++ b/bootstrap/lib/compiler/ebin/beam_a.beam diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam Binary files differindex 7b1ee38ef8..e09584fdeb 100644 --- a/bootstrap/lib/compiler/ebin/beam_asm.beam +++ b/bootstrap/lib/compiler/ebin/beam_asm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam Binary files differindex a7bb91adbb..0b93439386 100644 --- a/bootstrap/lib/compiler/ebin/beam_block.beam +++ b/bootstrap/lib/compiler/ebin/beam_block.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam Binary files differindex 252257b71d..18eb174687 100644 --- a/bootstrap/lib/compiler/ebin/beam_bool.beam +++ b/bootstrap/lib/compiler/ebin/beam_bool.beam diff --git a/bootstrap/lib/compiler/ebin/beam_bsm.beam b/bootstrap/lib/compiler/ebin/beam_bsm.beam Binary files differindex 0c998c8e8c..e0ec059999 100644 --- a/bootstrap/lib/compiler/ebin/beam_bsm.beam +++ b/bootstrap/lib/compiler/ebin/beam_bsm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex 70523ca134..3fe3225c14 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dead.beam b/bootstrap/lib/compiler/ebin/beam_dead.beam Binary files differindex 17cced3c1a..b664286f0f 100644 --- a/bootstrap/lib/compiler/ebin/beam_dead.beam +++ b/bootstrap/lib/compiler/ebin/beam_dead.beam diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam Binary files differindex 81e62b0a7d..50771f4e90 100644 --- a/bootstrap/lib/compiler/ebin/beam_dict.beam +++ b/bootstrap/lib/compiler/ebin/beam_dict.beam diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam Binary files differindex ec48b89de7..b80b543679 100644 --- a/bootstrap/lib/compiler/ebin/beam_disasm.beam +++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam Binary files differindex 5bd28a35d9..e86cdce99e 100644 --- a/bootstrap/lib/compiler/ebin/beam_except.beam +++ b/bootstrap/lib/compiler/ebin/beam_except.beam diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam Binary files differindex 0ac0dc7b92..8f06d7270c 100644 --- a/bootstrap/lib/compiler/ebin/beam_flatten.beam +++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam Binary files differindex 4811360890..07963ae01e 100644 --- a/bootstrap/lib/compiler/ebin/beam_jump.beam +++ b/bootstrap/lib/compiler/ebin/beam_jump.beam diff --git a/bootstrap/lib/compiler/ebin/beam_opcodes.beam b/bootstrap/lib/compiler/ebin/beam_opcodes.beam Binary files differindex 2c414f1c7d..8425c2b2b5 100644 --- a/bootstrap/lib/compiler/ebin/beam_opcodes.beam +++ b/bootstrap/lib/compiler/ebin/beam_opcodes.beam diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam Binary files differindex aaba79046c..a21cc7e1e1 100644 --- a/bootstrap/lib/compiler/ebin/beam_peep.beam +++ b/bootstrap/lib/compiler/ebin/beam_peep.beam diff --git a/bootstrap/lib/compiler/ebin/beam_receive.beam b/bootstrap/lib/compiler/ebin/beam_receive.beam Binary files differindex 43f41f6535..95145224bf 100644 --- a/bootstrap/lib/compiler/ebin/beam_receive.beam +++ b/bootstrap/lib/compiler/ebin/beam_receive.beam diff --git a/bootstrap/lib/compiler/ebin/beam_split.beam b/bootstrap/lib/compiler/ebin/beam_split.beam Binary files differindex 296e6c4671..2271c15ee4 100644 --- a/bootstrap/lib/compiler/ebin/beam_split.beam +++ b/bootstrap/lib/compiler/ebin/beam_split.beam diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam Binary files differindex 86f5d027f4..a497efa4cf 100644 --- a/bootstrap/lib/compiler/ebin/beam_trim.beam +++ b/bootstrap/lib/compiler/ebin/beam_trim.beam diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam Binary files differindex 3cb5f06859..7b005ba802 100644 --- a/bootstrap/lib/compiler/ebin/beam_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex 523a6f03fb..0c3ce5b710 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 41523ed185..d13cbe1944 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam Binary files differnew file mode 100644 index 0000000000..4d28344035 --- /dev/null +++ b/bootstrap/lib/compiler/ebin/beam_z.beam diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam Binary files differindex dcebe13bc8..a10f017869 100644 --- a/bootstrap/lib/compiler/ebin/cerl.beam +++ b/bootstrap/lib/compiler/ebin/cerl.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam Binary files differindex eed98ecd2c..b195422469 100644 --- a/bootstrap/lib/compiler/ebin/cerl_inline.beam +++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam Binary files differindex df3f351c8d..49528c1635 100644 --- a/bootstrap/lib/compiler/ebin/cerl_trees.beam +++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex c685035e23..ae8f3ee903 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app index 5170231c59..a4a7dec7c3 100644 --- a/bootstrap/lib/compiler/ebin/compiler.app +++ b/bootstrap/lib/compiler/ebin/compiler.app @@ -18,8 +18,9 @@ {application, compiler, [{description, "ERTS CXC 138 10"}, - {vsn, "4.8.1"}, + {vsn, "4.8.2"}, {modules, [ + beam_a, beam_asm, beam_block, beam_bool, @@ -40,6 +41,7 @@ beam_type, beam_utils, beam_validator, + beam_z, cerl, cerl_clauses, cerl_inline, diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam Binary files differindex 1a60454b42..d03dfe646c 100644 --- a/bootstrap/lib/compiler/ebin/core_lib.beam +++ b/bootstrap/lib/compiler/ebin/core_lib.beam diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam Binary files differindex 08fef1eb71..4dcf3868aa 100644 --- a/bootstrap/lib/compiler/ebin/core_lint.beam +++ b/bootstrap/lib/compiler/ebin/core_lint.beam diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex 4f555d8036..0993838799 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam Binary files differindex ef3504058a..e96e4bc654 100644 --- a/bootstrap/lib/compiler/ebin/core_pp.beam +++ b/bootstrap/lib/compiler/ebin/core_pp.beam diff --git a/bootstrap/lib/compiler/ebin/core_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam Binary files differindex 245e59483d..f14eda5a33 100644 --- a/bootstrap/lib/compiler/ebin/core_scan.beam +++ b/bootstrap/lib/compiler/ebin/core_scan.beam diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex 9234a54428..815258e0ac 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam Binary files differindex 91a86d9855..edabfdf444 100644 --- a/bootstrap/lib/compiler/ebin/rec_env.beam +++ b/bootstrap/lib/compiler/ebin/rec_env.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam Binary files differindex 0764734cb1..11c194a5cc 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex c878868598..7637853aea 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam Binary files differindex 907c9d53a5..b2762781e7 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_inline.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_inline.beam diff --git a/bootstrap/lib/compiler/ebin/sys_expand_pmod.beam b/bootstrap/lib/compiler/ebin/sys_expand_pmod.beam Binary files differindex 1649b9f2ff..17a208a769 100644 --- a/bootstrap/lib/compiler/ebin/sys_expand_pmod.beam +++ b/bootstrap/lib/compiler/ebin/sys_expand_pmod.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam Binary files differindex a7ca15a033..d3b213e75a 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex 1a176b2e3f..c08dd86a80 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/compiler/ebin/v3_codegen.beam b/bootstrap/lib/compiler/ebin/v3_codegen.beam Binary files differindex 12026564d9..8782fb01a8 100644 --- a/bootstrap/lib/compiler/ebin/v3_codegen.beam +++ b/bootstrap/lib/compiler/ebin/v3_codegen.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 84c005edc9..a51af4dd43 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam Binary files differindex cd4bf48540..3801b77852 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam Binary files differindex 485aa63dcb..8f18f5ff25 100644 --- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam +++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam diff --git a/bootstrap/lib/compiler/ebin/v3_life.beam b/bootstrap/lib/compiler/ebin/v3_life.beam Binary files differindex aa8b6b227b..f4a45b2a22 100644 --- a/bootstrap/lib/compiler/ebin/v3_life.beam +++ b/bootstrap/lib/compiler/ebin/v3_life.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 4485b9e1e8..ef1cb50098 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex 9c94dbd5c7..7dc72beba6 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam Binary files differindex 4d1098bcec..e73de8b687 100644 --- a/bootstrap/lib/kernel/ebin/application_master.beam +++ b/bootstrap/lib/kernel/ebin/application_master.beam diff --git a/bootstrap/lib/kernel/ebin/application_starter.beam b/bootstrap/lib/kernel/ebin/application_starter.beam Binary files differindex 14ff4dc088..06d8098af9 100644 --- a/bootstrap/lib/kernel/ebin/application_starter.beam +++ b/bootstrap/lib/kernel/ebin/application_starter.beam diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam Binary files differindex 33f1ab875b..0f0eb3437e 100644 --- a/bootstrap/lib/kernel/ebin/auth.beam +++ b/bootstrap/lib/kernel/ebin/auth.beam diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam Binary files differindex dc10d111d2..258a7b9181 100644 --- a/bootstrap/lib/kernel/ebin/code_server.beam +++ b/bootstrap/lib/kernel/ebin/code_server.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam Binary files differindex fa221e7c9d..6573609386 100644 --- a/bootstrap/lib/kernel/ebin/disk_log.beam +++ b/bootstrap/lib/kernel/ebin/disk_log.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam Binary files differindex 1deb5ad05e..aa2e21382b 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_1.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_1.beam diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam Binary files differindex d985f64937..81b76167a5 100644 --- a/bootstrap/lib/kernel/ebin/disk_log_server.beam +++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam Binary files differindex 3eae6b82a7..b8c133313b 100644 --- a/bootstrap/lib/kernel/ebin/dist_ac.beam +++ b/bootstrap/lib/kernel/ebin/dist_ac.beam diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam Binary files differindex 7fc3325da4..98d73eef55 100644 --- a/bootstrap/lib/kernel/ebin/dist_util.beam +++ b/bootstrap/lib/kernel/ebin/dist_util.beam diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam Binary files differindex 19f6ceeda2..47563a5d81 100644 --- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam +++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam diff --git a/bootstrap/lib/kernel/ebin/erl_ddll.beam b/bootstrap/lib/kernel/ebin/erl_ddll.beam Binary files differindex 4fdec24b11..776c36e739 100644 --- a/bootstrap/lib/kernel/ebin/erl_ddll.beam +++ b/bootstrap/lib/kernel/ebin/erl_ddll.beam diff --git a/bootstrap/lib/kernel/ebin/erl_distribution.beam b/bootstrap/lib/kernel/ebin/erl_distribution.beam Binary files differindex b084e63a0d..9a6acc0585 100644 --- a/bootstrap/lib/kernel/ebin/erl_distribution.beam +++ b/bootstrap/lib/kernel/ebin/erl_distribution.beam diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam Binary files differindex 8ae4bbaf14..0eaecd949a 100644 --- a/bootstrap/lib/kernel/ebin/erl_epmd.beam +++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam Binary files differindex 6d56c98c67..45dfcee12b 100644 --- a/bootstrap/lib/kernel/ebin/error_handler.beam +++ b/bootstrap/lib/kernel/ebin/error_handler.beam diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam Binary files differindex 5c6483e368..4dda8d492c 100644 --- a/bootstrap/lib/kernel/ebin/erts_debug.beam +++ b/bootstrap/lib/kernel/ebin/erts_debug.beam diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam Binary files differindex 243be75c43..45efb31e93 100644 --- a/bootstrap/lib/kernel/ebin/file.beam +++ b/bootstrap/lib/kernel/ebin/file.beam diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam Binary files differindex b8e2df2a2d..9ab1228354 100644 --- a/bootstrap/lib/kernel/ebin/file_io_server.beam +++ b/bootstrap/lib/kernel/ebin/file_io_server.beam diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam Binary files differindex fd9a9924bb..32c6a94a25 100644 --- a/bootstrap/lib/kernel/ebin/file_server.beam +++ b/bootstrap/lib/kernel/ebin/file_server.beam diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam Binary files differindex 3092353498..1f33d85cb2 100644 --- a/bootstrap/lib/kernel/ebin/gen_sctp.beam +++ b/bootstrap/lib/kernel/ebin/gen_sctp.beam diff --git a/bootstrap/lib/kernel/ebin/gen_tcp.beam b/bootstrap/lib/kernel/ebin/gen_tcp.beam Binary files differindex 02103cc215..0182e11345 100644 --- a/bootstrap/lib/kernel/ebin/gen_tcp.beam +++ b/bootstrap/lib/kernel/ebin/gen_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/gen_udp.beam b/bootstrap/lib/kernel/ebin/gen_udp.beam Binary files differindex 3b9ca85608..e49561399d 100644 --- a/bootstrap/lib/kernel/ebin/gen_udp.beam +++ b/bootstrap/lib/kernel/ebin/gen_udp.beam diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam Binary files differindex 96d7365006..e9f463867e 100644 --- a/bootstrap/lib/kernel/ebin/global.beam +++ b/bootstrap/lib/kernel/ebin/global.beam diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam Binary files differindex dd7d0e429e..e989448fae 100644 --- a/bootstrap/lib/kernel/ebin/global_group.beam +++ b/bootstrap/lib/kernel/ebin/global_group.beam diff --git a/bootstrap/lib/kernel/ebin/global_search.beam b/bootstrap/lib/kernel/ebin/global_search.beam Binary files differindex aa70042058..0d6f105e5f 100644 --- a/bootstrap/lib/kernel/ebin/global_search.beam +++ b/bootstrap/lib/kernel/ebin/global_search.beam diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam Binary files differindex 8e813f6964..bc2ef712aa 100644 --- a/bootstrap/lib/kernel/ebin/group.beam +++ b/bootstrap/lib/kernel/ebin/group.beam diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam Binary files differindex b20f872241..80f0a60c9f 100644 --- a/bootstrap/lib/kernel/ebin/heart.beam +++ b/bootstrap/lib/kernel/ebin/heart.beam diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam Binary files differindex 1574686ba6..f8d3e5847a 100644 --- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam +++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam Binary files differindex fe2d597723..b2eccbb475 100644 --- a/bootstrap/lib/kernel/ebin/inet.beam +++ b/bootstrap/lib/kernel/ebin/inet.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam Binary files differindex 4c80d1d71e..dc592e336c 100644 --- a/bootstrap/lib/kernel/ebin/inet6_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam Binary files differindex 1bc785fa37..dd2d62b8a0 100644 --- a/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam +++ b/bootstrap/lib/kernel/ebin/inet6_tcp_dist.beam diff --git a/bootstrap/lib/kernel/ebin/inet6_udp.beam b/bootstrap/lib/kernel/ebin/inet6_udp.beam Binary files differindex 736c0157e5..2c94263b99 100644 --- a/bootstrap/lib/kernel/ebin/inet6_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet6_udp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam Binary files differindex 555c8c307e..4fd0b25503 100644 --- a/bootstrap/lib/kernel/ebin/inet_db.beam +++ b/bootstrap/lib/kernel/ebin/inet_db.beam diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam Binary files differindex 7f262cf20d..4b82d77ccc 100644 --- a/bootstrap/lib/kernel/ebin/inet_dns.beam +++ b/bootstrap/lib/kernel/ebin/inet_dns.beam diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam Binary files differindex 4e6ce0fc5e..47aa6e05f0 100644 --- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam +++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam Binary files differindex b74c0ee730..ee4f541641 100644 --- a/bootstrap/lib/kernel/ebin/inet_parse.beam +++ b/bootstrap/lib/kernel/ebin/inet_parse.beam diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam Binary files differindex 9e8e9fa4de..bef3efd11b 100644 --- a/bootstrap/lib/kernel/ebin/inet_res.beam +++ b/bootstrap/lib/kernel/ebin/inet_res.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam Binary files differindex d16795f44d..00a8175665 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp.beam diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam Binary files differindex 22f2db4182..39389454f9 100644 --- a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam +++ b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam diff --git a/bootstrap/lib/kernel/ebin/inet_udp.beam b/bootstrap/lib/kernel/ebin/inet_udp.beam Binary files differindex 917e3da3a7..6fb98bd777 100644 --- a/bootstrap/lib/kernel/ebin/inet_udp.beam +++ b/bootstrap/lib/kernel/ebin/inet_udp.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam Binary files differindex 8321a999c1..7f6d8fcb30 100644 --- a/bootstrap/lib/kernel/ebin/kernel.beam +++ b/bootstrap/lib/kernel/ebin/kernel.beam diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam Binary files differindex c5a63b6217..848401eacf 100644 --- a/bootstrap/lib/kernel/ebin/kernel_config.beam +++ b/bootstrap/lib/kernel/ebin/kernel_config.beam diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam Binary files differindex 182c2cd0fc..dc7e091cf2 100644 --- a/bootstrap/lib/kernel/ebin/net_adm.beam +++ b/bootstrap/lib/kernel/ebin/net_adm.beam diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam Binary files differindex 9eebd72403..ebb9ed19d5 100644 --- a/bootstrap/lib/kernel/ebin/net_kernel.beam +++ b/bootstrap/lib/kernel/ebin/net_kernel.beam diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam Binary files differindex ea33408b31..8e13b88768 100644 --- a/bootstrap/lib/kernel/ebin/os.beam +++ b/bootstrap/lib/kernel/ebin/os.beam diff --git a/bootstrap/lib/kernel/ebin/packages.beam b/bootstrap/lib/kernel/ebin/packages.beam Binary files differindex 511c6a6e74..86fb5b6094 100644 --- a/bootstrap/lib/kernel/ebin/packages.beam +++ b/bootstrap/lib/kernel/ebin/packages.beam diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam Binary files differindex 439bbc24f2..02b9264e22 100644 --- a/bootstrap/lib/kernel/ebin/pg2.beam +++ b/bootstrap/lib/kernel/ebin/pg2.beam diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam Binary files differindex 02baece827..87af871756 100644 --- a/bootstrap/lib/kernel/ebin/ram_file.beam +++ b/bootstrap/lib/kernel/ebin/ram_file.beam diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam Binary files differindex bfb80cf827..305779539a 100644 --- a/bootstrap/lib/kernel/ebin/rpc.beam +++ b/bootstrap/lib/kernel/ebin/rpc.beam diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam Binary files differindex ceb4e14324..13489135a2 100644 --- a/bootstrap/lib/kernel/ebin/seq_trace.beam +++ b/bootstrap/lib/kernel/ebin/seq_trace.beam diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam Binary files differindex f34c1a9bd1..b5b22bb71a 100644 --- a/bootstrap/lib/kernel/ebin/standard_error.beam +++ b/bootstrap/lib/kernel/ebin/standard_error.beam diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam Binary files differindex f3aae4a980..d678631703 100644 --- a/bootstrap/lib/kernel/ebin/user.beam +++ b/bootstrap/lib/kernel/ebin/user.beam diff --git a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam Binary files differindex 1af9de5e72..7a328be682 100644 --- a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam +++ b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam Binary files differindex 8741e4d5df..28d04dea2c 100644 --- a/bootstrap/lib/stdlib/ebin/array.beam +++ b/bootstrap/lib/stdlib/ebin/array.beam diff --git a/bootstrap/lib/stdlib/ebin/base64.beam b/bootstrap/lib/stdlib/ebin/base64.beam Binary files differindex 07877625dd..1e9589e945 100644 --- a/bootstrap/lib/stdlib/ebin/base64.beam +++ b/bootstrap/lib/stdlib/ebin/base64.beam diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam Binary files differindex afe3bcc466..250be4dcb1 100644 --- a/bootstrap/lib/stdlib/ebin/beam_lib.beam +++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/binary.beam b/bootstrap/lib/stdlib/ebin/binary.beam Binary files differindex 255c50aa01..6077d965ed 100644 --- a/bootstrap/lib/stdlib/ebin/binary.beam +++ b/bootstrap/lib/stdlib/ebin/binary.beam diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam Binary files differindex 8c69197cbc..d627009e03 100644 --- a/bootstrap/lib/stdlib/ebin/c.beam +++ b/bootstrap/lib/stdlib/ebin/c.beam diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam Binary files differindex 4a33312cc0..48ed694380 100644 --- a/bootstrap/lib/stdlib/ebin/dets.beam +++ b/bootstrap/lib/stdlib/ebin/dets.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam Binary files differindex 26de164bd9..871104a73d 100644 --- a/bootstrap/lib/stdlib/ebin/dets_server.beam +++ b/bootstrap/lib/stdlib/ebin/dets_server.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam Binary files differindex e4cd1e8b2e..882228c5d8 100644 --- a/bootstrap/lib/stdlib/ebin/dets_utils.beam +++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v8.beam b/bootstrap/lib/stdlib/ebin/dets_v8.beam Binary files differindex c8e1549256..e580e2f1ea 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v8.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v8.beam diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam Binary files differindex 8cfcb9f8f1..f504c8e9d4 100644 --- a/bootstrap/lib/stdlib/ebin/dets_v9.beam +++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam Binary files differindex 35e67d6c59..83d30876cc 100644 --- a/bootstrap/lib/stdlib/ebin/dict.beam +++ b/bootstrap/lib/stdlib/ebin/dict.beam diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam Binary files differindex 2c1788668d..82735d07cc 100644 --- a/bootstrap/lib/stdlib/ebin/digraph.beam +++ b/bootstrap/lib/stdlib/ebin/digraph.beam diff --git a/bootstrap/lib/stdlib/ebin/digraph_utils.beam b/bootstrap/lib/stdlib/ebin/digraph_utils.beam Binary files differindex 39cb9d90da..9bab801654 100644 --- a/bootstrap/lib/stdlib/ebin/digraph_utils.beam +++ b/bootstrap/lib/stdlib/ebin/digraph_utils.beam diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam Binary files differindex 874bc4e107..3eac2b2000 100644 --- a/bootstrap/lib/stdlib/ebin/edlin.beam +++ b/bootstrap/lib/stdlib/ebin/edlin.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 2e2b3ef4ed..e48ebd1d89 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_bits.beam b/bootstrap/lib/stdlib/ebin/erl_bits.beam Binary files differindex 595be6a76a..7149491121 100644 --- a/bootstrap/lib/stdlib/ebin/erl_bits.beam +++ b/bootstrap/lib/stdlib/ebin/erl_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam Binary files differindex e449884f0b..c2757faf82 100644 --- a/bootstrap/lib/stdlib/ebin/erl_compile.beam +++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 6198c4f43a..d097eaf1f1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex 5c9663cd54..093bd0f501 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam Binary files differindex 94a0a75c29..d557c6c5d7 100644 --- a/bootstrap/lib/stdlib/ebin/erl_internal.beam +++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 875ccf94c2..9dc80f67b9 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex 85fa455908..d7a5103030 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex 2c32b68322..32e33ad130 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam Binary files differindex 9e70ed846e..3abab91ce1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_scan.beam +++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam Binary files differindex 7eacf3272c..90ed044a66 100644 --- a/bootstrap/lib/stdlib/ebin/erl_tar.beam +++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam Binary files differindex e832f973d7..2a29ae551f 100644 --- a/bootstrap/lib/stdlib/ebin/escript.beam +++ b/bootstrap/lib/stdlib/ebin/escript.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex cc6521891b..7d0554106e 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam Binary files differindex 73e20d9a8d..dc2ea0f521 100644 --- a/bootstrap/lib/stdlib/ebin/eval_bits.beam +++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam Binary files differindex 633d8acd10..e118a6ec85 100644 --- a/bootstrap/lib/stdlib/ebin/file_sorter.beam +++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam Binary files differindex 20f48fe18e..82dfeb7ca8 100644 --- a/bootstrap/lib/stdlib/ebin/filelib.beam +++ b/bootstrap/lib/stdlib/ebin/filelib.beam diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam Binary files differindex e371f3f478..f8a42129c1 100644 --- a/bootstrap/lib/stdlib/ebin/filename.beam +++ b/bootstrap/lib/stdlib/ebin/filename.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_sets.beam b/bootstrap/lib/stdlib/ebin/gb_sets.beam Binary files differindex dc4c752654..10b584677d 100644 --- a/bootstrap/lib/stdlib/ebin/gb_sets.beam +++ b/bootstrap/lib/stdlib/ebin/gb_sets.beam diff --git a/bootstrap/lib/stdlib/ebin/gb_trees.beam b/bootstrap/lib/stdlib/ebin/gb_trees.beam Binary files differindex edf1805440..24aab57544 100644 --- a/bootstrap/lib/stdlib/ebin/gb_trees.beam +++ b/bootstrap/lib/stdlib/ebin/gb_trees.beam diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam Binary files differindex 0a39dc1c7e..77d0bf806a 100644 --- a/bootstrap/lib/stdlib/ebin/gen.beam +++ b/bootstrap/lib/stdlib/ebin/gen.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam Binary files differindex 23c4f53c30..37b6753300 100644 --- a/bootstrap/lib/stdlib/ebin/gen_event.beam +++ b/bootstrap/lib/stdlib/ebin/gen_event.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam Binary files differindex c2713544ff..1fcabac0d7 100644 --- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam +++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam Binary files differindex 5d68dda4cf..f0fa4f03a9 100644 --- a/bootstrap/lib/stdlib/ebin/gen_server.beam +++ b/bootstrap/lib/stdlib/ebin/gen_server.beam diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam Binary files differindex 0a2ae3490c..cade9d5ac6 100644 --- a/bootstrap/lib/stdlib/ebin/io.beam +++ b/bootstrap/lib/stdlib/ebin/io.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam Binary files differindex b240aa157d..151fcd9d99 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam Binary files differindex 5fb023c5e1..226f8216be 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam Binary files differindex 5ecd664026..f3f059df26 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex be283307f3..16fad6af64 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam Binary files differindex dfd689aa5a..948af8d1be 100644 --- a/bootstrap/lib/stdlib/ebin/lists.beam +++ b/bootstrap/lib/stdlib/ebin/lists.beam diff --git a/bootstrap/lib/stdlib/ebin/log_mf_h.beam b/bootstrap/lib/stdlib/ebin/log_mf_h.beam Binary files differindex fdb417b71e..7d5ef0e093 100644 --- a/bootstrap/lib/stdlib/ebin/log_mf_h.beam +++ b/bootstrap/lib/stdlib/ebin/log_mf_h.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex bc16416161..6031052e4c 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/pg.beam b/bootstrap/lib/stdlib/ebin/pg.beam Binary files differindex 0b08fb57ca..65195defbf 100644 --- a/bootstrap/lib/stdlib/ebin/pg.beam +++ b/bootstrap/lib/stdlib/ebin/pg.beam diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam Binary files differindex 3b1dbc3524..8ad59de20d 100644 --- a/bootstrap/lib/stdlib/ebin/pool.beam +++ b/bootstrap/lib/stdlib/ebin/pool.beam diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam Binary files differindex 6b5c081480..25843dfe45 100644 --- a/bootstrap/lib/stdlib/ebin/proc_lib.beam +++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex 716f28b661..eef4cef042 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex 8a25d95384..e76d49052d 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/queue.beam b/bootstrap/lib/stdlib/ebin/queue.beam Binary files differindex 5ebb0f9cc6..688c411798 100644 --- a/bootstrap/lib/stdlib/ebin/queue.beam +++ b/bootstrap/lib/stdlib/ebin/queue.beam diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam Binary files differindex e20546d45d..f0508c73b3 100644 --- a/bootstrap/lib/stdlib/ebin/re.beam +++ b/bootstrap/lib/stdlib/ebin/re.beam diff --git a/bootstrap/lib/stdlib/ebin/sets.beam b/bootstrap/lib/stdlib/ebin/sets.beam Binary files differindex 5ac7691a8f..614f807ae1 100644 --- a/bootstrap/lib/stdlib/ebin/sets.beam +++ b/bootstrap/lib/stdlib/ebin/sets.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 20b9938d06..8705c85853 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam Binary files differindex dfc8cad9d6..4f3dfa3716 100644 --- a/bootstrap/lib/stdlib/ebin/slave.beam +++ b/bootstrap/lib/stdlib/ebin/slave.beam diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam Binary files differindex a0c8c58c03..d8d65c5521 100644 --- a/bootstrap/lib/stdlib/ebin/sofs.beam +++ b/bootstrap/lib/stdlib/ebin/sofs.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex 837027e93a..0e16688bc4 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam Binary files differindex 724dfed4e6..841874f1f5 100644 --- a/bootstrap/lib/stdlib/ebin/sys.beam +++ b/bootstrap/lib/stdlib/ebin/sys.beam diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam Binary files differindex 074fe0534d..4e91cf2466 100644 --- a/bootstrap/lib/stdlib/ebin/unicode.beam +++ b/bootstrap/lib/stdlib/ebin/unicode.beam diff --git a/bootstrap/lib/stdlib/ebin/win32reg.beam b/bootstrap/lib/stdlib/ebin/win32reg.beam Binary files differindex 9c7893f7ff..6df20f8db7 100644 --- a/bootstrap/lib/stdlib/ebin/win32reg.beam +++ b/bootstrap/lib/stdlib/ebin/win32reg.beam diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam Binary files differindex 2907ee286b..e8492c52bc 100644 --- a/bootstrap/lib/stdlib/ebin/zip.beam +++ b/bootstrap/lib/stdlib/ebin/zip.beam diff --git a/erts/configure.in b/erts/configure.in index 43f6cf39c9..3256b0cb59 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -3579,6 +3579,11 @@ case $host_os in DED_LDFLAGS="-m32 $DED_LDFLAGS" fi ;; + openbsd*) + DED_LD="$CC" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH="$CFLAG_RUNTIME_LIBRARY_PATH" + DED_LDFLAGS="-shared" + ;; osf*) # NOTE! Whitespace after -rpath is important. DED_LD_FLAG_RUNTIME_LIBRARY_PATH="-rpath " diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index 93d1289e8d..7cdb3a4dfe 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1042,6 +1042,37 @@ the emulator will be allowed to spend writing a crash dump. When the given number of seconds have elapsed, the emulator will be terminated by a SIGALRM signal.</p> + + <p> If the environment variable is <em>not</em> set or it is set to zero seconds, <c><![CDATA[ERL_CRASH_DUMP_SECONDS=0]]></c>, + the runtime system will not even attempt to write the crash dump file. It will just terminate. + </p> + <p> If the environment variable is set to negative valie, e.g. <c><![CDATA[ERL_CRASH_DUMP_SECONDS=-1]]></c>, + the runtime system will wait indefinitely for the crash dump file to be written. + </p> + <p> This environment variable is used in conjuction with + <seealso marker="kernel:heart"><c>heart</c></seealso> if <c>heart</c> is running: + </p> + <taglist> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=0]]></c></tag> + <item><p> + Suppresses the writing a crash dump file entirely, + thus rebooting the runtime system immediately. + This is the same as not setting the environment variable. + </p> + </item> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=-1]]></c></tag> + <item><p>Setting the environment variable to a negative value will cause the + termination of the runtime system to wait until the crash dump file + has been completly written. + </p> + </item> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=S]]></c></tag> + <item><p> + Will wait for <c>S</c> seconds to complete the crash dump file and + then terminate the runtime system. + </p> + </item> + </taglist> </item> <tag><c><![CDATA[ERL_AFLAGS]]></c></tag> <item> diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 106fad030b..afcbd732df 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -252,6 +252,7 @@ atom heap_block_size atom heap_size atom heap_sizes atom heap_type +atom heart_port atom heir atom hidden atom hide diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index e8f8a04344..9e4add823d 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -148,6 +148,15 @@ struct m { }; static Eterm staging_epilogue(Process* c_p, int, Eterm res, int, struct m*, int); +#ifdef ERTS_SMP +static void smp_code_ix_commiter(void*); + +static struct /* Protected by code_write_permission */ +{ + Process* stager; + ErtsThrPrgrLaterOp lop; +}commiter_state; +#endif static Eterm exception_list(Process* p, Eterm tag, struct m* mp, Sint exceptions) @@ -347,7 +356,6 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, } #ifdef ERTS_SMP else { - ErtsThrPrgrVal later; ASSERT(is_value(res)); if (loaded) { @@ -356,17 +364,17 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, erts_end_staging_code_ix(); /* * Now we must wait for all schedulers to do a memory barrier before - * we can activate and let them access the new staged code. This allows + * we can commit and let them access the new staged code. This allows * schedulers to read active code_ix in a safe way while executing * without any memory barriers at all. */ - - later = erts_thr_progress_later(c_p->scheduler_data); - erts_thr_progress_wakeup(c_p->scheduler_data, later); - erts_notify_code_ix_activation(c_p, later); + ASSERT(commiter_state.stager == NULL); + commiter_state.stager = c_p; + erts_schedule_thr_prgr_later_op(smp_code_ix_commiter, NULL, &commiter_state.lop); + erts_smp_proc_inc_refc(c_p); erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); /* - * handle_code_ix_activation() will do the rest "later" + * smp_code_ix_commiter() will do the rest "later" * and resume this process to return 'res'. */ ERTS_BIF_YIELD_RETURN(c_p, res); @@ -374,6 +382,28 @@ staging_epilogue(Process* c_p, int commit, Eterm res, int is_blocking, #endif } + +#ifdef ERTS_SMP +static void smp_code_ix_commiter(void* null) +{ + Process* p = commiter_state.stager; + + erts_commit_staging_code_ix(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_smp_proc_dec_refc(p); +#ifdef DEBUG + commiter_state.stager = NULL; +#endif + erts_release_code_write_permission(); +} +#endif /* ERTS_SMP */ + + + BIF_RETTYPE check_old_code_1(BIF_ALIST_1) { diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c index 50d18b0347..58e0090a76 100644 --- a/erts/emulator/beam/beam_bp.c +++ b/erts/emulator/beam/beam_bp.c @@ -254,7 +254,7 @@ erts_consolidate_bp_data(BpFunctions* f, int local) Uint i; Uint n = f->matched; - ERTS_SMP_LC_ASSERT(erts_is_code_ix_locked()); + ERTS_SMP_LC_ASSERT(erts_has_code_write_permission()); for (i = 0; i < n; i++) { consolidate_bp_data(fs[i].mod, fs[i].pc, local); @@ -266,7 +266,7 @@ erts_consolidate_bif_bp_data(void) { int i; - ERTS_SMP_LC_ASSERT(erts_is_code_ix_locked()); + ERTS_SMP_LC_ASSERT(erts_has_code_write_permission()); for (i = 0; i < BIF_SIZE; i++) { Export *ep = bif_export[i]; consolidate_bp_data(0, ep->code+3, 0); @@ -692,7 +692,7 @@ erts_bif_trace(int bif_index, Process* p, Eterm* args, BeamInstr* I) * export entry */ BeamInstr *cp = p->cp; GenericBp* g; - GenericBpData* bp; + GenericBpData* bp = NULL; Uint bp_flags = 0; ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); @@ -1449,7 +1449,7 @@ set_function_break(BeamInstr *pc, Binary *match_spec, Uint break_flags, Uint common; ErtsBpIndex ix = erts_staging_bp_ix(); - ERTS_SMP_LC_ASSERT(erts_is_code_ix_locked()); + ERTS_SMP_LC_ASSERT(erts_has_code_write_permission()); g = (GenericBp *) pc[-4]; if (g == 0) { int i; @@ -1565,7 +1565,7 @@ clear_function_break(BeamInstr *pc, Uint break_flags) Uint common; ErtsBpIndex ix = erts_staging_bp_ix(); - ERTS_SMP_LC_ASSERT(erts_is_code_ix_locked()); + ERTS_SMP_LC_ASSERT(erts_has_code_write_permission()); if ((g = (GenericBp *) pc[-4]) == 0) { return 1; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index d3f55a2ba4..b51f076a5d 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -756,7 +756,7 @@ erts_finish_loading(Binary* magic, Process* c_p, * table which is not protected by any locks. */ - ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_is_code_ix_locked() || + ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_has_code_write_permission() || erts_smp_thr_progress_is_blocking()); /* @@ -5527,7 +5527,8 @@ stub_copy_info(LoaderState* stp, int chunk, /* Chunk: ATTR_CHUNK or COMPILE_CHUNK */ byte* info, /* Where to store info. */ BeamInstr* ptr_word, /* Where to store pointer into info. */ - BeamInstr* size_word) /* Where to store size of info. */ + BeamInstr* size_word, /* Where to store size into info. */ + BeamInstr* size_on_heap_word) /* Where to store size on heap. */ { Sint decoded_size; Uint size = stp->chunks[chunk].size; @@ -5538,7 +5539,8 @@ stub_copy_info(LoaderState* stp, if (decoded_size < 0) { return 0; } - *size_word = decoded_size; + *size_word = (BeamInstr) size; + *size_on_heap_word = decoded_size; } return info + size; } @@ -5960,12 +5962,16 @@ erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) info = (byte *) fp; info = stub_copy_info(stp, ATTR_CHUNK, info, - code+MI_ATTR_PTR, code+MI_ATTR_SIZE_ON_HEAP); + code+MI_ATTR_PTR, + code+MI_ATTR_SIZE, + code+MI_ATTR_SIZE_ON_HEAP); if (info == NULL) { goto error; } info = stub_copy_info(stp, COMPILE_CHUNK, info, - code+MI_COMPILE_PTR, code+MI_COMPILE_SIZE_ON_HEAP); + code+MI_COMPILE_PTR, + code+MI_COMPILE_SIZE, + code+MI_COMPILE_SIZE_ON_HEAP); if (info == NULL) { goto error; } diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 66f4259d20..1cdce49eef 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -2844,7 +2844,7 @@ BIF_RETTYPE float_to_list_1(BIF_ALIST_1) if (is_not_float(BIF_ARG_1)) BIF_ERROR(BIF_P, BADARG); GET_DOUBLE(BIF_ARG_1, f); - if ((i = sys_double_to_chars(f.fd, fbuf)) <= 0) + if ((i = sys_double_to_chars(f.fd, fbuf, sizeof(fbuf))) <= 0) BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); need = i*2; hp = HAlloc(BIF_P, need); diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index 376201c309..63136d86c9 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -663,10 +663,13 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) ErtsThrPrgrData tpd_buf; /* in case we aren't a managed thread... */ #endif int fd; + size_t envsz; time_t now; + char env[21]; /* enough to hold any 64-bit integer */ size_t dumpnamebufsize = MAXPATHLEN; char dumpnamebuf[MAXPATHLEN]; char* dumpname; + int secs; if (ERTS_SOMEONE_IS_CRASH_DUMPING) return; @@ -689,9 +692,41 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args) erts_writing_erl_crash_dump = 1; #endif - erts_sys_prepare_crash_dump(); + envsz = sizeof(env); + /* ERL_CRASH_DUMP_SECONDS not set + * same as ERL_CRASH_DUMP_SECONDS = 0 + * - do not write dump + * - do not set an alarm + * - break immediately + * + * ERL_CRASH_DUMP_SECONDS = 0 + * - do not write dump + * - do not set an alarm + * - break immediately + * + * ERL_CRASH_DUMP_SECONDS < 0 + * - do not set alarm + * - write dump until done + * + * ERL_CRASH_DUMP_SECONDS = S (and S positive) + * - Don't dump file forever + * - set alarm (set in sys) + * - write dump until alarm or file is written completely + */ + + if (erts_sys_getenv__("ERL_CRASH_DUMP_SECONDS", env, &envsz) != 0) { + return; /* break immediately */ + } else { + secs = atoi(env); + } + + if (secs == 0) { + return; + } + + erts_sys_prepare_crash_dump(secs); - if (erts_sys_getenv_raw("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 0) + if (erts_sys_getenv__("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 0) dumpname = "erl_crash.dump"; else dumpname = &dumpnamebuf[0]; diff --git a/erts/emulator/beam/code_ix.c b/erts/emulator/beam/code_ix.c index 8025058ee0..c66d5a2f05 100644 --- a/erts/emulator/beam/code_ix.c +++ b/erts/emulator/beam/code_ix.c @@ -36,13 +36,13 @@ erts_smp_atomic32_t the_active_code_index; erts_smp_atomic32_t the_staging_code_index; -static int the_code_ix_lock = 0; -struct code_ix_queue_item { +static Process* code_writing_process = NULL; +struct code_write_queue_item { Process *p; - struct code_ix_queue_item* next; + struct code_write_queue_item* next; }; -static struct code_ix_queue_item* the_code_ix_queue = NULL; -static erts_smp_mtx_t the_code_ix_queue_lock; +static struct code_write_queue_item* code_write_queue = NULL; +static erts_smp_mtx_t code_write_permission_mtx; #ifdef ERTS_ENABLE_LOCK_CHECK static erts_tsd_key_t has_code_write_permission; @@ -56,7 +56,7 @@ void erts_code_ix_init(void) */ erts_smp_atomic32_init_nob(&the_active_code_index, 0); erts_smp_atomic32_init_nob(&the_staging_code_index, 0); - erts_smp_mtx_init(&the_code_ix_queue_lock, "code_ix_queue"); + erts_smp_mtx_init(&code_write_permission_mtx, "code_write_permission"); #ifdef ERTS_ENABLE_LOCK_CHECK erts_tsd_key_create(&has_code_write_permission); #endif @@ -114,53 +114,55 @@ int erts_try_seize_code_write_permission(Process* c_p) #ifdef ERTS_SMP ASSERT(!erts_smp_thr_progress_is_blocking()); /* to avoid deadlock */ #endif + ASSERT(c_p != NULL); - erts_smp_mtx_lock(&the_code_ix_queue_lock); - success = !the_code_ix_lock; + erts_smp_mtx_lock(&code_write_permission_mtx); + success = (code_writing_process == NULL); if (success) { - the_code_ix_lock = 1; + code_writing_process = c_p; #ifdef ERTS_ENABLE_LOCK_CHECK erts_tsd_set(has_code_write_permission, (void *) 1); #endif } else { /* Already locked */ - struct code_ix_queue_item* qitem; + struct code_write_queue_item* qitem; + ASSERT(code_writing_process != c_p); qitem = erts_alloc(ERTS_ALC_T_CODE_IX_LOCK_Q, sizeof(*qitem)); qitem->p = c_p; erts_smp_proc_inc_refc(c_p); - qitem->next = the_code_ix_queue; - the_code_ix_queue = qitem; + qitem->next = code_write_queue; + code_write_queue = qitem; erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); } - erts_smp_mtx_unlock(&the_code_ix_queue_lock); + erts_smp_mtx_unlock(&code_write_permission_mtx); return success; } void erts_release_code_write_permission(void) { - ERTS_SMP_LC_ASSERT(erts_is_code_ix_locked()); - erts_smp_mtx_lock(&the_code_ix_queue_lock); - while (the_code_ix_queue != NULL) { /* unleash the entire herd */ - struct code_ix_queue_item* qitem = the_code_ix_queue; + erts_smp_mtx_lock(&code_write_permission_mtx); + ERTS_SMP_LC_ASSERT(erts_has_code_write_permission()); + while (code_write_queue != NULL) { /* unleash the entire herd */ + struct code_write_queue_item* qitem = code_write_queue; erts_smp_proc_lock(qitem->p, ERTS_PROC_LOCK_STATUS); if (!ERTS_PROC_IS_EXITING(qitem->p)) { erts_resume(qitem->p, ERTS_PROC_LOCK_STATUS); } erts_smp_proc_unlock(qitem->p, ERTS_PROC_LOCK_STATUS); - the_code_ix_queue = qitem->next; + code_write_queue = qitem->next; erts_smp_proc_dec_refc(qitem->p); erts_free(ERTS_ALC_T_CODE_IX_LOCK_Q, qitem); } - the_code_ix_lock = 0; + code_writing_process = NULL; #ifdef ERTS_ENABLE_LOCK_CHECK erts_tsd_set(has_code_write_permission, (void *) 0); #endif - erts_smp_mtx_unlock(&the_code_ix_queue_lock); + erts_smp_mtx_unlock(&code_write_permission_mtx); } #ifdef ERTS_ENABLE_LOCK_CHECK -int erts_is_code_ix_locked(void) +int erts_has_code_write_permission(void) { - return the_code_ix_lock && erts_tsd_get(has_code_write_permission); + return (code_writing_process != NULL) && erts_tsd_get(has_code_write_permission); } #endif diff --git a/erts/emulator/beam/code_ix.h b/erts/emulator/beam/code_ix.h index 6b2680044e..bc10e956f5 100644 --- a/erts/emulator/beam/code_ix.h +++ b/erts/emulator/beam/code_ix.h @@ -116,7 +116,7 @@ void erts_commit_staging_code_ix(void); void erts_abort_staging_code_ix(void); #ifdef ERTS_ENABLE_LOCK_CHECK -int erts_is_code_ix_locked(void); +int erts_has_code_write_permission(void); #endif diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index ba73ca6da7..3eee53eba3 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1675,7 +1675,7 @@ erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) t_str = type_no_str(n); if (!t_str) { - sprintf(buf, "%d", (int) n); + erts_snprintf(buf, sizeof(buf), "%d", (int) n); t_str = buf; } @@ -3572,12 +3572,12 @@ check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func) ftype = type_no_str(found_type); if (!ftype) { - sprintf(fbuf, "%d", (int) found_type); + erts_snprintf(fbuf, sizeof(fbuf), "%d", (int) found_type); ftype = fbuf; } otype = type_no_str(n); if (!otype) { - sprintf(obuf, "%d", (int) n); + erts_snprintf(obuf, sizeof(obuf), "%d", (int) n); otype = obuf; } diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c index 831e05493a..1062d4379b 100644 --- a/erts/emulator/beam/erl_bif_os.c +++ b/erts/emulator/beam/erl_bif_os.c @@ -58,7 +58,7 @@ BIF_RETTYPE os_getpid_0(BIF_ALIST_0) char pid_string[21]; /* enough for a 64 bit number */ int n; Eterm* hp; - sys_get_pid(pid_string); /* In sys.c */ + sys_get_pid(pid_string, sizeof(pid_string)); /* In sys.c */ n = sys_strlen(pid_string); hp = HAlloc(BIF_P, n*2); BIF_RET(buf_to_intlist(&hp, pid_string, n, NIL)); diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c index 06cec1795d..805d788177 100644 --- a/erts/emulator/beam/erl_bif_trace.c +++ b/erts/emulator/beam/erl_bif_trace.c @@ -58,10 +58,17 @@ static struct { /* Protected by code write permission */ int local; BpFunctions f; /* Local functions */ BpFunctions e; /* Export entries */ +#ifdef ERTS_SMP + Process* stager; + ErtsThrPrgrLaterOp lop; +#endif } finish_bp; static Eterm trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist); +#ifdef ERTS_SMP +static void smp_bp_finisher(void* arg); +#endif static BIF_RETTYPE system_monitor(Process *p, Eterm monitor_pid, Eterm list); @@ -350,7 +357,10 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) #ifdef ERTS_SMP if (finish_bp.current >= 0) { ASSERT(matches >= 0); - erts_notify_finish_breakpointing(p); + ASSERT(finish_bp.stager == NULL); + finish_bp.stager = p; + erts_schedule_thr_prgr_later_op(smp_bp_finisher, NULL, &finish_bp.lop); + erts_smp_proc_inc_refc(p); erts_suspend(p, ERTS_PROC_LOCK_MAIN, NULL); ERTS_BIF_YIELD_RETURN(p, make_small(matches)); } @@ -366,6 +376,29 @@ trace_pattern(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) } } +#ifdef ERTS_SMP +static void smp_bp_finisher(void* null) +{ + if (erts_finish_breakpointing()) { /* Not done */ + /* Arrange for being called again */ + erts_schedule_thr_prgr_later_op(smp_bp_finisher, NULL, &finish_bp.lop); + } + else { /* Done */ + Process* p = finish_bp.stager; +#ifdef DEBUG + finish_bp.stager = NULL; +#endif + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (!ERTS_PROC_IS_EXITING(p)) { + erts_resume(p, ERTS_PROC_LOCK_STATUS); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_smp_proc_dec_refc(p); + erts_release_code_write_permission(); + } +} +#endif /* ERTS_SMP */ + void erts_get_default_trace_pattern(int *trace_pattern_is_on, Binary **match_spec, @@ -373,7 +406,7 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on, struct trace_pattern_flags *trace_pattern_flags, Eterm *meta_tracer_pid) { - ERTS_SMP_LC_ASSERT(erts_is_code_ix_locked() || + ERTS_SMP_LC_ASSERT(erts_has_code_write_permission() || erts_smp_thr_progress_is_blocking()); if (trace_pattern_is_on) *trace_pattern_is_on = erts_default_trace_pattern_is_on; @@ -389,7 +422,7 @@ erts_get_default_trace_pattern(int *trace_pattern_is_on, int erts_is_default_trace_enabled(void) { - ERTS_SMP_LC_ASSERT(erts_is_code_ix_locked() || + ERTS_SMP_LC_ASSERT(erts_has_code_write_permission() || erts_smp_thr_progress_is_blocking()); return erts_default_trace_pattern_is_on; } @@ -1530,7 +1563,7 @@ erts_set_trace_pattern(Process*p, Eterm* mfa, int specified, int erts_finish_breakpointing(void) { - ERTS_SMP_LC_ASSERT(erts_is_code_ix_locked()); + ERTS_SMP_LC_ASSERT(erts_has_code_write_permission()); /* * Memory barriers will be issued for all processes *before* @@ -1538,7 +1571,6 @@ erts_finish_breakpointing(void) * are blocked, in which case memory barriers will be issued * when they are awaken.) */ - switch (finish_bp.current++) { case 0: /* diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 42907e2e84..0c9ca83ce4 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -2480,7 +2480,7 @@ Eterm db_format_dmc_err_info(Process *p, DMCErrInfo *ei) vnum = tmp->variable; } if (vnum >= 0) - sprintf(buff,tmp->error_string, vnum); + erts_snprintf(buff,sizeof(buff)+20,tmp->error_string, vnum); else strcpy(buff,tmp->error_string); sl = strlen(buff); @@ -4485,7 +4485,9 @@ static DMCRet dmc_fun(DMCContext *context, if (context->err_info != NULL) { /* Ugly, should define a better RETURN_TERM_ERROR interface... */ char buff[100]; - sprintf(buff, "Function %%T/%d does_not_exist.", (int)a - 1); + erts_snprintf(buff, sizeof(buff), + "Function %%T/%d does_not_exist.", + (int)a - 1); RETURN_TERM_ERROR(buff, p[1], context, *constant); } else { return retFail; @@ -4500,7 +4502,7 @@ static DMCRet dmc_fun(DMCContext *context, if (context->err_info != NULL) { /* Ugly, should define a better RETURN_TERM_ERROR interface... */ char buff[100]; - sprintf(buff, + erts_snprintf(buff, sizeof(buff), "Function %%T/%d cannot be called in this context.", (int)a - 1); RETURN_TERM_ERROR(buff, p[1], context, *constant); @@ -4764,7 +4766,7 @@ static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info) for (j = 0; j < x && DMC_PEEK(heap,j) != n; ++j) ; ASSERT(j < x); - sprintf(buff+1,"%u", (unsigned) j); + erts_snprintf(buff+1, sizeof(buff) - 1, "%u", (unsigned) j); /* Yes, writing directly into terms, they ARE off heap */ *p = am_atom_put(buff, strlen(buff)); } diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c index 11fed4079d..314d2f6a9c 100644 --- a/erts/emulator/beam/erl_lock_check.c +++ b/erts/emulator/beam/erl_lock_check.c @@ -93,7 +93,7 @@ static erts_lc_lock_order_t erts_lock_order[] = { { "proc_msgq", "pid" }, { "dist_entry", "address" }, { "dist_entry_links", "address" }, - { "code_ix_queue", NULL }, + { "code_write_permission", NULL }, { "proc_status", "pid" }, { "proc_tab", NULL }, { "ports_snapshot", NULL }, diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index e397f075d1..d5b7d01048 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -1096,7 +1096,6 @@ erts_send_message(Process* sender, } BM_SWAP_TIMER(send,system); #endif /* #ifndef ERTS_SMP */ - return; } return res; } diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c index 358c67bf20..5a6fb8589f 100644 --- a/erts/emulator/beam/erl_mtrace.c +++ b/erts/emulator/beam/erl_mtrace.c @@ -611,7 +611,7 @@ void erts_mtrace_init(char *receiver, char *nodename) if (erts_sock_gethostname(hostname, MAXHOSTNAMELEN) != 0) hostname[0] = '\0'; hostname[MAXHOSTNAMELEN-1] = '\0'; - sys_get_pid(pid); + sys_get_pid(pid, sizeof(pid)); write_trace_header(nodename ? nodename : "", pid, hostname); erts_mtrace_update_heap_size(); } diff --git a/erts/emulator/beam/erl_posix_str.c b/erts/emulator/beam/erl_posix_str.c index 02db10905b..deb7e3e173 100644 --- a/erts/emulator/beam/erl_posix_str.c +++ b/erts/emulator/beam/erl_posix_str.c @@ -619,6 +619,7 @@ erl_errno_id(error) case WSAEINVALIDPROVIDER: return "einvalidprovider"; #endif #ifdef WSAEPROVIDERFAILEDINIT + /* You could get this if SYSTEMROOT env variable is set incorrectly */ case WSAEPROVIDERFAILEDINIT: return "eproviderfailedinit"; #endif #ifdef WSASYSCALLFAILURE diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index c58bf40435..09169ba914 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -530,10 +530,6 @@ dbg_chk_aux_work_val(erts_aint32_t value) #ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN valid |= ERTS_SSI_AUX_WORK_CHECK_CHILDREN; #endif -#ifdef ERTS_SMP - valid |= ERTS_SSI_AUX_WORK_CODE_IX_ACTIVATION; - valid |= ERTS_SSI_AUX_WORK_FINISH_BP; -#endif #ifdef ERTS_SSI_AUX_WORK_REAP_PORTS valid |= ERTS_SSI_AUX_WORK_REAP_PORTS; #endif @@ -1450,92 +1446,6 @@ handle_async_ready_clean(ErtsAuxWorkData *awdp, #endif /* ERTS_USE_ASYNC_READY_Q */ -#ifdef ERTS_SMP -void -erts_notify_code_ix_activation(Process* p, ErtsThrPrgrVal later) -{ - ErtsAuxWorkData* awdp = &p->scheduler_data->aux_work_data; - ASSERT(awdp->code_ix_activation.code_stager == NULL); - awdp->code_ix_activation.code_stager = p; - awdp->code_ix_activation.thr_prgr = later; - erts_smp_proc_inc_refc(p); - set_aux_work_flags_wakeup_relb(p->scheduler_data->ssi, - ERTS_SSI_AUX_WORK_CODE_IX_ACTIVATION); -} - -static erts_aint32_t -handle_code_ix_activation(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) -{ - Process* p; - if (!erts_thr_progress_has_reached(awdp->code_ix_activation.thr_prgr)) { - return aux_work & ~ERTS_SSI_AUX_WORK_CODE_IX_ACTIVATION; - } - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_CODE_IX_ACTIVATION); - p = awdp->code_ix_activation.code_stager; - ASSERT(p); -#ifdef DEBUG - awdp->code_ix_activation.code_stager = NULL; -#endif - erts_commit_staging_code_ix(); - erts_release_code_write_permission(); - erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); - if (!ERTS_PROC_IS_EXITING(p)) { - erts_resume(p, ERTS_PROC_LOCK_STATUS); - } - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_proc_dec_refc(p); - return aux_work & ~ERTS_SSI_AUX_WORK_CODE_IX_ACTIVATION; -} -#endif /* ERTS_SMP */ - -#ifdef ERTS_SMP -void -erts_notify_finish_breakpointing(Process* p) -{ - ErtsAuxWorkData* awdp = &p->scheduler_data->aux_work_data; - - ASSERT(awdp->bp_ix_activation.stager == NULL); - awdp->bp_ix_activation.stager = p; - awdp->bp_ix_activation.thr_prgr = erts_thr_progress_later(awdp->esdp); - erts_thr_progress_wakeup(awdp->esdp, awdp->bp_ix_activation.thr_prgr); - erts_smp_proc_inc_refc(p); - set_aux_work_flags_wakeup_relb(p->scheduler_data->ssi, - ERTS_SSI_AUX_WORK_FINISH_BP); -} - -static erts_aint32_t -handle_finish_bp(ErtsAuxWorkData* awdp, erts_aint32_t aux_work) -{ - ErtsThrPrgrVal current = haw_thr_prgr_current(awdp); - - if (!erts_thr_progress_has_reached_this(current, - awdp->bp_ix_activation.thr_prgr)) { - return aux_work & ~ERTS_SSI_AUX_WORK_FINISH_BP; - } - if (erts_finish_breakpointing()) { /* Not done */ - /* Arrange for being called again */ - awdp->bp_ix_activation.thr_prgr = - erts_thr_progress_later(awdp->esdp); - erts_thr_progress_wakeup(awdp->esdp, awdp->bp_ix_activation.thr_prgr); - } else { /* Done */ - Process* p; - - unset_aux_work_flags(awdp->ssi, ERTS_SSI_AUX_WORK_FINISH_BP); - p = awdp->bp_ix_activation.stager; -#ifdef DEBUG - awdp->bp_ix_activation.stager = NULL; -#endif - erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); - if (!ERTS_PROC_IS_EXITING(p)) { - erts_resume(p, ERTS_PROC_LOCK_STATUS); - } - erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); - erts_smp_proc_dec_refc(p); - erts_release_code_write_permission(); - } - return aux_work & ~ERTS_SSI_AUX_WORK_FINISH_BP; -} -#endif /* ERTS_SMP */ static ERTS_INLINE erts_aint32_t handle_fix_alloc(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) @@ -1670,6 +1580,9 @@ handle_thr_prgr_later_op(ErtsAuxWorkData *awdp, erts_aint32_t aux_work) if (!erts_thr_progress_has_reached_this(current, lop->later)) return aux_work & ~ERTS_SSI_AUX_WORK_THR_PRGR_LATER_OP; awdp->later_op.first = lop->next; + if (!awdp->later_op.first) { + awdp->later_op.last = NULL; + } lop->func(lop->data); if (!awdp->later_op.first) { awdp->later_op.last = NULL; @@ -1981,19 +1894,9 @@ handle_aux_work(ErtsAuxWorkData *awdp, erts_aint32_t orig_aux_work, int waiting) handle_mseg_cache_check); #endif -#ifdef ERTS_SMP - HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_CODE_IX_ACTIVATION, - handle_code_ix_activation); -#endif - HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_REAP_PORTS, handle_reap_ports); -#ifdef ERTS_SMP - HANDLE_AUX_WORK(ERTS_SSI_AUX_WORK_FINISH_BP, - handle_finish_bp); -#endif - ERTS_DBG_CHK_AUX_WORK_VAL(aux_work); #ifdef ERTS_SMP @@ -9453,7 +9356,7 @@ stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg) erts_print(to, to_arg, "\n%p ", sp); } else { char sbuf[16]; - sprintf(sbuf, "y(%d)", yreg); + erts_snprintf(sbuf, sizeof(sbuf), "y(%d)", yreg); erts_print(to, to_arg, "%-8s ", sbuf); yreg++; } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 1436e246d6..fa6961e8a4 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -283,9 +283,7 @@ typedef enum { #define ERTS_SSI_AUX_WORK_CHECK_CHILDREN (((erts_aint32_t) 1) << 10) #define ERTS_SSI_AUX_WORK_SET_TMO (((erts_aint32_t) 1) << 11) #define ERTS_SSI_AUX_WORK_MSEG_CACHE_CHECK (((erts_aint32_t) 1) << 12) -#define ERTS_SSI_AUX_WORK_CODE_IX_ACTIVATION (((erts_aint32_t) 1) << 13) -#define ERTS_SSI_AUX_WORK_REAP_PORTS (((erts_aint32_t) 1) << 14) -#define ERTS_SSI_AUX_WORK_FINISH_BP (((erts_aint32_t) 1) << 15) +#define ERTS_SSI_AUX_WORK_REAP_PORTS (((erts_aint32_t) 1) << 13) typedef struct ErtsSchedulerSleepInfo_ ErtsSchedulerSleepInfo; @@ -480,14 +478,6 @@ typedef struct { #endif #ifdef ERTS_SMP struct { - Process* code_stager; - ErtsThrPrgrVal thr_prgr; - } code_ix_activation; - struct { - Process* stager; - ErtsThrPrgrVal thr_prgr; - } bp_ix_activation; - struct { int *sched2jix; int jix; ErtsDelayedAuxWorkWakeupJob *job; diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 964dc1ae3e..542c5ed0d9 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -323,7 +323,7 @@ heap_dump(int to, void *to_arg, Eterm x) int i; GET_DOUBLE_DATA((ptr+1), f); - i = sys_double_to_chars(f.fd, (char*) sbuf); + i = sys_double_to_chars(f.fd, (char*) sbuf, sizeof(sbuf)); sys_memset(sbuf+i, 0, 31-i); erts_print(to, to_arg, "F%X:%s\n", i, sbuf); *ptr = OUR_NIL; diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c index 7777ba1d3d..84a8270d06 100644 --- a/erts/emulator/beam/erl_process_lock.c +++ b/erts/emulator/beam/erl_process_lock.c @@ -1587,7 +1587,7 @@ erts_proc_lc_chk_no_proc_locks(char *file, int line) lc_id.proc_lock_msgq, lc_id.proc_lock_status}; erts_lc_have_lock_ids(resv, ids, 4); - if (resv[0] || resv[1] || resv[2] || resv[3]) { + if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3])) { erts_lc_fail("%s:%d: Thread has process locks locked when expected " "not to have any process locks locked", file, line); diff --git a/erts/emulator/beam/erl_resolv_dns.c b/erts/emulator/beam/erl_resolv_dns.c deleted file mode 100644 index 9d76fa89f8..0000000000 --- a/erts/emulator/beam/erl_resolv_dns.c +++ /dev/null @@ -1,23 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - -/* - * Set this to non-zero value if DNS should be used. - */ -int erl_use_resolver = 1; diff --git a/erts/emulator/beam/erl_resolv_nodns.c b/erts/emulator/beam/erl_resolv_nodns.c deleted file mode 100644 index f14ab68e27..0000000000 --- a/erts/emulator/beam/erl_resolv_nodns.c +++ /dev/null @@ -1,23 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 1997-2009. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - */ - -/* - * Set this to non-zero value if DNS should be used. - */ -int erl_use_resolver = 0; diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c index f77e8b798f..bf7774f882 100644 --- a/erts/emulator/beam/erl_term.c +++ b/erts/emulator/beam/erl_term.c @@ -105,7 +105,7 @@ unsigned tag_val_def(Wterm x) break; } } - sprintf(msg, "tag_val_def: %#lx", (unsigned long) x); + erts_snprintf(msg, sizeof(msg), "tag_val_def: %#lx", (unsigned long) x); et_abort(msg, file, line); #undef file #undef line diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 16a987472a..ab1065aaa1 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -1850,8 +1850,8 @@ enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags, } else { *ep++ = FLOAT_EXT; - /* now the sprintf which does the work */ - i = sys_double_to_chars(f.fd, (char*) ep); + /* now the erts_snprintf which does the work */ + i = sys_double_to_chars(f.fd, (char*) ep, (size_t)31); /* Don't leave garbage after the float! (Bad practice in general, * and Purify complains.) diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 1503d793ab..4c0d3421c8 100755 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -999,6 +999,9 @@ Uint erts_port_ioq_size(Port *pp); void erts_stale_drv_select(Eterm, ErlDrvEvent, int, int); void erts_port_cleanup(Port *); void erts_fire_port_monitor(Port *prt, Eterm ref); + +Port *erts_get_heart_port(void); + #ifdef ERTS_SMP void erts_smp_xports_unlock(Port *); #endif diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c index 25d5cce0f3..c981a0a55e 100644 --- a/erts/emulator/beam/index.c +++ b/erts/emulator/beam/index.c @@ -82,7 +82,8 @@ index_put_entry(IndexTable* t, void* tmpl) if (ix >= t->size) { Uint sz; if (ix >= t->limit) { - erl_exit(1, "no more index entries in %s (max=%d)\n", + /* A core dump is unnecessary */ + erl_exit(ERTS_DUMP_EXIT, "no more index entries in %s (max=%d)\n", t->htable.name, t->limit); } sz = INDEX_PAGE_SIZE*sizeof(IndexSlot*); diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index dec51f3be5..60b9238d38 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1128,7 +1128,7 @@ int erts_write_to_port(Eterm caller_id, Port *p, Eterm list) Uint size; int fpe_was_unmasked; - ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p) || ERTS_IS_CRASH_DUMPING); ERTS_SMP_CHK_NO_PROC_LOCKS; p->caller = caller_id; @@ -5258,3 +5258,27 @@ erl_drv_getenv(char *key, char *value, size_t *value_size) { return erts_sys_getenv_raw(key, value, value_size); } + +/* get heart_port + * used by erl_crash_dump + * - uses the fact that heart_port is registered when starting heart + */ + +Port *erts_get_heart_port() { + + Port* port; + Uint ix; + + for(ix = 0; ix < erts_max_ports; ix++) { + port = &erts_port[ix]; + /* only examine undead or alive ports */ + if (port->status & ERTS_PORT_SFLGS_DEAD) + continue; + /* immediate atom compare */ + if (port->reg && port->reg->name == am_heart_port) { + return port; + } + } + + return NULL; +} diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c index 1ef71cda79..01856007ee 100644 --- a/erts/emulator/beam/module.c +++ b/erts/emulator/beam/module.c @@ -144,7 +144,7 @@ erts_put_module(Eterm mod) ASSERT(is_atom(mod)); ERTS_SMP_LC_ASSERT(erts_initialized == 0 - || erts_is_code_ix_locked()); + || erts_has_code_write_permission()); mod_tab = &module_tables[erts_staging_code_ix()]; e.module = atom_val(mod); diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index 2c65ce91d1..8957bb5bde 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -644,7 +644,7 @@ void erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec); void erts_sys_main_thread(void); #endif -extern void erts_sys_prepare_crash_dump(void); +extern void erts_sys_prepare_crash_dump(int secs); extern void erts_sys_pre_init(void); extern void erl_sys_init(void); extern void erl_sys_args(int *argc, char **argv); @@ -691,8 +691,8 @@ void fini_getenv_state(GETENV_STATE *); /* xxxP */ void init_sys_float(void); int sys_chars_to_double(char*, double*); -int sys_double_to_chars(double, char*); -void sys_get_pid(char *); +int sys_double_to_chars(double, char*, size_t); +void sys_get_pid(char *, size_t); /* erts_sys_putenv() returns, 0 on success and a value != 0 on failure. */ int erts_sys_putenv(char *key, char *value); diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c index 8981050228..3210ffa92a 100644 --- a/erts/emulator/drivers/common/inet_drv.c +++ b/erts/emulator/drivers/common/inet_drv.c @@ -10162,6 +10162,7 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, } new_udesc->inet.state = INET_STATE_CONNECTED; new_udesc->inet.stype = SOCK_STREAM; + SET_NONBLOCKING(new_udesc->inet.s); inet_reply_ok_port(desc, new_udesc->inet.dport); (*rbuf)[0] = INET_REP; diff --git a/erts/emulator/drivers/win32/registry_drv.c b/erts/emulator/drivers/win32/registry_drv.c index 1fad34e380..5b200ebd32 100644 --- a/erts/emulator/drivers/win32/registry_drv.c +++ b/erts/emulator/drivers/win32/registry_drv.c @@ -344,7 +344,7 @@ fix_value_result(RegPort* rp, LONG result, DWORD type, #ifdef DEBUG if (ok != ERROR_SUCCESS) { char buff[256]; - sprintf(buff,"Failure in registry_drv line %d, error = %d", + erts_snprintf(buff, sizeof(buff), "Failure in registry_drv line %d, error = %d", __LINE__, GetLastError()); MessageBox(NULL, buff, "Internal error", MB_OK); ASSERT(ok == ERROR_SUCCESS); diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index c1fa00b4ea..b485dbf784 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -58,7 +58,6 @@ #define __DARWIN__ 1 #endif - #ifdef USE_THREADS #include "erl_threads.h" #endif @@ -71,7 +70,6 @@ static erts_smp_rwmtx_t environ_rwmtx; #define MAX_VSIZE 16 /* Max number of entries allowed in an I/O * vector sock_sendv(). */ - /* * Don't need global.h, but bif_table.h (included by bif.h), * won't compile otherwise @@ -123,6 +121,15 @@ struct ErtsSysReportExit_ { #endif }; +/* This data is shared by these drivers - initialized by spawn_init() */ +static struct driver_data { + int port_num, ofd, packet_bytes; + ErtsSysReportExit *report_exit; + int pid; + int alive; + int status; +} *driver_data; /* indexed by fd */ + static ErtsSysReportExit *report_exit_list; #if CHLDWTHR && !defined(ERTS_SMP) static ErtsSysReportExit *report_exit_transit_list; @@ -570,7 +577,7 @@ erl_sys_init(void) + 1); child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz); erts_smp_atomic_add_nob(&sys_misc_mem_sz, csp_path_sz); - sprintf(child_setup_prog, + erts_snprintf(child_setup_prog, csp_path_sz, "%s%c%s", bindir, DIR_SEPARATOR_CHAR, @@ -680,17 +687,40 @@ static RETSIGTYPE break_handler(int sig) #endif /* 0 */ static ERTS_INLINE void -prepare_crash_dump(void) +prepare_crash_dump(int secs) { +#define NUFBUF (3) int i, max; char env[21]; /* enough to hold any 64-bit integer */ size_t envsz; + DeclareTmpHeapNoproc(heap,NUFBUF); + Port *heart_port; + Eterm *hp = heap; + Eterm list = NIL; + int heart_fd[2] = {-1,-1}; + + UseTmpHeapNoproc(NUFBUF); if (ERTS_PREPARED_CRASH_DUMP) return; /* We have already been called */ + heart_port = erts_get_heart_port(); + if (heart_port) { + /* hearts input fd + * We "know" drv_data is the in_fd since the port is started with read|write + */ + heart_fd[0] = (int)heart_port->drv_data; + heart_fd[1] = (int)driver_data[heart_fd[0]].ofd; + + list = CONS(hp, make_small(8), list); hp += 2; + + /* send to heart port, CMD = 8, i.e. prepare crash dump =o */ + erts_write_to_port(ERTS_INVALID_PID, heart_port, list); + } + /* Make sure we unregister at epmd (unknown fd) and get at least one free filedescriptor (for erl_crash.dump) */ + max = max_files; if (max < 1024) max = 1024; @@ -704,11 +734,15 @@ prepare_crash_dump(void) if (i == async_fd[0] || i == async_fd[1]) continue; #endif + /* We don't want to close our heart yet ... */ + if (i == heart_fd[0] || i == heart_fd[1]) + continue; + close(i); } envsz = sizeof(env); - i = erts_sys_getenv_raw("ERL_CRASH_DUMP_NICE", env, &envsz); + i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz); if (i >= 0) { int nice_val; nice_val = i != 0 ? 0 : atoi(env); @@ -717,21 +751,21 @@ prepare_crash_dump(void) } erts_silence_warn_unused_result(nice(nice_val)); } - - envsz = sizeof(env); - i = erts_sys_getenv_raw("ERL_CRASH_DUMP_SECONDS", env, &envsz); - if (i >= 0) { - unsigned sec; - sec = (unsigned) i != 0 ? 0 : atoi(env); - alarm(sec); - } + /* Positive secs means an alarm must be set + * 0 or negative means no alarm + */ + if (secs > 0) { + alarm((unsigned int)secs); + } + UnUseTmpHeapNoproc(NUFBUF); +#undef NUFBUF } void -erts_sys_prepare_crash_dump(void) +erts_sys_prepare_crash_dump(int secs) { - prepare_crash_dump(); + prepare_crash_dump(secs); } static ERTS_INLINE void @@ -773,7 +807,7 @@ sigusr1_exit(void) is hung somewhere, so it won't be able to poll any flag we set here. */ ERTS_SET_GOT_SIGUSR1; - prepare_crash_dump(); + prepare_crash_dump((int)0); erl_exit(1, "Received SIGUSR1\n"); } @@ -1021,15 +1055,6 @@ void fini_getenv_state(GETENV_STATE *state) #define ERTS_SYS_READ_BUF_SZ (64*1024) -/* This data is shared by these drivers - initialized by spawn_init() */ -static struct driver_data { - int port_num, ofd, packet_bytes; - ErtsSysReportExit *report_exit; - int pid; - int alive; - int status; -} *driver_data; /* indexed by fd */ - /* Driver interfaces */ static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); @@ -1532,12 +1557,13 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op } #if !DISABLE_VFORK } +#define ENOUGH_BYTES (44) else { /* Use vfork() */ char **cs_argv= erts_alloc(ERTS_ALC_T_TMP,(CS_ARGV_NO_OF_ARGS + 1)* sizeof(char *)); - char fd_close_range[44]; /* 44 bytes are enough to */ - char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][44]; /* hold any "%d:%d" string */ - /* on a 64-bit machine. */ + char fd_close_range[ENOUGH_BYTES]; /* 44 bytes are enough to */ + char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][ENOUGH_BYTES]; /* hold any "%d:%d" string */ + /* on a 64-bit machine. */ /* Setup argv[] for the child setup program (implemented in erl_child_setup.c) */ @@ -1545,23 +1571,23 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op if (opts->use_stdio) { if (opts->read_write & DO_READ){ /* stdout for process */ - sprintf(&dup2_op[i++][0], "%d:%d", ifd[1], 1); + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 1); if(opts->redir_stderr) /* stderr for process */ - sprintf(&dup2_op[i++][0], "%d:%d", ifd[1], 2); + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 2); } if (opts->read_write & DO_WRITE) /* stdin for process */ - sprintf(&dup2_op[i++][0], "%d:%d", ofd[0], 0); + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 0); } else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ if (opts->read_write & DO_READ) - sprintf(&dup2_op[i++][0], "%d:%d", ifd[1], 4); + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ifd[1], 4); if (opts->read_write & DO_WRITE) - sprintf(&dup2_op[i++][0], "%d:%d", ofd[0], 3); + erts_snprintf(&dup2_op[i++][0], ENOUGH_BYTES, "%d:%d", ofd[0], 3); } for (; i < CS_ARGV_NO_OF_DUP2_OPS; i++) strcpy(&dup2_op[i][0], "-"); - sprintf(fd_close_range, "%d:%d", opts->use_stdio ? 3 : 5, max_files-1); + erts_snprintf(fd_close_range, ENOUGH_BYTES, "%d:%d", opts->use_stdio ? 3 : 5, max_files-1); cs_argv[CS_ARGV_PROGNAME_IX] = child_setup_prog; cs_argv[CS_ARGV_WD_IX] = opts->wd ? opts->wd : "."; @@ -1612,6 +1638,7 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* op } erts_free(ERTS_ALC_T_TMP,cs_argv); } +#undef ENOUGH_BYTES #endif erts_sched_bind_atfork_parent(unbind); @@ -2355,10 +2382,10 @@ void erts_do_break_handling(void) ** no interpretatione of this should be done by the rest of the ** emulator. The buffer should be at least 21 bytes long. */ -void sys_get_pid(char *buffer){ +void sys_get_pid(char *buffer, size_t buffer_size){ pid_t p = getpid(); /* Assume the pid is scalar and can rest in an unsigned long... */ - sprintf(buffer,"%lu",(unsigned long) p); + erts_snprintf(buffer, buffer_size, "%lu",(unsigned long) p); } int @@ -2417,6 +2444,15 @@ erts_sys_getenv_raw(char *key, char *value, size_t *size) { return erts_sys_getenv(key, value, size); } +/* + * erts_sys_getenv + * returns: + * -1, if environment key is not set with a value + * 0, if environment key is set and value fits into buffer size + * 1, if environment key is set but does not fit into buffer size + * size is set with the needed buffer size value + */ + int erts_sys_getenv(char *key, char *value, size_t *size) { diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c index 8ec7b31ce0..3fcb4d88dc 100644 --- a/erts/emulator/sys/unix/sys_float.c +++ b/erts/emulator/sys/unix/sys_float.c @@ -745,18 +745,18 @@ void erts_sys_unblock_fpe(int unmasked) */ int -sys_double_to_chars(double fp, char *buf) +sys_double_to_chars(double fp, char *buffer, size_t buffer_size) { - char *s = buf; + char *s = buffer; - (void) sprintf(buf, "%.20e", fp); + (void) erts_snprintf(buffer, buffer_size, "%.20e", fp); /* Search upto decimal point */ if (*s == '+' || *s == '-') s++; while (ISDIGIT(*s)) s++; if (*s == ',') *s++ = '.'; /* Replace ',' with '.' */ /* Scan to end of string */ while (*s) s++; - return s-buf; /* i.e strlen(buf) */ + return s-buffer; /* i.e strlen(buffer) */ } /* Float conversion */ diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 6894d682e7..47d12ed5fe 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -256,10 +256,25 @@ void erl_sys_args(int* argc, char** argv) } void -erts_sys_prepare_crash_dump(void) +erts_sys_prepare_crash_dump(int secs) { + Port *heart_port; + Eterm heap[3]; + Eterm *hp = heap; + Eterm list = NIL; + + heart_port = erts_get_heart_port(); + + if (heart_port) { + + list = CONS(hp, make_small(8), list); hp += 2; + + /* send to heart port, CMD = 8, i.e. prepare crash dump =o */ + erts_write_to_port(NIL, heart_port, list); + } + /* Windows - free file descriptors are hopefully available */ - return; + /* Alarm not used on windows */ } static void @@ -420,6 +435,8 @@ typedef struct async_io { HANDLE ioAllowed; /* The thread will wait for this event * before starting a new read or write. */ + HANDLE flushEvent; /* Used to signal that a flush should be done. */ + HANDLE flushReplyEvent; /* Used to signal that a flush has been done. */ DWORD pendingError; /* Used to delay presentating an error to Erlang * until the check_io function is entered. */ @@ -878,6 +895,8 @@ init_async_io(AsyncIo* aio, int use_threads) aio->ov.Offset = 0L; aio->ov.OffsetHigh = 0L; aio->ioAllowed = NULL; + aio->flushEvent = NULL; + aio->flushReplyEvent = NULL; aio->pendingError = 0; aio->bytesTransferred = 0; #ifdef ERTS_SMP @@ -890,6 +909,12 @@ init_async_io(AsyncIo* aio, int use_threads) aio->ioAllowed = CreateAutoEvent(FALSE); if (aio->ioAllowed == NULL) return -1; + aio->flushEvent = CreateAutoEvent(FALSE); + if (aio->flushEvent == NULL) + return -1; + aio->flushReplyEvent = CreateAutoEvent(FALSE); + if (aio->flushReplyEvent == NULL) + return -1; } return 0; } @@ -923,6 +948,14 @@ release_async_io(AsyncIo* aio, ErlDrvPort port_num) if (aio->ioAllowed != NULL) CloseHandle(aio->ioAllowed); aio->ioAllowed = NULL; + + if (aio->flushEvent != NULL) + CloseHandle(aio->flushEvent); + aio->flushEvent = NULL; + + if (aio->flushReplyEvent != NULL) + CloseHandle(aio->flushReplyEvent); + aio->flushReplyEvent = NULL; } /* ---------------------------------------------------------------------- @@ -2083,16 +2116,26 @@ threaded_writer(LPVOID param) AsyncIo* aio = (AsyncIo *) param; HANDLE thread = GetCurrentThread(); char* buf; - DWORD numToWrite; + DWORD numToWrite, handle; int ok; + HANDLE handles[2]; + handles[0] = aio->ioAllowed; + handles[1] = aio->flushEvent; for (;;) { - WaitForSingleObject(aio->ioAllowed, INFINITE); + handle = WaitForMultipleObjects(2, handles, FALSE, INFINITE); if (aio->flags & DF_EXIT_THREAD) break; + buf = OV_BUFFER_PTR(aio); numToWrite = OV_NUM_TO_READ(aio); aio->pendingError = 0; + + if (handle == (WAIT_OBJECT_0 + 1) && numToWrite == 0) { + SetEvent(aio->flushReplyEvent); + continue; + } + ok = WriteFile(aio->fd, buf, numToWrite, &aio->bytesTransferred, NULL); if (!ok) { aio->pendingError = GetLastError(); @@ -2127,7 +2170,11 @@ threaded_writer(LPVOID param) } } } - SetEvent(aio->ov.hEvent); + OV_NUM_TO_READ(aio) = 0; + if (handle == (WAIT_OBJECT_0 + 1)) + SetEvent(aio->flushReplyEvent); + else + SetEvent(aio->ov.hEvent); if (aio->pendingError != NO_ERROR || aio->bytesTransferred == 0) break; if (aio->flags & DF_EXIT_THREAD) @@ -2193,6 +2240,43 @@ fd_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) if ((dp = new_driver_data(port_num, opts->packet_bytes, 2, TRUE)) == NULL) return ERL_DRV_ERROR_GENERAL; + /** + * Here is a brief description about how the fd driver works on windows. + * + * fd_init: + * For each in/out fd pair a threaded_reader and threaded_writer thread is + * created. Within the DriverData struct each of the threads have an AsyncIO + * sctruct associated with it. Within AsyncIO there are two important HANDLEs, + * ioAllowed and ov.hEvent. ioAllowed is used to signal the threaded_* threads + * should read/write some data, and ov.hEvent is driver_select'ed to be used to + * signal that the thread is done reading/writing. + * + * The reason for the driver being threaded like this is because once the FD is open + * on windows, it is not possible to set the it in overlapped mode. So we have to + * simulate this using threads. + * + * output: + * When an output occurs the data to be outputted is copied to AsyncIO.ov. Then + * the ioAllowed HANDLE is set, ov.hEvent is cleared and the port is marked as busy. + * The threaded_writer thread is lying in WaitForMultipleObjects on ioAllowed, and + * when signalled it writes all data in AsyncIO.ov and then sets ov.hEvent so that + * ready_output gets triggered and (potentially) sends the reply to the port and + * marks the port an non-busy. + * + * input: + * The threaded_reader is lying waiting in ReadFile on the in fd and when a new + * line is written it sets ov.hEvent that new data is available and then goes + * and waits for ioAllowed to be set. ready_input is run when ov.hEvent is set and + * delivers the data to the port. Then ioAllowed is signalled again and threaded_reader + * goes back to ReadFile. + * + * shutdown: + * In order to guarantee that all io is outputted before the driver is stopped, + * fd_stop uses flushEvent and flushReplyEvent to make sure that there is no data + * in ov which needs writing before returning from fd_stop. + * + **/ + if (!create_file_thread(&dp->in, DO_READ)) { dp->port_num = PORT_FREE; return ERL_DRV_ERROR_GENERAL; @@ -2241,6 +2325,8 @@ static void fd_stop(ErlDrvData d) (void) driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, ERL_DRV_WRITE, 0); + SetEvent(dp->out.flushEvent); + WaitForSingleObject(dp->out.flushReplyEvent, INFINITE); } } @@ -2764,10 +2850,10 @@ static void stop_select(ErlDrvEvent e, void* _) ** no interpretation of this should be done by the rest of the ** emulator. The buffer should be at least 21 bytes long. */ -void sys_get_pid(char *buffer){ +void sys_get_pid(char *buffer, size_t buffer_size){ DWORD p = GetCurrentProcessId(); /* The pid is scalar and is an unsigned long. */ - sprintf(buffer,"%lu",(unsigned long) p); + erts_snprintf(buffer, buffer_size, "%lu",(unsigned long) p); } void @@ -3107,7 +3193,8 @@ erl_assert_error(char* expr, char* file, int line) { char message[1024]; - sprintf(message, "File %hs, line %d: %hs", file, line, expr); + erts_snprintf(message, sizeof(message), + "File %hs, line %d: %hs", file, line, expr); MessageBox(GetActiveWindow(), message, "Assertion failed", MB_OK | MB_ICONERROR); #if 0 diff --git a/erts/emulator/sys/win32/sys_float.c b/erts/emulator/sys/win32/sys_float.c index 6558ad2d99..09dad89140 100644 --- a/erts/emulator/sys/win32/sys_float.c +++ b/erts/emulator/sys/win32/sys_float.c @@ -118,18 +118,18 @@ sys_chars_to_double(char *buf, double *fp) */ int -sys_double_to_chars(double fp, char *buf) +sys_double_to_chars(double fp, char *buffer, size_t buffer_size) { - char *s = buf; + char *s = buffer; - (void) sprintf(buf, "%.20e", fp); + (void) erts_snprintf(buffer, buffer_size, "%.20e", fp); /* Search upto decimal point */ if (*s == '+' || *s == '-') s++; while (isdigit(*s)) s++; if (*s == ',') *s++ = '.'; /* Replace ',' with '.' */ /* Scan to end of string */ while (*s) s++; - return s-buf; /* i.e strlen(buf) */ + return s-buffer; /* i.e strlen(buffer) */ } int diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c index 13af7d861a..b214f87e4a 100644 --- a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c @@ -16,11 +16,19 @@ * $Id$ */ +#include "erl_int_sizes_config.h" + #include "testcase_driver.h" #include "allocator_test.h" #include <stdio.h> -#define SBCT (512*1024) +#ifdef __WIN32__ && SIZEOF_VOID_P == 8 +/* Use larger threashold for win64 as block alignment + is 16 bytes and not 8 */ +#define SBCT ((1024*1024)) +#else +#define SBCT ((512*1024)) +#endif char * testcase_name(void) diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 58e0cb4096..babdb3363f 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -626,8 +626,32 @@ safe_binary_to_term2(Config) when is_list(Config) -> bad_terms(suite) -> []; bad_terms(Config) when is_list(Config) -> ?line test_terms(fun corrupter/1). - + +corrupter(Term) when is_function(Term); + is_function(hd(Term)); + is_function(element(2,element(2,element(2,Term)))) -> + %% Check if lists is native compiled. If it is, we do not try to + %% corrupt funs as this can create some very strange behaviour. + %% To show the error print `Byte` in the foreach fun in corrupter/2. + case erlang:system_info(hipe_architecture) of + undefined -> + corrupter0(Term); + Architecture -> + {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), + ChunkName = hipe_unified_loader:chunk_name(Architecture), + NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), + case NativeChunk of + {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> + S = io_lib:format("Skipping corruption of: ~P", [Term,12]), + io:put_chars(S); + {error, beam_lib, _} -> + corrupter0(Term) + end + end; corrupter(Term) -> + corrupter0(Term). + +corrupter0(Term) -> ?line try S = io_lib:format("About to corrupt: ~P", [Term,12]), io:put_chars(S) diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl index 390b49b604..26ac4f2f7f 100644 --- a/erts/emulator/test/save_calls_SUITE.erl +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -21,8 +21,10 @@ -include_lib("test_server/include/test_server.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). +-export([all/0, suite/0,groups/0, + init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2]). -export([save_calls_1/1,dont_break_reductions/1]). @@ -48,6 +50,27 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(dont_break_reductions,Config) -> + %% Skip on --enable-native-libs as hipe rescedules after each + %% function call. + case erlang:system_info(hipe_architecture) of + undefined -> + Config; + Architecture -> + {lists, ListsBinary, _ListsFilename} = code:get_object_code(lists), + ChunkName = hipe_unified_loader:chunk_name(Architecture), + NativeChunk = beam_lib:chunks(ListsBinary, [ChunkName]), + case NativeChunk of + {ok,{_,[{_,Bin}]}} when is_binary(Bin) -> + {skip,"Does not work for --enable-native-libs"}; + {error, beam_lib, _} -> Config + end + end; +init_per_testcase(_,Config) -> + Config. + +end_per_testcase(_,_Config) -> + ok. dont_break_reductions(suite) -> []; diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl index 98f1cf1ad5..71186d4942 100644 --- a/erts/emulator/test/smoke_test_SUITE.erl +++ b/erts/emulator/test/smoke_test_SUITE.erl @@ -51,7 +51,17 @@ end_per_group(_GroupName, Config) -> Config. +init_per_testcase(boot_combo = Case, Config) when is_list(Config) -> + case erlang:system_info(build_type) of + opt -> + init_per_tc(Case, Config); + _ -> + {skip,"Cannot test boot_combo in special builds since beam.* may not exist"} + end; init_per_testcase(Case, Config) when is_list(Config) -> + init_per_tc(Case, Config). + +init_per_tc(Case, Config) -> Dog = ?t:timetrap(?DEFAULT_TIMEOUT), [{testcase, Case},{watchdog, Dog}|Config]. @@ -121,18 +131,19 @@ start_node(Config) -> start_node(Config, ""). start_node(Config, Args) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line {A, B, C} = now(), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C)), - ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + Pa = filename:dirname(code:which(?MODULE)), + {A, B, C} = now(), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)), + Opts = [{args, "-pa "++Pa++" "++Args}], + ?t:start_node(Name, slave, Opts). stop_node(Node) -> ?t:stop_node(Node). diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index 8fe2402ca8..16a949c2a6 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -1,4 +1,4 @@ -#!/usr/bin/env perl +#!/usr/bin/env perl -W # # %CopyrightBegin% # @@ -362,7 +362,7 @@ while (<>) { $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; $min_window{"$name/$arity"} = 255; - $obsolete[$op_num] = $obsolete eq '-'; + $obsolete[$op_num] = defined $obsolete; } else { # Unnumbered generic operation. push(@unnumbered_generic, [$name, $arity]); $unnumbered{$name,$arity} = 1; @@ -379,7 +379,7 @@ while (<>) { if @args > $max_spec_operands; &syntax_check($name, @args); my $arity = @args; - if ($obsolete[$gen_opnum{$name,$arity}]) { + if (defined $gen_opnum{$name,$arity} and $obsolete[$gen_opnum{$name,$arity}]) { error("specific instructions may not be specified for obsolete instructions"); } push(@{$specific_op{"$name/$arity"}}, [$name, $hot, @args]); @@ -810,8 +810,8 @@ sub compiler_output { # # Generate .hrl file. # - my($name) = "$outdir/${module}.hrl"; - open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + my($hrl_name) = "$outdir/${module}.hrl"; + open(STDOUT, ">$hrl_name") || die "Failed to open $hrl_name for writing: $!\n"; &comment('erlang'); for ($i = 0; $i < @tag_type && $i < 8; $i++) { @@ -1251,8 +1251,8 @@ sub compile_transform { $arity++ unless $list[1] eq '*'; $_ = [ @list ]; } - - if ($obsolete[$gen_opnum{$name,$arity}]) { + + if (defined $gen_opnum{$name,$arity} && $obsolete[$gen_opnum{$name,$arity}]) { error("obsolete function must not be used in transformations"); } @@ -1704,14 +1704,15 @@ sub tr_gen_to { # my($first_ref) = shift(@code); my($size, $first, $key) = @$first_ref; - my($dummy, $op, $arity) = @$first; + my($dummy, $arity); + ($dummy, $op, $arity) = @$first; my($comment) = "\n/*\n * Line $line:\n * $orig_transform\n */\n\n"; $min_window{$key} = $min_window if $min_window{$key} > $min_window; my $prev_last; $prev_last = pop(@{$gen_transform{$key}}) - if defined @{$gen_transform{$key}}; # Fail + if defined $gen_transform{$key}; # Fail if ($prev_last && !is_instr($prev_last, 'fail')) { error("Line $line: A previous transformation shadows '$orig_transform'"); @@ -1719,7 +1720,7 @@ sub tr_gen_to { unless ($cannot_fail) { unshift(@code, make_op('', 'try_me_else', tr_code_len(@code))); - push(@code, make_op(""), make_op("$key", 'fail')); + push(@code, make_op("$key", 'fail')); } unshift(@code, make_op($comment)); push(@{$gen_transform{$key}}, @code), diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index 2267f9b12b..3577abf6ba 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -64,7 +64,7 @@ int epmd_dbg(int level,int port) /* Utility to debug epmd... */ if(port) { argv[argc++] = "-port"; - sprintf(ibuff,"%d",port); + erts_snprintf(ibuff, sizeof(ibuff), "%d",port); argv[argc++] = ibuff; } argv[argc] = NULL; diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index da575affa1..36565b7438 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -23,6 +23,7 @@ #endif #include "epmd.h" /* Renamed from 'epmd_r4.h' */ #include "epmd_int.h" +#include "erl_printf.h" /* erts_snprintf */ #ifndef INADDR_NONE # define INADDR_NONE 0xffffffff @@ -633,7 +634,7 @@ static void do_request(g, fd, s, buf, bsize) /* CAREFUL!!! These are parsed by "erl_epmd.erl" so a slight change in syntax will break < OTP R3A */ - sprintf(wbuf,"name %s at port %d\n",node->symname, node->port); + erts_snprintf(wbuf, sizeof(wbuf), "name %s at port %d\n",node->symname, node->port); len = strlen(wbuf); if (reply(g, fd, wbuf, len) != len) { @@ -669,7 +670,7 @@ static void do_request(g, fd, s, buf, bsize) /* CAREFUL!!! These are parsed by "erl_epmd.erl" so a slight change in syntax will break < OTP R3A */ - sprintf(wbuf,"active name <%s> at port %d, fd = %d\n", + erts_snprintf(wbuf, sizeof(wbuf), "active name <%s> at port %d, fd = %d\n", node->symname, node->port, node->fd); len = strlen(wbuf) + 1; if (reply(g, fd,wbuf,len) != len) @@ -686,7 +687,7 @@ static void do_request(g, fd, s, buf, bsize) /* CAREFUL!!! These are parsed by "erl_epmd.erl" so a slight change in syntax will break < OTP R3A */ - sprintf(wbuf,"old/unused name <%s>, port = %d, fd = %d \n", + erts_snprintf(wbuf, sizeof(wbuf), "old/unused name <%s>, port = %d, fd = %d \n", node->symname,node->port, node->fd); len = strlen(wbuf) + 1; if (reply(g, fd,wbuf,len) != len) diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c index 52add1c1ba..04d3425fe0 100644 --- a/erts/etc/common/erlexec.c +++ b/erts/etc/common/erlexec.c @@ -989,8 +989,7 @@ int main(int argc, char **argv) if (print_args_exit) { for (i = 1; i < EargsCnt; i++) - printf("%s ", Eargsp[i]); - printf("\n"); + printf("%s\n", Eargsp[i]); exit(0); } diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c index 7b78cc489d..81d797dc7e 100644 --- a/erts/etc/common/heart.c +++ b/erts/etc/common/heart.c @@ -115,7 +115,8 @@ # endif #endif -#define HEART_COMMAND_ENV "HEART_COMMAND" +#define HEART_COMMAND_ENV "HEART_COMMAND" +#define ERL_CRASH_DUMP_SECONDS_ENV "ERL_CRASH_DUMP_SECONDS" #define MSG_HDR_SIZE 2 #define MSG_HDR_PLUS_OP_SIZE 3 @@ -131,13 +132,14 @@ struct msg { }; /* operations */ -#define HEART_ACK 1 -#define HEART_BEAT 2 -#define SHUT_DOWN 3 -#define SET_CMD 4 -#define CLEAR_CMD 5 -#define GET_CMD 6 -#define HEART_CMD 7 +#define HEART_ACK (1) +#define HEART_BEAT (2) +#define SHUT_DOWN (3) +#define SET_CMD (4) +#define CLEAR_CMD (5) +#define GET_CMD (6) +#define HEART_CMD (7) +#define PREPARING_CRASH (8) /* Maybe interesting to change */ @@ -165,10 +167,11 @@ unsigned long heart_beat_kill_pid = 0; #define SOL_WD_TIMEOUT (heart_beat_timeout+heart_beat_boot_delay) /* reasons for reboot */ -#define R_TIMEOUT 1 -#define R_CLOSED 2 -#define R_ERROR 3 -#define R_SHUT_DOWN 4 +#define R_TIMEOUT (1) +#define R_CLOSED (2) +#define R_ERROR (3) +#define R_SHUT_DOWN (4) +#define R_CRASHING (5) /* Doing a crash dump and we will wait for it */ /* macros */ @@ -178,8 +181,8 @@ unsigned long heart_beat_kill_pid = 0; /* prototypes */ -static int message_loop(int,int); -static void do_terminate(int); +static int message_loop(int, int); +static void do_terminate(int, int); static int notify_ack(int); static int heart_cmd_reply(int, char *); static int write_message(int, struct msg *); @@ -190,6 +193,7 @@ static void print_error(const char *,...); static void debugf(const char *,...); static void init_timestamp(void); static time_t timestamp(time_t *); +static int wait_until_close_write_or_env_tmo(int); #ifdef __WIN32__ static BOOL enable_privilege(void); @@ -328,12 +332,14 @@ static void get_arguments(int argc, char** argv) { debugf("arguments -ht %d -wt %d -pid %lu\n",h,w,p); } -int -main(int argc, char **argv) -{ +int main(int argc, char **argv) { + + if (is_env_set("HEART_DEBUG")) { + fprintf(stderr, "heart: debug is ON!\r\n"); + debug_on = 1; + } + get_arguments(argc,argv); - if (is_env_set("HEART_DEBUG")) - debug_on=1; #ifdef __WIN32__ if (debug_on) { if(!is_env_set("ERLSRV_SERVICE_NAME")) { @@ -354,7 +360,7 @@ main(int argc, char **argv) program_name[sizeof(program_name)-1] = '\0'; notify_ack(erlout_fd); cmd[0] = '\0'; - do_terminate(message_loop(erlin_fd,erlout_fd)); + do_terminate(erlin_fd,message_loop(erlin_fd,erlout_fd)); return 0; } @@ -388,6 +394,7 @@ message_loop(erlin_fd, erlout_fd) #endif while (1) { + /* REFACTOR: below to select/tmo function */ #ifdef __WIN32__ wresult = WaitForSingleObject(hevent_dataready,SELECT_TIMEOUT*1000+ 2); if (wresult == WAIT_FAILED) { @@ -482,6 +489,10 @@ message_loop(erlin_fd, erlout_fd) free_env_val(env); } break; + case PREPARING_CRASH: + /* Erlang has reached a crushdump point (is crashing for sure) */ + print_error("Erlang is crashing .. (waiting for crash dump file)"); + return R_CRASHING; default: /* ignore all other messages */ break; @@ -612,72 +623,130 @@ void win_system(char *command) * do_terminate */ static void -do_terminate(reason) - int reason; -{ +do_terminate(int erlin_fd, int reason) { /* When we get here, we have HEART_BEAT_BOOT_DELAY secs to finish (plus heart_beat_report_delay if under VxWorks), so we don't need to call wd_reset(). */ - + int ret = 0, tmo=0; + char *tmo_env; + switch (reason) { case R_SHUT_DOWN: break; + case R_CRASHING: + if (is_env_set(ERL_CRASH_DUMP_SECONDS_ENV)) { + tmo_env = get_env(ERL_CRASH_DUMP_SECONDS_ENV); + tmo = atoi(tmo_env); + print_error("Waiting for dump - timeout set to %d seconds.", tmo); + wait_until_close_write_or_env_tmo(tmo); + free_env_val(tmo_env); + } + /* fall through */ case R_TIMEOUT: - case R_ERROR: case R_CLOSED: + case R_ERROR: default: -#if defined(__WIN32__) { - if(!cmd[0]) { - char *command = get_env(HEART_COMMAND_ENV); - if(!command) - print_error("Would reboot. Terminating."); - else { - kill_old_erlang(); - /* High prio combined with system() works badly indeed... */ - SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS); - win_system(command); - print_error("Executed \"%s\". Terminating.",command); +#if defined(__WIN32__) /* Not VxWorks */ + if(!cmd[0]) { + char *command = get_env(HEART_COMMAND_ENV); + if(!command) + print_error("Would reboot. Terminating."); + else { + kill_old_erlang(); + /* High prio combined with system() works badly indeed... */ + SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS); + win_system(command); + print_error("Executed \"%s\". Terminating.",command); + } + free_env_val(command); + } else { + kill_old_erlang(); + /* High prio combined with system() works badly indeed... */ + SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS); + win_system(&cmd[0]); + print_error("Executed \"%s\". Terminating.",cmd); } - free_env_val(command); - } - else { - kill_old_erlang(); - /* High prio combined with system() works badly indeed... */ - SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS); - win_system(&cmd[0]); - print_error("Executed \"%s\". Terminating.",cmd); - } - } - #else - { - if(!cmd[0]) { - char *command = get_env(HEART_COMMAND_ENV); - if(!command) - print_error("Would reboot. Terminating."); - else { - kill_old_erlang(); - /* suppress gcc warning with 'if' */ - if(system(command)); - print_error("Executed \"%s\". Terminating.",command); + if(!cmd[0]) { + char *command = get_env(HEART_COMMAND_ENV); + if(!command) + print_error("Would reboot. Terminating."); + else { + kill_old_erlang(); + /* suppress gcc warning with 'if' */ + ret = system(command); + print_error("Executed \"%s\" -> %d. Terminating.",command, ret); + } + free_env_val(command); + } else { + kill_old_erlang(); + /* suppress gcc warning with 'if' */ + ret = system((char*)&cmd[0]); + print_error("Executed \"%s\" -> %d. Terminating.",cmd, ret); } - free_env_val(command); - } - else { - kill_old_erlang(); - /* suppress gcc warning with 'if' */ - if(system((char*)&cmd[0])); - print_error("Executed \"%s\". Terminating.",cmd); - } +#endif } break; -#endif } /* switch(reason) */ } + +/* Waits until something happens on socket or handle + * + * Uses global variables erlin_fd or hevent_dataready + */ +int wait_until_close_write_or_env_tmo(int tmo) { + int i = 0; + +#ifdef __WIN32__ + DWORD wresult; + DWORD wtmo = INFINITE; + + if (tmo >= 0) { + wtmo = tmo*1000 + 2; + } + + wresult = WaitForSingleObject(hevent_dataready, wtmo); + if (wresult == WAIT_FAILED) { + print_last_error(); + return -1; + } + + if (wresult == WAIT_TIMEOUT) { + debugf("wait timed out\n"); + i = 0; + } else { + debugf("wait ok\n"); + i = 1; + } +#else + fd_set read_fds; + int max_fd; + struct timeval timeout; + struct timeval *tptr = NULL; + + max_fd = erlin_fd; /* global */ + + if (tmo >= 0) { + timeout.tv_sec = tmo; /* On Linux timeout is modified by select */ + timeout.tv_usec = 0; + tptr = &timeout; + } + + FD_ZERO(&read_fds); + FD_SET(erlin_fd, &read_fds); + if ((i = select(max_fd + 1, &read_fds, NULLFDS, NULLFDS, tptr)) < 0) { + print_error("error in select."); + return -1; + } +#endif + return i; +} + + /* * notify_ack * @@ -868,12 +937,13 @@ debugf(const char *format,...) { va_list args; - if (!debug_on) return; - va_start(args, format); - fprintf(stderr, "Heart: "); - vfprintf(stderr, format, args); - va_end(args); - fprintf(stderr, "\r\n"); + if (debug_on) { + va_start(args, format); + fprintf(stderr, "Heart: "); + vfprintf(stderr, format, args); + va_end(args); + fprintf(stderr, "\r\n"); + } } #ifdef __WIN32__ diff --git a/erts/etc/common/inet_gethost.c b/erts/etc/common/inet_gethost.c index e923233ce9..b9a0e6bde3 100644 --- a/erts/etc/common/inet_gethost.c +++ b/erts/etc/common/inet_gethost.c @@ -2522,7 +2522,7 @@ static char *format_address(int siz, AddrByte *addr) *buff='\0'; if (siz <= 4) { while(siz--) { - sprintf(tmp,"%d",(int) *addr++); + erts_snprintf(tmp, sizeof(tmp), "%d",(int) *addr++); strcat(buff,tmp); if(siz) { strcat(buff,"."); @@ -2531,7 +2531,7 @@ static char *format_address(int siz, AddrByte *addr) return buff; } while(siz--) { - sprintf(tmp,"%02x",(int) *addr++); + erts_snprintf(tmp, sizeof(tmp), "%02x",(int) *addr++); strcat(buff,tmp); if(siz) { strcat(buff,":"); @@ -2548,9 +2548,9 @@ static void debugf(char *format, ...) va_start(ap,format); #ifdef WIN32 - sprintf(buff,"%s[%d] (DEBUG):",program_name,(int) GetCurrentThreadId()); + erts_snprintf(buff, sizeof(buff), "%s[%d] (DEBUG):",program_name,(int) GetCurrentThreadId()); #else - sprintf(buff,"%s[%d] (DEBUG):",program_name,(int) getpid()); + erts_snprintf(buff, sizeof(buff), "%s[%d] (DEBUG):",program_name,(int) getpid()); #endif ptr = buff + strlen(buff); erts_vsnprintf(ptr,sizeof(buff)-strlen(buff)-2,format,ap); @@ -2574,7 +2574,7 @@ static void warning(char *format, ...) va_list ap; va_start(ap,format); - sprintf(buff,"%s[%d]: WARNING:",program_name, (int) getpid()); + erts_snprintf(buff, sizeof(buff), "%s[%d]: WARNING:",program_name, (int) getpid()); ptr = buff + strlen(buff); erts_vsnprintf(ptr,sizeof(buff)-strlen(buff)-2,format,ap); strcat(ptr,"\r\n"); @@ -2597,7 +2597,7 @@ static void fatal(char *format, ...) va_list ap; va_start(ap,format); - sprintf(buff,"%s[%d]: FATAL ERROR:",program_name, (int) getpid()); + erts_snprintf(buff, sizeof(buff), "%s[%d]: FATAL ERROR:",program_name, (int) getpid()); ptr = buff + strlen(buff); erts_vsnprintf(ptr,sizeof(buff)-strlen(buff)-2,format,ap); strcat(ptr,"\r\n"); diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src index e0d7404de7..651452e531 100644 --- a/erts/etc/unix/cerl.src +++ b/erts/etc/unix/cerl.src @@ -267,11 +267,16 @@ if [ "x$GDB" = "x" ]; then valgrind_misc_flags="$VALGRIND_MISC_FLAGS" fi beam_args=`$EXEC -emu_args_exit ${1+"$@"}` - # Ahhhh... Need to quote $PROGNAME... - early_beam_args=`echo $beam_args | sed "s|^\(.*-progname\).*$|\1|g"` - late_beam_args=`echo $beam_args | sed "s|^$pre_beam_args.*\(-- -home.*\)$|\1|g"` - - exec valgrind $valgrind_xml $valgrind_log $valgrind_misc_flags $BINDIR/$EMU_NAME $emu_xargs $early_beam_args "$PROGNAME" $late_beam_args -pz $PRELOADED + + # Time for some argument passing voodoo: + # $beam_args is a list of command line arguments separated by newlines. + # Make "$@" represent those arguments verbatim (including spaces and quotes). + SAVE_IFS="$IFS" + IFS=' +' + set -- $beam_args + IFS="$SAVE_IFS" + exec valgrind $valgrind_xml $valgrind_log $valgrind_misc_flags $BINDIR/$EMU_NAME $emu_xargs "$@" -pz $PRELOADED else exec $EXEC $eeargs $xargs ${1+"$@"} fi diff --git a/erts/etc/win32/nsis/Makefile b/erts/etc/win32/nsis/Makefile index f377a68c69..a53ac708f8 100644 --- a/erts/etc/win32/nsis/Makefile +++ b/erts/etc/win32/nsis/Makefile @@ -91,7 +91,7 @@ release_spec: fi;\ if [ '!' -z "$(REDIST_FILE)" -a '!' -z "$(REDIST_DLL_VERSION)" ];\ then \ - cp $(REDIST_FILE) "$(RELEASE_PATH)/$(REDIST_TARGET);"\ + cp $(REDIST_FILE) "$(RELEASE_PATH)/$(REDIST_TARGET)";\ echo '!define HAVE_REDIST_FILE 1' >> $(VERSION_HEADER); \ echo '!define REDIST_DLL_VERSION "$(REDIST_DLL_VERSION)"' >> $(VERSION_HEADER);\ echo '!define REDIST_DLL_NAME "$(REDIST_DLL_NAME)"' >> $(VERSION_HEADER);\ diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h index 142c26c0ca..e1885c627a 100644 --- a/erts/include/internal/ethread.h +++ b/erts/include/internal/ethread.h @@ -355,10 +355,8 @@ extern ethr_runtime_t ethr_runtime__; # include "sparc64/ethread.h" # endif # endif -#if 0 # include "gcc/ethread.h" # include "libatomic_ops/ethread.h" -#endif # endif # elif defined(ETHR_HAVE_LIBATOMIC_OPS) # include "libatomic_ops/ethread.h" diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 5f28f22606..b7ceb0a3fd 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -84,13 +84,14 @@ undefined_functions(Config) when is_list(Config) -> "ExcludedFrom = ~p:_/_," "Undef - Undef | ExcludedFrom", [UndefS,ExcludeFrom]), - ?line {ok,Undef0} = xref:q(Server, lists:flatten(Q)), - ?line Undef1 = hipe_filter(Undef0), - ?line Undef2 = ssl_crypto_filter(Undef1), - ?line Undef3 = edoc_filter(Undef2), + {ok,Undef0} = xref:q(Server, lists:flatten(Q)), + Undef1 = hipe_filter(Undef0), + Undef2 = ssl_crypto_filter(Undef1), + Undef3 = edoc_filter(Undef2), Undef4 = eunit_filter(Undef3), Undef5 = dialyzer_filter(Undef4), - Undef = wx_filter(Undef5), + Undef6 = wx_filter(Undef5), + Undef = gs_filter(Undef6), case Undef of [] -> ok; @@ -202,6 +203,16 @@ wx_filter(Undef) -> _ -> Undef end. +gs_filter(Undef) -> + case code:lib_dir(gs) of + {error,bad_name} -> + filter(fun({_,{gs,_,_}}) -> false; + ({_,{gse,_,_}}) -> false; + ({_,{tool_utils,_,_}}) -> false; + (_) -> true + end, Undef); + _ -> Undef + end. deprecated_not_in_obsolete(Config) when is_list(Config) -> ?line Server = ?config(xref_server, Config), diff --git a/lib/asn1/test/asn1_SUITE.erl b/lib/asn1/test/asn1_SUITE.erl index b0c37d79e7..501157b9b4 100644 --- a/lib/asn1/test/asn1_SUITE.erl +++ b/lib/asn1/test/asn1_SUITE.erl @@ -1,3 +1,4 @@ +%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 2001-2012. All Rights Reserved. @@ -242,8 +243,8 @@ init_per_testcase(Func, Config) -> true = code:add_patha(CaseDir), Dog = case Func of - testX420 -> test_server:timetrap({minutes, 90}); - _ -> test_server:timetrap({minutes, 60}) + testX420 -> ct:timetrap({minutes, 90}); + _ -> ct:timetrap({minutes, 60}) end, [{case_dir, CaseDir}, {watchdog, Dog}|Config]. diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml index 64eeb4af92..abe8cb2041 100644 --- a/lib/common_test/doc/src/notes.xml +++ b/lib/common_test/doc/src/notes.xml @@ -32,6 +32,22 @@ <file>notes.xml</file> </header> +<section><title>Common_Test 1.6.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The interactive mode (ct_run -shell) would not start + properly. This error has been fixed.</p> + <p> + Own Id: OTP-10414</p> + </item> + </list> + </section> + +</section> + <section><title>Common_Test 1.6.2</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 49b51c9207..5014309c0f 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -274,7 +274,8 @@ step(TestDir,Suite,Case,Opts) -> %%% <c>> ct_telnet:cmd(unix_telnet, "ls .").</c><br/> %%% <c>{ok,["ls","file1 ...",...]}</c></p> start_interactive() -> - ct_util:start(interactive). + ct_util:start(interactive), + ok. %%%----------------------------------------------------------------- %%% @spec stop_interactive() -> ok @@ -282,7 +283,8 @@ start_interactive() -> %%% @doc Exit the interactive mode. %%% @see start_interactive/0 stop_interactive() -> - ct_util:stop(normal). + ct_util:stop(normal), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% MISC INTERFACE diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 4d47731239..bec3368869 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -1529,6 +1529,12 @@ report(What,Data) -> end; tests_done -> ok; + severe_error -> + ct_event:sync_notify(#event{name=What, + node=node(), + data=Data}), + ct_util:set_testdata({What,Data}), + ok; tc_start -> %% Data = {{Suite,Func},LogFileName} ct_event:sync_notify(#event{name=tc_logfile, diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 042c5ba267..99bec3ea09 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -696,8 +696,9 @@ status(MasterPid,Event) -> log(To,Heading,Str,Args) -> if To == all ; To == tty -> - Str1 = ["=== ",Heading," ===\n",io_lib:format(Str,Args),"\n"], - io:format(Str1,[]); + Chars = ["=== ",Heading," ===\n", + io_lib:format(Str,Args),"\n"], + io:put_chars(Chars); true -> ok end, diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl index 9e61d5b16f..d76288feef 100644 --- a/lib/common_test/src/ct_master_logs.erl +++ b/lib/common_test/src/ct_master_logs.erl @@ -134,7 +134,7 @@ init(Parent,LogDir,Nodes) -> io:format(CtLogFd,int_header(),[log_timestamp(now()),"Test Nodes\n"]), io:format(CtLogFd,"~s\n",[NodeStr]), - io:format(CtLogFd,int_footer()++"\n",[]), + io:put_chars(CtLogFd,[int_footer(),"\n"]), NodeDirIxFd = open_nodedir_index(RunDirAbs,Time), Parent ! {started,self(),{Time,RunDirAbs}}, @@ -202,24 +202,21 @@ loop(State) -> open_ct_master_log(Dir) -> FullName = filename:join(Dir,?ct_master_log_name), {ok,Fd} = file:open(FullName,[write]), - io:format(Fd,header("Common Test Master Log", {[],[1,2],[]}),[]), + io:put_chars(Fd,header("Common Test Master Log", {[],[1,2],[]})), %% maybe add config info here later - io:format(Fd, config_table([]), []), - io:format(Fd, - "<style>\n" - "div.ct_internal { background:lightgrey; color:black }\n" - "div.default { background:lightgreen; color:black }\n" - "</style>\n", - []), - io:format(Fd, - xhtml("<br><h2>Progress Log</h2>\n<pre>\n", - "<br /><h2>Progress Log</h2>\n<pre>\n"), - []), + io:put_chars(config_table([])), + io:put_chars(Fd, + "<style>\n" + "div.ct_internal { background:lightgrey; color:black }\n" + "div.default { background:lightgreen; color:black }\n" + "</style>\n"), + io:put_chars(Fd, + xhtml("<br><h2>Progress Log</h2>\n<pre>\n", + "<br /><h2>Progress Log</h2>\n<pre>\n")), Fd. close_ct_master_log(Fd) -> - io:format(Fd,"</pre>",[]), - io:format(Fd,footer(),[]), + io:put_chars(Fd,["</pre>",footer()]), file:close(Fd). config_table(Vars) -> @@ -248,20 +245,20 @@ int_footer() -> open_nodedir_index(Dir,StartTime) -> FullName = filename:join(Dir,?nodedir_index_name), {ok,Fd} = file:open(FullName,[write]), - io:format(Fd,nodedir_index_header(StartTime),[]), + io:put_chars(Fd,nodedir_index_header(StartTime)), Fd. print_nodedir(Node,RunDir,Fd) -> Index = filename:join(RunDir,"index.html"), - io:format(Fd, - ["<tr>\n" - "<td align=center>",atom_to_list(Node),"</td>\n", - "<td align=left><a href=\"",Index,"\">",Index,"</a></td>\n", - "</tr>\n"],[]), + io:put_chars(Fd, + ["<tr>\n" + "<td align=center>",atom_to_list(Node),"</td>\n", + "<td align=left><a href=\"",Index,"\">",Index,"</a></td>\n", + "</tr>\n"]), ok. close_nodedir_index(Fd) -> - io:format(Fd,index_footer(),[]), + io:put_chars(Fd,index_footer()), file:close(Fd). nodedir_index_header(StartTime) -> diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index d80d216f9e..4a6a3cdcac 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -211,6 +211,8 @@ analyze_test_result([Result|Rs], Args) -> end; analyze_test_result([], _) -> ?EXIT_STATUS_TEST_SUCCESSFUL; +analyze_test_result(interactive_mode, _) -> + interactive_mode; analyze_test_result(Unknown, _) -> io:format("\nTest run failed! Reason:\n~p\n\n\n",[Unknown]), ?EXIT_STATUS_TEST_RUN_FAILED. @@ -218,17 +220,22 @@ analyze_test_result(Unknown, _) -> finish(Tracing, ExitStatus, Args) -> stop_trace(Tracing), timer:sleep(1000), - %% it's possible to tell CT to finish execution with a call - %% to a different function than the normal halt/1 BIF - %% (meant to be used mainly for reading the CT exit status) - case get_start_opt(halt_with, - fun([HaltMod,HaltFunc]) -> {list_to_atom(HaltMod), - list_to_atom(HaltFunc)} end, - Args) of - undefined -> - halt(ExitStatus); - {M,F} -> - apply(M, F, [ExitStatus]) + if ExitStatus == interactive_mode -> + interactive_mode; + true -> + %% it's possible to tell CT to finish execution with a call + %% to a different function than the normal halt/1 BIF + %% (meant to be used mainly for reading the CT exit status) + case get_start_opt(halt_with, + fun([HaltMod,HaltFunc]) -> + {list_to_atom(HaltMod), + list_to_atom(HaltFunc)} end, + Args) of + undefined -> + halt(ExitStatus); + {M,F} -> + apply(M, F, [ExitStatus]) + end end. script_start1(Parent, Args) -> @@ -635,6 +642,7 @@ script_start4(#opts{label = Label, profile = Profile, verbosity = Verbosity, enable_builtin_hooks = EnableBuiltinHooks, logdir = LogDir, testspecs = Specs}, _Args) -> + %% label - used by ct_logs application:set_env(common_test, test_label, Label), @@ -655,7 +663,7 @@ script_start4(#opts{label = Label, profile = Profile, ct_util:set_testdata({logopts, LogOpts}), log_ts_names(Specs), io:nl(), - ok; + interactive_mode; Error -> Error end; @@ -2184,6 +2192,15 @@ do_run_test(Tests, Skip, Opts) -> end, CleanUp), [code:del_path(Dir) || Dir <- AddedToPath], + %% If a severe error has occurred in the test_server, + %% we will generate an exception here. + case ct_util:get_testdata(severe_error) of + undefined -> ok; + SevereError -> + ct_logs:log("SEVERE ERROR", "~p\n", [SevereError]), + exit(SevereError) + end, + case ct_util:get_testdata(stats) of Stats = {_Ok,_Failed,{_UserSkipped,_AutoSkipped}} -> Stats; @@ -2776,6 +2793,8 @@ opts2args(EnvStartOpts) -> [{exit_status,[atom_to_list(ExitStatusOpt)]}]; ({halt_with,{HaltM,HaltF}}) -> [{halt_with,[atom_to_list(HaltM),atom_to_list(HaltF)]}]; + ({interactive_mode,true}) -> + [{shell,[]}]; ({config,CfgFiles}) -> [{ct_config,[CfgFiles]}]; ({userconfig,{CBM,CfgStr=[X|_]}}) when is_integer(X) -> diff --git a/lib/common_test/src/ct_snmp.erl b/lib/common_test/src/ct_snmp.erl index 8fe63e8ed1..71038bd4f4 100644 --- a/lib/common_test/src/ct_snmp.erl +++ b/lib/common_test/src/ct_snmp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -39,7 +39,7 @@ %%% %%% Manager config %%% [{start_manager, boolean()} % Optional - default is true %%% {users, [{user_name(), [call_back_module(), user_data()]}]}, %% Optional -%%% {usm_users, [{usm_user_name(), usm_config()}]},%% Optional - snmp v3 only +%%% {usm_users, [{usm_user_name(), [usm_config()]}]},%% Optional - snmp v3 only %%% % managed_agents is optional %%% {managed_agents,[{agent_name(), [user_name(), agent_ip(), agent_port(), [agent_config()]]}]}, %%% {max_msg_size, integer()}, % Optional - default is 484 @@ -130,7 +130,7 @@ %%% @type agent_config() = {Item, Value} %%% @type user_name() = atom() %%% @type usm_user_name() = string() -%%% @type usm_config() = string() +%%% @type usm_config() = {Item, Value} %%% @type call_back_module() = atom() %%% @type user_data() = term() %%% @type oids() = [oid()] @@ -157,8 +157,9 @@ %%% API -export([start/2, start/3, stop/1, get_values/3, get_next_values/3, set_values/4, set_info/1, register_users/2, register_agents/2, register_usm_users/2, - unregister_users/1, unregister_agents/1, update_usm_users/2, - load_mibs/1]). + unregister_users/1, unregister_users/2, unregister_agents/1, + unregister_agents/2, unregister_usm_users/1, unregister_usm_users/2, + load_mibs/1, unload_mibs/1]). %% Manager values -define(CT_SNMP_LOG_FILE, "ct_snmp_set.log"). @@ -250,10 +251,8 @@ stop(Config) -> %%% %%% @doc Issues a synchronous snmp get request. get_values(Agent, Oids, MgrAgentConfName) -> - [Uid, AgentIp, AgentUdpPort | _] = - agent_conf(Agent, MgrAgentConfName), - {ok, SnmpReply, _} = - snmpm:g(Uid, AgentIp, AgentUdpPort, Oids), + [Uid | _] = agent_conf(Agent, MgrAgentConfName), + {ok, SnmpReply, _} = snmpm:sync_get2(Uid, target_name(Agent), Oids), SnmpReply. %%% @spec get_next_values(Agent, Oids, MgrAgentConfName) -> SnmpReply @@ -265,10 +264,8 @@ get_values(Agent, Oids, MgrAgentConfName) -> %%% %%% @doc Issues a synchronous snmp get next request. get_next_values(Agent, Oids, MgrAgentConfName) -> - [Uid, AgentIp, AgentUdpPort | _] = - agent_conf(Agent, MgrAgentConfName), - {ok, SnmpReply, _} = - snmpm:gn(Uid, AgentIp, AgentUdpPort, Oids), + [Uid | _] = agent_conf(Agent, MgrAgentConfName), + {ok, SnmpReply, _} = snmpm:sync_get_next2(Uid, target_name(Agent), Oids), SnmpReply. %%% @spec set_values(Agent, VarsAndVals, MgrAgentConfName, Config) -> SnmpReply @@ -282,13 +279,11 @@ get_next_values(Agent, Oids, MgrAgentConfName) -> %%% @doc Issues a synchronous snmp set request. set_values(Agent, VarsAndVals, MgrAgentConfName, Config) -> PrivDir = ?config(priv_dir, Config), - [Uid, AgentIp, AgentUdpPort | _] = - agent_conf(Agent, MgrAgentConfName), + [Uid | _] = agent_conf(Agent, MgrAgentConfName), Oids = lists:map(fun({Oid, _, _}) -> Oid end, VarsAndVals), - {ok, SnmpGetReply, _} = - snmpm:g(Uid, AgentIp, AgentUdpPort, Oids), - {ok, SnmpSetReply, _} = - snmpm:s(Uid, AgentIp, AgentUdpPort, VarsAndVals), + TargetName = target_name(Agent), + {ok, SnmpGetReply, _} = snmpm:sync_get2(Uid, TargetName, Oids), + {ok, SnmpSetReply, _} = snmpm:sync_set2(Uid, TargetName, VarsAndVals), case SnmpSetReply of {noError, 0, _} when PrivDir /= false -> log(PrivDir, Agent, SnmpGetReply, VarsAndVals); @@ -328,12 +323,23 @@ set_info(Config) -> %%% Reason = term() %%% %%% @doc Register the manager entity (=user) responsible for specific agent(s). -%%% Corresponds to making an entry in users.conf +%%% Corresponds to making an entry in users.conf. +%%% +%%% This function will try to register the given users, without +%%% checking if any of them already exist. In order to change an +%%% already registered user, the user must first be unregistered. register_users(MgrAgentConfName, Users) -> - {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), - NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users, Users}), - ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), - setup_users(Users). + case setup_users(Users) of + ok -> + SnmpVals = ct:get_config(MgrAgentConfName), + OldUsers = ct:get_config({MgrAgentConfName,users},[]), + NewSnmpVals = lists:keystore(users, 1, SnmpVals, + {users, Users ++ OldUsers}), + ct_config:update_config(MgrAgentConfName, NewSnmpVals), + ok; + Error -> + Error + end. %%% @spec register_agents(MgrAgentConfName, ManagedAgents) -> ok | {error, Reason} %%% @@ -343,12 +349,24 @@ register_users(MgrAgentConfName, Users) -> %%% %%% @doc Explicitly instruct the manager to handle this agent. %%% Corresponds to making an entry in agents.conf +%%% +%%% This function will try to register the given managed agents, +%%% without checking if any of them already exist. In order to change +%%% an already registered managed agent, the agent must first be +%%% unregistered. register_agents(MgrAgentConfName, ManagedAgents) -> - {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), - NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals, - {managed_agents, ManagedAgents}), - ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), - setup_managed_agents(ManagedAgents). + case setup_managed_agents(MgrAgentConfName,ManagedAgents) of + ok -> + SnmpVals = ct:get_config(MgrAgentConfName), + OldAgents = ct:get_config({MgrAgentConfName,managed_agents},[]), + NewSnmpVals = lists:keystore(managed_agents, 1, SnmpVals, + {managed_agents, + ManagedAgents ++ OldAgents}), + ct_config:update_config(MgrAgentConfName, NewSnmpVals), + ok; + Error -> + Error + end. %%% @spec register_usm_users(MgrAgentConfName, UsmUsers) -> ok | {error, Reason} %%% @@ -358,60 +376,115 @@ register_agents(MgrAgentConfName, ManagedAgents) -> %%% %%% @doc Explicitly instruct the manager to handle this USM user. %%% Corresponds to making an entry in usm.conf +%%% +%%% This function will try to register the given users, without +%%% checking if any of them already exist. In order to change an +%%% already registered user, the user must first be unregistered. register_usm_users(MgrAgentConfName, UsmUsers) -> - {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), - NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {usm_users, UsmUsers}), - ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID), - setup_usm_users(UsmUsers, EngineID). + case setup_usm_users(UsmUsers, EngineID) of + ok -> + SnmpVals = ct:get_config(MgrAgentConfName), + OldUsmUsers = ct:get_config({MgrAgentConfName,usm_users},[]), + NewSnmpVals = lists:keystore(usm_users, 1, SnmpVals, + {usm_users, UsmUsers ++ OldUsmUsers}), + ct_config:update_config(MgrAgentConfName, NewSnmpVals), + ok; + Error -> + Error + end. -%%% @spec unregister_users(MgrAgentConfName) -> ok | {error, Reason} +%%% @spec unregister_users(MgrAgentConfName) -> ok %%% %%% MgrAgentConfName = atom() %%% Reason = term() %%% -%%% @doc Removes information added when calling register_users/2. +%%% @doc Unregister all users. unregister_users(MgrAgentConfName) -> - Users = lists:map(fun({UserName, _}) -> UserName end, - ct:get_config({MgrAgentConfName, users})), - {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), - NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users, []}), - ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), - takedown_users(Users). + Users = [Id || {Id,_} <- ct:get_config({MgrAgentConfName, users},[])], + unregister_users(MgrAgentConfName,Users). -%%% @spec unregister_agents(MgrAgentConfName) -> ok | {error, Reason} +%%% @spec unregister_users(MgrAgentConfName,Users) -> ok %%% %%% MgrAgentConfName = atom() +%%% Users = [user_name()] %%% Reason = term() %%% -%%% @doc Removes information added when calling register_agents/2. +%%% @doc Unregister the given users. +unregister_users(MgrAgentConfName,Users) -> + takedown_users(Users), + SnmpVals = ct:get_config(MgrAgentConfName), + AllUsers = ct:get_config({MgrAgentConfName, users},[]), + RemainingUsers = lists:filter(fun({Id,_}) -> + not lists:member(Id,Users) + end, + AllUsers), + NewSnmpVals = lists:keyreplace(users, 1, SnmpVals, {users,RemainingUsers}), + ct_config:update_config(MgrAgentConfName, NewSnmpVals), + ok. + +%%% @spec unregister_agents(MgrAgentConfName) -> ok +%%% +%%% MgrAgentConfName = atom() +%%% Reason = term() +%%% +%%% @doc Unregister all managed agents. unregister_agents(MgrAgentConfName) -> - ManagedAgents = lists:map(fun({_, [Uid, AgentIP, AgentPort, _]}) -> - {Uid, AgentIP, AgentPort} - end, - ct:get_config({MgrAgentConfName, managed_agents})), - {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), - NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals, - {managed_agents, []}), - ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), - takedown_managed_agents(ManagedAgents). + ManagedAgents = [AgentName || + {AgentName, _} <- + ct:get_config({MgrAgentConfName,managed_agents},[])], + unregister_agents(MgrAgentConfName,ManagedAgents). +%%% @spec unregister_agents(MgrAgentConfName,ManagedAgents) -> ok +%%% +%%% MgrAgentConfName = atom() +%%% ManagedAgents = [agent_name()] +%%% Reason = term() +%%% +%%% @doc Unregister the given managed agents. +unregister_agents(MgrAgentConfName,ManagedAgents) -> + takedown_managed_agents(MgrAgentConfName, ManagedAgents), + SnmpVals = ct:get_config(MgrAgentConfName), + AllAgents = ct:get_config({MgrAgentConfName,managed_agents},[]), + RemainingAgents = lists:filter(fun({Name,_}) -> + not lists:member(Name,ManagedAgents) + end, + AllAgents), + NewSnmpVals = lists:keyreplace(managed_agents, 1, SnmpVals, + {managed_agents,RemainingAgents}), + ct_config:update_config(MgrAgentConfName, NewSnmpVals), + ok. -%%% @spec update_usm_users(MgrAgentConfName, UsmUsers) -> ok | {error, Reason} +%%% @spec unregister_usm_users(MgrAgentConfName) -> ok %%% %%% MgrAgentConfName = atom() -%%% UsmUsers = usm_users() %%% Reason = term() %%% -%%% @doc Alters information added when calling register_usm_users/2. -update_usm_users(MgrAgentConfName, UsmUsers) -> - - {snmp, SnmpVals} = ct:get_config(MgrAgentConfName), - NewSnmpVals = lists:keyreplace(usm_users, 1, SnmpVals, - {usm_users, UsmUsers}), - ct_config:update_config(MgrAgentConfName, {snmp, NewSnmpVals}), +%%% @doc Unregister all usm users. +unregister_usm_users(MgrAgentConfName) -> + UsmUsers = [Id || {Id,_} <- ct:get_config({MgrAgentConfName, usm_users},[])], + unregister_usm_users(MgrAgentConfName,UsmUsers). + +%%% @spec unregister_usm_users(MgrAgentConfName,UsmUsers) -> ok +%%% +%%% MgrAgentConfName = atom() +%%% UsmUsers = [usm_user_name()] +%%% Reason = term() +%%% +%%% @doc Unregister the given usm users. +unregister_usm_users(MgrAgentConfName,UsmUsers) -> EngineID = ct:get_config({MgrAgentConfName, engine_id}, ?ENGINE_ID), - do_update_usm_users(UsmUsers, EngineID). + takedown_usm_users(UsmUsers,EngineID), + SnmpVals = ct:get_config(MgrAgentConfName), + AllUsmUsers = ct:get_config({MgrAgentConfName, usm_users},[]), + RemainingUsmUsers = lists:filter(fun({Id,_}) -> + not lists:member(Id,UsmUsers) + end, + AllUsmUsers), + NewSnmpVals = lists:keyreplace(usm_users, 1, SnmpVals, + {usm_users,RemainingUsmUsers}), + ct_config:update_config(MgrAgentConfName, NewSnmpVals), + ok. %%% @spec load_mibs(Mibs) -> ok | {error, Reason} %%% @@ -423,6 +496,15 @@ update_usm_users(MgrAgentConfName, UsmUsers) -> load_mibs(Mibs) -> snmpa:load_mibs(snmp_master_agent, Mibs). +%%% @spec unload_mibs(Mibs) -> ok | {error, Reason} +%%% +%%% Mibs = [MibName] +%%% MibName = string() +%%% Reason = term() +%%% +%%% @doc Unload the mibs from the agent 'snmp_master_agent'. +unload_mibs(Mibs) -> + snmpa:unload_mibs(snmp_master_agent, Mibs). %%%======================================================================== %%% Internal functions @@ -486,9 +568,8 @@ setup_agent(true, AgentConfName, SnmpConfName, file:make_dir(DbDir), snmp_config:write_agent_snmp_files(ConfDir, Vsns, ManagerIP, TrapUdp, AgentIP, AgentUdp, SysName, - atom_to_list(NotifType), - SecType, Passwd, AgentEngineID, - AgentMaxMsgSize), + NotifType, SecType, Passwd, + AgentEngineID, AgentMaxMsgSize), override_default_configuration(Config, AgentConfName), @@ -497,7 +578,8 @@ setup_agent(true, AgentConfName, SnmpConfName, {verbosity, trace}]}, {agent_type, master}, {agent_verbosity, trace}, - {net_if, [{verbosity, trace}]}], + {net_if, [{verbosity, trace}]}, + {versions, Vsns}], ct:get_config({SnmpConfName,agent})), application:set_env(snmp, agent, SnmpEnv). %%%--------------------------------------------------------------------------- @@ -535,65 +617,61 @@ manager_register(true, MgrAgentConfName) -> setup_usm_users(UsmUsers, EngineID), setup_users(Users), - setup_managed_agents(Agents). + setup_managed_agents(MgrAgentConfName,Agents). %%%--------------------------------------------------------------------------- setup_users(Users) -> - lists:foreach(fun({Id, [Module, Data]}) -> - snmpm:register_user(Id, Module, Data) - end, Users). + while_ok(fun({Id, [Module, Data]}) -> + snmpm:register_user(Id, Module, Data) + end, Users). %%%--------------------------------------------------------------------------- -setup_managed_agents([]) -> - ok; - -setup_managed_agents([{_, [Uid, AgentIp, AgentUdpPort, AgentConf]} | - Rest]) -> - NewAgentIp = case AgentIp of - IpTuple when is_tuple(IpTuple) -> - IpTuple; - HostName when is_list(HostName) -> - {ok,Hostent} = inet:gethostbyname(HostName), - [IpTuple|_] = Hostent#hostent.h_addr_list, - IpTuple - end, - ok = snmpm:register_agent(Uid, NewAgentIp, AgentUdpPort), - lists:foreach(fun({Item, Val}) -> - snmpm:update_agent_info(Uid, NewAgentIp, - AgentUdpPort, Item, Val) - end, AgentConf), - setup_managed_agents(Rest). +setup_managed_agents(AgentConfName,Agents) -> + Fun = + fun({AgentName, [Uid, AgentIp, AgentUdpPort, AgentConf0]}) -> + NewAgentIp = case AgentIp of + IpTuple when is_tuple(IpTuple) -> + IpTuple; + HostName when is_list(HostName) -> + {ok,Hostent} = inet:gethostbyname(HostName), + [IpTuple|_] = Hostent#hostent.h_addr_list, + IpTuple + end, + AgentConf = + case lists:keymember(engine_id,1,AgentConf0) of + true -> + AgentConf0; + false -> + DefaultEngineID = + ct:get_config({AgentConfName,agent_engine_id}, + ?AGENT_ENGINE_ID), + [{engine_id,DefaultEngineID}|AgentConf0] + end, + snmpm:register_agent(Uid, target_name(AgentName), + [{address,NewAgentIp},{port,AgentUdpPort} | + AgentConf]) + end, + while_ok(Fun,Agents). %%%--------------------------------------------------------------------------- setup_usm_users(UsmUsers, EngineID)-> - lists:foreach(fun({UsmUser, Conf}) -> - snmpm:register_usm_user(EngineID, UsmUser, Conf) - end, UsmUsers). + while_ok(fun({UsmUser, Conf}) -> + snmpm:register_usm_user(EngineID, UsmUser, Conf) + end, UsmUsers). %%%--------------------------------------------------------------------------- takedown_users(Users) -> - lists:foreach(fun({Id}) -> + lists:foreach(fun(Id) -> snmpm:unregister_user(Id) end, Users). %%%--------------------------------------------------------------------------- -takedown_managed_agents([{Uid, AgentIp, AgentUdpPort} | - Rest]) -> - NewAgentIp = case AgentIp of - IpTuple when is_tuple(IpTuple) -> - IpTuple; - HostName when is_list(HostName) -> - {ok,Hostent} = inet:gethostbyname(HostName), - [IpTuple|_] = Hostent#hostent.h_addr_list, - IpTuple - end, - ok = snmpm:unregister_agent(Uid, NewAgentIp, AgentUdpPort), - takedown_managed_agents(Rest); - -takedown_managed_agents([]) -> - ok. +takedown_managed_agents(MgrAgentConfName,ManagedAgents) -> + lists:foreach(fun(AgentName) -> + [Uid | _] = agent_conf(AgentName, MgrAgentConfName), + snmpm:unregister_agent(Uid, target_name(AgentName)) + end, ManagedAgents). %%%--------------------------------------------------------------------------- -do_update_usm_users(UsmUsers, EngineID) -> - lists:foreach(fun({UsmUser, {Item, Val}}) -> - snmpm:update_usm_user_info(EngineID, UsmUser, - Item, Val) - end, UsmUsers). +takedown_usm_users(UsmUsers, EngineID) -> + lists:foreach(fun(Id) -> + snmpm:unregister_usm_user(EngineID, Id) + end, UsmUsers). %%%--------------------------------------------------------------------------- log(PrivDir, Agent, {_, _, Varbinds}, NewVarsAndVals) -> @@ -657,7 +735,7 @@ override_contexts(Config, {data_dir_file, File}) -> override_contexts(Config, ContextInfo); override_contexts(Config, Contexts) -> - Dir = ?config(priv_dir, Config), + Dir = filename:join(?config(priv_dir, Config),"conf"), File = filename:join(Dir,"context.conf"), file:delete(File), snmp_config:write_agent_context_config(Dir, "", Contexts). @@ -673,7 +751,7 @@ override_sysinfo(Config, {data_dir_file, File}) -> override_sysinfo(Config, SysInfo); override_sysinfo(Config, SysInfo) -> - Dir = ?config(priv_dir, Config), + Dir = filename:join(?config(priv_dir, Config),"conf"), File = filename:join(Dir,"standard.conf"), file:delete(File), snmp_config:write_agent_standard_config(Dir, "", SysInfo). @@ -688,7 +766,7 @@ override_target_address(Config, {data_dir_file, File}) -> override_target_address(Config, TargetAddressConf); override_target_address(Config, TargetAddressConf) -> - Dir = ?config(priv_dir, Config), + Dir = filename:join(?config(priv_dir, Config),"conf"), File = filename:join(Dir,"target_addr.conf"), file:delete(File), snmp_config:write_agent_target_addr_config(Dir, "", TargetAddressConf). @@ -704,7 +782,7 @@ override_target_params(Config, {data_dir_file, File}) -> override_target_params(Config, TargetParamsConf); override_target_params(Config, TargetParamsConf) -> - Dir = ?config(priv_dir, Config), + Dir = filename:join(?config(priv_dir, Config),"conf"), File = filename:join(Dir,"target_params.conf"), file:delete(File), snmp_config:write_agent_target_params_config(Dir, "", TargetParamsConf). @@ -719,7 +797,7 @@ override_notify(Config, {data_dir_file, File}) -> override_notify(Config, NotifyConf); override_notify(Config, NotifyConf) -> - Dir = ?config(priv_dir, Config), + Dir = filename:join(?config(priv_dir, Config),"conf"), File = filename:join(Dir,"notify.conf"), file:delete(File), snmp_config:write_agent_notify_config(Dir, "", NotifyConf). @@ -734,7 +812,7 @@ override_usm(Config, {data_dir_file, File}) -> override_usm(Config, UsmConf); override_usm(Config, UsmConf) -> - Dir = ?config(priv_dir, Config), + Dir = filename:join(?config(priv_dir, Config),"conf"), File = filename:join(Dir,"usm.conf"), file:delete(File), snmp_config:write_agent_usm_config(Dir, "", UsmConf). @@ -749,7 +827,7 @@ override_community(Config, {data_dir_file, File}) -> override_community(Config, CommunityConf); override_community(Config, CommunityConf) -> - Dir = ?config(priv_dir, Config), + Dir = filename:join(?config(priv_dir, Config),"conf"), File = filename:join(Dir,"community.conf"), file:delete(File), snmp_config:write_agent_community_config(Dir, "", CommunityConf). @@ -765,7 +843,20 @@ override_vacm(Config, {data_dir_file, File}) -> override_vacm(Config, VacmConf); override_vacm(Config, VacmConf) -> - Dir = ?config(priv_dir, Config), - File = filename:join(Dir,"vacm.conf"), + Dir = filename:join(?config(priv_dir, Config),"conf"), + File = filename:join(Dir,"vacm.conf"), file:delete(File), snmp_config:write_agent_vacm_config(Dir, "", VacmConf). + +%%%--------------------------------------------------------------------------- + +target_name(Agent) -> + atom_to_list(Agent). + +while_ok(Fun,[H|T]) -> + case Fun(H) of + ok -> while_ok(Fun,T); + Error -> Error + end; +while_ok(_Fun,[]) -> + ok. diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index 7628ada61a..64e2cb6507 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -50,7 +50,11 @@ MODULES= \ ct_netconfc_SUITE \ ct_basic_html_SUITE \ ct_auto_compile_SUITE \ - ct_verbosity_SUITE + ct_verbosity_SUITE \ + ct_shell_SUITE \ + ct_system_error_SUITE \ + ct_snmp_SUITE \ + ct_group_leader_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/common_test/test/ct_group_leader_SUITE.erl b/lib/common_test/test/ct_group_leader_SUITE.erl new file mode 100644 index 0000000000..cde3061d6a --- /dev/null +++ b/lib/common_test/test/ct_group_leader_SUITE.erl @@ -0,0 +1,181 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File: ct_system_error_SUITE +%%% +%%% Description: +%%% +%%% Test the group leader functionality in the test_server application. +%%%------------------------------------------------------------------- +-module(ct_group_leader_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) -> + Config1 = ct_test_support:init_per_suite(Config), + Config1. + +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() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + basic + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +basic(Config) -> + TC = basic, + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "group_leader_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{label,TC}], Config), + SuiteLog = execute(TC, Opts, ERPid, Config), + {ok,Data} = file:read_file(SuiteLog), + Lines = binary:split(Data, <<"\n">>, [global]), + {ok,RE} = re:compile("(\\S+):(\\S+)$"), + Cases0 = [begin + {match,[M,F]} = re:run(Case, RE, [{capture,all_but_first,list}]), + {list_to_atom(M),list_to_atom(F)} + end || <<"=case ",Case/binary>> <- Lines], + Cases = [MF || {_,F}=MF <- Cases0, + F =/= init_per_suite, + F =/= end_per_suite, + F =/= init_per_group, + F =/= end_per_group], + io:format("~p\n", [Cases]), + [] = verify_cases(events_to_check(TC), Cases, false), + ok. + +verify_cases([{parallel,P}|Ts], Cases0, Par) -> + Cases = verify_cases(P, Cases0, true), + verify_cases(Ts, Cases, Par); +verify_cases([{?eh,tc_done,{M,F,_}}|Ts], Cases0, false) -> + [{M,F}|Cases] = Cases0, + verify_cases(Ts, Cases, false); +verify_cases([{?eh,tc_done,{M,F,_}}|Ts], Cases0, true) -> + case lists:member({M,F}, Cases0) of + true -> + Cases = Cases0 -- [{M,F}], + verify_cases(Ts, Cases, true); + false -> + io:format("~p not found\n", [{M,F}]), + ?t:fail() + end; +verify_cases([{?eh,_,_}|Ts], Cases, Par) -> + verify_cases(Ts, Cases, Par); +verify_cases([], Cases, _) -> + Cases; +verify_cases([List|Ts], Cases0, Par) when is_list(List) -> + Cases = verify_cases(List, Cases0, false), + verify_cases(Ts, Cases, Par). + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +execute(Name, Opts, ERPid, Config) -> + ok = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(Name, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(Name), + ok = ct_test_support:verify_events(TestEvents, Events, Config), + {event,tc_logfile,_,{_,File}} = + lists:keyfind(tc_logfile, 2, [Ev || {?eh,Ev} <- Events]), + LogDir = filename:dirname(File), + filename:join(LogDir, "suite.log"). + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- + +events_to_check(_Test) -> + [{?eh,tc_done,{group_leader_SUITE,tc1,ok}}, + {parallel,[{?eh,tc_start,{group_leader_SUITE,p1}}, + {?eh,tc_done,{group_leader_SUITE,p1,ok}}, + {?eh,tc_start,{group_leader_SUITE,p2}}, + {?eh,tc_done,{group_leader_SUITE,p2,ok}}]}, + {?eh,tc_done,{group_leader_SUITE,p_restart_my_io_server,ok}}, + {?eh,tc_done,{group_leader_SUITE,p3,ok}}, + {parallel,[ + {?eh,tc_start,{group_leader_SUITE,p10}}, + {?eh,tc_start,{group_leader_SUITE,p11}}, + {?eh,tc_done,{group_leader_SUITE,p10,ok}}, + {?eh,tc_done,{group_leader_SUITE,p11,ok}}, + [{?eh,tc_done,{group_leader_SUITE,s1,ok}}, + {?eh,tc_done,{group_leader_SUITE,s2,ok}}, + {?eh,tc_done,{group_leader_SUITE,s3,ok}}], + {?eh,tc_start,{group_leader_SUITE,p12}}, + {?eh,tc_done,{group_leader_SUITE,p12,ok}}, + [{?eh,tc_done,{group_leader_SUITE,s4,ok}}, + {?eh,tc_done,{group_leader_SUITE,s5,ok}}], + {?eh,tc_start,{group_leader_SUITE,p13}}, + {?eh,tc_done,{group_leader_SUITE,p13,ok}} ]}, + {?eh,tc_done,{group_leader_SUITE,cap1,ok}}, + {?eh,tc_done,{group_leader_SUITE,cap2,ok}}, + {parallel,[{?eh,tc_start,{group_leader_SUITE,cap1}}, + {?eh,tc_done,{group_leader_SUITE,cap1,ok}}, + {?eh,tc_start,{group_leader_SUITE,cap2}}, + {?eh,tc_done,{group_leader_SUITE,cap2,ok}}]}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]. diff --git a/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl new file mode 100644 index 0000000000..3f1844b4ae --- /dev/null +++ b/lib/common_test/test/ct_group_leader_SUITE_data/group_leader_SUITE.erl @@ -0,0 +1,252 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(group_leader_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% @spec suite() -> Info +%% Info = [tuple()] +%% @end +%%-------------------------------------------------------------------- +suite() -> + [{timetrap,{seconds,10}}]. + +%%-------------------------------------------------------------------- +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + start_my_io_server(), + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_suite(Config0) -> void() | {save_config,Config1} +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + my_io_server ! die, + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_group(GroupName, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_group(_GroupName, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_group(GroupName, Config0) -> +%% void() | {save_config,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_group(_GroupName, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec groups() -> [Group] +%% Group = {GroupName,Properties,GroupsAndTestCases} +%% GroupName = atom() +%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}] +%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase] +%% TestCase = atom() +%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}} +%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | +%% repeat_until_any_ok | repeat_until_any_fail +%% N = integer() | forever +%% @end +%%-------------------------------------------------------------------- +groups() -> + [{p,[parallel],[p1,p2]}, + {p_restart,[parallel],[p_restart_my_io_server]}, + {seq,[],[s1,s2,s3]}, + {seq2,[],[s4,s5]}, + {seq_in_par,[parallel],[p10,p11,{group,seq},p12,{group,seq2},p13]}, + {capture_io,[parallel],[cap1,cap2]}]. + +%%-------------------------------------------------------------------- +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +%% GroupsAndTestCases = [{group,GroupName} | TestCase] +%% GroupName = atom() +%% TestCase = atom() +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +all() -> + [tc1,{group,p},{group,p_restart},p3, + {group,seq_in_par}, + cap1,cap2, + {group,capture_io}]. + +tc1(_C) -> + ok. + +p1(_) -> + %% OTP-10101: + %% + %% External apps/processes started by init_per_suite (common operation), + %% will inherit the group leader of the init_per_suite process, i.e. the + %% test_server test case control process (executing run_test_case_msgloop/7). + %% If, later, a parallel test case triggers the external app to print with + %% e.g. io:format() (also common operation), the calling process will hang! + %% The reason for this is that a parallel test case has a dedicated IO + %% server process, other than the central test case control process. The + %% latter process is not executing run_test_case_msgloop/7 and will not + %% respond to IO messages. The process is still group leader for the + %% external app, however, which is wrong. It's the IO process for the + %% parallel test case that should be group leader - but only for the + %% particular invokation, since other parallel test cases could be + %% invoking the external app too. + print("hej\n"). + +p2(_) -> + print("hopp\n"). + +p_restart_my_io_server(_) -> + %% Restart the IO server and change its group leader. This used + %% to set to the group leader to a process that would soon die. + Ref = erlang:monitor(process, my_io_server), + my_io_server ! die, + receive + {'DOWN',Ref,_,_,_} -> + start_my_io_server() + end. + +p3(_) -> + %% OTP-10125. This would crash since the group leader process + %% for the my_io_server had died. + print("hoppsan\n"). + +print(String) -> + my_io_server ! {print,self(),String}, + receive + {printed,String} -> + ok + end. + +start_my_io_server() -> + Parent = self(), + Pid = spawn(fun() -> my_io_server(Parent) end), + receive + {Pid,started} -> + io:format("~p\n", [process_info(Pid)]), + ok + end. + +my_io_server(Parent) -> + register(my_io_server, self()), + Parent ! {self(),started}, + my_io_server_loop(). + +my_io_server_loop() -> + receive + {print,From,String} -> + io:put_chars(String), + From ! {printed,String}, + my_io_server_loop(); + die -> + ok + end. + +p10(_) -> + receive after 1 -> ok end. + +p11(_) -> + ok. + +p12(_) -> + ok. + +p13(_) -> + ok. + +s1(_) -> + ok. + +s2(_) -> + ok. + +s3(_) -> + ok. + +s4(_) -> + ok. + +s5(_) -> + ok. + +cap1(_) -> + ct:capture_start(), + IO = gen_io(cap1, 10, []), + ct:capture_stop(), + IO = ct:capture_get(), + ok. + +cap2(_) -> + ct:capture_start(), + {Pid,Ref} = spawn_monitor(fun() -> + exit(gen_io(cap2, 42, [])) + end), + receive + {'DOWN',Ref,process,Pid,IO} -> + ct:capture_stop(), + IO = ct:capture_get(), + ok + end. + +gen_io(_, 0, Acc) -> + lists:reverse(Acc); +gen_io(Label, N, Acc) -> + S = lists:flatten(io_lib:format("~s: ~p\n", [Label,N])), + io:put_chars(S), + gen_io(Label, N-1, [S|Acc]). diff --git a/lib/common_test/test/ct_shell_SUITE.erl b/lib/common_test/test/ct_shell_SUITE.erl new file mode 100644 index 0000000000..4b8c43d800 --- /dev/null +++ b/lib/common_test/test/ct_shell_SUITE.erl @@ -0,0 +1,133 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File: ct_shell_SUITE +%%% +%%% Description: +%%% Test that the interactive mode starts properly +%%% +%%% The suites used for the test are located in the data directory. +%%%------------------------------------------------------------------- +-module(ct_shell_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 +%%-------------------------------------------------------------------- + +init_per_suite(Config) -> + Config1 = ct_test_support:init_per_suite(Config), + Config1. + +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() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [start_interactive]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +start_interactive(Config) -> + DataDir = ?config(data_dir, Config), + CfgFile = filename:join(DataDir, "cfgdata"), + + {Opts,ERPid} = setup([{interactive_mode,true},{config,CfgFile}], + Config), + CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), + test_server:format(Level, "Saving start opts on ~p: ~p~n", + [CTNode, Opts]), + rpc:call(CTNode, application, set_env, + [common_test, run_test_start_opts, Opts]), + test_server:format(Level, "Calling ct_run:script_start() on ~p~n", + [CTNode]), + + interactive_mode = rpc:call(CTNode, ct_run, script_start, []), + + ok = rpc:call(CTNode, ct, require, [key1]), + value1 = rpc:call(CTNode, ct, get_config, [key1]), + ok = rpc:call(CTNode, ct, require, [x,key2]), + value2 = rpc:call(CTNode, ct, get_config, [x]), + + ok = rpc:call(CTNode, ct, stop_interactive, []), + + case rpc:call(CTNode, erlang, whereis, [ct_util_server]) of + undefined -> + ok; + _ -> + test_server:format(Level, + "ct_util_server not stopped on ~p yet, waiting 5 s...~n", + [CTNode]), + timer:sleep(5000), + undefined = rpc:call(CTNode, erlang, whereis, [ct_util_server]) + end, + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(start_interactive, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + TestEvents = test_events(start_interactive), + ok = ct_test_support:verify_events(TestEvents, Events, Config). + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- + +test_events(start_interactive) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} + ]. diff --git a/lib/common_test/test/ct_shell_SUITE_data/cfgdata b/lib/common_test/test/ct_shell_SUITE_data/cfgdata new file mode 100644 index 0000000000..23a40ad21a --- /dev/null +++ b/lib/common_test/test/ct_shell_SUITE_data/cfgdata @@ -0,0 +1,2 @@ +{key1,value1}. +{key2,value2}. diff --git a/lib/common_test/test/ct_snmp_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE.erl new file mode 100644 index 0000000000..f8b4543770 --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE.erl @@ -0,0 +1,141 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File: ct_snmp_SUITE +%%% +%%% Description: +%%% Test ct_snmp module +%%% +%%%------------------------------------------------------------------- +-module(ct_snmp_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) -> + Config1 = ct_test_support:init_per_suite(Config), + Config1. + +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() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + default + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +default(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "snmp_SUITE"), + CfgFile = filename:join(DataDir, "snmp.cfg"), + {Opts,ERPid} = setup([{suite,Suite},{config,CfgFile}, + {label,default}], Config), + + ok = execute(default, Opts, ERPid, Config). + + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +execute(Name, Opts, ERPid, Config) -> + ok = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(Name, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(Name,Config), + ct_test_support:verify_events(TestEvents, Events, Config). + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- +events_to_check(_TestName,Config) -> + {module,_} = code:load_abs(filename:join(?config(data_dir,Config), + snmp_SUITE)), + TCs = get_tcs(), + code:purge(snmp_SUITE), + code:delete(snmp_SUITE), + + OneTest = + [{?eh,start_logging,{'DEF','RUNDIR'}}] ++ + [{?eh,tc_done,{snmp_SUITE,TC,ok}} || TC <- TCs] ++ + [{?eh,stop_logging,[]}], + + %% 2 tests (ct:run_test + script_start) is default + OneTest ++ OneTest. + + +get_tcs() -> + All = snmp_SUITE:all(), + Groups = + try snmp_SUITE:groups() + catch error:undef -> [] + end, + flatten_tcs(All,Groups). + +flatten_tcs([H|T],Groups) when is_atom(H) -> + [H|flatten_tcs(T,Groups)]; +flatten_tcs([{group,Group}|T],Groups) -> + TCs = proplists:get_value(Group,Groups), + flatten_tcs(TCs ++ T,Groups); +flatten_tcs([],_) -> + []. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg b/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg new file mode 100644 index 0000000000..895e097de6 --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp.cfg @@ -0,0 +1,44 @@ +%% -*- erlang -*- +{snmp1, [{start_agent,true}, + {users,[{user_name,[snmpm_user_default,[]]}]}, + {managed_agents,[{agent_name, [user_name, {127,0,0,1}, 4000, + [{engine_id,"ct_snmp-test-engine"}, + {version,v2}]]}]}, + {engine_id,"ct_snmp-test-engine"}, + {agent_vsns,[v2]} + ]}. +{snmp2, [{start_agent,true}, + {engine_id,"ct_snmp-test-engine"} + ]}. +{snmp3, [{start_agent,true}, + {engine_id,"ct_snmp-test-engine"}, + {agent_vsns,[v1,v2,v3]}, + {agent_contexts,{data_dir_file,"context.conf"}}, + {agent_usm,{data_dir_file,"usm.conf"}}, + {agent_community,{data_dir_file,"community.conf"}}, + {agent_notify_def,{data_dir_file,"notify.conf"}}, + {agent_sysinfo,{data_dir_file,"standard.conf"}}, + {agent_target_address_def,{data_dir_file,"target_addr.conf"}}, + {agent_target_param_def,{data_dir_file,"target_params.conf"}}, + {agent_vacm,{data_dir_file,"vacm.conf"}}]}. +{snmp_app1,[{manager, [{config, [{verbosity, silence}]}, + {server,[{verbosity,silence}]}, + {net_if,[{verbosity,silence}]}, + {versions,[v2]} + ]}, + {agent, [{config, [{verbosity, silence}]}, + {net_if,[{verbosity,silence}]}, + {mib_server,[{verbosity,silence}]}, + {local_db,[{verbosity,silence}]}, + {agent_verbosity,silence} + ]}]}. +{snmp_app2,[{manager, [{config, [{verbosity, silence}]}, + {server,[{verbosity,silence}]}, + {net_if,[{verbosity,silence}]} + ]}, + {agent, [{config, [{verbosity, silence}]}, + {net_if,[{verbosity,silence}]}, + {mib_server,[{verbosity,silence}]}, + {local_db,[{verbosity,silence}]}, + {agent_verbosity,silence} + ]}]}. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl new file mode 100644 index 0000000000..16b2b5690c --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE.erl @@ -0,0 +1,395 @@ +%%-------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%---------------------------------------------------------------------- +%% File: ct_snmp_SUITE.erl +%% +%% Description: +%% This file contains the test cases for the ct_snmp API. +%% +%% @author Support +%% @doc Test of SNMP support in common_test +%% @end +%%---------------------------------------------------------------------- +%%---------------------------------------------------------------------- +-module(snmp_SUITE). +-include_lib("common_test/include/ct.hrl"). +-include_lib("snmp/include/STANDARD-MIB.hrl"). +-include_lib("snmp/include/SNMP-USER-BASED-SM-MIB.hrl"). +-include_lib("snmp/include/snmp_types.hrl"). + +-compile(export_all). + +%% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). + +-define(AGENT_UDP, 4000). + +suite() -> + [ + {require, snmp1, snmp1}, + {require, snmp_app1, snmp_app1}, + {require, snmp2, snmp2}, + {require, snmp_app2, snmp_app2}, + {require, snmp3, snmp3} + ]. + +all() -> + [start_stop, + {group,get_set}, + {group,register}, + {group,override}, + set_info]. + + +groups() -> + [{get_set,[get_values, + get_next_values, + set_values, + load_mibs]}, + {register,[register_users, + register_users_fail, + register_agents, + register_agents_fail, + register_usm_users, + register_usm_users_fail]}, + {override,[override_usm, + override_standard, + override_context, + override_community, + override_notify, + override_target_addr, + override_target_params, + override_vacm]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(Config) -> + Config. + +init_per_group(get_set, Config) -> + ok = ct_snmp:start(Config,snmp1,snmp_app1), + Config; +init_per_group(register, Config) -> + ok = ct_snmp:start(Config,snmp2,snmp_app2), + Config; +init_per_group(_, Config) -> + ok = ct_snmp:start(Config,snmp3,snmp_app2), + Config. + +end_per_group(_Group, Config) -> + catch ct_snmp:stop(Config), + Config. + +init_per_testcase(_Case, Config) -> + Dog = test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +end_per_testcase(Case, Config) -> + try apply(?MODULE,Case,[cleanup,Config]) + catch error:undef -> ok + end, + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +%%%----------------------------------------------------------------- +%%% Test cases +break(_Config) -> + test_server:break(""), + ok. + +start_stop(Config) -> + ok = ct_snmp:start(Config,snmp1,snmp_app1), + timer:sleep(1000), + {snmp,_,_} = lists:keyfind(snmp,1,application:which_applications()), + [_|_] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)), + + ok = ct_snmp:stop(Config), + timer:sleep(1000), + false = lists:keyfind(snmp,1,application:which_applications()), + [] = filelib:wildcard("*/*.conf",?config(priv_dir,Config)), + ok. + +get_values(_Config) -> + Oids1 = [?sysDescr_instance, ?sysName_instance], + {noError,_,V1} = ct_snmp:get_values(agent_name,Oids1,snmp1), + [#varbind{oid=?sysDescr_instance,value="Erlang SNMP agent"}, + #varbind{oid=?sysName_instance,value="ct_test"}] = V1, + ok. + +get_next_values(_Config) -> + Oids2 = [?system], + {noError,_,V2} = ct_snmp:get_next_values(agent_name,Oids2,snmp1), + [#varbind{oid=?sysDescr_instance,value="Erlang SNMP agent"}] = V2, + ok. + +set_values(Config) -> + Oid3 = ?sysName_instance, + NewName = "ct_test changed by " ++ atom_to_list(?MODULE), + VarsAndVals = [{Oid3,s,NewName}], + {noError,_,_} = + ct_snmp:set_values(agent_name,VarsAndVals,snmp1,Config), + + Oids4 = [?sysName_instance], + {noError,_,V4} = ct_snmp:get_values(agent_name,Oids4,snmp1), + [#varbind{oid=?sysName_instance,value=NewName}] = V4, + + ok. + +load_mibs(_Config) -> + [{'SNMPv2-MIB',_}=SnmpV2Mib] = snmpa:which_mibs(), + Mib = filename:join([code:priv_dir(snmp),"mibs","SNMP-USER-BASED-SM-MIB"]), + ok = ct_snmp:load_mibs([Mib]), + TwoMibs = [_,_] = snmpa:which_mibs(), + [{'SNMP-USER-BASED-SM-MIB',_}] = lists:delete(SnmpV2Mib,TwoMibs), + ok = ct_snmp:unload_mibs([Mib]), + [{'SNMPv2-MIB',_}] = snmpa:which_mibs(), + ok. + + +register_users(_Config) -> + [] = snmpm:which_users(), + ok = ct_snmp:register_users(snmp2,[{reg_user1,[snmpm_user_default,[]]}]), + [_] = snmpm:which_users(), + [_] = ct:get_config({snmp2,users}), + ok = ct_snmp:register_users(snmp2,[{reg_user2,[snmpm_user_default,[]]}]), + [_,_] = snmpm:which_users(), + [_,_] = ct:get_config({snmp2,users}), + ok = ct_snmp:register_users(snmp2,[{reg_user3,[snmpm_user_default,[]]}]), + [_,_,_] = snmpm:which_users(), + [_,_,_] = ct:get_config({snmp2,users}), + ok = ct_snmp:unregister_users(snmp2,[reg_user3]), + [_,_] = snmpm:which_users(), + [_,_] = ct:get_config({snmp2,users}), + ok = ct_snmp:unregister_users(snmp2), + [] = snmpm:which_users(), + [] = ct:get_config({snmp2,users}), + ok. +register_users(cleanup,_Config) -> + ct_snmp:unregister_users(snmp2). + +register_users_fail(_Config) -> + [] = snmpm:which_users(), + {error,_} = ct_snmp:register_users(snmp2,[{reg_user3,[unknown_module,[]]}]), + [] = snmpm:which_users(), + ok. +register_users_fail(cleanup,_Config) -> + ct_snmp:unregister_users(snmp2). + +register_agents(_Config) -> + {ok, HostName} = inet:gethostname(), + {ok, Addr} = inet:getaddr(HostName, inet), + + [] = snmpm:which_agents(), + ok = ct_snmp:register_users(snmp2,[{reg_user1,[snmpm_user_default,[]]}]), + ok = ct_snmp:register_agents(snmp2,[{reg_agent1, + [reg_user1,Addr,?AGENT_UDP,[]]}]), + [_] = snmpm:which_agents(), + [_] = ct:get_config({snmp2,managed_agents}), + ok = ct_snmp:register_agents(snmp2,[{reg_agent2, + [reg_user1,Addr,?AGENT_UDP,[]]}]), + [_,_] = snmpm:which_agents(), + [_,_] = ct:get_config({snmp2,managed_agents}), + + ok = ct_snmp:register_agents(snmp2,[{reg_agent3, + [reg_user1,Addr,?AGENT_UDP,[]]}]), + [_,_,_] = snmpm:which_agents(), + [_,_,_] = ct:get_config({snmp2,managed_agents}), + + ok = ct_snmp:unregister_agents(snmp2,[reg_agent3]), + [_,_] = snmpm:which_agents(), + [_,_] = ct:get_config({snmp2,managed_agents}), + + ok = ct_snmp:unregister_agents(snmp2), + ok = ct_snmp:unregister_users(snmp2), + [] = snmpm:which_agents(), + [] = ct:get_config({snmp2,managed_agents}), + ok. +register_agents(cleanup,_Config) -> + ct_snmp:unregister_agents(snmp2), + ct_snmp:unregister_users(snmp2). + +register_agents_fail(_Config) -> + {ok, HostName} = inet:gethostname(), + {ok, Addr} = inet:getaddr(HostName, inet), + + [] = snmpm:which_agents(), + {error,_} + = ct_snmp:register_agents(snmp2,[{reg_agent3, + [unknown_user,Addr,?AGENT_UDP,[]]}]), + [] = snmpm:which_agents(), + ok. +register_agents_fail(cleanup,_Config) -> + ct_snmp:unregister_agents(snmp2). + +register_usm_users(_Config) -> + [] = snmpm:which_usm_users(), + ok = ct_snmp:register_usm_users(snmp2,[{"reg_usm_user1",[]}]), + [_] = snmpm:which_usm_users(), + [_] = ct:get_config({snmp2,usm_users}), + ok = ct_snmp:register_usm_users(snmp2,[{"reg_usm_user2",[]}]), + [_,_] = snmpm:which_usm_users(), + [_,_] = ct:get_config({snmp2,usm_users}), + ok = ct_snmp:register_usm_users(snmp2,[{"reg_usm_user3",[]}]), + [_,_,_] = snmpm:which_usm_users(), + [_,_,_] = ct:get_config({snmp2,usm_users}), + ok = ct_snmp:unregister_usm_users(snmp2,["reg_usm_user3"]), + [_,_] = snmpm:which_usm_users(), + [_,_] = ct:get_config({snmp2,usm_users}), + ok = ct_snmp:unregister_usm_users(snmp2), + [] = snmpm:which_usm_users(), + [] = ct:get_config({snmp2,usm_users}), + ok. +register_usm_users(cleanup,_Config) -> + ct_snmp:unregister_usm_users(snmp2). + +register_usm_users_fail(_Config) -> + [] = snmpm:which_usm_users(), + {error,_} + = ct_snmp:register_usm_users(snmp2,[{"reg_usm_user3", + [{sec_name,invalid_data_type}]}]), + [] = snmpm:which_usm_users(), + ok. +register_usm_users_fail(cleanup,_Config) -> + ct_snmp:unregister_usm_users(snmp2). + +%% Test that functionality for overriding default configuration file +%% works - i.e. that the files are written and that the configuration +%% is actually used. +%% +%% Note that the config files used in this test case do not +%% necessarily make up a reasonable configuration for the snmp +%% application... +override_usm(Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + ConfDir = filename:join(PrivDir,"conf"), + + Mib = filename:join([code:priv_dir(snmp),"mibs","SNMP-USER-BASED-SM-MIB"]), + ok = ct_snmp:load_mibs([Mib]), + + %% Check that usm.conf is overwritten + {ok,MyUsm} = snmpa_conf:read_usm_config(DataDir), + {ok,UsedUsm} = snmpa_conf:read_usm_config(ConfDir), + true = (MyUsm == UsedUsm), + + %% Check that the usm user is actually configured... + [{Index,"secname"}] = + snmp_user_based_sm_mib:usmUserTable(get_next,?usmUserEntry,[3]), + true = lists:suffix("usm_user_name",Index), + ok. + +override_standard(Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + ConfDir = filename:join(PrivDir,"conf"), + + %% Check that standard.conf is overwritten + {ok,MyStandard} = snmpa_conf:read_standard_config(DataDir), + {ok,UsedStandard} = snmpa_conf:read_standard_config(ConfDir), + true = (MyStandard == UsedStandard), + + %% Check that the values from standard.conf is actually configured... + {value,"name for override test"} = snmp_standard_mib:sysName(get), + {value,"agent for ct_snmp override test"} = snmp_standard_mib:sysDescr(get), + ok. + +override_context(Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + ConfDir = filename:join(PrivDir,"conf"), + + %% Check that context.conf is overwritten + {ok,MyContext} = snmpa_conf:read_context_config(DataDir), + {ok,UsedContext} = snmpa_conf:read_context_config(ConfDir), + true = (MyContext == UsedContext), + ok. + +override_community(Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + ConfDir = filename:join(PrivDir,"conf"), + + %% Check that community.conf is overwritten + {ok,MyCommunity} = snmpa_conf:read_community_config(DataDir), + {ok,UsedCommunity} = snmpa_conf:read_community_config(ConfDir), + true = (MyCommunity == UsedCommunity), + ok. + +override_notify(Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + ConfDir = filename:join(PrivDir,"conf"), + + %% Check that notify.conf is overwritten + {ok,MyNotify} = snmpa_conf:read_notify_config(DataDir), + {ok,UsedNotify} = snmpa_conf:read_notify_config(ConfDir), + true = (MyNotify == UsedNotify), + ok. + +override_target_addr(Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + ConfDir = filename:join(PrivDir,"conf"), + + %% Check that target_addr.conf is overwritten + {ok,MyTargetAddr} = snmpa_conf:read_target_addr_config(DataDir), + {ok,UsedTargetAddr} = snmpa_conf:read_target_addr_config(ConfDir), + true = (MyTargetAddr == UsedTargetAddr), + ok. + +override_target_params(Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + ConfDir = filename:join(PrivDir,"conf"), + + %% Check that target_params.conf is overwritten + {ok,MyTargetParams} = snmpa_conf:read_target_params_config(DataDir), + {ok,UsedTargetParams} = snmpa_conf:read_target_params_config(ConfDir), + true = (MyTargetParams == UsedTargetParams), + ok. + +override_vacm(Config) -> + DataDir = ?config(data_dir,Config), + PrivDir = ?config(priv_dir,Config), + ConfDir = filename:join(PrivDir,"conf"), + + %% Check that vacm.conf is overwritten + {ok,MyVacm} = snmpa_conf:read_vacm_config(DataDir), + {ok,UsedVacm} = snmpa_conf:read_vacm_config(ConfDir), + true = (MyVacm == UsedVacm), + ok. + + + + +%% NOTE!! This test must always be executed last in the suite, and +%% should match all set requests performed in the suite. I.e. if you +%% add a set request, you must add an entry in the return value of +%% ct_snmp:set_info/1 below. +set_info(Config) -> + %% From test case set_values/1: + Oid1 = ?sysName_instance, + NewValue1 = "ct_test changed by " ++ atom_to_list(?MODULE), + + %% The test... + [{_AgentName,_,[{Oid1,_,NewValue1}]}] + = ct_snmp:set_info(Config), + ok. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/community.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/community.conf new file mode 100644 index 0000000000..5a64df6605 --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/community.conf @@ -0,0 +1 @@ +{"public", "public", "initial", "", ""}. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/context.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/context.conf new file mode 100644 index 0000000000..feed5e1d11 --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/context.conf @@ -0,0 +1 @@ +"testcontext". diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/notify.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/notify.conf new file mode 100644 index 0000000000..367ba3aa4b --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/notify.conf @@ -0,0 +1 @@ +{"standard inform", "std_inform", inform}. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/standard.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/standard.conf new file mode 100644 index 0000000000..79908fb355 --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/standard.conf @@ -0,0 +1,7 @@ +{sysDescr, "agent for ct_snmp override test"}. +{sysObjectID, [1,2,3]}. +{sysContact, "[email protected]"}. +{sysLocation, "erlang"}. +{sysServices, 72}. +{snmpEnableAuthenTraps, enabled}. +{sysName, "name for override test"}. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf new file mode 100644 index 0000000000..d02672a074 --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_addr.conf @@ -0,0 +1,2 @@ +{"target1", snmpUDPDomain, [147,214,122,73], 5000, 1500, 3, "std_trap", "target_v3", "", [], 2048}. +{"target2", snmpUDPDomain, [147,214,122,73], 5000, 1500, 3, "std_inform", "target_v3", "", [], 2048}. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_params.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_params.conf new file mode 100644 index 0000000000..5a9a619422 --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/target_params.conf @@ -0,0 +1 @@ +{"target_v3", v3, usm, "initial", noAuthNoPriv}. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/usm.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/usm.conf new file mode 100644 index 0000000000..d6e245914e --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/usm.conf @@ -0,0 +1 @@ +{"ct_snmp-test-engine","usm_user_name","secname",zeroDotZero,usmNoAuthProtocol,"","",usmNoPrivProtocol,"","","","",""}. diff --git a/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/vacm.conf b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/vacm.conf new file mode 100644 index 0000000000..158fe02e3b --- /dev/null +++ b/lib/common_test/test/ct_snmp_SUITE_data/snmp_SUITE_data/vacm.conf @@ -0,0 +1,6 @@ +{vacmSecurityToGroup, usm, "initial", "initial"}. +{vacmAccess, "initial", "", any, noAuthNoPriv, exact, "restricted", "", "restricted"}. +{vacmAccess, "initial", "", usm, authNoPriv, exact, "internet", "internet", "internet"}. +{vacmAccess, "initial", "", usm, authPriv, exact, "internet", "internet", "internet"}. +{vacmViewTreeFamily, "restricted", [1,3,6,1], included, null}. +{vacmViewTreeFamily, "internet", [1,3,6,1], included, null}. diff --git a/lib/common_test/test/ct_system_error_SUITE.erl b/lib/common_test/test/ct_system_error_SUITE.erl new file mode 100644 index 0000000000..f2d6ef4b1b --- /dev/null +++ b/lib/common_test/test/ct_system_error_SUITE.erl @@ -0,0 +1,132 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File: ct_system_error_SUITE +%%% +%%% Description: +%%% +%%% Test that severe system errors (such as failure to write logs) are +%%% noticed and handled. +%%%------------------------------------------------------------------- +-module(ct_system_error_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) -> + Config1 = ct_test_support:init_per_suite(Config), + Config1. + +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() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + test_server_failing_logs + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +%%%----------------------------------------------------------------- +%%% +test_server_failing_logs(Config) -> + TC = test_server_failing_logs, + DataDir = ?config(data_dir, Config), + Suite = filename:join(DataDir, "a_SUITE"), + {Opts,ERPid} = setup([{suite,Suite},{label,TC}], Config), + crash_test_server(Config), + {error,{cannot_create_log_dir,__}} = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + ct_test_support:log_events(TC, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(TC), + ok = ct_test_support:verify_events(TestEvents, Events, Config). + +crash_test_server(Config) -> + DataDir = ?config(data_dir, Config), + Root = proplists:get_value(logdir, ct_test_support:get_opts(Config)), + [$@|Host] = lists:dropwhile(fun(C) -> + C =/= $@ + end, atom_to_list(node())), + Format = filename:join(Root, + "ct_run.ct@" ++ Host ++ + ".~4..0w-~2..0w-~2..0w_" + "~2..0w.~2..0w.~2..0w"), + [C2,C1|_] = lists:reverse(filename:split(DataDir)), + LogDir = C1 ++ "." ++ C2 ++ ".a_SUITE.logs", + T = calendar:datetime_to_gregorian_seconds(calendar:local_time()), + [begin + {{Y,Mon,D},{H,Min,S}} = + calendar:gregorian_seconds_to_datetime(T+Offset), + Dir0 = io_lib:format(Format, [Y,Mon,D,H,Min,S]), + Dir = lists:flatten(Dir0), + file:make_dir(Dir), + File = filename:join(Dir, LogDir), + file:write_file(File, "anything goes\n") + end || Offset <- lists:seq(0, 20)], + ok. + +%%%----------------------------------------------------------------- +%%% HELP FUNCTIONS +%%%----------------------------------------------------------------- + +setup(Test, Config) -> + Opts0 = ct_test_support:get_opts(Config), + Level = ?config(trace_level, Config), + EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}}|Test], + ERPid = ct_test_support:start_event_receiver(Config), + {Opts,ERPid}. + +reformat(Events, EH) -> + ct_test_support:reformat(Events, EH). + +%%%----------------------------------------------------------------- +%%% TEST EVENTS +%%%----------------------------------------------------------------- + +events_to_check(_Test) -> + [{?eh,severe_error,{cannot_create_log_dir,{'_','_'}}}]. diff --git a/lib/common_test/test/ct_system_error_SUITE_data/a_SUITE.erl b/lib/common_test/test/ct_system_error_SUITE_data/a_SUITE.erl new file mode 100644 index 0000000000..c6e3ddfd5d --- /dev/null +++ b/lib/common_test/test/ct_system_error_SUITE_data/a_SUITE.erl @@ -0,0 +1,122 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(a_SUITE). + +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% @spec suite() -> Info +%% Info = [tuple()] +%% @end +%%-------------------------------------------------------------------- +suite() -> + [{timetrap,{seconds,10}}]. + +%%-------------------------------------------------------------------- +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_suite(Config0) -> void() | {save_config,Config1} +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_suite(_Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_group(GroupName, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_group(_GroupName, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_group(GroupName, Config0) -> +%% void() | {save_config,Config1} +%% GroupName = atom() +%% Config0 = Config1 = [tuple()] +%% @end +%%-------------------------------------------------------------------- +end_per_group(_GroupName, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +%% TestCase = atom() +%% Config0 = Config1 = [tuple()] +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +end_per_testcase(_TestCase, _Config) -> + ok. + +%%-------------------------------------------------------------------- +%% @spec groups() -> [Group] +%% Group = {GroupName,Properties,GroupsAndTestCases} +%% GroupName = atom() +%% Properties = [parallel | sequence | Shuffle | {RepeatType,N}] +%% GroupsAndTestCases = [Group | {group,GroupName} | TestCase] +%% TestCase = atom() +%% Shuffle = shuffle | {shuffle,{integer(),integer(),integer()}} +%% RepeatType = repeat | repeat_until_all_ok | repeat_until_all_fail | +%% repeat_until_any_ok | repeat_until_any_fail +%% N = integer() | forever +%% @end +%%-------------------------------------------------------------------- +groups() -> + []. + +%%-------------------------------------------------------------------- +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +%% GroupsAndTestCases = [{group,GroupName} | TestCase] +%% GroupName = atom() +%% TestCase = atom() +%% Reason = term() +%% @end +%%-------------------------------------------------------------------- +all() -> + [tc1]. + +tc1(_C) -> + ok. diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl index b7e19f25dd..6a4a4acd80 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE.erl @@ -58,7 +58,7 @@ end_per_testcase(TestCase, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [all_suites, skip_all_suites, suite, skip_suite, all_testcases, skip_all_testcases, testcase, skip_testcase, all_groups, skip_all_groups, group, @@ -67,23 +67,23 @@ all() -> skip_group_testcase, topgroup, subgroup, skip_subgroup, subgroup_all_testcases, skip_subgroup_all_testcases, subgroup_testcase, skip_subgroup_testcase, - sub_skipped_by_top, testcase_in_multiple_groups, - order_of_tests_in_multiple_dirs_no_merge_tests, - order_of_tests_in_multiple_suites_no_merge_tests, - order_of_suites_in_multiple_dirs_no_merge_tests, - order_of_groups_in_multiple_dirs_no_merge_tests, - order_of_groups_in_multiple_suites_no_merge_tests, - order_of_tests_in_multiple_dirs, - order_of_tests_in_multiple_suites, - order_of_suites_in_multiple_dirs, - order_of_groups_in_multiple_dirs, - order_of_groups_in_multiple_suites, - order_of_tests_in_multiple_suites_with_skip_no_merge_tests, - order_of_tests_in_multiple_suites_with_skip, + sub_skipped_by_top, testcase_many_groups, + order_of_tests_many_dirs_no_merge_tests, + order_of_tests_many_suites_no_merge_tests, + order_of_suites_many_dirs_no_merge_tests, + order_of_groups_many_dirs_no_merge_tests, + order_of_groups_many_suites_no_merge_tests, + order_of_tests_many_dirs, + order_of_tests_many_suites, + order_of_suites_many_dirs, + order_of_groups_many_dirs, + order_of_groups_many_suites, + order_of_tests_many_suites_with_skip_no_merge_tests, + order_of_tests_many_suites_with_skip, all_plus_one_tc_no_merge_tests, all_plus_one_tc]. -groups() -> +groups() -> []. init_per_group(_GroupName, Config) -> @@ -373,19 +373,19 @@ sub_skipped_by_top(Config) when is_list(Config) -> %%%----------------------------------------------------------------- %%% -testcase_in_multiple_groups(Config) when is_list(Config) -> +testcase_many_groups(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir = filename:join(DataDir, "groups_1"), TestSpec = [{cases,TestDir,groups_12_SUITE,[testcase_1a,testcase_1b]}, {skip_cases,TestDir,groups_12_SUITE,[testcase_1b],"SKIPPED!"}], - setup_and_execute(testcase_in_multiple_groups, TestSpec, Config). + setup_and_execute(testcase_many_groups, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_tests_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> +order_of_tests_many_dirs_no_merge_tests(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -395,13 +395,13 @@ order_of_tests_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> {cases,TestDir2,groups_22_SUITE,[testcase_1]}, {cases,TestDir1,groups_12_SUITE,[testcase_1b]}], - setup_and_execute(order_of_tests_in_multiple_dirs_no_merge_tests, + setup_and_execute(order_of_tests_many_dirs_no_merge_tests, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_tests_in_multiple_suites_no_merge_tests(Config) when is_list(Config) -> +order_of_tests_many_suites_no_merge_tests(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -410,13 +410,13 @@ order_of_tests_in_multiple_suites_no_merge_tests(Config) when is_list(Config) -> {cases,TestDir1,groups_11_SUITE,[testcase_1]}, {cases,TestDir1,groups_12_SUITE,[testcase_1b]}], - setup_and_execute(order_of_tests_in_multiple_suites_no_merge_tests, + setup_and_execute(order_of_tests_many_suites_no_merge_tests, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_suites_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> +order_of_suites_many_dirs_no_merge_tests(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -426,13 +426,13 @@ order_of_suites_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> {suites,TestDir2,groups_22_SUITE}, {suites,TestDir1,groups_11_SUITE}], - setup_and_execute(order_of_suites_in_multiple_dirs_no_merge_tests, + setup_and_execute(order_of_suites_many_dirs_no_merge_tests, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_groups_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> +order_of_groups_many_dirs_no_merge_tests(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -442,13 +442,13 @@ order_of_groups_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> {groups,TestDir2,groups_22_SUITE,test_group_1a}, {groups,TestDir1,groups_12_SUITE,test_group_1b}], - setup_and_execute(order_of_groups_in_multiple_dirs_no_merge_tests, + setup_and_execute(order_of_groups_many_dirs_no_merge_tests, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_groups_in_multiple_suites_no_merge_tests(Config) +order_of_groups_many_suites_no_merge_tests(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), @@ -458,13 +458,13 @@ order_of_groups_in_multiple_suites_no_merge_tests(Config) {groups,TestDir1,groups_11_SUITE,test_group_1a}, {groups,TestDir1,groups_12_SUITE,test_group_1b}], - setup_and_execute(order_of_groups_in_multiple_suites_no_merge_tests, + setup_and_execute(order_of_groups_many_suites_no_merge_tests, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_tests_in_multiple_suites_with_skip_no_merge_tests(Config) +order_of_tests_many_suites_with_skip_no_merge_tests(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), @@ -477,14 +477,14 @@ order_of_tests_in_multiple_suites_with_skip_no_merge_tests(Config) {skip_cases,TestDir1,groups_12_SUITE,[testcase_1b],"Skip it"}], setup_and_execute( - order_of_tests_in_multiple_suites_with_skip_no_merge_tests, + order_of_tests_many_suites_with_skip_no_merge_tests, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_tests_in_multiple_dirs(Config) when is_list(Config) -> +order_of_tests_many_dirs(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -493,13 +493,13 @@ order_of_tests_in_multiple_dirs(Config) when is_list(Config) -> {cases,TestDir2,groups_22_SUITE,[testcase_1]}, {cases,TestDir1,groups_12_SUITE,[testcase_1b]}], - setup_and_execute(order_of_tests_in_multiple_dirs, + setup_and_execute(order_of_tests_many_dirs, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_tests_in_multiple_suites(Config) when is_list(Config) -> +order_of_tests_many_suites(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -507,13 +507,13 @@ order_of_tests_in_multiple_suites(Config) when is_list(Config) -> {cases,TestDir1,groups_11_SUITE,[testcase_1]}, {cases,TestDir1,groups_12_SUITE,[testcase_1b]}], - setup_and_execute(order_of_tests_in_multiple_suites, + setup_and_execute(order_of_tests_many_suites, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_suites_in_multiple_dirs(Config) when is_list(Config) -> +order_of_suites_many_dirs(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -522,13 +522,13 @@ order_of_suites_in_multiple_dirs(Config) when is_list(Config) -> {suites,TestDir2,groups_22_SUITE}, {suites,TestDir1,groups_11_SUITE}], - setup_and_execute(order_of_suites_in_multiple_dirs, + setup_and_execute(order_of_suites_many_dirs, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_groups_in_multiple_dirs(Config) when is_list(Config) -> +order_of_groups_many_dirs(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -537,13 +537,13 @@ order_of_groups_in_multiple_dirs(Config) when is_list(Config) -> {groups,TestDir2,groups_22_SUITE,test_group_1a}, {groups,TestDir1,groups_12_SUITE,test_group_1b}], - setup_and_execute(order_of_groups_in_multiple_dirs, + setup_and_execute(order_of_groups_many_dirs, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_groups_in_multiple_suites(Config) when is_list(Config) -> +order_of_groups_many_suites(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -551,13 +551,13 @@ order_of_groups_in_multiple_suites(Config) when is_list(Config) -> {groups,TestDir1,groups_11_SUITE,test_group_1a}, {groups,TestDir1,groups_12_SUITE,test_group_1b}], - setup_and_execute(order_of_groups_in_multiple_suites, + setup_and_execute(order_of_groups_many_suites, TestSpec, Config). %%%----------------------------------------------------------------- %%% -order_of_tests_in_multiple_suites_with_skip(Config) when is_list(Config) -> +order_of_tests_many_suites_with_skip(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), TestDir1 = filename:join(DataDir, "groups_1"), @@ -567,7 +567,7 @@ order_of_tests_in_multiple_suites_with_skip(Config) when is_list(Config) -> {cases,TestDir1,groups_11_SUITE,[testcase_2]}, {skip_cases,TestDir1,groups_12_SUITE,[testcase_1b],"Skip it!"}], - setup_and_execute(order_of_tests_in_multiple_suites_with_skip, + setup_and_execute(order_of_tests_many_suites_with_skip, TestSpec, Config). %%%----------------------------------------------------------------- @@ -1204,10 +1204,10 @@ test_events(sub_skipped_by_top) -> {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; -test_events(testcase_in_multiple_groups) -> +test_events(testcase_many_groups) -> []; -test_events(order_of_tests_in_multiple_dirs_no_merge_tests) -> +test_events(order_of_tests_many_dirs_no_merge_tests) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, {?eh,tc_done, {groups_12_SUITE,testcase_1a, @@ -1219,7 +1219,7 @@ test_events(order_of_tests_in_multiple_dirs_no_merge_tests) -> {failed,{error,{test_case_failed,no_group_data}}}}}, {?eh,stop_logging,[]} ]; -test_events(order_of_tests_in_multiple_suites_no_merge_tests) -> +test_events(order_of_tests_many_suites_no_merge_tests) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, {?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}}, @@ -1229,7 +1229,7 @@ test_events(order_of_tests_in_multiple_suites_no_merge_tests) -> {?eh,tc_done,{groups_12_SUITE,testcase_1b,'_'}}, {?eh,stop_logging,[]} ]; -test_events(order_of_suites_in_multiple_dirs_no_merge_tests) -> +test_events(order_of_suites_many_dirs_no_merge_tests) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_done,{groups_12_SUITE,init_per_suite,'_'}}, @@ -1244,7 +1244,7 @@ test_events(order_of_suites_in_multiple_dirs_no_merge_tests) -> {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, {?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}}, {?eh,stop_logging,[]}]; -test_events(order_of_groups_in_multiple_dirs_no_merge_tests) -> +test_events(order_of_groups_many_dirs_no_merge_tests) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}}, @@ -1257,7 +1257,7 @@ test_events(order_of_groups_in_multiple_dirs_no_merge_tests) -> {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1b,'_'},'_'}}, {?eh,stop_logging,[]}]; -test_events(order_of_groups_in_multiple_suites_no_merge_tests) -> +test_events(order_of_groups_many_suites_no_merge_tests) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}}, @@ -1270,7 +1270,7 @@ test_events(order_of_groups_in_multiple_suites_no_merge_tests) -> {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1b,'_'},'_'}}, {?eh,stop_logging,[]}]; -test_events(order_of_tests_in_multiple_suites_with_skip_no_merge_tests) -> +test_events(order_of_tests_many_suites_with_skip_no_merge_tests) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, {?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}}, @@ -1282,7 +1282,7 @@ test_events(order_of_tests_in_multiple_suites_with_skip_no_merge_tests) -> {?eh,stop_logging,[]} ]; -test_events(order_of_tests_in_multiple_dirs) -> +test_events(order_of_tests_many_dirs) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, {?eh,tc_done, @@ -1296,7 +1296,7 @@ test_events(order_of_tests_in_multiple_dirs) -> {?eh,tc_done,{groups_22_SUITE,testcase_1,ok}}, {?eh,stop_logging,[]} ]; -test_events(order_of_tests_in_multiple_suites) -> +test_events(order_of_tests_many_suites) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, {?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}}, @@ -1308,7 +1308,7 @@ test_events(order_of_tests_in_multiple_suites) -> {?eh,tc_done,{groups_11_SUITE,testcase_1,ok}}, {?eh,stop_logging,[]} ]; -test_events(order_of_suites_in_multiple_dirs) -> +test_events(order_of_suites_many_dirs) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_done,{groups_12_SUITE,init_per_suite,'_'}}, @@ -1325,7 +1325,7 @@ test_events(order_of_suites_in_multiple_dirs) -> {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, {?eh,tc_done,{groups_22_SUITE,end_per_suite,'_'}}, {?eh,stop_logging,[]}]; -test_events(order_of_groups_in_multiple_dirs) -> +test_events(order_of_groups_many_dirs) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}}, @@ -1338,7 +1338,7 @@ test_events(order_of_groups_in_multiple_dirs) -> {?eh,tc_done, {groups_22_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, {?eh,stop_logging,[]}]; -test_events(order_of_groups_in_multiple_suites) -> +test_events(order_of_groups_many_suites) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}}, @@ -1352,7 +1352,7 @@ test_events(order_of_groups_in_multiple_suites) -> {?eh,stop_logging,[]}]; -test_events(order_of_tests_in_multiple_suites_with_skip) -> +test_events(order_of_tests_many_suites_with_skip) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, {?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}}, diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk index 877aa775fd..5c9fdfc47e 100644 --- a/lib/common_test/vsn.mk +++ b/lib/common_test/vsn.mk @@ -1 +1 @@ -COMMON_TEST_VSN = 1.6.2 +COMMON_TEST_VSN = 1.6.2.1 diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 958d3501c7..cbcbf79839 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -45,6 +45,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/compiler-$(VSN) # Target Specs # ---------------------------------------------------- MODULES = \ + beam_a \ beam_asm \ beam_block \ beam_bool \ @@ -65,6 +66,7 @@ MODULES = \ beam_type \ beam_utils \ beam_validator \ + beam_z \ cerl \ cerl_clauses \ cerl_inline \ diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl new file mode 100644 index 0000000000..1c51226314 --- /dev/null +++ b/lib/compiler/src/beam_a.erl @@ -0,0 +1,97 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose: Run directly after code generation to do any normalization +%% or preparation to simplify the optimization passes. +%% (Mandatory.) + +-module(beam_a). + +-export([module/2]). + +module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> + Fs = [function(F) || F <- Fs0], + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +function({function,Name,Arity,CLabel,Is0}) -> + try + %% Rename certain operations to simplify the optimization passes. + Is1 = rename_instrs(Is0), + + %% Remove unusued labels for cleanliness and to help + %% optimization passes and HiPE. + Is = beam_jump:remove_unused_labels(Is1), + {function,Name,Arity,CLabel,Is} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +rename_instrs([{apply_last,A,N}|Is]) -> + [{apply,A},{deallocate,N},return|rename_instrs(Is)]; +rename_instrs([{call_last,A,F,N}|Is]) -> + [{call,A,F},{deallocate,N},return|rename_instrs(Is)]; +rename_instrs([{call_ext_last,A,F,N}|Is]) -> + [{call_ext,A,F},{deallocate,N},return|rename_instrs(Is)]; +rename_instrs([{call_only,A,F}|Is]) -> + [{call,A,F},return|rename_instrs(Is)]; +rename_instrs([{call_ext_only,A,F}|Is]) -> + [{call_ext,A,F},return|rename_instrs(Is)]; +rename_instrs([I|Is]) -> + [rename_instr(I)|rename_instrs(Is)]; +rename_instrs([]) -> []. + +rename_instr({bs_put_binary=I,F,Sz,U,Fl,Src}) -> + {bs_put,F,{I,U,Fl},[Sz,Src]}; +rename_instr({bs_put_float=I,F,Sz,U,Fl,Src}) -> + {bs_put,F,{I,U,Fl},[Sz,Src]}; +rename_instr({bs_put_integer=I,F,Sz,U,Fl,Src}) -> + {bs_put,F,{I,U,Fl},[Sz,Src]}; +rename_instr({bs_put_utf8=I,F,Fl,Src}) -> + {bs_put,F,{I,Fl},[Src]}; +rename_instr({bs_put_utf16=I,F,Fl,Src}) -> + {bs_put,F,{I,Fl},[Src]}; +rename_instr({bs_put_utf32=I,F,Fl,Src}) -> + {bs_put,F,{I,Fl},[Src]}; +%% rename_instr({bs_put_string,_,_}=I) -> +%% {bs_put,{f,0},I,[]}; +rename_instr({bs_add=I,F,[Src1,Src2,U],Dst}) when is_integer(U) -> + {bif,I,F,[Src1,Src2,{integer,U}],Dst}; +rename_instr({bs_utf8_size=I,F,Src,Dst}) -> + {bif,I,F,[Src],Dst}; +rename_instr({bs_utf16_size=I,F,Src,Dst}) -> + {bif,I,F,[Src],Dst}; +rename_instr({bs_init2=I,F,Sz,Extra,Live,Flags,Dst}) -> + {bs_init,F,{I,Extra,Flags},Live,[Sz],Dst}; +rename_instr({bs_init_bits=I,F,Sz,Extra,Live,Flags,Dst}) -> + {bs_init,F,{I,Extra,Flags},Live,[Sz],Dst}; +rename_instr({bs_append=I,F,Sz,Extra,Live,U,Src,Flags,Dst}) -> + {bs_init,F,{I,Extra,U,Flags},Live,[Sz,Src],Dst}; +rename_instr({bs_private_append=I,F,Sz,U,Src,Flags,Dst}) -> + {bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}; +rename_instr(bs_init_writable=I) -> + {bs_init,{f,0},I,1,[{x,0}],{x,0}}; +rename_instr({select_val=I,Reg,Fail,{list,List}}) -> + {select,I,Reg,Fail,List}; +rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) -> + {select,I,Reg,Fail,List}; +rename_instr(send) -> + {call_ext,2,send}; +rename_instr(I) -> I. diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index cd568097fa..3e0050382c 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -31,19 +31,16 @@ module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> function({function,Name,Arity,CLabel,Is0}, Lc0) -> try - %% Extra labels may thwart optimizations. - Is1 = beam_jump:remove_unused_labels(Is0), - %% Collect basic blocks and optimize them. - Is2 = blockify(Is1), - Is3 = embed_lines(Is2), - Is4 = move_allocates(Is3), - Is5 = beam_utils:live_opt(Is4), - Is6 = opt_blocks(Is5), - Is7 = beam_utils:delete_live_annos(Is6), + Is1 = blockify(Is0), + Is2 = embed_lines(Is1), + Is3 = move_allocates(Is2), + Is4 = beam_utils:live_opt(Is3), + Is5 = opt_blocks(Is4), + Is6 = beam_utils:delete_live_annos(Is5), %% Optimize bit syntax. - {Is,Lc} = bsm_opt(Is7, Lc0), + {Is,Lc} = bsm_opt(Is6, Lc0), %% Done. {{function,Name,Arity,CLabel,Is},Lc} @@ -74,9 +71,9 @@ blockify([{bs_save2,R,Point}=I,{test,is_eq_exact,_,_}=Test, %% Do other peep-hole optimizations. blockify([{test,is_atom,{f,Fail},[Reg]}=I| - [{select_val,Reg,{f,Fail}, - {list,[{atom,false},{f,_}=BrFalse, - {atom,true}=AtomTrue,{f,_}=BrTrue]}}|Is]=Is0], + [{select,select_val,Reg,{f,Fail}, + [{atom,false},{f,_}=BrFalse, + {atom,true}=AtomTrue,{f,_}=BrTrue]}|Is]=Is0], [{block,Bl}|_]=Acc) -> case is_last_bool(Bl, Reg) of false -> @@ -89,9 +86,9 @@ blockify([{test,is_atom,{f,Fail},[Reg]}=I| {test,is_eq_exact,BrFalse,[Reg,AtomTrue]}|Acc]) end; blockify([{test,is_atom,{f,Fail},[Reg]}=I| - [{select_val,Reg,{f,Fail}, - {list,[{atom,true}=AtomTrue,{f,_}=BrTrue, - {atom,false},{f,_}=BrFalse]}}|Is]=Is0], + [{select,select_val,Reg,{f,Fail}, + [{atom,true}=AtomTrue,{f,_}=BrTrue, + {atom,false},{f,_}=BrFalse]}|Is]=Is0], [{block,Bl}|_]=Acc) -> case is_last_bool(Bl, Reg) of false -> @@ -423,8 +420,8 @@ inverse_comp_op(_) -> none. %%% Evaluation of constant bit fields. %%% -is_bs_put({bs_put_integer,_,_,_,_,_}) -> true; -is_bs_put({bs_put_float,_,_,_,_,_}) -> true; +is_bs_put({bs_put,_,{bs_put_integer,_,_},_}) -> true; +is_bs_put({bs_put,_,{bs_put_float,_,_},_}) -> true; is_bs_put(_) -> false. collect_bs_puts(Is) -> @@ -439,20 +436,24 @@ collect_bs_puts_1([I|Is]=Is0, Acc) -> opt_bs_puts(Is) -> opt_bs_1(Is, []). -opt_bs_1([{bs_put_float,Fail,{integer,Sz},1,Flags0,Src}=I0|Is], Acc) -> +opt_bs_1([{bs_put,Fail, + {bs_put_float,1,Flags0},[{integer,Sz},Src]}=I0|Is], Acc) -> try eval_put_float(Src, Sz, Flags0) of <<Int:Sz>> -> Flags = force_big(Flags0), - I = {bs_put_integer,Fail,{integer,Sz},1,Flags,{integer,Int}}, + I = {bs_put,Fail,{bs_put_integer,1,Flags}, + [{integer,Sz},{integer,Int}]}, opt_bs_1([I|Is], Acc) catch error:_ -> opt_bs_1(Is, [I0|Acc]) end; -opt_bs_1([{bs_put_integer,_,{integer,8},1,_,{integer,_}}|_]=IsAll, Acc0) -> +opt_bs_1([{bs_put,_,{bs_put_integer,1,_},[{integer,8},{integer,_}]}|_]=IsAll, + Acc0) -> {Is,Acc} = bs_collect_string(IsAll, Acc0), opt_bs_1(Is, Acc); -opt_bs_1([{bs_put_integer,Fail,{integer,Sz},1,F,{integer,N}}=I|Is0], Acc) when Sz > 8 -> +opt_bs_1([{bs_put,Fail,{bs_put_integer,1,F},[{integer,Sz},{integer,N}]}=I|Is0], + Acc) when Sz > 8 -> case field_endian(F) of big -> %% We can do this optimization for any field size without risk @@ -466,14 +467,14 @@ opt_bs_1([{bs_put_integer,Fail,{integer,Sz},1,F,{integer,N}}=I|Is0], Acc) when S %% an explosion in code size. <<Int:Sz>> = <<N:Sz/little>>, Flags = force_big(F), - Is = [{bs_put_integer,Fail,{integer,Sz},1, - Flags,{integer,Int}}|Is0], + Is = [{bs_put,Fail,{bs_put_integer,1,Flags}, + [{integer,Sz},{integer,Int}]}|Is0], opt_bs_1(Is, Acc); _ -> %native or too wide little field opt_bs_1(Is0, [I|Acc]) end; -opt_bs_1([{Op,Fail,{integer,Sz},U,F,Src}|Is], Acc) when U > 1 -> - opt_bs_1([{Op,Fail,{integer,U*Sz},1,F,Src}|Is], Acc); +opt_bs_1([{bs_put,Fail,{Op,U,F},[{integer,Sz},Src]}|Is], Acc) when U > 1 -> + opt_bs_1([{bs_put,Fail,{Op,1,F},[{integer,U*Sz},Src]}|Is], Acc); opt_bs_1([I|Is], Acc) -> opt_bs_1(Is, [I|Acc]); opt_bs_1([], Acc) -> reverse(Acc). @@ -489,17 +490,17 @@ eval_put_float(Src, Sz, Flags) when Sz =< 256 -> %Only evaluate if Sz is reasona value({integer,I}) -> I; value({float,F}) -> F. -bs_collect_string(Is, [{bs_put_string,Len,{string,Str}}|Acc]) -> +bs_collect_string(Is, [{bs_put,_,{bs_put_string,Len,{string,Str}},[]}|Acc]) -> bs_coll_str_1(Is, Len, reverse(Str), Acc); bs_collect_string(Is, Acc) -> bs_coll_str_1(Is, 0, [], Acc). -bs_coll_str_1([{bs_put_integer,_,{integer,Sz},U,_,{integer,V}}|Is], +bs_coll_str_1([{bs_put,_,{bs_put_integer,U,_},[{integer,Sz},{integer,V}]}|Is], Len, StrAcc, IsAcc) when U*Sz =:= 8 -> Byte = V band 16#FF, bs_coll_str_1(Is, Len+1, [Byte|StrAcc], IsAcc); bs_coll_str_1(Is, Len, StrAcc, IsAcc) -> - {Is,[{bs_put_string,Len,{string,reverse(StrAcc)}}|IsAcc]}. + {Is,[{bs_put,{f,0},{bs_put_string,Len,{string,reverse(StrAcc)}},[]}|IsAcc]}. field_endian({field_flags,F}) -> field_endian_1(F). @@ -531,15 +532,17 @@ bs_split_int(N, Sz, Fail, Acc) -> bs_split_int_1(N, FirstByteSz, Sz, Fail, Acc). bs_split_int_1(-1, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put_integer,Fail,{integer,Sz},1,{field_flags,[big]},{integer,-1}}, + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,Sz},{integer,-1}]}, [I|Acc]; bs_split_int_1(0, _, Sz, Fail, Acc) when Sz > 64 -> - I = {bs_put_integer,Fail,{integer,Sz},1,{field_flags,[big]},{integer,0}}, + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,Sz},{integer,0}]}, [I|Acc]; bs_split_int_1(N, ByteSz, Sz, Fail, Acc) when Sz > 0 -> Mask = (1 bsl ByteSz) - 1, - I = {bs_put_integer,Fail,{integer,ByteSz},1, - {field_flags,[big]},{integer,N band Mask}}, + I = {bs_put,Fail,{bs_put_integer,1,{field_flags,[big]}}, + [{integer,ByteSz},{integer,N band Mask}]}, bs_split_int_1(N bsr ByteSz, 8, Sz-ByteSz, Fail, [I|Acc]); bs_split_int_1(_, _, _, _, Acc) -> Acc. @@ -577,9 +580,9 @@ bsm_reroute([{bs_restore2,Reg,Save}=I|Is], D, _, Acc) -> bsm_reroute(Is, D, {Reg,Save}, [I|Acc]); bsm_reroute([{label,_}=I|Is], D, S, Acc) -> bsm_reroute(Is, D, S, [I|Acc]); -bsm_reroute([{select_val,Reg,F0,{list,Lbls0}}|Is], D, {_,Save}=S, Acc0) -> +bsm_reroute([{select,select_val,Reg,F0,Lbls0}|Is], D, {_,Save}=S, Acc0) -> [F|Lbls] = bsm_subst_labels([F0|Lbls0], Save, D), - Acc = [{select_val,Reg,F,{list,Lbls}}|Acc0], + Acc = [{select,select_val,Reg,F,Lbls}|Acc0], bsm_reroute(Is, D, S, Acc); bsm_reroute([{test,TestOp,F0,TestArgs}=I|Is], D, {_,Save}=S, Acc0) -> F = bsm_subst_label(F0, Save, D), @@ -615,10 +618,6 @@ bsm_opt_2([{test,bs_skip_bits2,F,[Ctx,{integer,I1},Unit1,_]}|Is], [{test,bs_skip_bits2,F,[Ctx,{integer,I2},Unit2,Flags]}|Acc]) -> bsm_opt_2(Is, [{test,bs_skip_bits2,F, [Ctx,{integer,I1*Unit1+I2*Unit2},1,Flags]}|Acc]); -bsm_opt_2([{test,bs_match_string,F,[Ctx,Bin1]}, - {test,bs_match_string,F,[Ctx,Bin2]}|Is], Acc) -> - I = {test,bs_match_string,F,[Ctx,<<Bin1/bitstring,Bin2/bitstring>>]}, - bsm_opt_2([I|Is], Acc); bsm_opt_2([I|Is], Acc) -> bsm_opt_2(Is, [I|Acc]); bsm_opt_2([], Acc) -> reverse(Acc). diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index d9ea6f5a70..81be262d6d 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -168,18 +168,18 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> end. %% ensure_opt_safe(OriginalCode, OptCode, FollowingCode, Fail, -%% ReversedPreceedingCode, State) -> ok +%% ReversedPrecedingCode, State) -> ok %% Comparing the original code to the optimized code, determine %% whether the optimized code is guaranteed to work in the same %% way as the original code. %% %% Throw an exception if the optimization is not safe. %% -ensure_opt_safe(Bl, NewCode, OldIs, Fail, PreceedingCode, St) -> +ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) -> %% Here are the conditions that must be true for the %% optimization to be safe. %% - %% 1. If a register is INITIALIZED by PreceedingCode, + %% 1. If a register is INITIALIZED by PrecedingCode, %% then if that register assigned a value in the original %% code, but not in the optimized code, it must be UNUSED or KILLED %% in the code that follows. @@ -190,29 +190,50 @@ ensure_opt_safe(Bl, NewCode, OldIs, Fail, PreceedingCode, St) -> %% by the code that follows. %% %% 3. Any register that is assigned a value in the optimized - %% code must be UNUSED or KILLED in the following code - %% (because the register might be assigned the wrong value, - %% and even if the value is right it might no longer be - %% assigned on *all* paths leading to its use). + %% code must be UNUSED or KILLED in the following code, + %% unless we can be sure that it is always assigned the same + %% value. - InitInPreceeding = initialized_regs(PreceedingCode), + InitInPreceding = initialized_regs(PrecedingCode), PrevDst = dst_regs(Bl), NewDst = dst_regs(NewCode), NotSet = ordsets:subtract(PrevDst, NewDst), - MustBeKilled = ordsets:subtract(NotSet, InitInPreceeding), - MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), MustBeKilled), + MustBeKilled = ordsets:subtract(NotSet, InitInPreceding), case all_killed(MustBeKilled, OldIs, Fail, St) of false -> throw(all_registers_not_killed); true -> ok end, + Same = assigned_same_value(Bl, NewCode), + MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), + ordsets:union(MustBeKilled, Same)), case none_used(MustBeUnused, OldIs, Fail, St) of false -> throw(registers_used); true -> ok end, ok. +%% assigned_same_value(OldCode, NewCodeReversed) -> [DestinationRegs] +%% Return an ordset with a list of all y registers that are always +%% assigned the same value in the old and new code. Currently, we +%% are very conservative in that we only consider identical move +%% instructions in the same order. +%% +assigned_same_value(Old, New) -> + case reverse(New) of + [{block,Bl}|_] -> + assigned_same_value(Old, Bl, []); + _ -> + ordsets:new() + end. + +assigned_same_value([{set,[{y,_}=D],[S],move}|T1], + [{set,[{y,_}=D],[S],move}|T2], Acc) -> + assigned_same_value(T1, T2, [D|Acc]); +assigned_same_value(_, _, Acc) -> + ordsets:from_list(Acc). + update_fail_label([{set,_,_,move}=I|Is], Fail, Acc) -> update_fail_label(Is, Fail, [I|Acc]); update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 1217f7f777..37053e1cc4 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -204,16 +204,6 @@ btb_reaches_match_1(Is, Regs, D) -> btb_reaches_match_2([{block,Bl}|Is], Regs0, D) -> Regs = btb_reaches_match_block(Bl, Regs0), btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{call_only,Arity,{f,Lbl}}|_], Regs0, D) -> - Regs = btb_kill_not_live(Arity, Regs0), - btb_tail_call(Lbl, Regs, D); -btb_reaches_match_2([{call_ext_only,Arity,Func}|_], Regs0, D) -> - Regs = btb_kill_not_live(Arity, Regs0), - btb_tail_call(Func, Regs, D); -btb_reaches_match_2([{call_last,Arity,{f,Lbl},_}|_], Regs0, D) -> - Regs1 = btb_kill_not_live(Arity, Regs0), - Regs = btb_kill_yregs(Regs1), - btb_tail_call(Lbl, Regs, D); btb_reaches_match_2([{call,Arity,{f,Lbl}}|Is], Regs, D) -> btb_call(Arity, Lbl, Regs, Is, D); btb_reaches_match_2([{apply,Arity}|Is], Regs, D) -> @@ -222,19 +212,16 @@ btb_reaches_match_2([{call_fun,Live}=I|Is], Regs, D) -> btb_call(Live, I, Regs, Is, D); btb_reaches_match_2([{make_fun2,_,_,_,Live}|Is], Regs, D) -> btb_call(Live, make_fun2, Regs, Is, D); -btb_reaches_match_2([{call_ext,Arity,{extfunc,Mod,Name,Arity}=Func}|Is], Regs0, D) -> +btb_reaches_match_2([{call_ext,Arity,Func}=I|Is], Regs0, D) -> %% Allow us scanning beyond the call in case the match %% context is saved on the stack. - case erl_bifs:is_exit_bif(Mod, Name, Arity) of + case beam_jump:is_exit_instruction(I) of false -> btb_call(Arity, Func, Regs0, Is, D); true -> Regs = btb_kill_not_live(Arity, Regs0), btb_tail_call(Func, Regs, D) end; -btb_reaches_match_2([{call_ext_last,Arity,_,_}=I|_], Regs, D) -> - btb_ensure_not_used(btb_regs_from_arity(Arity), I, Regs), - D; btb_reaches_match_2([{kill,Y}|Is], Regs, D) -> btb_reaches_match_1(Is, btb_kill([Y], Regs), D); btb_reaches_match_2([{deallocate,_}|Is], Regs0, D) -> @@ -278,12 +265,7 @@ btb_reaches_match_2([{test,_,{f,F},_,Ss,_}=I|Is], Regs, D0) -> btb_ensure_not_used(Ss, I, Regs), D = btb_follow_branch(F, Regs, D0), btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{select_val,Src,{f,F},{list,Conds}}=I|Is], Regs, D0) -> - btb_ensure_not_used([Src], I, Regs), - D1 = btb_follow_branch(F, Regs, D0), - D = btb_follow_branches(Conds, Regs, D1), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{select_tuple_arity,Src,{f,F},{list,Conds}}=I|Is], Regs, D0) -> +btb_reaches_match_2([{select,_,Src,{f,F},Conds}=I|Is], Regs, D0) -> btb_ensure_not_used([Src], I, Regs), D1 = btb_follow_branch(F, Regs, D0), D = btb_follow_branches(Conds, Regs, D1), @@ -293,46 +275,11 @@ btb_reaches_match_2([{jump,{f,Lbl}}|_], Regs, #btb{index=Li}=D) -> btb_reaches_match_2(Is, Regs, D); btb_reaches_match_2([{label,_}|Is], Regs, D) -> btb_reaches_match_2(Is, Regs, D); -btb_reaches_match_2([{bs_add,{f,0},_,Dst}|Is], Regs, D) -> - btb_reaches_match_1(Is, btb_kill([Dst], Regs), D); -btb_reaches_match_2([bs_init_writable|Is], Regs0, D) -> - Regs = btb_kill_not_live(0, Regs0), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bs_init2,{f,0},_,_,_,_,Dst}|Is], Regs, D) -> - btb_reaches_match_1(Is, btb_kill([Dst], Regs), D); -btb_reaches_match_2([{bs_init_bits,{f,0},_,_,_,_,Dst}|Is], Regs, D) -> - btb_reaches_match_1(Is, btb_kill([Dst], Regs), D); -btb_reaches_match_2([{bs_append,{f,0},_,_,_,_,Src,_,Dst}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - btb_reaches_match_1(Is, btb_kill([Dst], Regs), D); -btb_reaches_match_2([{bs_private_append,{f,0},_,_,Src,_,Dst}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - btb_reaches_match_1(Is, btb_kill([Dst], Regs), D); -btb_reaches_match_2([{bs_put_integer,{f,0},_,_,_,Src}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bs_put_float,{f,0},_,_,_,Src}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bs_put_binary,{f,0},_,_,_,Src}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bs_put_string,_,_}|Is], Regs, D) -> - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bs_utf8_size,_,Src,Dst}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - btb_reaches_match_1(Is, btb_kill([Dst], Regs), D); -btb_reaches_match_2([{bs_utf16_size,_,Src,Dst}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), +btb_reaches_match_2([{bs_init,{f,0},_,_,Ss,Dst}=I|Is], Regs, D) -> + btb_ensure_not_used(Ss, I, Regs), btb_reaches_match_1(Is, btb_kill([Dst], Regs), D); -btb_reaches_match_2([{bs_put_utf8,_,_,Src}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bs_put_utf16,_,_,Src}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), - btb_reaches_match_1(Is, Regs, D); -btb_reaches_match_2([{bs_put_utf32,_,_,Src}=I|Is], Regs, D) -> - btb_ensure_not_used([Src], I, Regs), +btb_reaches_match_2([{bs_put,{f,0},_,Ss}=I|Is], Regs, D) -> + btb_ensure_not_used(Ss, I, Regs), btb_reaches_match_1(Is, Regs, D); btb_reaches_match_2([{bs_restore2,Src,_}=I|Is], Regs0, D) -> case btb_contains_context(Src, Regs0) of @@ -389,13 +336,16 @@ btb_call(Arity, Lbl, Regs0, Is, D0) -> %% First handle the call as if it were a tail call. D = btb_tail_call(Lbl, Regs, D0), - %% No problem so far, but now we must make sure that - %% we don't have any copies of the match context - %% tucked away in an y register. + %% No problem so far (the called function can handle a + %% match context). Now we must make sure that the rest + %% of this function following the call does not attempt + %% to use the match context in case there is a copy + %% tucked away in a y register. RegList = btb_context_regs(Regs), - case [R || {y,_}=R <- RegList] of - [] -> D; - [_|_] -> btb_error({multiple_uses,RegList}) + YRegs = [R || {y,_}=R <- RegList], + case btb_are_all_killed(YRegs, Is, D) of + true -> D; + false -> btb_error({multiple_uses,RegList}) end; true -> %% No match context in any x register. It could have been @@ -475,15 +425,6 @@ btb_reaches_match_block([{set,Ds,Ss,_}=I|Is], Regs0) -> btb_reaches_match_block([], Regs) -> Regs. -%% btb_regs_from_arity(Arity) -> [Register]) -%% Create a list of x registers from a function arity. - -btb_regs_from_arity(Arity) -> - btb_regs_from_arity_1(Arity, []). - -btb_regs_from_arity_1(0, Acc) -> Acc; -btb_regs_from_arity_1(N, Acc) -> btb_regs_from_arity_1(N-1, [{x,N-1}|Acc]). - %% btb_are_all_killed([Register], [Instruction], D) -> true|false %% Test whether all of the register are killed in the instruction stream. diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index a7994ab3b3..26ba93b91c 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -74,10 +74,6 @@ find_all_used([], _All, Used) -> Used. update_work_list([{call,_,{f,L}}|Is], Sets) -> update_work_list(Is, add_to_work_list(L, Sets)); -update_work_list([{call_last,_,{f,L},_}|Is], Sets) -> - update_work_list(Is, add_to_work_list(L, Sets)); -update_work_list([{call_only,_,{f,L}}|Is], Sets) -> - update_work_list(Is, add_to_work_list(L, Sets)); update_work_list([{make_fun2,{f,L},_,_,_}|Is], Sets) -> update_work_list(Is, add_to_work_list(L, Sets)); update_work_list([_|Is], Sets) -> @@ -200,7 +196,7 @@ replace([{test,Test,{f,Lbl},Ops}|Is], Acc, D) -> replace(Is, [{test,Test,{f,label(Lbl, D)},Ops}|Acc], D); replace([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D) -> replace(Is, [{test,Test,{f,label(Lbl, D)},Live,Ops,Dst}|Acc], D); -replace([{select_val,R,{f,Fail0},{list,Vls0}}|Is], Acc, D) -> +replace([{select,I,R,{f,Fail0},Vls0}|Is], Acc, D) -> Vls1 = map(fun ({f,L}) -> {f,label(L, D)}; (Other) -> Other end, Vls0), Fail = label(Fail0, D), @@ -210,12 +206,8 @@ replace([{select_val,R,{f,Fail0},{list,Vls0}}|Is], Acc, D) -> %% Convert to a plain jump. replace(Is, [{jump,{f,Fail}}|Acc], D); Vls -> - replace(Is, [{select_val,R,{f,Fail},{list,Vls}}|Acc], D) + replace(Is, [{select,I,R,{f,Fail},Vls}|Acc], D) end; -replace([{select_tuple_arity,R,{f,Fail},{list,Vls0}}|Is], Acc, D) -> - Vls = map(fun ({f,L}) -> {f,label(L, D)}; - (Other) -> Other end, Vls0), - replace(Is, [{select_tuple_arity,R,{f,label(Fail, D)},{list,Vls}}|Acc], D); replace([{'try',R,{f,Lbl}}|Is], Acc, D) -> replace(Is, [{'try',R,{f,label(Lbl, D)}}|Acc], D); replace([{'catch',R,{f,Lbl}}|Is], Acc, D) -> @@ -236,37 +228,12 @@ replace([{gc_bif,Name,{f,Lbl},Live,As,R}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{gc_bif,Name,{f,label(Lbl, D)},Live,As,R}|Acc], D); replace([{call,Ar,{f,Lbl}}|Is], Acc, D) -> replace(Is, [{call,Ar,{f,label(Lbl,D)}}|Acc], D); -replace([{call_last,Ar,{f,Lbl},N}|Is], Acc, D) -> - replace(Is, [{call_last,Ar,{f,label(Lbl,D)},N}|Acc], D); -replace([{call_only,Ar,{f,Lbl}}|Is], Acc, D) -> - replace(Is, [{call_only,Ar,{f,label(Lbl, D)}}|Acc], D); replace([{make_fun2,{f,Lbl},U1,U2,U3}|Is], Acc, D) -> replace(Is, [{make_fun2,{f,label(Lbl, D)},U1,U2,U3}|Acc], D); -replace([{bs_init2,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init2,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); -replace([{bs_init_bits,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init_bits,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); -replace([{bs_put_integer,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_integer,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_put_utf8=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_utf16=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_utf32=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_binary,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_binary,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_put_float,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_float,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_add,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_add,{f,label(Lbl, D)},Src,Dst}|Acc], D); -replace([{bs_append,{f,Lbl},_,_,_,_,_,_,_}=I0|Is], Acc, D) when Lbl =/= 0 -> - I = setelement(2, I0, {f,label(Lbl, D)}), - replace(Is, [I|Acc], D); -replace([{bs_utf8_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); -replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); +replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D); +replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D); replace([I|Is], Acc, D) -> replace(Is, [I|Acc], D); replace([], Acc, _) -> Acc. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 5f12a98f09..92d8e5acb3 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -182,7 +182,7 @@ forward(Is, Lc) -> forward([{block,[]}|Is], D, Lc, Acc) -> %% Empty blocks can prevent optimizations. forward(Is, D, Lc, Acc); -forward([{select_val,Reg,_,{list,List}}=I|Is], D0, Lc, Acc) -> +forward([{select,select_val,Reg,_,List}=I|Is], D0, Lc, Acc) -> D = update_value_dict(List, Reg, D0), forward(Is, D, Lc, [I|Acc]); forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) -> @@ -271,11 +271,11 @@ backward([{test,is_eq_exact,Fail,[Dst,{integer,Arity}]}=I| end; backward([{label,Lbl}=L|Is], D, Acc) -> backward(Is, beam_utils:index_label(Lbl, Acc, D), [L|Acc]); -backward([{select_val,Reg,{f,Fail0},{list,List0}}|Is], D, Acc) -> +backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> List = shortcut_select_list(List0, Reg, D, []), Fail1 = shortcut_label(Fail0, D), Fail = shortcut_bs_test(Fail1, Is, D), - Sel = {select_val,Reg,{f,Fail},{list,List}}, + Sel = {select,select_val,Reg,{f,Fail},List}, backward(Is, D, [Sel|Acc]); backward([{jump,{f,To0}},{move,Src,Reg}=Move0|Is], D, Acc) -> {To,Move} = case Src of @@ -382,7 +382,7 @@ shortcut_select_label(To0, Reg, Val, D) -> case beam_utils:code_at(To0, D) of [{jump,{f,To}}|_] -> shortcut_select_label(To, Reg, Val, D); - [{test,is_atom,_,[Reg]},{select_val,Reg,{f,Fail},{list,Map}}|_] -> + [{test,is_atom,_,[Reg]},{select,select_val,Reg,{f,Fail},Map}|_] -> To = find_select_val(Map, Val, Fail), shortcut_select_label(To, Reg, Val, D); [{test,is_eq_exact,{f,_},[Reg,{atom,Val}]},{label,To}|_] when is_atom(Val) -> @@ -472,10 +472,10 @@ combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_]) case beam_utils:code_at(To, D) of [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]}, {label,L2}|_] when Lit1 =/= Lit2 -> - {select_val,Reg,{f,F2},{list,[Lit1,{f,L1},Lit2,{f,L2}]}}; - [{select_val,Reg,{f,F2},{list,[{Type,_}|_]=List0}}|_] -> + {select,select_val,Reg,{f,F2},[Lit1,{f,L1},Lit2,{f,L2}]}; + [{select,select_val,Reg,{f,F2},[{Type,_}|_]=List0}|_] -> List = remove_from_list(Lit1, List0), - {select_val,Reg,{f,F2},{list,[Lit1,{f,L1}|List]}}; + {select,select_val,Reg,{f,F2},[Lit1,{f,L1}|List]}; _Is -> {test,is_eq_exact,{f,To},Ops} end; @@ -527,6 +527,8 @@ count_bits_matched([{test,_,_,_,[_,Sz,U,{field_flags,_}],_}|Is], SavePoint, Bits {integer,N} -> count_bits_matched(Is, SavePoint, Bits+N*U); _ -> count_bits_matched(Is, SavePoint, Bits) end; +count_bits_matched([{test,bs_match_string,_,[_,Bits,_]}|Is], SavePoint, Bits0) -> + count_bits_matched(Is, SavePoint, Bits0+Bits); count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> count_bits_matched(Is, SavePoint, Bits); count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index fb1a43cd9e..14e9943f88 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -65,10 +65,6 @@ function_1(Is0) -> translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> translate_1(Ar, I, Is, St, Acc); -translate([{call_ext_only,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> - translate_1(Ar, I, Is, St, Acc); -translate([{call_ext_last,Ar,{extfunc,erlang,error,Ar},_}=I|Is], St, Acc) -> - translate_1(Ar, I, Is, St, Acc); translate([I|Is], St, Acc) -> translate(Is, St, [I|Acc]); translate([], _, Acc) -> diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 6c7cb849aa..04232d8fd2 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -79,49 +79,28 @@ norm_allocate({nozero,Ns,Nh,Inits}, Regs) -> %% insert_alloc_in_bs_init(ReverseInstructionStream, AllocationInfo) -> %% impossible | ReverseInstructionStream' -%% A bs_init2/6 instruction should not be followed by a test heap instruction. +%% A bs_init/6 instruction should not be followed by a test heap instruction. %% Given the AllocationInfo from a test heap instruction, merge the -%% allocation amounts into the previous bs_init2/6 instruction (if any). +%% allocation amounts into the previous bs_init/6 instruction (if any). %% -insert_alloc_in_bs_init([I|_]=Is, Alloc) -> - case is_bs_constructor(I) of - false -> impossible; - true -> insert_alloc_1(Is, Alloc, []) - end. - -insert_alloc_1([{bs_init2=Op,Fail,Bs,Ws1,Regs,F,Dst}|Is], {_,nostack,Ws2,[]}, Acc) -> - Al = beam_utils:combine_heap_needs(Ws1, Ws2), - I = {Op,Fail,Bs,Al,Regs,F,Dst}, - reverse(Acc, [I|Is]); -insert_alloc_1([{bs_init_bits=Op,Fail,Bs,Ws1,Regs,F,Dst}|Is], {_,nostack,Ws2,[]}, Acc) -> - Al = beam_utils:combine_heap_needs(Ws1, Ws2), - I = {Op,Fail,Bs,Al,Regs,F,Dst}, - reverse(Acc, [I|Is]); -insert_alloc_1([{bs_append,Fail,Sz,Ws1,Regs,U,Bin,Fl,Dst}|Is], - {_,nostack,Ws2,[]}, Acc) -> +insert_alloc_in_bs_init([{bs_put,_,_,_}=I|Is], Alloc) -> + %% The instruction sequence ends with an bs_put/4 instruction. + %% We'll need to search backwards for the bs_init/6 instruction. + insert_alloc_1(Is, Alloc, [I]); +insert_alloc_in_bs_init(_, _) -> impossible. + +insert_alloc_1([{bs_init=Op,Fail,Info0,Live,Ss,Dst}|Is], + {_,nostack,Ws2,[]}, Acc) when is_integer(Live) -> + %% The number of extra heap words is always in the second position + %% in the Info tuple. + Ws1 = element(2, Info0), Al = beam_utils:combine_heap_needs(Ws1, Ws2), - I = {bs_append,Fail,Sz,Al,Regs,U,Bin,Fl,Dst}, + Info = setelement(2, Info0, Al), + I = {Op,Fail,Info,Live,Ss,Dst}, reverse(Acc, [I|Is]); -insert_alloc_1([I|Is], Alloc, Acc) -> +insert_alloc_1([{bs_put,_,_,_}=I|Is], Alloc, Acc) -> insert_alloc_1(Is, Alloc, [I|Acc]). - -%% is_bs_constructor(Instruction) -> true|false. -%% Test whether the instruction is a bit syntax construction -%% instruction that can occur at the end of a bit syntax -%% construction. (Since an empty binary would be expressed -%% as a literal, the bs_init2/6 instruction will not occur -%% at the end and therefore it is no need to test for it here.) -%% -is_bs_constructor({bs_put_integer,_,_,_,_,_}) -> true; -is_bs_constructor({bs_put_utf8,_,_,_}) -> true; -is_bs_constructor({bs_put_utf16,_,_,_}) -> true; -is_bs_constructor({bs_put_utf32,_,_,_}) -> true; -is_bs_constructor({bs_put_float,_,_,_,_,_}) -> true; -is_bs_constructor({bs_put_binary,_,_,_,_,_}) -> true; -is_bs_constructor({bs_put_string,_,_}) -> true; -is_bs_constructor(_) -> false. - %% opt(Is0) -> Is %% Simple peep-hole optimization to move a {move,Any,{x,0}} past %% any kill up to the next call instruction. (To give the loader diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index db67d24514..b05d01b2a1 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -20,7 +20,7 @@ -module(beam_jump). --export([module/2,module_labels/1, +-export([module/2, is_unreachable_after/1,is_exit_instruction/1, remove_unused_labels/1,is_label_used_in/2]). @@ -46,10 +46,13 @@ %%% such as a jump that never transfers control to the instruction %%% following it. %%% -%%% (2) case_end, if_end, and badmatch, and function calls that cause an -%%% exit (such as calls to exit/1) are moved to the end of the function. -%%% The purpose is to allow further optimizations at the place from -%%% which the code was moved. +%%% (2) Short sequences starting with a label and ending in case_end, if_end, +%%% and badmatch, and function calls that cause an exit (such as calls +%%% to exit/1) are moved to the end of the function, but only if the +%%% the block is not entered via a fallthrough. The purpose of this move +%%% is to allow further optimizations at the place from which the +%%% code was moved (a jump around the block could be replaced with a +%%% fallthrough). %%% %%% (3) Any unreachable code is removed. Unreachable code is code %%% after jump, call_last and other instructions which never @@ -130,13 +133,6 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> Fs = [function(F) || F <- Fs0], {ok,{Mod,Exp,Attr,Fs,Lc}}. -module_labels({Mod,Exp,Attr,Fs,Lc}) -> - {Mod,Exp,Attr,[function_labels(F) || F <- Fs],Lc}. - -function_labels({function,Name,Arity,CLabel,Asm0}) -> - Asm = remove_unused_labels(Asm0), - {function,Name,Arity,CLabel,Asm}. - %% function(Function) -> Function' %% Optimize jumps and branches. %% @@ -232,6 +228,9 @@ extract_seq_1([{line,_}=Line|Is], Acc) -> extract_seq_1(Is, [Line|Acc]); extract_seq_1([{label,_},{func_info,_,_,_}|_], _) -> no; +extract_seq_1([{label,Lbl},{jump,{f,Lbl}}|_], _) -> + %% Don't move a sequence which have a fallthrough entering it. + no; extract_seq_1([{label,_}=Lbl|Is], Acc) -> {yes,[Lbl|Acc],Is}; extract_seq_1(_, _) -> no. @@ -260,43 +259,39 @@ find_fixpoint(OptFun, Is0) -> Is -> find_fixpoint(OptFun, Is) end. -opt([{test,Test0,{f,Lnum}=Lbl,Ops}=I|Is0], Acc, St) -> - case Is0 of - [{jump,{f,Lnum}}|Is] -> - %% We have - %% Test Label Ops - %% jump Label - %% The test instruction is definitely not needed. - %% The jump instruction is not needed if there is - %% a definition of Label following the jump instruction. - case is_label_defined(Is, Lnum) of - false -> - %% The jump instruction is still needed. - opt(Is0, [I|Acc], label_used(Lbl, St)); - true -> - %% Neither the test nor the jump are needed. - opt(Is, Acc, St) - end; - [{jump,To}|Is] -> - case is_label_defined(Is, Lnum) of - false -> +opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) -> + %% We have + %% Test Label Ops + %% jump Label + %% The test instruction is not needed if the test is pure + %% (it modifies neither registers nor bit syntax state). + case beam_utils:is_pure_test(I) of + false -> + %% Test is not pure; we must keep it. + opt(Is, [I|Acc], label_used(Lbl, St)); + true -> + %% The test is pure and its failure label is the same + %% as in the jump that follows -- thus it is not needed. + opt(Is, Acc, St) + end; +opt([{test,Test0,{f,L}=Lbl,Ops}=I|[{jump,To}|Is]=Is0], Acc, St) -> + case is_label_defined(Is, L) of + false -> + opt(Is0, [I|Acc], label_used(Lbl, St)); + true -> + case invert_test(Test0) of + not_possible -> opt(Is0, [I|Acc], label_used(Lbl, St)); - true -> - case invert_test(Test0) of - not_possible -> - opt(Is0, [I|Acc], label_used(Lbl, St)); - Test -> - opt([{test,Test,To,Ops}|Is], Acc, St) - end - end; - _Other -> - opt(Is0, [I|Acc], label_used(Lbl, St)) + Test -> + %% Invert the test and remove the jump. + opt([{test,Test,To,Ops}|Is], Acc, St) + end end; +opt([{test,_,{f,_}=Lbl,_}=I|Is], Acc, St) -> + opt(Is, [I|Acc], label_used(Lbl, St)); opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) -> opt(Is, [I|Acc], label_used(Lbl, St)); -opt([{select_val,_R,Fail,{list,Vls}}=I|Is], Acc, St) -> - skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); -opt([{select_tuple_arity,_R,Fail,{list,Vls}}=I|Is], Acc, St) -> +opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) -> skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); opt([{label,L}=I|Is], Acc, #st{entry=L}=St) -> %% NEVER move the entry label. @@ -412,14 +407,8 @@ is_label_used(L, St) -> is_unreachable_after({func_info,_M,_F,_A}) -> true; is_unreachable_after(return) -> true; -is_unreachable_after({call_ext_last,_Ar,_ExtFunc,_D}) -> true; -is_unreachable_after({call_ext_only,_Ar,_ExtFunc}) -> true; -is_unreachable_after({call_last,_Ar,_Lbl,_D}) -> true; -is_unreachable_after({call_only,_Ar,_Lbl}) -> true; -is_unreachable_after({apply_last,_Ar,_N}) -> true; is_unreachable_after({jump,_Lbl}) -> true; -is_unreachable_after({select_val,_R,_Lbl,_Cases}) -> true; -is_unreachable_after({select_tuple_arity,_R,_Lbl,_Cases}) -> true; +is_unreachable_after({select,_What,_R,_Lbl,_Cases}) -> true; is_unreachable_after({loop_rec_end,_}) -> true; is_unreachable_after({wait,_}) -> true; is_unreachable_after(I) -> is_exit_instruction(I). @@ -430,10 +419,6 @@ is_unreachable_after(I) -> is_exit_instruction(I). is_exit_instruction({call_ext,_,{extfunc,M,F,A}}) -> erl_bifs:is_exit_bif(M, F, A); -is_exit_instruction({call_ext_last,_,{extfunc,M,F,A},_}) -> - erl_bifs:is_exit_bif(M, F, A); -is_exit_instruction({call_ext_only,_,{extfunc,M,F,A}}) -> - erl_bifs:is_exit_bif(M, F, A); is_exit_instruction(if_end) -> true; is_exit_instruction({case_end,_}) -> true; is_exit_instruction({try_case_end,_}) -> true; @@ -516,9 +501,7 @@ ulbl({test,_,Fail,_}, Used) -> mark_used(Fail, Used); ulbl({test,_,Fail,_,_,_}, Used) -> mark_used(Fail, Used); -ulbl({select_val,_,Fail,{list,Vls}}, Used) -> - mark_used_list(Vls, mark_used(Fail, Used)); -ulbl({select_tuple_arity,_,Fail,{list,Vls}}, Used) -> +ulbl({select,_,_,Fail,Vls}, Used) -> mark_used_list(Vls, mark_used(Fail, Used)); ulbl({'try',_,Lbl}, Used) -> mark_used(Lbl, Used); @@ -538,29 +521,9 @@ ulbl({bif,_Name,Lbl,_As,_R}, Used) -> mark_used(Lbl, Used); ulbl({gc_bif,_Name,Lbl,_Live,_As,_R}, Used) -> mark_used(Lbl, Used); -ulbl({bs_init2,Lbl,_,_,_,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_init_bits,Lbl,_,_,_,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_integer,Lbl,_Bits,_Unit,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_float,Lbl,_Bits,_Unit,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_binary,Lbl,_Bits,_Unit,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_utf8,Lbl,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_utf16,Lbl,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_put_utf32,Lbl,_Fl,_Val}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_add,Lbl,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_append,Lbl,_,_,_,_,_,_,_}, Used) -> - mark_used(Lbl, Used); -ulbl({bs_utf8_size,Lbl,_,_}, Used) -> +ulbl({bs_init,Lbl,_,_,_,_}, Used) -> mark_used(Lbl, Used); -ulbl({bs_utf16_size,Lbl,_,_}, Used) -> +ulbl({bs_put,Lbl,_,_}, Used) -> mark_used(Lbl, Used); ulbl(_, Used) -> Used. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index f39fc50b95..a199aa50ed 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -120,13 +120,13 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> peep(Is, SeenTests, [I|Acc]) end end; -peep([{select_val,Src,Fail, - {list,[{atom,false},{f,L},{atom,true},{f,L}]}}| +peep([{select,select_val,Src,Fail, + [{atom,false},{f,L},{atom,true},{f,L}]}| [{label,L}|_]=Is], SeenTests, Acc) -> I = {test,is_boolean,Fail,[Src]}, peep([I|Is], SeenTests, Acc); -peep([{select_val,Src,Fail, - {list,[{atom,true},{f,L},{atom,false},{f,L}]}}| +peep([{select,select_val,Src,Fail, + [{atom,true},{f,L},{atom,false},{f,L}]}| [{label,L}|_]=Is], SeenTests, Acc) -> I = {test,is_boolean,Fail,[Src]}, peep([I|Is], SeenTests, Acc); diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index bd1f44f66b..fe95a7e35b 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -84,13 +84,29 @@ function({function,Name,Arity,Entry,Is}) -> erlang:raise(Class, Error, Stack) end. +opt([{call_ext,A,{extfunc,erlang,spawn_monitor,A}}=I0|Is0], D, Acc) + when A =:= 1; A =:= 3 -> + case ref_in_tuple(Is0) of + no -> + opt(Is0, D, [I0|Acc]); + {yes,Regs,Is1,MatchReversed} -> + %% The call creates a brand new reference. Now + %% search for a receive statement in the same + %% function that will match against the reference. + case opt_recv(Is1, Regs, D) of + no -> + opt(Is0, D, [I0|Acc]); + {yes,Is,Lbl} -> + opt(Is, D, MatchReversed++[I0,{recv_mark,{f,Lbl}}|Acc]) + end + end; opt([{call_ext,Arity,{extfunc,erlang,Name,Arity}}=I|Is0], D, Acc) -> case creates_new_ref(Name, Arity) of true -> %% The call creates a brand new reference. Now %% search for a receive statement in the same %% function that will match against the reference. - case opt_recv(Is0, D) of + case opt_recv(Is0, regs_init_x0(), D) of no -> opt(Is0, D, [I|Acc]); {yes,Is,Lbl} -> @@ -104,19 +120,34 @@ opt([I|Is], D, Acc) -> opt([], _, Acc) -> reverse(Acc). +ref_in_tuple([{test,is_tuple,_,[{x,0}]}=I1, + {test,test_arity,_,[{x,0},2]}=I2, + {block,[{set,[_],[{x,0}],{get_tuple_element,0}}, + {set,[Dst],[{x,0}],{get_tuple_element,1}}|Bl]}=I3|Is]) -> + ref_in_tuple_1(Bl, Dst, Is, [I3,I2,I1]); +ref_in_tuple([{test,is_tuple,_,[{x,0}]}=I1, + {test,test_arity,_,[{x,0},2]}=I2, + {block,[{set,[Dst],[{x,0}],{get_tuple_element,1}}|Bl]}=I3|Is]) -> + ref_in_tuple_1(Bl, Dst, Is, [I3,I2,I1]); +ref_in_tuple(_) -> no. + +ref_in_tuple_1(Bl, Dst, Is, MatchReversed) -> + Regs0 = regs_init_singleton(Dst), + Regs = opt_update_regs_bl(Bl, Regs0), + {yes,Regs,Is,MatchReversed}. + %% creates_new_ref(Name, Arity) -> true|false. %% Return 'true' if the BIF Name/Arity will create a new reference. creates_new_ref(monitor, 2) -> true; creates_new_ref(make_ref, 0) -> true; creates_new_ref(_, _) -> false. -%% opt_recv([Instruction], LabelIndex) -> no|{yes,[Instruction]} +%% opt_recv([Instruction], Regs, LabelIndex) -> no|{yes,[Instruction]} %% Search for a receive statement that will only retrieve messages %% that contain the newly created reference (which is currently in {x,0}). -opt_recv(Is, D) -> - R = regs_init_x0(), +opt_recv(Is, Regs, D) -> L = gb_sets:empty(), - opt_recv(Is, D, R, L, []). + opt_recv(Is, D, Regs, L, []). opt_recv([{label,L}=Lbl,{loop_rec,{f,Fail},_}=Loop|Is], D, R0, _, Acc) -> R = regs_kill_not_live(0, R0), @@ -157,8 +188,6 @@ opt_update_regs({call_fun,_}, R, L) -> {regs_kill_not_live(0, R),L}; opt_update_regs({kill,Y}, R, L) -> {regs_kill([Y], R),L}; -opt_update_regs(send, R, L) -> - {regs_kill_not_live(0, R),L}; opt_update_regs({'catch',_,{f,Lbl}}, R, L) -> {R,gb_sets:add(Lbl, L)}; opt_update_regs({catch_end,_}, R, L) -> @@ -253,10 +282,7 @@ opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) -> opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefReg, D, Done0, Regs) -> Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs), opt_ref_used_1(Is, RefReg, D, Done, Regs); -opt_ref_used_1([{select_tuple_arity,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) -> - Lbls = [F || {f,F} <- List] ++ [Fail], - opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs); -opt_ref_used_1([{select_val,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) -> +opt_ref_used_1([{select,_,_,{f,Fail},List}|_], RefReg, D, Done, Regs) -> Lbls = [F || {f,F} <- List] ++ [Fail], opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs); opt_ref_used_1([{label,Lbl}|Is], RefReg, D, Done, Regs) -> @@ -323,6 +349,12 @@ opt_ref_used_bl([], Regs) -> Regs. regs_init() -> {0,0}. +%% regs_init_singleton(Register) -> RegisterSet +%% Return a set that only contains one register. + +regs_init_singleton(Reg) -> + regs_add(Reg, regs_init()). + %% regs_init_x0() -> RegisterSet %% Return a set that only contains the {x,0} register. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 5f4fa3b1f8..d95db1f681 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -172,38 +172,16 @@ remap([{bif,Name,Fail,Ss,D}|Is], Map, Acc) -> remap([{gc_bif,Name,Fail,Live,Ss,D}|Is], Map, Acc) -> I = {gc_bif,Name,Fail,Live,[Map(S) || S <- Ss],Map(D)}, remap(Is, Map, [I|Acc]); -remap([{bs_add,Fail,[SrcA,SrcB,U],D}|Is], Map, Acc) -> - I = {bs_add,Fail,[Map(SrcA),Map(SrcB),U],Map(D)}, +remap([{bs_init,Fail,Info,Live,Ss0,Dst0}|Is], Map, Acc) -> + Ss = [Map(Src) || Src <- Ss0], + Dst = Map(Dst0), + I = {bs_init,Fail,Info,Live,Ss,Dst}, remap(Is, Map, [I|Acc]); -remap([{bs_append=Op,Fail,Bits,Heap,Live,Unit,Bin,Flags,D}|Is], Map, Acc) -> - I = {Op,Fail,Map(Bits),Heap,Live,Unit,Map(Bin),Flags,Map(D)}, - remap(Is, Map, [I|Acc]); -remap([{bs_private_append=Op,Fail,Bits,Unit,Bin,Flags,D}|Is], Map, Acc) -> - I = {Op,Fail,Map(Bits),Unit,Map(Bin),Flags,Map(D)}, - remap(Is, Map, [I|Acc]); -remap([bs_init_writable=I|Is], Map, Acc) -> - remap(Is, Map, [I|Acc]); -remap([{bs_init2,Fail,Src,Live,U,Flags,D}|Is], Map, Acc) -> - I = {bs_init2,Fail,Map(Src),Live,U,Flags,Map(D)}, - remap(Is, Map, [I|Acc]); -remap([{bs_init_bits,Fail,Src,Live,U,Flags,D}|Is], Map, Acc) -> - I = {bs_init_bits,Fail,Map(Src),Live,U,Flags,Map(D)}, - remap(Is, Map, [I|Acc]); -remap([{bs_put_binary=Op,Fail,Src,U,Flags,D}|Is], Map, Acc) -> - I = {Op,Fail,Map(Src),U,Flags,Map(D)}, - remap(Is, Map, [I|Acc]); -remap([{bs_put_integer=Op,Fail,Src,U,Flags,D}|Is], Map, Acc) -> - I = {Op,Fail,Map(Src),U,Flags,Map(D)}, - remap(Is, Map, [I|Acc]); -remap([{bs_put_float=Op,Fail,Src,U,Flags,D}|Is], Map, Acc) -> - I = {Op,Fail,Map(Src),U,Flags,Map(D)}, - remap(Is, Map, [I|Acc]); -remap([{bs_put_string,_,_}=I|Is], Map, Acc) -> +remap([{bs_put=Op,Fail,Info,Ss}|Is], Map, Acc) -> + I = {Op,Fail,Info,[Map(S) || S <- Ss]}, remap(Is, Map, [I|Acc]); remap([{kill,Y}|T], Map, Acc) -> remap(T, Map, [{kill,Map(Y)}|Acc]); -remap([send=I|T], Map, Acc) -> - remap(T, Map, [I|Acc]); remap([{make_fun2,_,_,_,_}=I|T], Map, Acc) -> remap(T, Map, [I|Acc]); remap([{deallocate,N}|Is], Map, Acc) -> @@ -217,12 +195,6 @@ remap([{test,Name,Fail,Live,Ss,Dst}|Is], Map, Acc) -> remap(Is, Map, [I|Acc]); remap([return|_]=Is, _, Acc) -> reverse(Acc, Is); -remap([{call_last,Ar,Name,N}|Is], Map, Acc) -> - I = {call_last,Ar,Name,Map({frame_size,N})}, - reverse(Acc, [I|Is]); -remap([{call_ext_last,Ar,Name,N}|Is], Map, Acc) -> - I = {call_ext_last,Ar,Name,Map({frame_size,N})}, - reverse(Acc, [I|Is]); remap([{line,_}=I|Is], Map, Acc) -> remap(Is, Map, [I|Acc]). @@ -280,8 +252,8 @@ frame_size([{call_fun,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{call,_,_}|Is], Safe) -> frame_size(Is, Safe); -frame_size([{call_ext,A,{extfunc,M,F,A}}|Is], Safe) -> - case erl_bifs:is_exit_bif(M, F, A) of +frame_size([{call_ext,_,_}=I|Is], Safe) -> + case beam_jump:is_exit_instruction(I) of true -> throw(not_possible); false -> frame_size(Is, Safe) end; @@ -295,35 +267,15 @@ frame_size([{test,_,{f,L},_}|Is], Safe) -> frame_size_branch(L, Is, Safe); frame_size([{test,_,{f,L},_,_,_}|Is], Safe) -> frame_size_branch(L, Is, Safe); -frame_size([{bs_add,{f,L},_,_}|Is], Safe) -> +frame_size([{bs_init,{f,L},_,_,_,_}|Is], Safe) -> frame_size_branch(L, Is, Safe); -frame_size([{bs_append,{f,L},_,_,_,_,_,_,_}|Is], Safe) -> +frame_size([{bs_put,{f,L},_,_}|Is], Safe) -> frame_size_branch(L, Is, Safe); -frame_size([{bs_private_append,{f,L},_,_,_,_,_}|Is], Safe) -> - frame_size_branch(L, Is, Safe); -frame_size([bs_init_writable|Is], Safe) -> - frame_size(Is, Safe); -frame_size([{bs_init2,{f,L},_,_,_,_,_}|Is], Safe) -> - frame_size_branch(L, Is, Safe); -frame_size([{bs_init_bits,{f,L},_,_,_,_,_}|Is], Safe) -> - frame_size_branch(L, Is, Safe); -frame_size([{bs_put_binary,{f,L},_,_,_,_}|Is], Safe) -> - frame_size_branch(L, Is, Safe); -frame_size([{bs_put_integer,{f,L},_,_,_,_}|Is], Safe) -> - frame_size_branch(L, Is, Safe); -frame_size([{bs_put_float,{f,L},_,_,_,_}|Is], Safe) -> - frame_size_branch(L, Is, Safe); -frame_size([{bs_put_string,_,_}|Is], Safe) -> - frame_size(Is, Safe); frame_size([{kill,_}|Is], Safe) -> frame_size(Is, Safe); -frame_size([send|Is], Safe) -> - frame_size(Is, Safe); frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{deallocate,N}|_], _) -> N; -frame_size([{call_last,_,_,N}|_], _) -> N; -frame_size([{call_ext_last,_,_,N}|_], _) -> N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([_|_], _) -> throw(not_possible). diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 194f089ba1..8b661e6901 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -87,7 +87,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) -> %% across branches. is_not_used(R, Is, D) -> - St = #live{bl=fun check_used_block/2,lbl=D,res=gb_trees:empty()}, + St = #live{bl=check_used_block_fun(D),lbl=D,res=gb_trees:empty()}, case check_liveness(R, Is, St) of {killed,_} -> true; {used,_} -> false; @@ -102,7 +102,7 @@ is_not_used(R, Is, D) -> %% across branches. is_not_used_at(R, Lbl, D) -> - St = #live{bl=fun check_used_block/2,lbl=D,res=gb_trees:empty()}, + St = #live{bl=check_used_block_fun(D),lbl=D,res=gb_trees:empty()}, case check_liveness_at(R, Lbl, St) of {killed,_} -> true; {used,_} -> false; @@ -276,13 +276,9 @@ check_liveness(R, [{test,_,{f,Fail},Live,Ss,_}|Is], St0) -> {_,_}=Other -> Other end end; -check_liveness(R, [{select_val,R,_,_}|_], St) -> +check_liveness(R, [{select,_,R,_,_}|_], St) -> {used,St}; -check_liveness(R, [{select_val,_,Fail,{list,Branches}}|_], St) -> - check_liveness_everywhere(R, [Fail|Branches], St); -check_liveness(R, [{select_tuple_arity,R,_,_}|_], St) -> - {used,St}; -check_liveness(R, [{select_tuple_arity,_,Fail,{list,Branches}}|_], St) -> +check_liveness(R, [{select,_,_,Fail,Branches}|_], St) -> check_liveness_everywhere(R, [Fail|Branches], St); check_liveness(R, [{jump,{f,F}}|_], St) -> check_liveness_at(R, F, St); @@ -301,37 +297,33 @@ check_liveness(R, [{kill,R}|_], St) -> {killed,St}; check_liveness(R, [{kill,_}|Is], St) -> check_liveness(R, Is, St); -check_liveness(R, [bs_init_writable|Is], St) -> - if - R =:= {x,0} -> {used,St}; - true -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_private_append,_,Bits,_,Bin,_,Dst}|Is], St) -> - case R of - Bits -> {used,St}; - Bin -> {used,St}; - Dst -> {killed,St}; - _ -> check_liveness(R, Is, St) +check_liveness(R, [{bs_init,_,_,none,Ss,Dst}|Is], St) -> + case member(R, Ss) of + true -> + {used,St}; + false -> + if + R =:= Dst -> {killed,St}; + true -> check_liveness(R, Is, St) + end end; -check_liveness(R, [{bs_append,_,Bits,_,_,_,Bin,_,Dst}|Is], St) -> +check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) -> case R of - Bits -> {used,St}; - Bin -> {used,St}; - Dst -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_init2,_,_,_,_,_,Dst}|Is], St) -> - if - R =:= Dst -> {killed,St}; - true -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_init_bits,_,_,_,_,_,Dst}|Is], St) -> - if - R =:= Dst -> {killed,St}; - true -> check_liveness(R, Is, St) + {x,X} -> + case X < Live orelse member(R, Ss) of + true -> {used,St}; + false -> {killed,St} + end; + {y,_} -> + case member(R, Ss) of + true -> {used,St}; + false -> + if + R =:= Dst -> {killed,St}; + true -> check_liveness(R, Is, St) + end + end end; -check_liveness(R, [{bs_put_string,_,_}|Is], St) -> - check_liveness(R, Is, St); check_liveness(R, [{deallocate,_}|Is], St) -> case R of {y,_} -> {killed,St}; @@ -339,29 +331,20 @@ check_liveness(R, [{deallocate,_}|Is], St) -> end; check_liveness(R, [return|_], St) -> check_liveness_live_ret(R, 1, St); -check_liveness(R, [{call_last,Live,_,_}|_], St) -> - check_liveness_live_ret(R, Live, St); -check_liveness(R, [{call_only,Live,_}|_], St) -> - check_liveness_live_ret(R, Live, St); -check_liveness(R, [{call_ext_last,Live,_,_}|_], St) -> - check_liveness_live_ret(R, Live, St); -check_liveness(R, [{call_ext_only,Live,_}|_], St) -> - check_liveness_live_ret(R, Live, St); check_liveness(R, [{call,Live,_}|Is], St) -> case R of {x,X} when X < Live -> {used,St}; {x,_} -> {killed,St}; {y,_} -> check_liveness(R, Is, St) end; -check_liveness(R, [{call_ext,Live,Func}|Is], St) -> +check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> case R of {x,X} when X < Live -> {used,St}; {x,_} -> {killed,St}; {y,_} -> - {extfunc,Mod,Name,Arity} = Func, - case erl_bifs:is_exit_bif(Mod, Name, Arity) of + case beam_jump:is_exit_instruction(I) of false -> check_liveness(R, Is, St); true -> @@ -387,14 +370,6 @@ check_liveness(R, [{apply,Args}|Is], St) -> {x,_} -> {killed,St}; {y,_} -> check_liveness(R, Is, St) end; -check_liveness(R, [{apply_last,Args,_}|_], St) -> - check_liveness_live_ret(R, Args+2, St); -check_liveness(R, [send|Is], St) -> - case R of - {x,X} when X < 2 -> {used,St}; - {x,_} -> {killed,St}; - {y,_} -> check_liveness(R, Is, St) - end; check_liveness({x,R}, [{'%live',Live}|Is], St) -> if R < Live -> check_liveness(R, Is, St); @@ -429,25 +404,9 @@ check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St0) -> Other end end; -check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) -> +check_liveness(R, [{bs_put,{f,0},_,Ss}|Is], St) -> case member(R, Ss) of true -> {used,St}; - false when R =:= D -> {killed,St}; - false -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_put_binary,{f,0},Sz,_,_,Src}|Is], St) -> - case member(R, [Sz,Src]) of - true -> {used,St}; - false -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_put_integer,{f,0},Sz,_,_,Src}|Is], St) -> - case member(R, [Sz,Src]) of - true -> {used,St}; - false -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_put_float,{f,0},Sz,_,_,Src}|Is], St) -> - case member(R, [Sz,Src]) of - true -> {used,St}; false -> check_liveness(R, Is, St) end; check_liveness(R, [{bs_restore2,S,_}|Is], St) -> @@ -472,6 +431,16 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> {x,_} -> {killed,St}; _ -> check_liveness(R, Is, St) end; +check_liveness({x,_}=R, [{'catch',_,_}|Is], St) -> + %% All x registers will be killed if an exception occurs. + %% Therefore we only need to check the liveness for the + %% instructions following the catch instruction. + check_liveness(R, Is, St); +check_liveness({x,_}=R, [{'try',_,_}|Is], St) -> + %% All x registers will be killed if an exception occurs. + %% Therefore we only need to check the liveness for the + %% instructions inside the 'try' block. + check_liveness(R, Is, St); check_liveness(R, [{try_end,Y}|Is], St) -> case R of Y -> @@ -602,26 +571,50 @@ check_killed_block(_, []) -> transparent. %% %% (Unknown instructions will cause an exception.) -check_used_block({x,X}=R, [{set,_,_,{alloc,Live,_}}|Is]) -> +check_used_block_fun(D) -> + fun(R, Is) -> check_used_block(R, Is, D) end. + +check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], D) -> if X >= Live -> killed; - true -> check_used_block(R, Is) + true -> + case member(R, Ss) orelse + is_reg_used_at(R, Op, D) of + true -> used; + false -> + case member(R, Ds) of + true -> killed; + false -> check_used_block(R, Is, D) + end + end end; -check_used_block(R, [{set,Ds,Ss,_Op}|Is]) -> - case member(R, Ss) of +check_used_block(R, [{set,Ds,Ss,Op}|Is], D) -> + case member(R, Ss) orelse + is_reg_used_at(R, Op, D) of true -> used; false -> case member(R, Ds) of true -> killed; - false -> check_used_block(R, Is) + false -> check_used_block(R, Is, D) end end; -check_used_block(R, [{'%live',Live}|Is]) -> +check_used_block(R, [{'%live',Live}|Is], D) -> case R of {x,X} when X >= Live -> killed; - _ -> check_used_block(R, Is) + _ -> check_used_block(R, Is, D) end; -check_used_block(_, []) -> transparent. +check_used_block(_, [], _) -> transparent. + +is_reg_used_at(R, {gc_bif,_,{f,Lbl}}, D) -> + is_reg_used_at_1(R, Lbl, D); +is_reg_used_at(R, {bif,_,{f,Lbl}}, D) -> + is_reg_used_at_1(R, Lbl, D); +is_reg_used_at(_, _, _) -> false. + +is_reg_used_at_1(_, 0, _) -> + false; +is_reg_used_at_1(R, Lbl, D) -> + not is_not_used_at(R, Lbl, D). index_labels_1([{label,Lbl}|Is0], Acc) -> Is = lists:dropwhile(fun({label,_}) -> true; @@ -654,49 +647,21 @@ combine_alloc_lists_1([]) -> []. live_opt([{bs_context_to_binary,Src}=I|Is], Regs0, D, Acc) -> Regs = x_live([Src], Regs0), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_add,Fail,[Src1,Src2,_],Dst}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src1,Src2], x_dead([Dst], Regs0)), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_init2,Fail,_,_,Live,_,_}=I|Is], _, D, Acc) -> - Regs1 = live_call(Live), +live_opt([{bs_init,Fail,_,none,Ss,Dst}=I|Is], Regs0, D, Acc) -> + Regs1 = x_live(Ss, x_dead([Dst], Regs0)), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_init_bits,Fail,Src1,_,Live,_,Src2}=I|Is], _, D, Acc) -> - Regs1 = live_call(Live), - Regs2 = x_live([Src1,Src2], Regs1), - Regs = live_join_label(Fail, D, Regs2), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_append,Fail,Src1,_,Live,_,Src2,_,Dst}=I|Is], _Regs0, D, Acc) -> - Regs1 = x_dead([Dst], x_live([Src1,Src2], live_call(Live))), - Regs = live_join_label(Fail, D, Regs1), +live_opt([{bs_init,Fail,Info,Live0,Ss,Dst}|Is], Regs0, D, Acc) -> + Regs1 = x_dead([Dst], Regs0), + Live = live_regs(Regs1), + true = Live =< Live0, %Assertion. + Regs2 = live_call(Live), + Regs3 = x_live(Ss, Regs2), + Regs = live_join_label(Fail, D, Regs3), + I = {bs_init,Fail,Info,Live,Ss,Dst}, live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_private_append,Fail,Src1,_,Src2,_,Dst}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src1,Src2], x_dead([Dst], Regs0)), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_put_binary,Fail,Src1,_,_,Src2}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src1,Src2], Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_put_float,Fail,Src1,_,_,Src2}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src1,Src2], Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_put_integer,Fail,Src1,_,_,Src2}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src1,Src2], Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_put_utf8,Fail,_,Src}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src], Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_put_utf16,Fail,_,Src}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src], Regs0), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_put_utf32,Fail,_,Src}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src], Regs0), +live_opt([{bs_put,Fail,_,Ss}=I|Is], Regs0, D, Acc) -> + Regs1 = x_live(Ss, Regs0), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); live_opt([{bs_restore2,Src,_}=I|Is], Regs0, D, Acc) -> @@ -705,14 +670,6 @@ live_opt([{bs_restore2,Src,_}=I|Is], Regs0, D, Acc) -> live_opt([{bs_save2,Src,_}=I|Is], Regs0, D, Acc) -> Regs = x_live([Src], Regs0), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_utf8_size,Fail,Src,Dst}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src], x_dead([Dst], Regs0)), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{bs_utf16_size,Fail,Src,Dst}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src], x_dead([Dst], Regs0)), - Regs = live_join_label(Fail, D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) -> Regs0 = live_call(Live), Regs1 = x_live([Src], Regs0), @@ -747,30 +704,16 @@ live_opt([{try_case_end,Src}=I|Is], _, D, Acc) -> live_opt([if_end=I|Is], _, D, Acc) -> Regs = 0, live_opt(Is, Regs, D, [I|Acc]); -live_opt([bs_init_writable=I|Is], _, D, Acc) -> - live_opt(Is, live_call(1), D, [I|Acc]); live_opt([{call,Arity,_}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Arity), D, [I|Acc]); live_opt([{call_ext,Arity,_}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Arity), D, [I|Acc]); live_opt([{call_fun,Arity}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Arity+1), D, [I|Acc]); -live_opt([{call_last,Arity,_,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([{call_ext_last,Arity,_,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); live_opt([{apply,Arity}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Arity+2), D, [I|Acc]); -live_opt([{apply_last,Arity,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity+2), D, [I|Acc]); -live_opt([{call_only,Arity,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([{call_ext_only,Arity,_}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Arity), D, [I|Acc]); live_opt([{make_fun2,_,_,_,Arity}=I|Is], _, D, Acc) -> live_opt(Is, live_call(Arity), D, [I|Acc]); -live_opt([send=I|Is], _, D, Acc) -> - live_opt(Is, live_call(2), D, [I|Acc]); live_opt([{test,_,Fail,Ss}=I|Is], Regs0, D, Acc) -> Regs1 = x_live(Ss, Regs0), Regs = live_join_label(Fail, D, Regs1), @@ -780,16 +723,14 @@ live_opt([{test,_,Fail,Live,Ss,_}=I|Is], _, D, Acc) -> Regs1 = x_live(Ss, Regs0), Regs = live_join_label(Fail, D, Regs1), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{select_val,Src,Fail,{list,List}}=I|Is], Regs0, D, Acc) -> +live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) -> Regs1 = x_live([Src], Regs0), Regs = live_join_labels([Fail|List], D, Regs1), live_opt(Is, Regs, D, [I|Acc]); -live_opt([{select_tuple_arity,Src,Fail,{list,List}}=I|Is], Regs0, D, Acc) -> - Regs1 = x_live([Src], Regs0), - Regs = live_join_labels([Fail|List], D, Regs1), - live_opt(Is, Regs, D, [I|Acc]); -live_opt([{'try',_,Fail}=I|Is], Regs0, D, Acc) -> - Regs = live_join_label(Fail, D, Regs0), +live_opt([{'try',_,_}=I|Is], Regs, D, Acc) -> + %% If an exeption happens, all x registers will be killed. + %% Therefore, we should only base liveness of the code inside + %% the try. live_opt(Is, Regs, D, [I|Acc]); live_opt([{try_case,_}=I|Is], _, D, Acc) -> live_opt(Is, live_call(1), D, [I|Acc]); @@ -799,8 +740,6 @@ live_opt([timeout=I|Is], _, D, Acc) -> live_opt(Is, 0, D, [I|Acc]); %% Transparent instructions - they neither use nor modify x registers. -live_opt([{bs_put_string,_,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{kill,_}=I|Is], Regs, D, Acc) -> @@ -827,13 +766,24 @@ live_opt([{allocate_heap,_,_,Live}=I|Is], _, D, Acc) -> live_opt([], _, _, Acc) -> Acc. -live_opt_block([{set,[],[],{alloc,Live,_}}=I|Is], _, D, Acc) -> - live_opt_block(Is, live_call(Live), D, [I|Acc]); -live_opt_block([{set,Ds,Ss,Op}=I|Is], Regs0, D, Acc) -> - Regs = case Op of - {alloc,Live,_} -> live_call(Live); - _ -> x_live(Ss, x_dead(Ds, Regs0)) - end, +live_opt_block([{set,Ds,Ss,Op}=I0|Is], Regs0, D, Acc) -> + Regs1 = x_live(Ss, x_dead(Ds, Regs0)), + {I,Regs} = case Op of + {alloc,Live0,Alloc} -> + %% The life-time analysis used by the code generator + %% is sometimes too conservative, so it may be + %% possible to lower the number of live registers + %% based on the exact liveness information. + %% The main benefit is that more optimizations that + %% depend on liveness information (such as the + %% beam_bool and beam_dead passes) may be applied. + Live = live_regs(Regs1), + true = Live =< Live0, %Assertion. + I1 = {set,Ds,Ss,{alloc,Live,Alloc}}, + {I1,live_call(Live)}; + _ -> + {I0,Regs1} + end, case Ds of [{x,X}] -> case (not is_live(X, Regs0)) andalso Op =:= move of diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl new file mode 100644 index 0000000000..8c6b0c916d --- /dev/null +++ b/lib/compiler/src/beam_z.erl @@ -0,0 +1,79 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose: Run right before beam_asm to do any final fix-ups or clean-ups. +%% (Mandatory.) + +-module(beam_z). + +-export([module/2]). + +module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> + Fs = [function(F) || F <- Fs0], + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +function({function,Name,Arity,CLabel,Is0}) -> + try + Is = undo_renames(Is0), + {function,Name,Arity,CLabel,Is} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +undo_renames([{call_ext,2,send}|Is]) -> + [send|undo_renames(Is)]; +undo_renames([{apply,A},{deallocate,N},return|Is]) -> + [{apply_last,A,N}|undo_renames(Is)]; +undo_renames([{call,A,F},{deallocate,N},return|Is]) -> + [{call_last,A,F,N}|undo_renames(Is)]; +undo_renames([{call_ext,A,F},{deallocate,N},return|Is]) -> + [{call_ext_last,A,F,N}|undo_renames(Is)]; +undo_renames([{call,A,F},return|Is]) -> + [{call_only,A,F}|undo_renames(Is)]; +undo_renames([{call_ext,A,F},return|Is]) -> + [{call_ext_only,A,F}|undo_renames(Is)]; +undo_renames([I|Is]) -> + [undo_rename(I)|undo_renames(Is)]; +undo_renames([]) -> []. + +undo_rename({bs_put,F,{I,U,Fl},[Sz,Src]}) -> + {I,F,Sz,U,Fl,Src}; +undo_rename({bs_put,F,{I,Fl},[Src]}) -> + {I,F,Fl,Src}; +undo_rename({bs_put,{f,0},{bs_put_string,_,_}=I,[]}) -> + I; +undo_rename({bif,bs_add=I,F,[Src1,Src2,{integer,U}],Dst}) -> + {I,F,[Src1,Src2,U],Dst}; +undo_rename({bif,bs_utf8_size=I,F,[Src],Dst}) -> + {I,F,Src,Dst}; +undo_rename({bif,bs_utf16_size=I,F,[Src],Dst}) -> + {I,F,Src,Dst}; +undo_rename({bs_init,F,{I,U,Flags},none,[Sz,Src],Dst}) -> + {I,F,Sz,U,Src,Flags,Dst}; +undo_rename({bs_init,F,{I,Extra,Flags},Live,[Sz],Dst}) -> + {I,F,Sz,Extra,Live,Flags,Dst}; +undo_rename({bs_init,F,{I,Extra,U,Flags},Live,[Sz,Src],Dst}) -> + {I,F,Sz,Extra,Live,U,Src,Flags,Dst}; +undo_rename({bs_init,_,bs_init_writable=I,_,_,_}) -> + I; +undo_rename({select,I,Reg,Fail,List}) -> + {I,Reg,Fail,{list,List}}; +undo_rename(I) -> I. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 0a368df5d6..df1af36eeb 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -224,6 +224,8 @@ format_error({delete_temp,File,Error}) -> [File,file:format_error(Error)]); format_error({parse_transform,M,R}) -> io_lib:format("error in parse transform '~s': ~p", [M, R]); +format_error({undef_parse_transform,M}) -> + io_lib:format("undefined parse transform '~s'", [M]); format_error({core_transform,M,R}) -> io_lib:format("error in core transform '~s': ~p", [M, R]); format_error({crash,Pass,Reason}) -> @@ -551,12 +553,12 @@ select_list_passes_1([{iff,Flag,{done,Ext}}|Ps], Opts, Acc) -> end; select_list_passes_1([{iff=Op,Flag,List0}|Ps], Opts, Acc) when is_list(List0) -> case select_list_passes(List0, Opts) of - {done,_}=Done -> Done; + {done,List} -> {done,reverse(Acc) ++ List}; {not_done,List} -> select_list_passes_1(Ps, Opts, [{Op,Flag,List}|Acc]) end; select_list_passes_1([{unless=Op,Flag,List0}|Ps], Opts, Acc) when is_list(List0) -> case select_list_passes(List0, Opts) of - {done,_}=Done -> Done; + {done,List} -> {done,reverse(Acc) ++ List}; {not_done,List} -> select_list_passes_1(Ps, Opts, [{Op,Flag,List}|Acc]) end; select_list_passes_1([P|Ps], Opts, Acc) -> @@ -630,7 +632,8 @@ kernel_passes() -> asm_passes() -> %% Assembly level optimisations. [{delay, - [{unless,no_postopt, + [{pass,beam_a}, + {unless,no_postopt, [{pass,beam_block}, {iff,dblk,{listing,"block"}}, {unless,no_except,{pass,beam_except}}, @@ -657,13 +660,11 @@ asm_passes() -> {iff,dtrim,{listing,"trim"}}, {pass,beam_flatten}]}, - %% If post optimizations are turned off, we still coalesce - %% adjacent labels and remove unused labels to keep the - %% HiPE compiler happy. - {iff,no_postopt, - [?pass(beam_unused_labels), - {pass,beam_clean}]}, + %% If post optimizations are turned off, we still + %% need to do a few clean-ups to code. + {iff,no_postopt,[{pass,beam_clean}]}, + {pass,beam_z}, {iff,dopt,{listing,"optimize"}}, {iff,'S',{listing,"S"}}, {iff,'to_asm',{done,"S"}}]}, @@ -850,6 +851,10 @@ foldl_transform(St, [T|Ts]) -> {error,Es,Ws} -> {error,St#compile{warnings=St#compile.warnings ++ Ws, errors=St#compile.errors ++ Es}}; + {'EXIT',{undef,_}} -> + Es = [{St#compile.ifile,[{none,compile, + {undef_parse_transform,T}}]}], + {error,St#compile{errors=St#compile.errors ++ Es}}; {'EXIT',R} -> Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}], {error,St#compile{errors=St#compile.errors ++ Es}}; @@ -1236,10 +1241,6 @@ random_bytes_1(N, Acc) -> random_bytes_1(N-1, [random:uniform(255)|Acc]). save_core_code(St) -> {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}. -beam_unused_labels(#compile{code=Code0}=St) -> - Code = beam_jump:module_labels(Code0), - {ok,St#compile{code=Code}}. - beam_asm(#compile{ifile=File,code=Code0, abstract_code=Abst,mod_options=Opts0}=St) -> Source = filename:absname(File), diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 1133882728..94c78e68f9 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -20,6 +20,7 @@ [{description, "ERTS CXC 138 10"}, {vsn, "%VSN%"}, {modules, [ + beam_a, beam_asm, beam_block, beam_bool, @@ -40,6 +41,7 @@ beam_type, beam_utils, beam_validator, + beam_z, cerl, cerl_clauses, cerl_inline, diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index be15495672..3b73269545 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -123,15 +123,24 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> put_reg(V, Reg) end, [], Hvs), stk=[]}, 0, Vdb), - {B,_Aft,St} = cg_list(Les, 0, Vdb, Bef, + {B0,_Aft,St} = cg_list(Les, 0, Vdb, Bef, St3#cg{bfail=0, ultimate_failure=UltimateMatchFail, is_top_block=true}), + B = fix_bs_match_strings(B0), {Name,Arity} = NameArity, Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity}, {label,Fl}|B++[{label,UltimateMatchFail},if_end]], {Asm,Fl,St}. +fix_bs_match_strings([{test,bs_match_string,F,[Ctx,BinList]}|Is]) + when is_list(BinList) -> + I = {test,bs_match_string,F,[Ctx,list_to_bitstring(BinList)]}, + [I|fix_bs_match_strings(Is)]; +fix_bs_match_strings([I|Is]) -> + [I|fix_bs_match_strings(Is)]; +fix_bs_match_strings([]) -> []. + %% cg(Lkexpr, Vdb, StackReg, State) -> {[Ainstr],StackReg,State}. %% Generate code for a kexpr. %% Split function into two steps for clarity, not efficiency. @@ -713,7 +722,22 @@ select_bin_seg(#l{ke={val_clause,{bin_int,Ctx,Sz,U,Fs,Val,Es},B},i=I,vdb=Vdb}, I, Vdb, Bef, Ctx, St0), {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), CtxReg = fetch_var(Ctx, Bef), - {[{bs_restore2,CtxReg,{Ctx,Ivar}}|Mis] ++ Bis,Aft,St2}. + Is = case Mis ++ Bis of + [{test,bs_match_string,F,[OtherCtx,Bin1]}, + {bs_save2,OtherCtx,_}, + {bs_restore2,OtherCtx,_}, + {test,bs_match_string,F,[OtherCtx,Bin2]}|Is0] -> + %% We used to do this optimization later, but it + %% turns out that in huge functions with many + %% bs_match_string instructions, it's a big win + %% to do the combination now. To avoid copying the + %% binary data again and again, we'll combine bitstrings + %% in a list and convert all of it to a bitstring later. + [{test,bs_match_string,F,[OtherCtx,[Bin1,Bin2]]}|Is0]; + Is0 -> + Is0 + end, + {[{bs_restore2,CtxReg,{Ctx,Ivar}}|Is],Aft,St2}. select_extract_int([{var,Tl}], Val, {integer,Sz}, U, Fs, Vf, I, Vdb, Bef, Ctx, St) -> @@ -1385,22 +1409,32 @@ catch_cg(C, {var,R}, Le, Vdb, Bef, St0) -> %% %% put_list for constructing a cons is an atomic instruction %% which can safely resuse one of the source registers as target. -%% Also binaries can reuse a source register as target. set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> - [S1,S2] = map(fun ({var,V}) -> fetch_var(V, Bef); - (Other) -> Other - end, Es), + [S1,S2] = cg_reg_args(Es, Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, Ret = fetch_reg(R, Int1#sr.reg), {[{put_list,S1,S2,Ret}], Int1, St}; set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{in_catch=InCatch, bfail=Bfail}=St) -> + %% At run-time, binaries are constructed in three stages: + %% 1) First the size of the binary is calculated. + %% 2) Then the binary is allocated. + %% 3) Then each field in the binary is constructed. + %% For simplicity, we use the target register to also hold the + %% size of the binary. Therefore the target register must *not* + %% be one of the source registers. + + %% First allocate the target register. Int0 = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, Target = fetch_reg(R, Int0#sr.reg), - Fail = {f,Bfail}, + + %% Also allocate a scratch register for size calculations. Temp = find_scratch_reg(Int0#sr.reg), + + %% First generate the code that constructs each field. + Fail = {f,Bfail}, PutCode = cg_bin_put(Segs, Fail, Bef), {Sis,Int1} = case InCatch of @@ -1409,6 +1443,8 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, end, MaxRegs = max_reg(Bef#sr.reg), Aft = clear_dead(Int1, Le#l.i, Vdb), + + %% Now generate the complete code for constructing the binary. Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), {Sis++Code,Aft,St}; set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> @@ -1418,10 +1454,8 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> Ais = case Con of {tuple,Es} -> [{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef); - {var,V} -> % Normally removed by kernel optimizer. - [{move,fetch_var(V, Int),Ret}]; Other -> - [{move,Other,Ret}] + [{move,cg_reg_arg(Other, Int),Ret}] end, {Ais,clear_dead(Int, Le#l.i, Vdb),St}. @@ -1575,8 +1609,7 @@ cg_gen_binsize([], _, _, _, _, Acc) -> Acc. %% cg_bin_opt(Code0) -> Code %% Optimize the size calculations for binary construction. -cg_bin_opt([{move,Size,D},{bs_append,Fail,D,Extra,Regs0,U,Bin,Flags,D}|Is]) -> - Regs = cg_bo_newregs(Regs0, D), +cg_bin_opt([{move,Size,D},{bs_append,Fail,D,Extra,Regs,U,Bin,Flags,D}|Is]) -> cg_bin_opt([{bs_append,Fail,Size,Extra,Regs,U,Bin,Flags,D}|Is]); cg_bin_opt([{move,Size,D},{bs_private_append,Fail,D,U,Bin,Flags,D}|Is]) -> cg_bin_opt([{bs_private_append,Fail,Size,U,Bin,Flags,D}|Is]); @@ -1584,9 +1617,8 @@ cg_bin_opt([{move,{integer,0},D},{bs_add,_,[D,{integer,_}=S,1],Dst}|Is]) -> cg_bin_opt([{move,S,Dst}|Is]); cg_bin_opt([{move,{integer,0},D},{bs_add,Fail,[D,S,U],Dst}|Is]) -> cg_bin_opt([{bs_add,Fail,[{integer,0},S,U],Dst}|Is]); -cg_bin_opt([{move,{integer,Bytes},D},{Op,Fail,D,Extra,Regs0,Flags,D}|Is]) +cg_bin_opt([{move,{integer,Bytes},D},{Op,Fail,D,Extra,Regs,Flags,D}|Is]) when Op =:= bs_init2; Op =:= bs_init_bits -> - Regs = cg_bo_newregs(Regs0, D), cg_bin_opt([{Op,Fail,Bytes,Extra,Regs,Flags,D}|Is]); cg_bin_opt([{move,Src1,Dst},{bs_add,Fail,[Dst,Src2,U],Dst}|Is]) -> cg_bin_opt([{bs_add,Fail,[Src1,Src2,U],Dst}|Is]); @@ -1594,20 +1626,9 @@ cg_bin_opt([I|Is]) -> [I|cg_bin_opt(Is)]; cg_bin_opt([]) -> []. -cg_bo_newregs(R, {x,X}) when R-1 =:= X -> R-1; -cg_bo_newregs(R, _) -> R. - -%% Common for new and old binary code generation. - cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) -> - S1 = case S0 of - {var,Sv} -> fetch_var(Sv, Bef); - _ -> S0 - end, - E1 = case E0 of - {var,V} -> fetch_var(V, Bef); - Other -> Other - end, + S1 = cg_reg_arg(S0, Bef), + E1 = cg_reg_arg(E0, Bef), {Format,Op} = case T of integer -> {plain,bs_put_integer}; utf8 -> {utf,bs_put_utf8}; @@ -1625,9 +1646,7 @@ cg_bin_put({bin_seg,[],S0,U,T,Fs,[E0,Next]}, Fail, Bef) -> cg_bin_put({bin_end,[]}, _, _) -> []. cg_build_args(As, Bef) -> - map(fun ({var,V}) -> {put,fetch_var(V, Bef)}; - (Other) -> {put,Other} - end, As). + [{put,cg_reg_arg(A, Bef)} || A <- As]. %% return_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. %% break_cg([Val], Le, Vdb, Bef, St) -> {[Ainstr],Aft,St}. @@ -1906,27 +1925,13 @@ fetch_var(V, Sr) -> error -> fetch_stack(V, Sr#sr.stk) end. -% find_var(V, Sr) -> -% case find_reg(V, Sr#sr.reg) of -% {ok,R} -> {ok,R}; -% error -> -% case find_stack(V, Sr#sr.stk) of -% {ok,S} -> {ok,S}; -% error -> error -% end -% end. - load_vars(Vs, Regs) -> foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). %% put_reg(Val, Regs) -> Regs. -%% free_reg(Val, Regs) -> Regs. %% find_reg(Val, Regs) -> ok{r{R}} | error. %% fetch_reg(Val, Regs) -> r{R}. %% Functions to interface the registers. -%% put_reg puts a value into a free register, -%% load_reg loads a value into a fixed register -%% free_reg frees a register containing a specific value. % put_regs(Vs, Rs) -> foldl(fun put_reg/2, Rs, Vs). @@ -1937,10 +1942,6 @@ put_reg_1(V, [{reserved,I,V}|Rs], I) -> [{I,V}|Rs]; put_reg_1(V, [R|Rs], I) -> [R|put_reg_1(V, Rs, I+1)]; put_reg_1(V, [], I) -> [{I,V}]. -% free_reg(V, [{I,V}|Rs]) -> [free|Rs]; -% free_reg(V, [R|Rs]) -> [R|free_reg(V, Rs)]; -% free_reg(V, []) -> []. - fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). @@ -1957,9 +1958,6 @@ find_scratch_reg([free|_], I) -> {x,I}; find_scratch_reg([_|Rs], I) -> find_scratch_reg(Rs, I+1); find_scratch_reg([], I) -> {x,I}. -%%copy_reg(Val, R, Regs) -> load_reg(Val, R, Regs). -%%move_reg(Val, R, Regs) -> load_reg(Val, R, free_reg(Val, Regs)). - replace_reg_contents(Old, New, [{I,Old}|Rs]) -> [{I,New}|Rs]; replace_reg_contents(Old, New, [R|Rs]) -> [R|replace_reg_contents(Old, New, Rs)]. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index b184987625..8ef71e1346 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -81,7 +81,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keymember/3,keyfind/3]). + keymember/3,keyfind/3,partition/2]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). @@ -1081,9 +1081,44 @@ select_bin_con(Cs0) -> end, Cs0), select_bin_con_1(Cs1). + select_bin_con_1(Cs) -> try - select_bin_int(Cs) + %% The usual way to match literals is to first extract the + %% value to a register, and then compare the register to the + %% literal value. Extracting the value is good if we need + %% compare it more than once. + %% + %% But we would like to combine the extracting and the + %% comparing into a single instruction if we know that + %% a binary segment must contain specific integer value + %% or the matching will fail, like in this example: + %% + %% <<42:8,...>> -> + %% <<42:8,...>> -> + %% . + %% . + %% . + %% <<42:8,...>> -> + %% <<>> -> + %% + %% The first segment must either contain the integer 42 + %% or the binary must end for the match to succeed. + %% + %% The way we do is to replace the generic #k_bin_seg{} + %% record with a #k_bin_int{} record if all clauses will + %% select the same literal integer (except for one or more + %% clauses that will end the binary). + + {BinSegs0,BinEnd} = + partition(fun (C) -> + clause_con(C) =:= k_bin_seg + end, Cs), + BinSegs = select_bin_int(BinSegs0), + case BinEnd of + [] -> BinSegs; + [_|_] -> BinSegs ++ [{k_bin_end,BinEnd}] + end catch throw:not_possible -> select_bin_con_2(Cs) @@ -1097,7 +1132,7 @@ select_bin_con_2([]) -> []. %% select_bin_int([Clause]) -> {k_bin_int,[Clause]} %% If the first pattern in each clause selects the same integer, -%% rewrite all clauses to use #k_bin_int{} (which will later to +%% rewrite all clauses to use #k_bin_int{} (which will later be %% translated to a bs_match_string/4 instruction). %% %% If it is not possible to do this rewrite, a 'not_possible' @@ -1346,7 +1381,7 @@ clause_arg(#iclause{pats=[Arg|_]}) -> Arg. clause_con(C) -> arg_con(clause_arg(C)). -clause_val(C) -> arg_val(clause_arg(C)). +clause_val(C) -> arg_val(clause_arg(C), C). is_var_clause(C) -> clause_con(C) =:= k_var. @@ -1377,7 +1412,7 @@ arg_con(Arg) -> #k_var{} -> k_var end. -arg_val(Arg) -> +arg_val(Arg, C) -> case arg_arg(Arg) of #k_literal{val=Lit} -> Lit; #k_int{val=I} -> I; @@ -1385,7 +1420,13 @@ arg_val(Arg) -> #k_atom{val=A} -> A; #k_tuple{es=Es} -> length(Es); #k_bin_seg{size=S,unit=U,type=T,flags=Fs} -> - {set_kanno(S, []),U,T,Fs} + case S of + #k_var{name=V} -> + #iclause{isub=Isub} = C, + {#k_var{name=get_vsub(V, Isub)},U,T,Fs}; + _ -> + {set_kanno(S, []),U,T,Fs} + end end. %% ubody_used_vars(Expr, State) -> [UsedVar] diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index e047166ade..3b065ec3b9 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -10,7 +10,7 @@ MODULES= \ apply_SUITE \ beam_validator_SUITE \ beam_disasm_SUITE \ - beam_expect_SUITE \ + beam_except_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ @@ -39,7 +39,7 @@ MODULES= \ NO_OPT= \ andor \ apply \ - beam_expect \ + beam_except \ bs_construct \ bs_match \ bs_utf \ diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index f7388f1614..fe69aeeb43 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -29,11 +29,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [t_case, t_and_or, t_andalso, t_orelse, inside, overlap, - combined, in_case, before_and_inside_if]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [t_case,t_and_or,t_andalso,t_orelse,inside,overlap, + combined,in_case,before_and_inside_if]}]. init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/beam_expect_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index 6f216eac4f..6b55224a42 100644 --- a/lib/compiler/test/beam_expect_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -16,7 +16,7 @@ %% %% %CopyrightEnd% %% --module(beam_expect_SUITE). +-module(beam_except_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 902867bc19..c84c83795a 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -47,17 +47,18 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [beam_files, compiler_bug, stupid_but_valid, xrange, - yrange, stack, call_last, merge_undefined, uninit, - unsafe_catch, dead_code, mult_labels, - overwrite_catchtag, overwrite_trytag, accessing_tags, - bad_catch_try, cons_guard, freg_range, freg_uninit, - freg_state, bin_match, bin_aligned, bad_dsetel, - state_after_fault_in_catch, no_exception_in_catch, - undef_label, illegal_instruction, failing_gc_guard_bif]. + [beam_files,{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [compiler_bug,stupid_but_valid,xrange, + yrange,stack,call_last,merge_undefined,uninit, + unsafe_catch,dead_code,mult_labels, + overwrite_catchtag,overwrite_trytag,accessing_tags, + bad_catch_try,cons_guard,freg_range,freg_uninit, + freg_state,bin_match,bin_aligned,bad_dsetel, + state_after_fault_in_catch,no_exception_in_catch, + undef_label,illegal_instruction,failing_gc_guard_bif]}]. init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl index 30276f1259..897b4769f1 100644 --- a/lib/compiler/test/bs_bit_binaries_SUITE.erl +++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl @@ -34,13 +34,15 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [misc, horrid_match, test_bitstr, test_bit_size, - asymmetric_tests, big_asymmetric_tests, - binary_to_and_from_list, big_binary_to_and_from_list, - send_and_receive, send_and_receive_alot]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [misc,horrid_match,test_bitstr,test_bit_size, + asymmetric_tests,big_asymmetric_tests, + binary_to_and_from_list,big_binary_to_and_from_list, + send_and_receive,send_and_receive_alot]}]. + init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index 9ab76449c7..4ea5235bb6 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -36,12 +36,14 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [two, test1, fail, float_bin, in_guard, in_catch, - nasty_literals, side_effect, opt, otp_7556, float_arith, - otp_8054]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [two,test1,fail,float_bin,in_guard,in_catch, + nasty_literals,side_effect,opt,otp_7556,float_arith, + otp_8054]}]. + init_per_suite(Config) -> Config. @@ -360,6 +362,11 @@ in_catch(Config) when is_list(Config) -> ?line <<255>> = small(255, <<1,2,3,4,5,6,7,8,9>>), ?line <<1,2>> = small(<<7,8,9,10>>, 258), ?line <<>> = small(<<1,2,3,4,5>>, <<7,8,9,10>>), + + <<15,240,0,42>> = small2(255, 42), + <<7:20>> = small2(<<1,2,3>>, 7), + <<300:12>> = small2(300, <<1,2,3>>), + <<>> = small2(<<1>>, <<2>>), ok. small(A, B) -> @@ -381,6 +388,25 @@ small(A, B) -> end, <<ResA/binary,ResB/binary>>. +small2(A, B) -> + case begin + case catch <<A:12>> of + {'EXIT',_} -> <<>>; + ResA0 -> ResA0 + end + end of + ResA -> ok + end, + case begin + case catch <<B:20>> of + {'EXIT',_} -> <<>>; + ResB0 -> ResB0 + end + end of + ResB -> ok + end, + <<ResA/binary-unit:1,ResB/binary-unit:1>>. + nasty_literals(Config) when is_list(Config) -> case erlang:system_info(endian) of big -> diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 01b7568122..1bef409be0 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -33,7 +33,7 @@ matching_meets_construction/1,simon/1,matching_and_andalso/1, otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, - cover_beam_bool/1]). + cover_beam_bool/1,matched_out_size/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -44,19 +44,21 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [fun_shadow, int_float, otp_5269, null_fields, wiger, - bin_tail, save_restore, shadowed_size_var, - partitioned_bs_match, function_clause, unit, - shared_sub_bins, bin_and_float, dec_subidentifiers, - skip_optional_tag, wfbm, degenerated_match, bs_sum, - coverage, multiple_uses, zero_label, followed_by_catch, - matching_meets_construction, simon, - matching_and_andalso, otp_7188, otp_7233, otp_7240, - otp_7498, match_string, zero_width, bad_size, haystack, - cover_beam_bool]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [fun_shadow,int_float,otp_5269,null_fields,wiger, + bin_tail,save_restore,shadowed_size_var, + partitioned_bs_match,function_clause,unit, + shared_sub_bins,bin_and_float,dec_subidentifiers, + skip_optional_tag,wfbm,degenerated_match,bs_sum, + coverage,multiple_uses,zero_label,followed_by_catch, + matching_meets_construction,simon, + matching_and_andalso,otp_7188,otp_7233,otp_7240, + otp_7498,match_string,zero_width,bad_size,haystack, + cover_beam_bool,matched_out_size]}]. + init_per_suite(Config) -> Config. @@ -1062,6 +1064,33 @@ do_cover_beam_bool(Bin, X) when X > 0 -> do_cover_beam_bool(<<_,Bin/binary>>, X) -> do_cover_beam_bool(Bin, X+1). +matched_out_size(Config) when is_list(Config) -> + {253,16#DEADBEEF} = mos_int(<<8,253,16#DEADBEEF:32>>), + {6,16#BEEFDEAD} = mos_int(<<3,6:3,16#BEEFDEAD:32>>), + {53,16#CAFEDEADBEEFCAFE} = mos_int(<<16,53:16,16#CAFEDEADBEEFCAFE:64>>), + {23,16#CAFEDEADBEEFCAFE} = mos_int(<<5,23:5,16#CAFEDEADBEEFCAFE:64>>), + + {<<1,2,3>>,4} = mos_bin(<<3,1,2,3,4,3>>), + {<<1,2,3,7>>,19,42} = mos_bin(<<4,1,2,3,7,19,4,42>>), + <<1,2,3,7>> = mos_bin(<<4,1,2,3,7,"abcdefghij">>), + + ok. + +mos_int(<<L,I:L,X:32>>) -> + {I,X}; +mos_int(<<L,I:L,X:64>>) -> + {I,X}. + +mos_bin(<<L,Bin:L/binary,X:8,L>>) -> + L = byte_size(Bin), + {Bin,X}; +mos_bin(<<L,Bin:L/binary,X:8,L,Y:8>>) -> + L = byte_size(Bin), + {Bin,X,Y}; +mos_bin(<<L,Bin:L/binary,"abcdefghij">>) -> + L = byte_size(Bin), + Bin. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index fed7bec7d4..bec97b0199 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -28,26 +28,29 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [self_compile_old_inliner, self_compile, compiler_1, - compiler_3, compiler_5, beam_compiler_1, - beam_compiler_2, beam_compiler_3, beam_compiler_4, - beam_compiler_5, beam_compiler_6, beam_compiler_7, - beam_compiler_8, beam_compiler_9, beam_compiler_10, - beam_compiler_11, beam_compiler_12, - nested_tuples_in_case_expr, otp_2330, guards, - {group, vsn}, otp_2380, otp_2141, otp_2173, otp_4790, - const_list_256, bin_syntax_1, bin_syntax_2, - bin_syntax_3, bin_syntax_4, bin_syntax_5, bin_syntax_6, - live_var, convopts, bad_functional_value, - catch_in_catch, redundant_case, long_string, otp_5076, - complex_guard, otp_5092, otp_5151, otp_5235, otp_5244, - trycatch_4, opt_crash, otp_5404, otp_5436, otp_5481, - otp_5553, otp_5632, otp_5714, otp_5872, otp_6121, - otp_6121a, otp_6121b, otp_7202, otp_7345, on_load, - string_table,otp_8949_a,otp_8949_a,split_cases]. + [self_compile_old_inliner,self_compile, + {group,p}]. groups() -> - [{vsn, [], [vsn_1, vsn_2, vsn_3]}]. + [{vsn,[parallel],[vsn_1,vsn_2,vsn_3]}, + {p,test_lib:parallel(), + [compiler_1, + compiler_3,compiler_5,beam_compiler_1, + beam_compiler_2,beam_compiler_3,beam_compiler_4, + beam_compiler_5,beam_compiler_6,beam_compiler_7, + beam_compiler_8,beam_compiler_9,beam_compiler_10, + beam_compiler_11,beam_compiler_12, + nested_tuples_in_case_expr,otp_2330,guards, + {group,vsn},otp_2380,otp_2141,otp_2173,otp_4790, + const_list_256,bin_syntax_1,bin_syntax_2, + bin_syntax_3,bin_syntax_4,bin_syntax_5,bin_syntax_6, + live_var,convopts,bad_functional_value, + catch_in_catch,redundant_case,long_string,otp_5076, + complex_guard,otp_5092,otp_5151,otp_5235,otp_5244, + trycatch_4,opt_crash,otp_5404,otp_5436,otp_5481, + otp_5553,otp_5632,otp_5714,otp_5872,otp_6121, + otp_6121a,otp_6121b,otp_7202,otp_7345,on_load, + string_table,otp_8949_a,otp_8949_a,split_cases]}]. init_per_suite(Config) -> Config. @@ -623,7 +626,7 @@ string_table(Config) when is_list(Config) -> ?line File = filename:join(DataDir, "string_table.erl"), ?line {ok,string_table,Beam,[]} = compile:file(File, [return, binary]), ?line {ok,{string_table,[StringTableChunk]}} = beam_lib:chunks(Beam, ["StrT"]), - ?line {"StrT", <<"stringabletringtable">>} = StringTableChunk, + ?line {"StrT", <<"stringtable">>} = StringTableChunk, ok. otp_8949_a(Config) when is_list(Config) -> diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 06185bfc34..a40dc32d59 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -43,11 +43,13 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, - eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, + eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos]}]. + init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 54bd52947e..2adc71c237 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -31,11 +31,13 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [t_element, setelement, t_length, append, t_apply, bifs, - eq, nested_call_in_case, guard_try_catch, coverage]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [t_element,setelement,t_length,append,t_apply,bifs, + eq,nested_call_in_case,guard_try_catch,coverage]}]. + init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index fb51e013ce..859c4571ea 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -22,16 +22,21 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1]). + head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1, + transforms/1]). + +%% Used by transforms/1 test case. +-export([parse_transform/2]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [head_mismatch_line, warnings_as_errors, bif_clashes]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [head_mismatch_line,warnings_as_errors,bif_clashes,transforms]}]. init_per_suite(Config) -> Config. @@ -216,6 +221,24 @@ warnings_as_errors(Config) when is_list(Config) -> ok. +transforms(Config) -> + Ts1 = [{undef_parse_transform, + <<" + -compile({parse_transform,non_existing}). + ">>, + [return], + {error,[{none,compile,{undef_parse_transform,non_existing}}],[]}}], + [] = run(Config, Ts1), + Ts2 = <<" + -compile({parse_transform,",?MODULE_STRING,"}). + ">>, + {error,[{none,compile,{parse_transform,?MODULE,{too_bad,_}}}],[]} = + run_test(Ts2, test_filename(Config), [], dont_write_beam), + ok. + +parse_transform(_, _) -> + error(too_bad). + run(Config, Tests) -> ?line File = test_filename(Config), @@ -260,12 +283,14 @@ filter(X) -> %% Compiles a test module and returns the list of errors and warnings. test_filename(Conf) -> - Filename = "errors_test.erl", + Filename = ["errors_test_",test_lib:uniq(),".erl"], DataDir = ?config(priv_dir, Conf), filename:join(DataDir, Filename). run_test(Test0, File, Warnings, WriteBeam) -> - ?line Test = ["-module(errors_test). ", Test0], + ModName = filename:rootname(filename:basename(File), ".erl"), + Mod = list_to_atom(ModName), + Test = ["-module(",ModName,"). ",Test0], ?line Opts = case WriteBeam of dont_write_beam -> [binary,return_errors|Warnings]; @@ -279,17 +304,17 @@ run_test(Test0, File, Warnings, WriteBeam) -> %% Test result of compilation. ?line Res = case compile:file(File, Opts) of - {ok,errors_test,_,[{_File,Ws}]} -> + {ok,Mod,_,[{_File,Ws}]} -> %io:format("compile:file(~s,~p) ->~n~p~n", % [File,Opts,Ws]), {warning,Ws}; - {ok,errors_test,_,[]} -> + {ok,Mod,_,[]} -> %io:format("compile:file(~s,~p) ->~n~p~n", % [File,Opts,Ws]), []; - {ok,errors_test,[{_File,Ws}]} -> + {ok,Mod,[{_File,Ws}]} -> {warning,Ws}; - {ok,errors_test,[]} -> + {ok,Mod,[]} -> []; {error,[{XFile,Es}],Ws} = _ZZ when is_list(XFile) -> %io:format("compile:file(~s,~p) ->~n~p~n", diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 40711783ed..66c0b9a295 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -39,17 +39,18 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [misc, const_cond, basic_not, complex_not, nested_nots, - semicolon, complex_semicolon, comma, or_guard, - more_or_guards, complex_or_guards, and_guard, xor_guard, - more_xor_guards, build_in_guard, old_guard_tests, gbif, - t_is_boolean, is_function_2, tricky, rel_ops, - literal_type_tests, basic_andalso_orelse, traverse_dcd, - check_qlc_hrl, andalso_semi, t_tuple_size, binary_part, - bad_constants]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [misc,const_cond,basic_not,complex_not,nested_nots, + semicolon,complex_semicolon,comma,or_guard, + more_or_guards,complex_or_guards,and_guard,xor_guard, + more_xor_guards,build_in_guard,old_guard_tests,gbif, + t_is_boolean,is_function_2,tricky,rel_ops, + literal_type_tests,basic_andalso_orelse,traverse_dcd, + check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, + bad_constants]}]. init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 2e17d3fde6..e2eb6a0dec 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -32,17 +32,22 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [attribute, bsdecode, bsdes, barnes2, decode1, smith, - itracer, pseudoknot, comma_splitter, lists, really_inlined, otp_7223, - coverage]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [attribute,bsdecode,bsdes,barnes2,decode1,smith, + itracer,pseudoknot,comma_splitter,lists,really_inlined,otp_7223, + coverage]}]. init_per_suite(Config) -> - Config. + Pa = "-pa " ++ filename:dirname(code:which(?MODULE)), + {ok,Node} = start_node(compiler, Pa), + [{testing_node,Node}|Config]. -end_per_suite(_Config) -> +end_per_suite(Config) -> + Node = ?config(testing_node, Config), + ?t:stop_node(Node), ok. init_per_group(_GroupName, Config) -> @@ -81,6 +86,7 @@ attribute(Config) when is_list(Config) -> ?comp(comma_splitter). try_inline(Mod, Config) -> + Node = ?config(testing_node, Config), ?line Src = filename:join(?config(data_dir, Config), atom_to_list(Mod)), ?line Out = ?config(priv_dir,Config), @@ -89,8 +95,6 @@ try_inline(Mod, Config) -> ?line {ok,Mod} = compile:file(Src, [{outdir,Out},report,bin_opt_info,clint]), ?line Dog = test_server:timetrap(test_server:minutes(10)), - ?line Pa = "-pa " ++ filename:dirname(code:which(?MODULE)), - ?line {ok,Node} = start_node(compiler, Pa), ?line NormalResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]), ?line test_server:timetrap_cancel(Dog), @@ -125,7 +129,6 @@ try_inline(Mod, Config) -> %% Delete Beam file. ?line ok = file:delete(filename:join(Out, atom_to_list(Mod)++code:objfile_extension())), - ?line ?t:stop_node(Node), ok. compare(Same, Same) -> ok; @@ -293,9 +296,9 @@ otp_7223_2({a}) -> 1. coverage(Config) when is_list(Config) -> - ?line Src = filename:join(?config(data_dir, Config), bsdecode), - ?line Out = ?config(priv_dir,Config), - ?line {ok,Mod} = compile:file(Src, [{outdir,Out},report,{inline,0},clint]), - ?line {ok,Mod} = compile:file(Src, [{outdir,Out},report,{inline,20},verbose,clint]), - ?line ok = file:delete(filename:join(Out, "bsdecode"++code:objfile_extension())), + Mod = bsdecode, + Src = filename:join(?config(data_dir, Config), Mod), + {ok,Mod,_} = compile:file(Src, [binary,report,{inline,0},clint]), + {ok,Mod,_} = compile:file(Src, [binary,report,{inline,20}, + verbose,clint]), ok. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 9406d7de8f..de44926d81 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -30,11 +30,13 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [pmatch, mixed, aliases, match_in_call, untuplify, - shortcut_boolean, letify_guard, selectify, underscore, coverage]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [pmatch,mixed,aliases,match_in_call,untuplify, + shortcut_boolean,letify_guard,selectify,underscore,coverage]}]. + init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 0376c7ef3e..44c7161530 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -57,11 +57,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> misc_SUITE_test_cases(). all() -> test_lib:recompile(?MODULE), - [tobias, empty_string, md5, silly_coverage, - confused_literals, integer_encoding, override_bif]. + [{group,p}]. groups() -> - []. + [{p,[],%%test_lib:parallel(), + [tobias,empty_string,md5,silly_coverage, + confused_literals,integer_encoding,override_bif]}]. init_per_suite(Config) -> Config. @@ -182,6 +183,14 @@ silly_coverage(Config) when is_list(Config) -> CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]}, ?line expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), + %% beam_a + BeamAInput = {?MODULE,[{foo,0}],[], + [{function,foo,0,2, + [{label,1}, + {func_info,{atom,?MODULE},{atom,foo},0}, + {label,2}|non_proper_list]}],99}, + expect_error(fun() -> beam_a:module(BeamAInput, []) end), + %% beam_block BlockInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -263,6 +272,13 @@ silly_coverage(Config) when is_list(Config) -> {block,[a|b]}]}],0}, ?line expect_error(fun() -> beam_receive:module(ReceiveInput, []) end), + BeamZInput = {?MODULE,[{foo,0}],[], + [{function,foo,0,2, + [{label,1}, + {func_info,{atom,?MODULE},{atom,foo},0}, + {label,2}|non_proper_list]}],99}, + expect_error(fun() -> beam_z:module(BeamZInput, []) end), + ok. expect_error(Fun) -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 2a67615e5e..55aaa0e5d9 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -40,10 +40,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [recv, coverage, otp_7980, ref_opt, export]. + [{group,p}]. groups() -> - []. + {p,test_lib:parallel(), + [recv,coverage,otp_7980,ref_opt,export]}. + init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_4.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_4.erl new file mode 100644 index 0000000000..3ce222176b --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_4.erl @@ -0,0 +1,12 @@ +-module(no_4). +-compile(export_all). + +?MODULE() -> + ok. + +f(X) -> + {Pid,Ref} = spawn_monitor(fun() -> ok end), + r(Pid, Ref). + +r(_, _) -> + ok. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_10.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_10.erl new file mode 100644 index 0000000000..7ce6e6103c --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_10.erl @@ -0,0 +1,13 @@ +-module(yes_10). +-compile(export_all). + +?MODULE() -> + ok. + +f() -> + Ref = make_ref(), + receive + %% Artifical example to cover more code in beam_receive. + {X,Y} when Ref =/= X, Ref =:= Y -> + ok + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_11.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_11.erl new file mode 100644 index 0000000000..62f439fc42 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_11.erl @@ -0,0 +1,21 @@ +-module(yes_11). +-compile(export_all). + +?MODULE() -> + ok. + +%% Artifical example to cover more code in beam_receive. +do_call(Process, Request) -> + Mref = erlang:monitor(process, Process), + Process ! Request, + receive + {X,Y,Z} when Mref =/= X, Z =:= 42, Mref =:= Y -> + error; + {X,Y,_} when Mref =/= X, Mref =:= Y -> + error; + {Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + {ok, Reply}; + {'DOWN', Mref, _, _, _} -> + error + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_12.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_12.erl new file mode 100644 index 0000000000..efcfed6059 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_12.erl @@ -0,0 +1,12 @@ +-module(yes_12). +-compile(export_all). + +?MODULE() -> + ok. + +f() -> + {_,Ref} = spawn_monitor(fun() -> ok end), + receive + {'DOWN',Ref,_,_,Reason} -> + Reason + end. diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_13.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_13.erl new file mode 100644 index 0000000000..9e93d12ed6 --- /dev/null +++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_13.erl @@ -0,0 +1,12 @@ +-module(yes_13). +-compile(export_all). + +?MODULE() -> + ok. + +f() -> + {Pid,Ref} = spawn_monitor(fun() -> ok end), + receive + {'DOWN',Ref,process,Pid,Reason} -> + Reason + end. diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 363422ec7e..96f3712be9 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -42,12 +42,14 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [errors, record_test_2, record_test_3, - record_access_in_guards, guard_opt, eval_once, foobar, - missing_test_heap, nested_access, coverage]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [errors,record_test_2,record_test_3, + record_access_in_guards,guard_opt,eval_once,foobar, + missing_test_heap,nested_access,coverage]}]. + init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 2295592a38..996c369705 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -20,7 +20,8 @@ -include("test_server.hrl"). -compile({no_auto_import,[binary_part/2]}). --export([recompile/1,opt_opts/1,get_data_dir/1,smoke_disasm/1,p_run/2,binary_part/2]). +-export([recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1, + smoke_disasm/1,p_run/2,binary_part/2]). recompile(Mod) when is_atom(Mod) -> case whereis(cover_server) of @@ -43,6 +44,18 @@ smoke_disasm(File) when is_list(File) -> Res = beam_disasm:file(File), {beam_file,_Mod} = {element(1, Res),element(2, Res)}. +parallel() -> + case ?t:is_cover() orelse erlang:system_info(schedulers) =:= 1 of + true -> []; + false -> [parallel] + end. + +uniq() -> + U0 = erlang:ref_to_list(make_ref()), + U1 = re:replace(U0, "^#Ref", ""), + U = re:replace(U1, "[^[A-Za-z0-9_]+", "_", [global]), + re:replace(U, "_*$", "", [{return,list}]). + %% Retrieve the "interesting" compiler options (options for optimization %% and compatibility) for the given module. diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 29119c0f5d..4530d08c77 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -32,13 +32,15 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [basic, lean_throw, try_of, try_after, catch_oops, - after_oops, eclectic, rethrow, nested_of, nested_catch, - nested_after, nested_horrid, last_call_optimization, - bool, plain_catch_coverage, andalso_orelse, get_in_try]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [basic,lean_throw,try_of,try_after,catch_oops, + after_oops,eclectic,rethrow,nested_of,nested_catch, + nested_after,nested_horrid,last_call_optimization, + bool,plain_catch_coverage,andalso_orelse,get_in_try]}]. + init_per_suite(Config) -> Config. diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index f6a572abfa..9ce0df5ec4 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -55,12 +55,13 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [pattern, pattern2, pattern3, pattern4, guard, - bad_arith, bool_cases, bad_apply, files, effect, - bin_opt_info, bin_construction]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [pattern,pattern2,pattern3,pattern4,guard, + bad_arith,bool_cases,bad_apply,files,effect, + bin_opt_info,bin_construction]}]. init_per_suite(Config) -> Config. @@ -556,9 +557,10 @@ run(Config, Tests) -> %% Compiles a test module and returns the list of errors and warnings. run_test(Conf, Test0, Warnings) -> - Filename = 'warnings_test.erl', + Mod = "warnings_"++test_lib:uniq(), + Filename = Mod ++ ".erl", ?line DataDir = ?privdir, - ?line Test = ["-module(warnings_test). ", Test0], + Test = ["-module(", Mod, "). ", Test0], ?line File = filename:join(DataDir, Filename), ?line Opts = [binary,export_all,return|Warnings], ?line ok = file:write_file(File, Test), diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index 3e3c12405f..63c51e219a 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -162,14 +162,17 @@ run(Opts) -> {error, Msg} -> throw({dialyzer_error, Msg}); OptsRecord -> - case cl_check_init(OptsRecord) of - {ok, ?RET_NOTHING_SUSPICIOUS} -> - case dialyzer_cl:start(OptsRecord) of - {?RET_DISCREPANCIES, Warnings} -> Warnings; - {?RET_NOTHING_SUSPICIOUS, []} -> [] - end; - {error, ErrorMsg1} -> - throw({dialyzer_error, ErrorMsg1}) + case OptsRecord#options.check_plt of + true -> + case cl_check_init(OptsRecord) of + {ok, ?RET_NOTHING_SUSPICIOUS} -> ok; + {error, ErrorMsg1} -> throw({dialyzer_error, ErrorMsg1}) + end; + false -> ok + end, + case dialyzer_cl:start(OptsRecord) of + {?RET_DISCREPANCIES, Warnings} -> Warnings; + {?RET_NOTHING_SUSPICIOUS, []} -> [] end catch throw:{dialyzer_error, ErrorMsg} -> @@ -380,8 +383,6 @@ message_to_string({pattern_match_cov, [Pat, Type]}) -> message_to_string({unmatched_return, [Type]}) -> io_lib:format("Expression produces a value of type ~s," " but this value is unmatched\n", [Type]); -message_to_string({unused_fun, []}) -> - io_lib:format("Function will never be called\n", []); message_to_string({unused_fun, [F, A]}) -> io_lib:format("Function ~w/~w will never be called\n", [F, A]); %%----- Warnings for specs and contracts ------------------- diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index c237d4e0e9..86618a4915 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -326,13 +326,6 @@ cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, ModuleDeps = dialyzer_callgraph:module_deps(Callgraph), send_mod_deps(Parent, ModuleDeps), {Callgraph1, ExtCalls} = dialyzer_callgraph:remove_external(Callgraph), - RelevantAPICalls = - dialyzer_behaviours:get_behaviour_apis([gen_server]), - BehaviourAPICalls = [Call || {_From, To} = Call <- ExtCalls, - lists:member(To, RelevantAPICalls)], - Callgraph2 = - dialyzer_callgraph:put_behaviour_api_calls(BehaviourAPICalls, - Callgraph1), ExtCalls1 = [Call || Call = {_From, To} <- ExtCalls, not dialyzer_plt:contains_mfa(InitPlt, To)], {BadCalls1, RealExtCalls} = @@ -355,7 +348,7 @@ cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, true -> send_ext_calls(Parent, lists:usort([To || {_From, To} <- RealExtCalls])) end, - Callgraph2. + Callgraph1. compile_src(File, Includes, Defines, Callgraph, CServer, UseContracts) -> DefaultIncludes = default_includes(filename:dirname(File)), diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index b84071b95c..36aef2a37f 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -30,11 +30,9 @@ -module(dialyzer_behaviours). --export([check_callbacks/5, get_behaviour_apis/1, - translate_behaviour_api_call/5, translatable_behaviours/1, - translate_callgraph/3]). +-export([check_callbacks/5]). --export_type([behaviour/0, behaviour_api_dict/0]). +-export_type([behaviour/0]). %%-------------------------------------------------------------------- @@ -224,103 +222,3 @@ get_line([]) -> -1. get_file([{file, File}|_]) -> File; get_file([_|Tail]) -> get_file(Tail). - -%%----------------------------------------------------------------------------- - --spec translatable_behaviours(cerl:c_module()) -> behaviour_api_dict(). - -translatable_behaviours(Tree) -> - Attrs = cerl:module_attrs(Tree), - {Behaviours, _BehLines} = get_behaviours(Attrs), - [{B, Calls} || B <- Behaviours, (Calls = behaviour_api_calls(B)) =/= []]. - --spec get_behaviour_apis([behaviour()]) -> [mfa()]. - -get_behaviour_apis(Behaviours) -> - get_behaviour_apis(Behaviours, []). - --spec translate_behaviour_api_call(dialyzer_callgraph:mfa_or_funlbl(), - [erl_types:erl_type()], - [dialyzer_races:core_vars()], - module(), - behaviour_api_dict()) -> - {dialyzer_callgraph:mfa_or_funlbl(), - [erl_types:erl_type()], - [dialyzer_races:core_vars()]} - | 'plain_call'. - -translate_behaviour_api_call(_Fun, _ArgTypes, _Args, _Module, []) -> - plain_call; -translate_behaviour_api_call({Module, Fun, Arity}, ArgTypes, Args, - CallbackModule, BehApiInfo) -> - case lists:keyfind(Module, 1, BehApiInfo) of - false -> plain_call; - {Module, Calls} -> - case lists:keyfind({Fun, Arity}, 1, Calls) of - false -> plain_call; - {{Fun, Arity}, {CFun, CArity, COrder}} -> - {{CallbackModule, CFun, CArity}, - [nth_or_0(N, ArgTypes, erl_types:t_any()) || N <-COrder], - [nth_or_0(N, Args, bypassed) || N <-COrder]} - end - end; -translate_behaviour_api_call(_Fun, _ArgTypes, _Args, _Module, _BehApiInfo) -> - plain_call. - --spec translate_callgraph(behaviour_api_dict(), atom(), - dialyzer_callgraph:callgraph()) -> - dialyzer_callgraph:callgraph(). - -translate_callgraph([{Behaviour,_}|Behaviours], Module, Callgraph) -> - UsedCalls = [Call || {_From, {M, _F, _A}} = Call <- - dialyzer_callgraph:get_behaviour_api_calls(Callgraph), - M =:= Behaviour], - Calls = [{{Behaviour, API, Arity}, Callback} || - {{API, Arity}, Callback} <- behaviour_api_calls(Behaviour)], - DirectCalls = [{From, {Module, Fun, Arity}} || - {From, To} <- UsedCalls,{API, {Fun, Arity, _Ord}} <- Calls, - To =:= API], - dialyzer_callgraph:add_edges(DirectCalls, Callgraph), - translate_callgraph(Behaviours, Module, Callgraph); -translate_callgraph([], _Module, Callgraph) -> - Callgraph. - -get_behaviour_apis([], Acc) -> - Acc; -get_behaviour_apis([Behaviour | Rest], Acc) -> - MFAs = [{Behaviour, Fun, Arity} || - {{Fun, Arity}, _} <- behaviour_api_calls(Behaviour)], - get_behaviour_apis(Rest, MFAs ++ Acc). - -%------------------------------------------------------------------------------ - -nth_or_0(0, _List, Zero) -> - Zero; -nth_or_0(N, List, _Zero) -> - lists:nth(N, List). - -%------------------------------------------------------------------------------ - --type behaviour_api_dict()::[{behaviour(), behaviour_api_info()}]. --type behaviour_api_info()::[{original_fun(), replacement_fun()}]. --type original_fun()::{atom(), arity()}. --type replacement_fun()::{atom(), arity(), arg_list()}. --type arg_list()::[byte()]. - --spec behaviour_api_calls(behaviour()) -> behaviour_api_info(). - -behaviour_api_calls(gen_server) -> - [{{start_link, 3}, {init, 1, [2]}}, - {{start_link, 4}, {init, 1, [3]}}, - {{start, 3}, {init, 1, [2]}}, - {{start, 4}, {init, 1, [3]}}, - {{call, 2}, {handle_call, 3, [2, 0, 0]}}, - {{call, 3}, {handle_call, 3, [2, 0, 0]}}, - {{multi_call, 2}, {handle_call, 3, [2, 0, 0]}}, - {{multi_call, 3}, {handle_call, 3, [3, 0, 0]}}, - {{multi_call, 4}, {handle_call, 3, [3, 0, 0]}}, - {{cast, 2}, {handle_cast, 2, [2, 0]}}, - {{abcast, 2}, {handle_cast, 2, [2, 0]}}, - {{abcast, 3}, {handle_cast, 2, [3, 0]}}]; -behaviour_api_calls(_Other) -> - []. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 7131633da1..6956850f1a 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -91,9 +91,8 @@ warning_mode = false :: boolean(), warnings = [] :: [dial_warning()], work :: {[_], [_], set()}, - module :: module(), - behaviour_api_dict = [] :: - dialyzer_behaviours:behaviour_api_dict()}). + module :: module() + }). -record(map, {dict = dict:new() :: dict(), subst = dict:new() :: dict(), @@ -135,38 +134,15 @@ get_fun_types(Tree, Plt, Callgraph, Records) -> analyze_module(Tree, Plt, Callgraph, Records, GetWarnings) -> debug_pp(Tree, false), Module = cerl:atom_val(cerl:module_name(Tree)), - RaceDetection = dialyzer_callgraph:get_race_detection(Callgraph), - BehaviourTranslations = - case RaceDetection of - true -> dialyzer_behaviours:translatable_behaviours(Tree); - false -> [] - end, TopFun = cerl:ann_c_fun([{label, top}], [], Tree), - State = - state__new(Callgraph, TopFun, Plt, Module, Records, BehaviourTranslations), + State = state__new(Callgraph, TopFun, Plt, Module, Records), State1 = state__race_analysis(not GetWarnings, State), State2 = analyze_loop(State1), case GetWarnings of true -> State3 = state__set_warning_mode(State2), State4 = analyze_loop(State3), - - %% EXPERIMENTAL: Turn all behaviour API calls into calls to the - %% respective callback module's functions. - - case BehaviourTranslations of - [] -> dialyzer_races:race(State4); - Behaviours -> - Digraph = dialyzer_callgraph:get_digraph(State4#state.callgraph), - TranslatedCallgraph = - dialyzer_behaviours:translate_callgraph(Behaviours, Module, - Callgraph), - St = - dialyzer_races:race(State4#state{callgraph = TranslatedCallgraph}), - FinalCallgraph = dialyzer_callgraph:put_digraph(Digraph, - St#state.callgraph), - St#state{callgraph = FinalCallgraph} - end; + dialyzer_races:race(State4); false -> State2 end. @@ -530,21 +506,8 @@ handle_apply_or_call([{TypeOfApply, {Fun, Sig, Contr, LocalRet}}|Left], Ann = cerl:get_ann(Tree), File = get_file(Ann), Line = abs(get_line(Ann)), - - %% EXPERIMENTAL: Turn a behaviour's API call into a call to the - %% respective callback module's function. - - Module = State#state.module, - BehApiDict = State#state.behaviour_api_dict, - {RealFun, RealArgTypes, RealArgs} = - case dialyzer_behaviours:translate_behaviour_api_call(Fun, ArgTypes, - Args, Module, - BehApiDict) of - plain_call -> {Fun, ArgTypes, Args}; - BehaviourAPI -> BehaviourAPI - end, - dialyzer_races:store_race_call(RealFun, RealArgTypes, RealArgs, - {File, Line}, State); + dialyzer_races:store_race_call(Fun, ArgTypes, Args, + {File, Line}, State); false -> State end, FailedConj = any_none([RetWithoutLocal|NewArgTypes]), @@ -2711,7 +2674,7 @@ determine_mode(Type, Opaques) -> %%% %%% =========================================================================== -state__new(Callgraph, Tree, Plt, Module, Records, BehaviourTranslations) -> +state__new(Callgraph, Tree, Plt, Module, Records) -> Opaques = erl_types:module_builtin_opaques(Module) ++ erl_types:t_opaque_from_records(Records), TreeMap = build_tree_map(Tree), @@ -2725,7 +2688,7 @@ state__new(Callgraph, Tree, Plt, Module, Records, BehaviourTranslations) -> #state{callgraph = Callgraph, envs = Env, fun_tab = FunTab, opaques = Opaques, plt = Plt, races = dialyzer_races:new(), records = Records, warning_mode = false, warnings = [], work = Work, tree_map = TreeMap, - module = Module, behaviour_api_dict = BehaviourTranslations}. + module = Module}. state__warning_mode(#state{warning_mode = WM}) -> WM. @@ -2806,7 +2769,7 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, true -> {Warn, Msg} = case dialyzer_callgraph:lookup_name(FunLbl, Callgraph) of - error -> {true, {unused_fun, []}}; + error -> {false, {}}; {ok, {_M, F, A} = MFA} -> {not sets:is_element(MFA, NoWarnUnused), {unused_fun, [F, A]}} diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index cdb9f25999..2aa8343bce 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -1758,7 +1758,10 @@ compare_var_list(Var, VarList, RaceVarMap) -> ets_list_args(MaybeList) -> case is_list(MaybeList) of - true -> [ets_tuple_args(T) || T <- MaybeList]; + true -> + try [ets_tuple_args(T) || T <- MaybeList] + catch _:_ -> [?no_label] + end; false -> [ets_tuple_args(MaybeList)] end. diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 index 292275dd6e..c11105b76d 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 +++ b/lib/dialyzer/test/r9c_SUITE_data/results/asn1 @@ -68,7 +68,6 @@ asn1rt_check.erl:100: The variable _ can never match since previous clauses comp asn1rt_check.erl:85: The variable _ can never match since previous clauses completely covered the type [any()] asn1rt_driver_handler.erl:32: The pattern 'already_done' can never match the type {'error',_} asn1rt_per.erl:1065: The pattern {'BMPString', {'octets', Ol}} can never match the type {_,[{'bits',1 | 2 | 4 | 8 | 16 | 32,_}]} -asn1rt_per.erl:1066: Function will never be called asn1rt_per.erl:1231: The call erlang:'not'('implemented') will never return since it differs in the 1st argument from the success typing arguments: (boolean()) asn1rt_per.erl:1233: The call erlang:'not'('implemented') will never return since it differs in the 1st argument from the success typing arguments: (boolean()) asn1rt_per.erl:1235: The call erlang:'not'('implemented') will never return since it differs in the 1st argument from the success typing arguments: (boolean()) @@ -76,7 +75,6 @@ asn1rt_per.erl:1237: The call erlang:'not'('implemented') will never return sinc asn1rt_per.erl:989: The pattern <_C, 'true', _Val> can never match the type <_,'false',_> asn1rt_per_bin.erl:1361: The pattern <_, 'true', _> can never match the type <_,'false',_> asn1rt_per_bin.erl:1436: The pattern {'BMPString', {'octets', Ol}} can never match the type {'BMPString' | 'IA5String' | 'NumericString' | 'PrintableString' | 'UniversalString' | 'VisibleString',[{'bits',1 | 2 | 4 | 8 | 16 | 32,_}]} -asn1rt_per_bin.erl:1437: Function will never be called asn1rt_per_bin.erl:161: The call asn1rt_per_bin:getbit({0,maybe_improper_list()}) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>> | {non_neg_integer(),<<_:1,_:_*1>>}) asn1rt_per_bin.erl:1812: The pattern {Name, Val} can never match since previous clauses completely covered the type any() asn1rt_per_bin.erl:2106: Cons will produce an improper list since its 2nd argument is binary() @@ -94,7 +92,6 @@ asn1rt_per_bin.erl:487: The variable _ can never match since previous clauses co asn1rt_per_bin.erl:498: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin_rt2ct.erl:152: The call asn1rt_per_bin_rt2ct:getbit({0,maybe_improper_list()}) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>> | {non_neg_integer(),<<_:1,_:_*1>>}) asn1rt_per_bin_rt2ct.erl:1533: The pattern {'BMPString', {'octets', Ol}} can never match the type {_,[[any(),...]]} -asn1rt_per_bin_rt2ct.erl:1534: Function will never be called asn1rt_per_bin_rt2ct.erl:1875: The pattern {Name, Val} can never match since previous clauses completely covered the type any() asn1rt_per_bin_rt2ct.erl:443: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_bin_rt2ct.erl:464: The variable _ can never match since previous clauses completely covered the type integer() @@ -103,4 +100,3 @@ asn1rt_per_bin_rt2ct.erl:484: The variable _ can never match since previous clau asn1rt_per_bin_rt2ct.erl:495: The variable _ can never match since previous clauses completely covered the type integer() asn1rt_per_v1.erl:1209: The pattern <_, 'true', _> can never match the type <_,'false',_> asn1rt_per_v1.erl:1290: The pattern {'BMPString', {'octets', Ol}} can never match the type {'BMPString' | 'IA5String' | 'NumericString' | 'PrintableString' | 'UniversalString' | 'VisibleString',[{'bits',1 | 2 | 4 | 8 | 16 | 32,_}]} -asn1rt_per_v1.erl:1291: Function will never be called diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index b397d37523..17f2bd2ea8 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -1,7 +1,6 @@ mnesia.erl:1319: Guard test size(Spec::[{_,_,_},...]) can never succeed mnesia.erl:1498: The call mnesia:bad_info_reply(Tab::atom(),Item::'type') will never return since it differs in the 2nd argument from the success typing arguments: (atom(),'memory' | 'size') -mnesia.erl:331: Function mod2abs/1 has no local return mnesia_backup.erl:49: Callback info about the mnesia_backup behaviour is not available mnesia_bup.erl:111: The created fun has no local return mnesia_bup.erl:574: Function fallback_receiver/2 has no local return diff --git a/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 b/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 new file mode 100644 index 0000000000..c3c9b12bdd --- /dev/null +++ b/lib/dialyzer/test/race_SUITE_data/results/ets_insert_args10 @@ -0,0 +1,2 @@ + +ets_insert_args10.erl:9: The call ets:insert(T::'foo',[{'counter',number()},...]) might have an unintended effect due to a possible race condition caused by its combination with the ets:lookup(T::'foo','counter') call in ets_insert_args10.erl on line 8 diff --git a/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl b/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl new file mode 100644 index 0000000000..c897a34af0 --- /dev/null +++ b/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args10.erl @@ -0,0 +1,19 @@ +%% This tests the presence of possible races due to an ets:lookup/ets:insert +%% combination. It takes into account the argument types of the calls. + +-module(ets_insert_args10). +-export([start/0]). + +start() -> + F = fun(T) -> [{_, N}] = ets:lookup(T, counter), + ets:insert(T, [{counter, N+1}]) + end, + io:format("Created ~w\n", [ets:new(foo, [named_table, public])]), + A = {counter, 0}, + B = [], + ets:insert(foo, [A|B]), + io:format("Inserted ~w\n", [{counter, 0}]), + F(foo), + io:format("Update complete\n", []), + ObjectList = ets:lookup(foo, counter), + io:format("Counter: ~w\n", [ObjectList]). diff --git a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes index 8dc0361b0d..4850f3ff0c 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes +++ b/lib/dialyzer/test/small_SUITE_data/results/contracts_with_subtypes @@ -6,7 +6,7 @@ contracts_with_subtypes.erl:109: The call contracts_with_subtypes:rec_arg({'b',{ contracts_with_subtypes.erl:110: The call contracts_with_subtypes:rec_arg({'a',{'b',{'a','b'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:111: The call contracts_with_subtypes:rec_arg({'b',{'a',{'b','a'}}}) breaks the contract (Arg) -> 'ok' when is_subtype(Arg,{'a',A} | {'b',B}), is_subtype(A,'a' | {'b',B}), is_subtype(B,'b' | {'a',A}) contracts_with_subtypes.erl:142: The pattern 1 can never match the type binary() | string() -contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',X} | {'ok',X,binary() | string()} +contracts_with_subtypes.erl:145: The pattern 'alpha' can never match the type {'ok',_} | {'ok',_,binary() | string()} contracts_with_subtypes.erl:147: The pattern 42 can never match the type {'ok',_} | {'ok',_,binary() | string()} contracts_with_subtypes.erl:163: The pattern 'alpha' can never match the type {'ok',X} contracts_with_subtypes.erl:165: The pattern 42 can never match the type {'ok',X} diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match b/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match index 60b34530b4..e69de29bb2 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match +++ b/lib/dialyzer/test/small_SUITE_data/results/fun_ref_match @@ -1,2 +0,0 @@ - -fun_ref_match.erl:14: Function will never be called diff --git a/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl b/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl new file mode 100644 index 0000000000..6c440ed04c --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/remote_tuple_set.erl @@ -0,0 +1,8 @@ +-module(remote_tuple_set). + +-export([parse_cidr/0]). + +-spec parse_cidr() -> {inet:address_family(),1,2} | {error}. + +parse_cidr() -> + {inet,1,2}. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 1579735773..bc7ea17077 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -687,8 +687,8 @@ t_solve_remote(?tuple(Types, _Arity, _Tag), ET, R, C) -> {RL, RR} = list_solve_remote(Types, ET, R, C), {t_tuple(RL), RR}; t_solve_remote(?tuple_set(Set), ET, R, C) -> - {NewSet, RR} = tuples_solve_remote(Set, ET, R, C), - {?tuple_set(NewSet), RR}; + {NewTuples, RR} = tuples_solve_remote(Set, ET, R, C), + {t_sup(NewTuples), RR}; t_solve_remote(?remote(Set), ET, R, C) -> RemoteList = ordsets:to_list(Set), {RL, RR} = list_solve_remote_type(RemoteList, ET, R, C), @@ -788,10 +788,10 @@ opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], ET, R, C) -> tuples_solve_remote([], _ET, _R, _C) -> {[], []}; -tuples_solve_remote([{Sz, Tuples}|Tail], ET, R, C) -> +tuples_solve_remote([{_Sz, Tuples}|Tail], ET, R, C) -> {RL, RR1} = list_solve_remote(Tuples, ET, R, C), {LSzTpls, RR2} = tuples_solve_remote(Tail, ET, R, C), - {[{Sz, RL}|LSzTpls], RR1 ++ RR2}. + {RL ++ LSzTpls, RR1 ++ RR2}. %%----------------------------------------------------------------------------- %% Unit type. Signals non termination. diff --git a/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src b/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src index c106261efd..ac8f2e619f 100644 --- a/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src +++ b/lib/ic/test/java_client_erl_server_SUITE_data/Makefile.src @@ -66,8 +66,11 @@ CLASS_FILES = $(JAVA_FILES:.java=.class) ERL_FILES = $(GEN_ERL_FILES) m_i_impl.erl EBINS = $(ERL_FILES:.erl=.@EMULATOR@) - +@IFEQ@ (@jinterface_classpath@,) +all: +@ELSE all: $(CLASS_FILES) $(EBINS) +@ENDIF@ $(GEN_ERL_FILES) $(GEN_HRL_FILES): java_erl_test.built_erl $(GEN_JAVA_FILES): java_erl_test.built_java diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 14ce3cbe7f..741f2abaef 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -43,8 +43,12 @@ cookies and other options that can be applied to more than one request. </p> - <p>If the scheme - https is used the ssl application needs to be started.</p> + <p>If the scheme https is used the ssl application needs to be + started. When https links needs to go through a proxy the + CONNECT method extension to HTTP-1.1 is used to establish a + tunnel and then the connection is upgraded to TLS, + however "TLS upgrade" according to RFC 2817 is not + supported.</p> <p>Also note that pipelining will only be used if the pipeline timeout is set, otherwise persistent connections without @@ -449,7 +453,8 @@ apply(Module, Function, [ReplyInfo | Args]) <type> <v>Options = [Option]</v> <v>Option = {proxy, {Proxy, NoProxy}} | - {max_sessions, MaxSessions} | + {https_proxy, {Proxy, NoProxy}} | + {max_sessions, MaxSessions} | {max_keep_alive_length, MaxKeepAlive} | {keep_alive_timeout, KeepAliveTimeout} | {max_pipeline_length, MaxPipeline} | @@ -460,25 +465,23 @@ apply(Module, Function, [ReplyInfo | Args]) {port, Port} | {socket_opts, socket_opts()} | {verbose, VerboseMode} </v> + <v>Proxy = {Hostname, Port}</v> <v>Hostname = string() </v> <d>ex: "localhost" or "foo.bar.se"</d> <v>Port = integer()</v> <d>ex: 8080 </d> - <v>socket_opts() = [socket_opt()]</v> - <d>The options are appended to the socket options used by the - client. </d> - <d>These are the default values when a new request handler - is started (for the initial connect). They are passed directly - to the underlying transport (gen_tcp or ssl) <em>without</em> - verification! </d> <v>NoProxy = [NoProxyDesc]</v> <v>NoProxyDesc = DomainDesc | HostName | IPDesc</v> <v>DomainDesc = "*.Domain"</v> <d>ex: "*.ericsson.se"</d> <v>IpDesc = string()</v> <d>ex: "134.138" or "[FEDC:BA98" (all IP-addresses starting with 134.138 or FEDC:BA98), "66.35.250.150" or "[2010:836B:4179::836B:4179]" (a complete IP-address).</d> - <v>MaxSessions = integer() </v> + + <d>proxy defaults to {undefined, []} e.i. no proxy is configured and https_proxy defaults to + the value of proxy.</d> + + <v>MaxSessions = integer() </v> <d>Default is <c>2</c>. Maximum number of persistent connections to a host.</d> <v>MaxKeepAlive = integer() </v> @@ -520,6 +523,13 @@ apply(Module, Function, [ReplyInfo | Args]) <v>Port = integer() </v> <d>Specify which local port number to use. See <seealso marker="kernel:gen_tcp#connect">gen_tcp:connect/3,4</seealso> for more info. </d> + <v>socket_opts() = [socket_opt()]</v> + <d>The options are appended to the socket options used by the + client. </d> + <d>These are the default values when a new request handler + is started (for the initial connect). They are passed directly + to the underlying transport (gen_tcp or ssl) <em>without</em> + verification! </d> <v>VerboseMode = false | verbose | debug | trace </v> <d>Default is <c>false</c>. This option is used to switch on (or off) @@ -554,7 +564,8 @@ apply(Module, Function, [ReplyInfo | Args]) <fsummary>Gets the currently used options.</fsummary> <type> <v>OptionItems = all | [option_item()]</v> - <v>option_item() = proxy | + <v>option_item() = proxy | + https_proxy max_sessions | keep_alive_timeout | max_keep_alive_length | diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index b6e7708353..ede649a5a9 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -917,6 +917,10 @@ validate_options([{proxy, Proxy} = Opt| Tail], Acc) -> validate_proxy(Proxy), validate_options(Tail, [Opt | Acc]); +validate_options([{https_proxy, Proxy} = Opt| Tail], Acc) -> + validate_https_proxy(Proxy), + validate_options(Tail, [Opt | Acc]); + validate_options([{max_sessions, Value} = Opt| Tail], Acc) -> validate_max_sessions(Value), validate_options(Tail, [Opt | Acc]); @@ -979,6 +983,14 @@ validate_proxy({{ProxyHost, ProxyPort}, NoProxy} = Proxy) validate_proxy(BadProxy) -> bad_option(proxy, BadProxy). +validate_https_proxy({{ProxyHost, ProxyPort}, NoProxy} = Proxy) + when is_list(ProxyHost) andalso + is_integer(ProxyPort) andalso + is_list(NoProxy) -> + Proxy; +validate_https_proxy(BadProxy) -> + bad_option(https_proxy, BadProxy). + validate_max_sessions(Value) when is_integer(Value) andalso (Value >= 0) -> Value; validate_max_sessions(BadValue) -> diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index 923213d34d..784a9c0019 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -29,44 +29,44 @@ %%-------------------------------------------------------------------- %% Internal Application API -export([ - start_link/4, - %% connect_and_send/2, - send/2, - cancel/3, - stream/3, - stream_next/1, - info/1 - ]). + start_link/4, + %% connect_and_send/2, + send/2, + cancel/3, + stream/3, + stream_next/1, + info/1 + ]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). + terminate/2, code_change/3]). -record(timers, - { - request_timers = [], % [ref()] - queue_timer % ref() - }). + { + request_timers = [], % [ref()] + queue_timer % ref() + }). -record(state, - { - request, % #request{} - session, % #session{} - status_line, % {Version, StatusCode, ReasonPharse} - headers, % #http_response_h{} - body, % binary() - mfa, % {Module, Function, Args} - pipeline = queue:new(), % queue() - keep_alive = queue:new(), % queue() - status, % undefined | new | pipeline | keep_alive | close | ssl_tunnel - canceled = [], % [RequestId] - max_header_size = nolimit, % nolimit | integer() - max_body_size = nolimit, % nolimit | integer() - options, % #options{} - timers = #timers{}, % #timers{} - profile_name, % atom() - id of httpc_manager process. - once % send | undefined - }). + { + request, % #request{} + session, % #session{} + status_line, % {Version, StatusCode, ReasonPharse} + headers, % #http_response_h{} + body, % binary() + mfa, % {Module, Function, Args} + pipeline = queue:new(), % queue() + keep_alive = queue:new(), % queue() + status, % undefined | new | pipeline | keep_alive | close | {ssl_tunnel, Request} + canceled = [], % [RequestId] + max_header_size = nolimit, % nolimit | integer() + max_body_size = nolimit, % nolimit | integer() + options, % #options{} + timers = #timers{}, % #timers{} + profile_name, % atom() - id of httpc_manager process. + once % send | undefined + }). %%==================================================================== @@ -75,8 +75,8 @@ %%-------------------------------------------------------------------- %% Function: start_link(Request, Options, ProfileName) -> {ok, Pid} %% -%% Request = #request{} -%% Options = #options{} +%% Request = #request{} +%% Options = #options{} %% ProfileName = atom() - id of httpc manager process %% %% Description: Starts a http-request handler process. Intended to be @@ -96,11 +96,11 @@ start_link(Parent, Request, Options, ProfileName) -> {ok, proc_lib:start_link(?MODULE, init, [[Parent, Request, Options, - ProfileName]])}. + ProfileName]])}. %%-------------------------------------------------------------------- %% Function: send(Request, Pid) -> ok -%% Request = #request{} +%% Request = #request{} %% Pid = pid() - the pid of the http-request handler process. %% %% Description: Uses this handlers session to send a request. Intended @@ -112,7 +112,7 @@ send(Request, Pid) -> %%-------------------------------------------------------------------- %% Function: cancel(RequestId, Pid) -> ok -%% RequestId = ref() +%% RequestId = ref() %% Pid = pid() - the pid of the http-request handler process. %% %% Description: Cancels a request. Intended to be called by the httpc @@ -142,12 +142,16 @@ stream_next(Pid) -> %% Used for debugging and testing %%-------------------------------------------------------------------- info(Pid) -> - call(info, Pid). - + try + call(info, Pid) + catch + _:_ -> + [] + end. %%-------------------------------------------------------------------- %% Function: stream(BodyPart, Request, Code) -> _ -%% BodyPart = binary() +%% BodyPart = binary() %% Request = #request{} %% Code = integer() %% @@ -167,7 +171,7 @@ stream(BodyPart, #request{stream = Self} = Request, Code) ((Self =:= self) orelse (Self =:= {self, once})) -> ?hcrt("stream - self", [{stream, Self}, {code, Code}]), httpc_response:send(Request#request.from, - {Request#request.id, stream, BodyPart}), + {Request#request.id, stream, BodyPart}), {<<>>, Request}; %% Stream to file @@ -177,11 +181,11 @@ stream(BodyPart, #request{stream = Filename} = Request, Code) when ((Code =:= 200) orelse (Code =:= 206)) andalso is_list(Filename) -> ?hcrt("stream - filename", [{stream, Filename}, {code, Code}]), case file:open(Filename, [write, raw, append, delayed_write]) of - {ok, Fd} -> - ?hcrt("stream - file open ok", [{fd, Fd}]), - stream(BodyPart, Request#request{stream = Fd}, 200); - {error, Reason} -> - exit({stream_to_file_failed, Reason}) + {ok, Fd} -> + ?hcrt("stream - file open ok", [{fd, Fd}]), + stream(BodyPart, Request#request{stream = Fd}, 200); + {error, Reason} -> + exit({stream_to_file_failed, Reason}) end; %% Stream to file @@ -189,10 +193,10 @@ stream(BodyPart, #request{stream = Fd} = Request, Code) when ((Code =:= 200) orelse (Code =:= 206)) -> ?hcrt("stream to file", [{stream, Fd}, {code, Code}]), case file:write(Fd, BodyPart) of - ok -> - {<<>>, Request}; - {error, Reason} -> - exit({stream_to_file_failed, Reason}) + ok -> + {<<>>, Request}; + {error, Reason} -> + exit({stream_to_file_failed, Reason}) end; stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed @@ -208,7 +212,7 @@ stream(BodyPart, Request,_) -> % only 200 and 206 responses can be streamed %% Function: init([Options, ProfileName]) -> {ok, State} | %% {ok, State, Timeout} | ignore | {stop, Reason} %% -%% Options = #options{} +%% Options = #options{} %% ProfileName = atom() - id of httpc manager process %% %% Description: Initiates the httpc_handler process @@ -224,20 +228,19 @@ init([Parent, Request, Options, ProfileName]) -> %% Do not let initial tcp-connection block the manager-process proc_lib:init_ack(Parent, self()), handle_verbose(Options#options.verbose), - Address = handle_proxy(Request#request.address, Options#options.proxy), + ProxyOptions = handle_proxy_options(Request#request.scheme, Options), + Address = handle_proxy(Request#request.address, ProxyOptions), {ok, State} = - case {Address /= Request#request.address, Request#request.scheme} of - {true, https} -> - Error = https_through_proxy_is_not_currently_supported, - self() ! {init_error, - Error, httpc_response:error(Request, Error)}, - {ok, #state{request = Request, options = Options, - status = ssl_tunnel}}; - {_, _} -> - connect_and_send_first_request(Address, Request, - #state{options = Options, - profile_name = ProfileName}) - end, + case {Address /= Request#request.address, Request#request.scheme} of + {true, https} -> + connect_and_send_upgrade_request(Address, Request, + #state{options = Options, + profile_name = ProfileName}); + {_, _} -> + connect_and_send_first_request(Address, Request, + #state{options = Options, + profile_name = ProfileName}) + end, gen_server:enter_loop(?MODULE, [], State). %%-------------------------------------------------------------------- @@ -250,139 +253,139 @@ init([Parent, Request, Options, ProfileName]) -> %% Description: Handling call messages %%-------------------------------------------------------------------- handle_call(#request{address = Addr} = Request, _, - #state{status = Status, - session = #session{type = pipeline} = Session, - timers = Timers, - options = #options{proxy = Proxy} = _Options, - profile_name = ProfileName} = State) + #state{status = Status, + session = #session{type = pipeline} = Session, + timers = Timers, + options = #options{proxy = Proxy} = _Options, + profile_name = ProfileName} = State) when Status =/= undefined -> ?hcrv("new request on a pipeline session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}, - {timers, Timers}]), + [{request, Request}, + {profile, ProfileName}, + {status, Status}, + {timers, Timers}]), Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, Request) of ok -> - ?hcrd("request sent", []), + ?hcrd("request sent", []), - %% Activate the request time out for the new request - NewState = - activate_request_timeout(State#state{request = Request}), + %% Activate the request time out for the new request + NewState = + activate_request_timeout(State#state{request = Request}), - ClientClose = - httpc_request:is_client_closing(Request#request.headers), + ClientClose = + httpc_request:is_client_closing(Request#request.headers), case State#state.request of #request{} -> %% Old request not yet finished - ?hcrd("old request still not finished", []), - %% Make sure to use the new value of timers in state - NewTimers = NewState#state.timers, + ?hcrd("old request still not finished", []), + %% Make sure to use the new value of timers in state + NewTimers = NewState#state.timers, NewPipeline = queue:in(Request, State#state.pipeline), - NewSession = - Session#session{queue_length = - %% Queue + current - queue:len(NewPipeline) + 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), + NewSession = + Session#session{queue_length = + %% Queue + current + queue:len(NewPipeline) + 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + ?hcrd("session updated", []), {reply, ok, State#state{pipeline = NewPipeline, - session = NewSession, - timers = NewTimers}}; - undefined -> - %% Note: tcp-message receiving has already been - %% activated by handle_pipeline/2. - ?hcrd("no current request", []), - cancel_timer(Timers#timers.queue_timer, - timeout_queue), - NewSession = - Session#session{queue_length = 1, - client_close = ClientClose}, - httpc_manager:insert_session(NewSession, ProfileName), - Relaxed = - (Request#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, - NewTimers = Timers#timers{queue_timer = undefined}, - ?hcrd("session created", []), - {reply, ok, NewState#state{request = Request, - session = NewSession, - mfa = MFA, - timers = NewTimers}} - end; - {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {reply, {pipeline_failed, Reason}, State} + session = NewSession, + timers = NewTimers}}; + undefined -> + %% Note: tcp-message receiving has already been + %% activated by handle_pipeline/2. + ?hcrd("no current request", []), + cancel_timer(Timers#timers.queue_timer, + timeout_queue), + NewSession = + Session#session{queue_length = 1, + client_close = ClientClose}, + httpc_manager:insert_session(NewSession, ProfileName), + Relaxed = + (Request#request.settings)#http_options.relaxed, + MFA = {httpc_response, parse, + [State#state.max_header_size, Relaxed]}, + NewTimers = Timers#timers{queue_timer = undefined}, + ?hcrd("session created", []), + {reply, ok, NewState#state{request = Request, + session = NewSession, + mfa = MFA, + timers = NewTimers}} + end; + {error, Reason} -> + ?hcri("failed sending request", [{reason, Reason}]), + {reply, {pipeline_failed, Reason}, State} end; handle_call(#request{address = Addr} = Request, _, - #state{status = Status, - session = #session{type = keep_alive} = Session, - timers = Timers, - options = #options{proxy = Proxy} = _Options, - profile_name = ProfileName} = State) + #state{status = Status, + session = #session{type = keep_alive} = Session, + timers = Timers, + options = #options{proxy = Proxy} = _Options, + profile_name = ProfileName} = State) when Status =/= undefined -> ?hcrv("new request on a keep-alive session", - [{request, Request}, - {profile, ProfileName}, - {status, Status}]), + [{request, Request}, + {profile, ProfileName}, + {status, Status}]), Address = handle_proxy(Addr, Proxy), case httpc_request:send(Address, Session, Request) of - ok -> + ok -> - ?hcrd("request sent", []), + ?hcrd("request sent", []), - %% Activate the request time out for the new request - NewState = - activate_request_timeout(State#state{request = Request}), + %% Activate the request time out for the new request + NewState = + activate_request_timeout(State#state{request = Request}), - ClientClose = - httpc_request:is_client_closing(Request#request.headers), + ClientClose = + httpc_request:is_client_closing(Request#request.headers), - case State#state.request of - #request{} -> %% Old request not yet finished - %% Make sure to use the new value of timers in state - ?hcrd("old request still not finished", []), - NewTimers = NewState#state.timers, + case State#state.request of + #request{} -> %% Old request not yet finished + %% Make sure to use the new value of timers in state + ?hcrd("old request still not finished", []), + NewTimers = NewState#state.timers, NewKeepAlive = queue:in(Request, State#state.keep_alive), - NewSession = - Session#session{queue_length = - %% Queue + current - queue:len(NewKeepAlive) + 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - ?hcrd("session updated", []), + NewSession = + Session#session{queue_length = + %% Queue + current + queue:len(NewKeepAlive) + 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + ?hcrd("session updated", []), {reply, ok, State#state{keep_alive = NewKeepAlive, - session = NewSession, - timers = NewTimers}}; - undefined -> - %% Note: tcp-message reciving has already been - %% activated by handle_pipeline/2. - ?hcrd("no current request", []), - cancel_timer(Timers#timers.queue_timer, - timeout_queue), - NewSession = - Session#session{queue_length = 1, - client_close = ClientClose}, - insert_session(NewSession, ProfileName), - Relaxed = - (Request#request.settings)#http_options.relaxed, - MFA = {httpc_response, parse, - [State#state.max_header_size, Relaxed]}, - {reply, ok, NewState#state{request = Request, - session = NewSession, - mfa = MFA}} - end; + session = NewSession, + timers = NewTimers}}; + undefined -> + %% Note: tcp-message reciving has already been + %% activated by handle_pipeline/2. + ?hcrd("no current request", []), + cancel_timer(Timers#timers.queue_timer, + timeout_queue), + NewSession = + Session#session{queue_length = 1, + client_close = ClientClose}, + insert_session(NewSession, ProfileName), + Relaxed = + (Request#request.settings)#http_options.relaxed, + MFA = {httpc_response, parse, + [State#state.max_header_size, Relaxed]}, + {reply, ok, NewState#state{request = Request, + session = NewSession, + mfa = MFA}} + end; - {error, Reason} -> - ?hcri("failed sending request", [{reason, Reason}]), - {reply, {request_failed, Reason}, State} + {error, Reason} -> + ?hcri("failed sending request", [{reason, Reason}]), + {reply, {request_failed, Reason}, State} end; @@ -411,25 +414,25 @@ handle_call(info, _, State) -> %% request as if it was never issued as in this case the request will %% not have been sent. handle_cast({cancel, RequestId, From}, - #state{request = #request{id = RequestId} = Request, - profile_name = ProfileName, - canceled = Canceled} = State) -> + #state{request = #request{id = RequestId} = Request, + profile_name = ProfileName, + canceled = Canceled} = State) -> ?hcrv("cancel current request", [{request_id, RequestId}, - {profile, ProfileName}, - {canceled, Canceled}]), + {profile, ProfileName}, + {canceled, Canceled}]), httpc_manager:request_canceled(RequestId, ProfileName, From), ?hcrv("canceled", []), {stop, normal, State#state{canceled = [RequestId | Canceled], - request = Request#request{from = answer_sent}}}; + request = Request#request{from = answer_sent}}}; handle_cast({cancel, RequestId, From}, - #state{profile_name = ProfileName, - request = #request{id = CurrId}, - canceled = Canceled} = State) -> + #state{profile_name = ProfileName, + request = #request{id = CurrId}, + canceled = Canceled} = State) -> ?hcrv("cancel", [{request_id, RequestId}, - {curr_req_id, CurrId}, - {profile, ProfileName}, - {canceled, Canceled}]), + {curr_req_id, CurrId}, + {profile, ProfileName}, + {canceled, Canceled}]), httpc_manager:request_canceled(RequestId, ProfileName, From), ?hcrv("canceled", []), {noreply, State#state{canceled = [RequestId | Canceled]}}; @@ -446,94 +449,94 @@ handle_cast(stream_next, #state{session = Session} = State) -> %% Description: Handling all non call/cast messages %%-------------------------------------------------------------------- handle_info({Proto, _Socket, Data}, - #state{mfa = {Module, Function, Args}, - request = #request{method = Method, - stream = Stream} = Request, - session = Session, - status_line = StatusLine} = State) + #state{mfa = {Module, Function, Args}, + request = #request{method = Method, + stream = Stream} = Request, + session = Session, + status_line = StatusLine} = State) when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> ?hcri("received data", [{proto, Proto}, - {module, Module}, - {function, Function}, - {method, Method}, - {stream, Stream}, - {session, Session}, - {status_line, StatusLine}]), + {module, Module}, + {function, Function}, + {method, Method}, + {stream, Stream}, + {session, Session}, + {status_line, StatusLine}]), FinalResult = - try Module:Function([Data | Args]) of - {ok, Result} -> - ?hcrd("data processed - ok", []), - handle_http_msg(Result, State); - {_, whole_body, _} when Method =:= head -> - ?hcrd("data processed - whole body", []), - handle_response(State#state{body = <<>>}); - {Module, whole_body, [Body, Length]} -> - ?hcrd("data processed - whole body", [{length, Length}]), - {_, Code, _} = StatusLine, - {NewBody, NewRequest} = stream(Body, Request, Code), - %% When we stream we will not keep the already - %% streamed data, that would be a waste of memory. - NewLength = - case Stream of - none -> - Length; - _ -> - Length - size(Body) - end, - - NewState = next_body_chunk(State), - NewMFA = {Module, whole_body, [NewBody, NewLength]}, - {noreply, NewState#state{mfa = NewMFA, - request = NewRequest}}; - NewMFA -> - ?hcrd("data processed - new mfa", []), - activate_once(Session), - {noreply, State#state{mfa = NewMFA}} - catch - exit:_Exit -> - ?hcrd("data processing exit", [{exit, _Exit}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState}; - error:_Error -> - ?hcrd("data processing error", [{error, _Error}]), - ClientReason = {could_not_parse_as_http, Data}, - ClientErrMsg = httpc_response:error(Request, ClientReason), - NewState = answer_request(Request, ClientErrMsg, State), - {stop, normal, NewState} - - end, + try Module:Function([Data | Args]) of + {ok, Result} -> + ?hcrd("data processed - ok", []), + handle_http_msg(Result, State); + {_, whole_body, _} when Method =:= head -> + ?hcrd("data processed - whole body", []), + handle_response(State#state{body = <<>>}); + {Module, whole_body, [Body, Length]} -> + ?hcrd("data processed - whole body", [{length, Length}]), + {_, Code, _} = StatusLine, + {NewBody, NewRequest} = stream(Body, Request, Code), + %% When we stream we will not keep the already + %% streamed data, that would be a waste of memory. + NewLength = + case Stream of + none -> + Length; + _ -> + Length - size(Body) + end, + + NewState = next_body_chunk(State), + NewMFA = {Module, whole_body, [NewBody, NewLength]}, + {noreply, NewState#state{mfa = NewMFA, + request = NewRequest}}; + NewMFA -> + ?hcrd("data processed - new mfa", []), + activate_once(Session), + {noreply, State#state{mfa = NewMFA}} + catch + exit:_Exit -> + ?hcrd("data processing exit", [{exit, _Exit}]), + ClientReason = {could_not_parse_as_http, Data}, + ClientErrMsg = httpc_response:error(Request, ClientReason), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState}; + error:_Error -> + ?hcrd("data processing error", [{error, _Error}]), + ClientReason = {could_not_parse_as_http, Data}, + ClientErrMsg = httpc_response:error(Request, ClientReason), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState} + + end, ?hcri("data processed", [{final_result, FinalResult}]), FinalResult; handle_info({Proto, Socket, Data}, - #state{mfa = MFA, - request = Request, - session = Session, - status = Status, - status_line = StatusLine, - profile_name = Profile} = State) + #state{mfa = MFA, + request = Request, + session = Session, + status = Status, + status_line = StatusLine, + profile_name = Profile} = State) when (Proto =:= tcp) orelse (Proto =:= ssl) orelse (Proto =:= httpc_handler) -> error_logger:warning_msg("Received unexpected ~p data on ~p" - "~n Data: ~p" - "~n MFA: ~p" - "~n Request: ~p" - "~n Session: ~p" - "~n Status: ~p" - "~n StatusLine: ~p" - "~n Profile: ~p" - "~n", - [Proto, Socket, Data, MFA, - Request, Session, Status, StatusLine, Profile]), + "~n Data: ~p" + "~n MFA: ~p" + "~n Request: ~p" + "~n Session: ~p" + "~n Status: ~p" + "~n StatusLine: ~p" + "~n Profile: ~p" + "~n", + [Proto, Socket, Data, MFA, + Request, Session, Status, StatusLine, Profile]), {noreply, State}; @@ -572,45 +575,45 @@ handle_info({ssl_error, _, _} = Reason, State) -> %% Internally, to a request handling process, a request timeout is %% seen as a canceled request. handle_info({timeout, RequestId}, - #state{request = #request{id = RequestId} = Request, - canceled = Canceled, - profile_name = ProfileName} = State) -> + #state{request = #request{id = RequestId} = Request, + canceled = Canceled, + profile_name = ProfileName} = State) -> ?hcri("timeout of current request", [{id, RequestId}]), httpc_response:send(Request#request.from, - httpc_response:error(Request, timeout)), + httpc_response:error(Request, timeout)), httpc_manager:request_done(RequestId, ProfileName), ?hcrv("response (timeout) sent - now terminate", []), {stop, normal, State#state{request = Request#request{from = answer_sent}, - canceled = [RequestId | Canceled]}}; + canceled = [RequestId | Canceled]}}; handle_info({timeout, RequestId}, - #state{canceled = Canceled, - profile_name = ProfileName} = State) -> + #state{canceled = Canceled, + profile_name = ProfileName} = State) -> ?hcri("timeout", [{id, RequestId}]), Filter = - fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> - ?hcrv("found request", [{id, Id}, {from, From}]), - %% Notify the owner - httpc_response:send(From, - httpc_response:error(Request, timeout)), - httpc_manager:request_done(RequestId, ProfileName), - ?hcrv("response (timeout) sent", []), - [Request#request{from = answer_sent}]; - (_) -> - true - end, + fun(#request{id = Id, from = From} = Request) when Id =:= RequestId -> + ?hcrv("found request", [{id, Id}, {from, From}]), + %% Notify the owner + httpc_response:send(From, + httpc_response:error(Request, timeout)), + httpc_manager:request_done(RequestId, ProfileName), + ?hcrv("response (timeout) sent", []), + [Request#request{from = answer_sent}]; + (_) -> + true + end, case State#state.status of - pipeline -> - ?hcrd("pipeline", []), - Pipeline = queue:filter(Filter, State#state.pipeline), - {noreply, State#state{canceled = [RequestId | Canceled], - pipeline = Pipeline}}; - keep_alive -> - ?hcrd("keep_alive", []), - KeepAlive = queue:filter(Filter, State#state.keep_alive), - {noreply, State#state{canceled = [RequestId | Canceled], - keep_alive = KeepAlive}} + pipeline -> + ?hcrd("pipeline", []), + Pipeline = queue:filter(Filter, State#state.pipeline), + {noreply, State#state{canceled = [RequestId | Canceled], + pipeline = Pipeline}}; + keep_alive -> + ?hcrd("keep_alive", []), + KeepAlive = queue:filter(Filter, State#state.keep_alive), + {noreply, State#state{canceled = [RequestId | Canceled], + keep_alive = KeepAlive}} end; handle_info(timeout_queue, State = #state{request = undefined}) -> @@ -619,11 +622,11 @@ handle_info(timeout_queue, State = #state{request = undefined}) -> %% Timing was such as the pipeline_timout was not canceled! handle_info(timeout_queue, #state{timers = Timers} = State) -> {noreply, State#state{timers = - Timers#timers{queue_timer = undefined}}}; + Timers#timers{queue_timer = undefined}}}; %% Setting up the connection to the server somehow failed. handle_info({init_error, Tag, ClientErrMsg}, - State = #state{request = Request}) -> + State = #state{request = Request}) -> ?hcrv("init error", [{tag, Tag}, {client_error, ClientErrMsg}]), NewState = answer_request(Request, ClientErrMsg, State), {stop, normal, NewState}; @@ -647,21 +650,21 @@ handle_info({'EXIT', _, _}, State) -> %% Init error there is no socket to be closed. terminate(normal, - #state{request = Request, - session = {send_failed, AReason} = Reason} = State) -> + #state{request = Request, + session = {send_failed, AReason} = Reason} = State) -> ?hcrd("terminate", [{send_reason, AReason}, {request, Request}]), maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), + httpc_response:error(Request, Reason), + State), ok; terminate(normal, - #state{request = Request, - session = {connect_failed, AReason} = Reason} = State) -> + #state{request = Request, + session = {connect_failed, AReason} = Reason} = State) -> ?hcrd("terminate", [{connect_reason, AReason}, {request, Request}]), maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), + httpc_response:error(Request, Reason), + State), ok; terminate(normal, #state{session = undefined}) -> @@ -670,21 +673,21 @@ terminate(normal, #state{session = undefined}) -> %% Init error sending, no session information has been setup but %% there is a socket that needs closing. terminate(normal, - #state{session = #session{id = undefined} = Session}) -> + #state{session = #session{id = undefined} = Session}) -> close_socket(Session); %% Socket closed remotely terminate(normal, - #state{session = #session{socket = {remote_close, Socket}, - socket_type = SocketType, - id = Id}, - profile_name = ProfileName, - request = Request, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> + #state{session = #session{socket = {remote_close, Socket}, + socket_type = SocketType, + id = Id}, + profile_name = ProfileName, + request = Request, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> ?hcrt("terminate(normal) - remote close", - [{id, Id}, {profile, ProfileName}]), + [{id, Id}, {profile, ProfileName}]), %% Clobber session (catch httpc_manager:delete_session(Id, ProfileName)), @@ -702,15 +705,15 @@ terminate(normal, http_transport:close(SocketType, Socket); terminate(Reason, #state{session = #session{id = Id, - socket = Socket, - socket_type = SocketType}, - request = undefined, - profile_name = ProfileName, - timers = Timers, - pipeline = Pipeline, - keep_alive = KeepAlive} = State) -> + socket = Socket, + socket_type = SocketType}, + request = undefined, + profile_name = ProfileName, + timers = Timers, + pipeline = Pipeline, + keep_alive = KeepAlive} = State) -> ?hcrt("terminate", - [{id, Id}, {profile, ProfileName}, {reason, Reason}]), + [{id, Id}, {profile, ProfileName}, {reason, Reason}]), %% Clobber session (catch httpc_manager:delete_session(Id, ProfileName)), @@ -728,16 +731,16 @@ terminate(Reason, #state{request = undefined}) -> terminate(Reason, #state{request = Request} = State) -> ?hcrd("terminate", [{reason, Reason}, {request, Request}]), NewState = maybe_send_answer(Request, - httpc_response:error(Request, Reason), - State), + httpc_response:error(Request, Reason), + State), terminate(Reason, NewState#state{request = undefined}). maybe_retry_queue(Q, State) -> case queue:is_empty(Q) of - false -> - retry_pipeline(queue:to_list(Q), State); - true -> - ok + false -> + retry_pipeline(queue:to_list(Q), State); + true -> + ok end. maybe_send_answer(#request{from = answer_sent}, _Reason, State) -> @@ -761,44 +764,44 @@ deliver_answer(Request) -> %%-------------------------------------------------------------------- code_change(_, - #state{session = OldSession, - profile_name = ProfileName} = State, - upgrade_from_pre_5_8_1) -> + #state{session = OldSession, + profile_name = ProfileName} = State, + upgrade_from_pre_5_8_1) -> case OldSession of - {session, - Id, ClientClose, Scheme, Socket, SocketType, QueueLen, Type} -> - NewSession = #session{id = Id, - client_close = ClientClose, - scheme = Scheme, - socket = Socket, - socket_type = SocketType, - queue_length = QueueLen, - type = Type}, - insert_session(NewSession, ProfileName), - {ok, State#state{session = NewSession}}; - _ -> - {ok, State} + {session, + Id, ClientClose, Scheme, Socket, SocketType, QueueLen, Type} -> + NewSession = #session{id = Id, + client_close = ClientClose, + scheme = Scheme, + socket = Socket, + socket_type = SocketType, + queue_length = QueueLen, + type = Type}, + insert_session(NewSession, ProfileName), + {ok, State#state{session = NewSession}}; + _ -> + {ok, State} end; code_change(_, - #state{session = OldSession, - profile_name = ProfileName} = State, - downgrade_to_pre_5_8_1) -> + #state{session = OldSession, + profile_name = ProfileName} = State, + downgrade_to_pre_5_8_1) -> case OldSession of - #session{id = Id, - client_close = ClientClose, - scheme = Scheme, - socket = Socket, - socket_type = SocketType, - queue_length = QueueLen, - type = Type} -> - NewSession = {session, - Id, ClientClose, Scheme, Socket, SocketType, - QueueLen, Type}, - insert_session(NewSession, ProfileName), - {ok, State#state{session = NewSession}}; - _ -> - {ok, State} + #session{id = Id, + client_close = ClientClose, + scheme = Scheme, + socket = Socket, + socket_type = SocketType, + queue_length = QueueLen, + type = Type} -> + NewSession = {session, + Id, ClientClose, Scheme, Socket, SocketType, + QueueLen, Type}, + insert_session(NewSession, ProfileName), + {ok, State#state{session = NewSession}}; + _ -> + {ok, State} end; code_change(_, State, _) -> @@ -806,22 +809,22 @@ code_change(_, State, _) -> %% new_http_options({http_options, TimeOut, AutoRedirect, SslOpts, -%% Auth, Relaxed}) -> +%% Auth, Relaxed}) -> %% {http_options, "HTTP/1.1", TimeOut, AutoRedirect, SslOpts, %% Auth, Relaxed}. %% old_http_options({http_options, _, TimeOut, AutoRedirect, -%% SslOpts, Auth, Relaxed}) -> +%% SslOpts, Auth, Relaxed}) -> %% {http_options, TimeOut, AutoRedirect, SslOpts, Auth, Relaxed}. %% new_queue(Queue, Fun) -> %% List = queue:to_list(Queue), %% NewList = -%% lists:map(fun(Request) -> -%% Settings = -%% Fun(Request#request.settings), -%% Request#request{settings = Settings} -%% end, List), +%% lists:map(fun(Request) -> +%% Settings = +%% Fun(Request#request.settings), +%% Request#request{settings = Settings} +%% end, List), %% queue:from_list(NewList). @@ -830,97 +833,121 @@ code_change(_, State, _) -> %%%-------------------------------------------------------------------- connect(SocketType, ToAddress, - #options{ipfamily = IpFamily, - ip = FromAddress, - port = FromPort, - socket_opts = Opts0}, Timeout) -> + #options{ipfamily = IpFamily, + ip = FromAddress, + port = FromPort, + socket_opts = Opts0}, Timeout) -> Opts1 = - case FromPort of - default -> - Opts0; - _ -> - [{port, FromPort} | Opts0] - end, + case FromPort of + default -> + Opts0; + _ -> + [{port, FromPort} | Opts0] + end, Opts2 = - case FromAddress of - default -> - Opts1; - _ -> - [{ip, FromAddress} | Opts1] - end, + case FromAddress of + default -> + Opts1; + _ -> + [{ip, FromAddress} | Opts1] + end, case IpFamily of - inet6fb4 -> - Opts3 = [inet6 | Opts2], - case http_transport:connect(SocketType, - ToAddress, Opts3, Timeout) of - {error, Reason6} -> - Opts4 = [inet | Opts2], - case http_transport:connect(SocketType, - ToAddress, Opts4, Timeout) of - {error, Reason4} -> - {error, {failed_connect, - [{to_address, ToAddress}, - {inet6, Opts3, Reason6}, - {inet, Opts4, Reason4}]}}; - OK -> - OK - end; - OK -> - OK - end; - _ -> - Opts3 = [IpFamily | Opts2], - case http_transport:connect(SocketType, ToAddress, Opts3, Timeout) of - {error, Reason} -> - {error, {failed_connect, [{to_address, ToAddress}, - {IpFamily, Opts3, Reason}]}}; - Else -> - Else - end + inet6fb4 -> + Opts3 = [inet6 | Opts2], + case http_transport:connect(SocketType, + ToAddress, Opts3, Timeout) of + {error, Reason6} -> + Opts4 = [inet | Opts2], + case http_transport:connect(SocketType, + ToAddress, Opts4, Timeout) of + {error, Reason4} -> + {error, {failed_connect, + [{to_address, ToAddress}, + {inet6, Opts3, Reason6}, + {inet, Opts4, Reason4}]}}; + OK -> + OK + end; + OK -> + OK + end; + _ -> + Opts3 = [IpFamily | Opts2], + case http_transport:connect(SocketType, ToAddress, Opts3, Timeout) of + {error, Reason} -> + {error, {failed_connect, [{to_address, ToAddress}, + {IpFamily, Opts3, Reason}]}}; + Else -> + Else + end end. connect_and_send_first_request(Address, Request, #state{options = Options} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, ?hcri("connect", - [{address, Address}, {request, Request}, {options, Options}]), + [{address, Address}, {request, Request}, {options, Options}]), case connect(SocketType, Address, Options, ConnTimeout) of - {ok, Socket} -> - ClientClose = - httpc_request:is_client_closing( - Request#request.headers), + {ok, Socket} -> + ClientClose = + httpc_request:is_client_closing( + Request#request.headers), + SessionType = httpc_manager:session_type(Options), + SocketType = socket_type(Request), + Session = #session{id = {Request#request.address, self()}, + scheme = Request#request.scheme, + socket = Socket, + socket_type = SocketType, + client_close = ClientClose, + type = SessionType}, + ?hcri("connected - now send first request", [{socket, Socket}]), + + case httpc_request:send(Address, Session, Request) of + ok -> + ?hcri("first request sent", []), + TmpState = State#state{request = Request, + session = Session, + mfa = init_mfa(Request, State), + status_line = + init_status_line(Request), + headers = undefined, + body = undefined, + status = new}, + http_transport:setopts(SocketType, + Socket, [{active, once}]), + NewState = activate_request_timeout(TmpState), + {ok, NewState}; + {error, Reason} -> + self() ! {init_error, error_sending, + httpc_response:error(Request, Reason)}, + {ok, State#state{request = Request, + session = + #session{socket = Socket}}} + end; + {error, Reason} -> + self() ! {init_error, error_connecting, + httpc_response:error(Request, Reason)}, + {ok, State#state{request = Request}} + end. + +connect_and_send_upgrade_request(Address, Request, #state{options = Options} = State) -> + ConnTimeout = (Request#request.settings)#http_options.connect_timeout, + SocketType = ip_comm, + case connect(SocketType, Address, Options, ConnTimeout) of + {ok, Socket} -> SessionType = httpc_manager:session_type(Options), - SocketType = socket_type(Request), - Session = #session{id = {Request#request.address, self()}, - scheme = Request#request.scheme, - socket = Socket, + Session = #session{socket = Socket, socket_type = SocketType, - client_close = ClientClose, + id = {Request#request.address, self()}, + scheme = http, + client_close = false, type = SessionType}, - ?hcri("connected - now send first request", [{socket, Socket}]), - - case httpc_request:send(Address, Session, Request) of - ok -> - ?hcri("first request sent", []), - TmpState = State#state{request = Request, - session = Session, - mfa = init_mfa(Request, State), - status_line = - init_status_line(Request), - headers = undefined, - body = undefined, - status = new}, - http_transport:setopts(SocketType, - Socket, [{active, once}]), - NewState = activate_request_timeout(TmpState), - {ok, NewState}; - {error, Reason} -> - self() ! {init_error, error_sending, - httpc_response:error(Request, Reason)}, - {ok, State#state{request = Request, - session = - #session{socket = Socket}}} - end; + ErrorHandler = + fun(ERequest, EState, EReason) -> + self() ! {init_error, error_sending, + httpc_response:error(ERequest, EReason)}, + {ok, EState#state{request = ERequest}} end, + tls_tunnel(Address, Request, State#state{session = Session}, ErrorHandler); {error, Reason} -> self() ! {init_error, error_connecting, httpc_response:error(Request, Reason)}, @@ -1024,15 +1051,25 @@ handle_http_msg(Body, #state{status_line = {_,Code, _}} = State) -> {NewBody, NewRequest} = stream(Body, State#state.request, Code), handle_response(State#state{body = NewBody, request = NewRequest}). -handle_http_body(<<>>, State = #state{status_line = {_,304, _}}) -> +handle_http_body(_, #state{status = {ssl_tunnel, _}, + status_line = {_,200, _}} = State) -> + tls_upgrade(State); + +handle_http_body(_, #state{status = {ssl_tunnel, Request}, + status_line = StatusLine} = State) -> + ClientErrMsg = httpc_response:error(Request,{could_no_establish_ssh_tunnel, StatusLine}), + NewState = answer_request(Request, ClientErrMsg, State), + {stop, normal, NewState}; + +handle_http_body(<<>>, #state{status_line = {_,304, _}} = State) -> ?hcrt("handle_http_body - 304", []), handle_response(State#state{body = <<>>}); -handle_http_body(<<>>, State = #state{status_line = {_,204, _}}) -> +handle_http_body(<<>>, #state{status_line = {_,204, _}} = State) -> ?hcrt("handle_http_body - 204", []), handle_response(State#state{body = <<>>}); -handle_http_body(<<>>, State = #state{request = #request{method = head}}) -> +handle_http_body(<<>>, #state{request = #request{method = head}} = State) -> ?hcrt("handle_http_body - head", []), handle_response(State#state{body = <<>>}); @@ -1119,7 +1156,7 @@ handle_response(#state{request = Request, {session, Session}, {status_line, StatusLine}]), - handle_cookies(Headers, Request, Options, ProfileName), + handle_cookies(Headers, Request, Options, httpc_manager), %% FOO profile_name case httpc_response:result({StatusLine, Headers, Body}, Request) of %% 100-continue continue -> @@ -1503,6 +1540,12 @@ retry_pipeline([Request | PipeLine], end, retry_pipeline(PipeLine, NewState). +handle_proxy_options(https, #options{https_proxy = {HttpsProxy, _} = HttpsProxyOpt}) when + HttpsProxy =/= undefined -> + HttpsProxyOpt; +handle_proxy_options(_, #options{proxy = Proxy}) -> + Proxy. + %%% Check to see if the given {Host,Port} tuple is in the NoProxyList %%% Returns an eventually updated {Host,Port} tuple, with the proxy address handle_proxy(HostPort = {Host, _Port}, {Proxy, NoProxy}) -> @@ -1696,6 +1739,96 @@ send_raw(SocketType, Socket, ProcessBody, Acc) -> end end. +tls_tunnel(Address, Request, #state{session = #session{socket = Socket, + socket_type = SocketType} = Session} = State, + ErrorHandler) -> + UpgradeRequest = tls_tunnel_request(Request), + case httpc_request:send(Address, Session, UpgradeRequest) of + ok -> + TmpState = State#state{request = UpgradeRequest, + %% session = Session, + mfa = init_mfa(UpgradeRequest, State), + status_line = + init_status_line(UpgradeRequest), + headers = undefined, + body = undefined}, + http_transport:setopts(SocketType, + Socket, [{active, once}]), + NewState = activate_request_timeout(TmpState), + {ok, NewState#state{status = {ssl_tunnel, Request}}}; + {error, Reason} -> + ErrorHandler(Request, State, Reason) + end. + +tls_tunnel_request(#request{headers = Headers, + settings = Options, + address = {Host, Port}= Adress, + ipv6_host_with_brackets = IPV6}) -> + + URI = Host ++":" ++ integer_to_list(Port), + + #request{ + id = make_ref(), + from = self(), + scheme = http, %% Use tcp-first and then upgrade! + address = Adress, + path = URI, + pquery = "", + method = connect, + headers = #http_request_h{host = host_header(Headers, URI), + te = "", + pragma = "no-cache", + other = [{"Proxy-Connection", " Keep-Alive"}]}, + settings = Options, + abs_uri = URI, + stream = false, + userinfo = "", + headers_as_is = [], + started = http_util:timestamp(), + ipv6_host_with_brackets = IPV6 + }. + +host_header(#http_request_h{host = Host}, _) -> + Host; + +%% Handles header_as_is +host_header(_, URI) -> + {ok, {_, _, Host, _, _, _}} = http_uri:parse(URI), + Host. + +tls_upgrade(#state{status = + {ssl_tunnel, + #request{settings = + #http_options{ssl = {_, TLSOptions} = SocketType}} = Request}, + session = #session{socket = TCPSocket} = Session0, + options = Options} = State) -> + + case ssl:connect(TCPSocket, TLSOptions) of + {ok, TLSSocket} -> + Address = Request#request.address, + ClientClose = httpc_request:is_client_closing(Request#request.headers), + SessionType = httpc_manager:session_type(Options), + Session = Session0#session{ + scheme = https, + socket = TLSSocket, + socket_type = SocketType, + type = SessionType, + client_close = ClientClose}, + httpc_request:send(Address, Session, Request), + http_transport:setopts(SocketType, TLSSocket, [{active, once}]), + NewState = State#state{session = Session, + request = Request, + mfa = init_mfa(Request, State), + status_line = + init_status_line(Request), + headers = undefined, + body = undefined, + status = new + }, + {noreply, activate_request_timeout(NewState)}; + {error, _Reason} -> + {stop, normal, State#state{request = Request}} + end. %% --------------------------------------------------------------------- %% Session wrappers diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 8af752546c..30e2742e9d 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -37,6 +37,7 @@ -define(HTTP_MAX_REDIRECTS, 4). -define(HTTP_KEEP_ALIVE_TIMEOUT, 120000). -define(HTTP_KEEP_ALIVE_LENGTH, 5). +-define(TLS_UPGRADE_TOKEN, "TLS/1.0"). %%% HTTP Client per request settings -record(http_options, @@ -72,6 +73,7 @@ -record(options, { proxy = {undefined, []}, % {{ProxyHost, ProxyPort}, [NoProxy]}, + https_proxy = {undefined, []}, % {{ProxyHost, ProxyPort}, [NoProxy]} %% 0 means persistent connections are used without pipelining pipeline_timeout = ?HTTP_PIPELINE_TIMEOUT, max_pipeline_length = ?HTTP_PIPELINE_LENGTH, diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index 3612b331e7..c45dcab802 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -577,6 +577,7 @@ handle_cast({set_options, Options}, State = #state{options = OldOptions}) -> ?hcrv("set options", [{options, Options}, {old_options, OldOptions}]), NewOptions = #options{proxy = get_proxy(Options, OldOptions), + https_proxy = get_https_proxy(Options, OldOptions), pipeline_timeout = get_pipeline_timeout(Options, OldOptions), max_pipeline_length = get_max_pipeline_length(Options, OldOptions), max_keep_alive_length = get_max_keep_alive_length(Options, OldOptions), @@ -741,7 +742,7 @@ get_manager_info(#state{handler_db = HDB, SessionInfo = which_sessions2(SDB), OptionsInfo = [{Item, get_option(Item, Options)} || - Item <- record_info(fields, options)], + Item <- record_info(fields, options)], CookieInfo = httpc_cookie:which_cookies(CDB), [{handlers, HandlerInfo}, {sessions, SessionInfo}, @@ -769,20 +770,7 @@ get_handler_info(Tab) -> Pattern = {'$2', '$1', '_'}, Handlers1 = [{Pid, Id} || [Pid, Id] <- ets:match(Tab, Pattern)], Handlers2 = sort_handlers(Handlers1), - Handlers3 = [{Pid, Reqs, - try - begin - httpc_handler:info(Pid) - end - catch - _:_ -> - %% Why would this crash? - %% Only if the process has died, but we don't - %% know about it? - [] - end} || {Pid, Reqs} <- Handlers2], - Handlers3. - + [{Pid, Reqs, httpc_handler:info(Pid)} || {Pid, Reqs} <- Handlers2]. handle_request(#request{settings = #http_options{version = "HTTP/0.9"}} = Request, @@ -1001,6 +989,8 @@ cast(ProfileName, Msg) -> get_option(proxy, #options{proxy = Proxy}) -> Proxy; +get_option(https_proxy, #options{https_proxy = Proxy}) -> + Proxy; get_option(pipeline_timeout, #options{pipeline_timeout = Timeout}) -> Timeout; get_option(max_pipeline_length, #options{max_pipeline_length = Length}) -> @@ -1027,6 +1017,9 @@ get_option(socket_opts, #options{socket_opts = SocketOpts}) -> get_proxy(Opts, #options{proxy = Default}) -> proplists:get_value(proxy, Opts, Default). +get_https_proxy(Opts, #options{https_proxy = Default}) -> + proplists:get_value(https_proxy, Opts, Default). + get_pipeline_timeout(Opts, #options{pipeline_timeout = Default}) -> proplists:get_value(pipeline_timeout, Opts, Default). diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index b575d7331b..747118431e 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -829,9 +829,7 @@ os_info(Info) -> {OsFamily, _OsName} when Info =:= partial -> lists:flatten(io_lib:format("(~w)", [OsFamily])); {OsFamily, OsName} -> - lists:flatten(io_lib:format("(~w/~w)", [OsFamily, OsName])); - OsFamily -> - lists:flatten(io_lib:format("(~w)", [OsFamily])) + lists:flatten(io_lib:format("(~w/~w)", [OsFamily, OsName])) end. otp_release() -> diff --git a/lib/inets/src/inets_app/inets.erl b/lib/inets/src/inets_app/inets.erl index f33e0abe27..ed8082534f 100644 --- a/lib/inets/src/inets_app/inets.erl +++ b/lib/inets/src/inets_app/inets.erl @@ -274,13 +274,8 @@ sys_info() -> os_info() -> V = os:version(), - case os:type() of - {OsFam, OsName} -> - [{fam, OsFam}, {name, OsName}, {ver, V}]; - OsFam -> - [{fam, OsFam}, {ver, V}] - end. - + {OsFam, OsName} = os:type(), + [{fam, OsFam}, {name, OsName}, {ver, V}]. print_mods_info(Versions) -> case key1search(mod_info, Versions) of diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index 0fc98eff6f..0ca99e8692 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -149,6 +149,7 @@ INETS_ROOT = ../../inets MODULES = \ inets_test_lib \ + erl_make_certs \ ftp_SUITE \ ftp_format_SUITE \ ftp_solaris8_sparc_test \ @@ -169,6 +170,7 @@ MODULES = \ http_format_SUITE \ httpc_SUITE \ httpc_cookie_SUITE \ + httpc_proxy_SUITE \ httpd_SUITE \ httpd_basic_SUITE \ httpd_mod \ @@ -213,7 +215,7 @@ INETS_FILES = inets.config $(INETS_SPECS) INETS_DATADIRS = inets_SUITE_data inets_sup_SUITE_data HTTPD_DATADIRS = httpd_test_data httpd_SUITE_data -HTTPC_DATADIRS = httpc_SUITE_data +HTTPC_DATADIRS = httpc_SUITE_data httpc_proxy_SUITE_data FTP_DATADIRS = ftp_SUITE_data DATADIRS = $(INETS_DATADIRS) $(HTTPD_DATADIRS) $(HTTPC_DATADIRS) $(FTP_DATADIRS) diff --git a/lib/inets/test/erl_make_certs.erl b/lib/inets/test/erl_make_certs.erl new file mode 100644 index 0000000000..254aa6d2f9 --- /dev/null +++ b/lib/inets/test/erl_make_certs.erl @@ -0,0 +1,429 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% 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 Subject PublicKey rsa or dsa 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 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}}) + 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); + 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(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', list_to_binary(Der), not_encrypted}; +encode_key(Key = #'DSAPrivateKey'{}) -> + {ok, Der} = 'OTP-PUB-KEY':encode('DSAPrivateKey', Key), + {'DSAPrivateKey', list_to_binary(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(random: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 -> 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). + +user() -> + case os:getenv("USER") of + false -> + "test_user"; + User -> + User + end. + +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}. + +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}}}. + +make_key(rsa, _Opts) -> + %% (OBS: for testing only) + gen_rsa2(64); +make_key(dsa, _Opts) -> + gen_dsa2(128, 20). %% Bytes i.e. {1024, 160} + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 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_exp(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_exp(G, X, P), %% Calculate y = g^x mod p. + + #'DSAPrivateKey'{version=0, p=P, q=Q, g=G, y=Y, x=X} + end. + +%% See fips_186-3.pdf +dsa_search(T, P0, Q, Iter) when Iter > 0 -> + P = 2*T*Q*P0 + 1, + case is_prime(crypto:mpint(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), + crypto:erlint(prime_odd(Rand, 0)). + +prime_odd(Rand, N) -> + case is_prime(Rand, 50) of + true -> + Rand; + false -> + NotPrime = crypto:erlint(Rand), + prime_odd(crypto:mpint(NotPrime+2), N+1) + end. + +%% see http://en.wikipedia.org/wiki/Fermat_primality_test +is_prime(_, 0) -> true; +is_prime(Candidate, Test) -> + CoPrime = odd_rand(<<0,0,0,4, 10000:32>>, Candidate), + case crypto:mod_exp(CoPrime, Candidate, Candidate) of + CoPrime -> is_prime(Candidate, Test-1); + _ -> false + end. + +odd_rand(Size) -> + Min = 1 bsl (Size*8-1), + Max = (1 bsl (Size*8))-1, + odd_rand(crypto:mpint(Min), crypto:mpint(Max)). + +odd_rand(Min,Max) -> + Rand = <<Sz:32, _/binary>> = crypto:rand_uniform(Min,Max), + BitSkip = (Sz+4)*8-1, + case Rand of + Odd = <<_:BitSkip, 1:1>> -> Odd; + Even = <<_:BitSkip, 0:1>> -> + crypto:mpint(crypto:erlint(Even)+1) + 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/inets/test/ftp_suite_lib.erl b/lib/inets/test/ftp_suite_lib.erl index ffb58c91b6..211c9b5bee 100644 --- a/lib/inets/test/ftp_suite_lib.erl +++ b/lib/inets/test/ftp_suite_lib.erl @@ -206,7 +206,6 @@ init_per_testcase(Case, Config) init_per_testcase(Case, Config) -> put(ftp_testcase, Case), - inets:enable_trace(max, io, ftpc), do_init_per_testcase(Case, Config). do_init_per_testcase(Case, Config) diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 1cdd96f0b0..644b01120c 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -34,9 +34,6 @@ -compile(export_all). %% Test server specific exports --define(PROXY_URL, "http://www.erlang.org"). --define(PROXY, "www-proxy.ericsson.se"). --define(PROXY_PORT, 8080). -define(IP_PORT, 8998). -define(SSL_PORT, 8999). -define(NOT_IN_USE_PORT, 8997). @@ -91,7 +88,6 @@ all() -> options, headers_as_is, selecting_session, - {group, proxy}, {group, ssl}, {group, stream}, {group, ipv6}, @@ -101,18 +97,6 @@ all() -> groups() -> [ - {proxy, [], [proxy_options, - proxy_head, - proxy_get, - proxy_trace, - proxy_post, - proxy_put, - proxy_delete, - proxy_auth, - proxy_headers, - proxy_emulate_lower_versions, - proxy_page_does_not_exist, - proxy_https_not_supported]}, {ssl, [], [ssl_head, essl_head, ssl_get, @@ -120,13 +104,11 @@ groups() -> ssl_trace, essl_trace]}, {stream, [], [http_stream, - http_stream_once, - proxy_stream]}, + http_stream_once]}, {tickets, [], [hexed_query_otp_6191, empty_body_otp_6243, empty_response_header_otp_6830, transfer_encoding_otp_6807, - proxy_not_modified_otp_6821, no_content_204_otp_6982, missing_CR_otp_7304, {group, otp_7883}, @@ -287,66 +269,6 @@ init_per_testcase(Case, Timeout, Config) -> init_per_testcase_ssl(essl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); - "proxy_" ++ Rest -> - io:format("init_per_testcase -> Rest: ~p~n", [Rest]), - case Rest of - "https_not_supported" -> - tsp("init_per_testcase -> [proxy case] start inets"), - inets:start(), - tsp("init_per_testcase -> " - "[proxy case] start crypto, public_key and ssl"), - try ?ENSURE_STARTED([crypto, public_key, ssl]) of - ok -> - [{watchdog, Dog} | TmpConfig] - catch - throw:{error, {failed_starting, App, _}} -> - SkipString = - "Could not start " ++ atom_to_list(App), - skip(SkipString); - _:X -> - SkipString = - lists:flatten( - io_lib:format("Failed starting apps: ~p", [X])), - skip(SkipString) - end; - - _ -> - %% We use erlang.org for the proxy tests - %% and after the switch to erlang-web, many - %% of the test cases no longer work (erlang.org - %% previously run on Apache). - %% Until we have had time to update inets - %% (and updated erlang.org to use that inets) - %% and the test cases, we simply skip the - %% problematic test cases. - %% This is not ideal, but I am busy.... - case is_proxy_available(?PROXY, ?PROXY_PORT) of - true -> - BadCases = - [ - "delete", - "get", - "head", - "not_modified_otp_6821", - "options", - "page_does_not_exist", - "post", - "put", - "stream" - ], - case lists:member(Rest, BadCases) of - true -> - [skip("TC and server not compatible") | - TmpConfig]; - false -> - inets:start(), - [{watchdog, Dog} | TmpConfig] - end; - false -> - [skip("proxy not responding") | TmpConfig] - end - end; - "ipv6_" ++ _Rest -> %% Ensure needed apps (crypto, public_key and ssl) are started try ?ENSURE_STARTED([crypto, public_key, ssl]) of @@ -415,14 +337,6 @@ init_per_testcase(Case, Timeout, Config) -> %% so this value will be overwritten (see "ipv6_" below). %% </IPv6> - %% This will fail for the ipv6_ - cases (but that is ok) - ProxyExceptions = ["localhost", ?IPV6_LOCAL_HOST], - tsp("init_per_testcase -> Options before proxy set: ~n~p", - [httpc:get_options(all)]), - ok = httpc:set_options([{proxy, {{?PROXY, ?PROXY_PORT}, ProxyExceptions}}]), - tsp("init_per_testcase -> Options after proxy set: ~n~p", - [httpc:get_options(all)]), - inets:enable_trace(max, io, httpc), %% inets:enable_trace(max, io, all), %% snmp:set_trace([gen_tcp]), tsp("init_per_testcase(~w) -> done when" @@ -466,7 +380,6 @@ end_per_testcase(http_save_to_file = Case, Config) -> end_per_testcase(Case, Config) -> io:format(user, "~n~n*** END ~w:~w ***~n~n", [?MODULE, Case]), - dbg:stop(), % ? case atom_to_list(Case) of "ipv6_" ++ _Rest -> tsp("end_per_testcase(~w) -> stop ssl", [Case]), @@ -915,7 +828,7 @@ pipeline_await_async_reply(ReqIds, _, Acc) -> %%------------------------------------------------------------------------- http_trace(doc) -> - ["Perform a TRACE request that goes through a proxy."]; + ["Perform a TRACE request."]; http_trace(suite) -> []; http_trace(Config) when is_list(Config) -> @@ -1554,260 +1467,6 @@ http_cookie(Config) when is_list(Config) -> ok. %%------------------------------------------------------------------------- -proxy_options(doc) -> - ["Perform a OPTIONS request that goes through a proxy."]; -proxy_options(suite) -> - []; -proxy_options(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets, which - %% do not implement "options". - case ?config(skip, Config) of - undefined -> - case httpc:request(options, {?PROXY_URL, []}, [], []) of - {ok, {{_,200,_}, Headers, _}} -> - case lists:keysearch("allow", 1, Headers) of - {value, {"allow", _}} -> - ok; - _ -> - tsf(http_options_request_failed) - end; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_head(doc) -> - ["Perform a HEAD request that goes through a proxy."]; -proxy_head(suite) -> - []; -proxy_head(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets. - case ?config(skip, Config) of - undefined -> - case httpc:request(head, {?PROXY_URL, []}, [], []) of - {ok, {{_,200, _}, [_ | _], []}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_get(doc) -> - ["Perform a GET request that goes through a proxy."]; -proxy_get(suite) -> - []; -proxy_get(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - case httpc:request(get, {?PROXY_URL, []}, [], []) of - {ok, {{_,200,_}, [_ | _], Body = [_ | _]}} -> - inets_test_lib:check_body(Body); - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - -%%------------------------------------------------------------------------- -proxy_emulate_lower_versions(doc) -> - ["Perform requests as 0.9 and 1.0 clients."]; -proxy_emulate_lower_versions(suite) -> - []; -proxy_emulate_lower_versions(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - Result09 = pelv_get("HTTP/0.9"), - case Result09 of - {ok, [_| _] = Body0} -> - inets_test_lib:check_body(Body0), - ok; - _ -> - tsf({unexpected_result, "HTTP/0.9", Result09}) - end, - - %% We do not check the version here as many servers - %% do not behave according to the rfc and send - %% 1.1 in its response. - Result10 = pelv_get("HTTP/1.0"), - case Result10 of - {ok,{{_, 200, _}, [_ | _], Body1 = [_ | _]}} -> - inets_test_lib:check_body(Body1), - ok; - _ -> - tsf({unexpected_result, "HTTP/1.0", Result10}) - end, - - Result11 = pelv_get("HTTP/1.1"), - case Result11 of - {ok, {{"HTTP/1.1", 200, _}, [_ | _], Body2 = [_ | _]}} -> - inets_test_lib:check_body(Body2); - _ -> - tsf({unexpected_result, "HTTP/1.1", Result11}) - end; - - Reason -> - skip(Reason) - end. - -pelv_get(Version) -> - httpc:request(get, {?PROXY_URL, []}, [{version, Version}], []). - - -%%------------------------------------------------------------------------- -proxy_trace(doc) -> - ["Perform a TRACE request that goes through a proxy."]; -proxy_trace(suite) -> - []; -proxy_trace(Config) when is_list(Config) -> - %%{ok, {{_,200,_}, [_ | _], "TRACE " ++ _}} = - %% httpc:request(trace, {?PROXY_URL, []}, [], []), - skip("HTTP TRACE is no longer allowed on the ?PROXY_URL server due " - "to security reasons"). - - -%%------------------------------------------------------------------------- -proxy_post(doc) -> - ["Perform a POST request that goes through a proxy. Note the server" - " will reject the request this is a test of the sending of the" - " request."]; -proxy_post(suite) -> - []; -proxy_post(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets. - case ?config(skip, Config) of - undefined -> - case httpc:request(post, {?PROXY_URL, [], - "text/plain", "foobar"}, [],[]) of - {ok, {{_,405,_}, [_ | _], [_ | _]}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_put(doc) -> - ["Perform a PUT request that goes through a proxy. Note the server" - " will reject the request this is a test of the sending of the" - " request."]; -proxy_put(suite) -> - []; -proxy_put(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets. - case ?config(skip, Config) of - undefined -> - case httpc:request(put, {"http://www.erlang.org/foobar.html", [], - "html", "<html> <body><h1> foo </h1>" - "<p>bar</p> </body></html>"}, [], []) of - {ok, {{_,405,_}, [_ | _], [_ | _]}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_delete(doc) -> - ["Perform a DELETE request that goes through a proxy. Note the server" - " will reject the request this is a test of the sending of the" - " request. But as the file does not exist the return code will" - " be 404 not found."]; -proxy_delete(suite) -> - []; -proxy_delete(Config) when is_list(Config) -> - %% As of 2011-03-24, erlang.org (which is used as server) - %% does no longer run Apache, but instead runs inets. - case ?config(skip, Config) of - undefined -> - URL = ?PROXY_URL ++ "/foobar.html", - case httpc:request(delete, {URL, []}, [], []) of - {ok, {{_,404,_}, [_ | _], [_ | _]}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_headers(doc) -> - ["Use as many request headers as possible"]; -proxy_headers(suite) -> - []; -proxy_headers(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - {ok, {{_,200,_}, [_ | _], [_ | _]}} - = httpc:request(get, {?PROXY_URL, - [ - {"Accept", - "text/*, text/html," - " text/html;level=1," - " */*"}, - {"Accept-Charset", - "iso-8859-5, unicode-1-1;" - "q=0.8"}, - {"Accept-Encoding", "*"}, - {"Accept-Language", - "sv, en-gb;q=0.8," - " en;q=0.7"}, - {"User-Agent", "inets"}, - {"Max-Forwards","5"}, - {"Referer", - "http://otp.ericsson.se:8000" - "/product/internal"} - ]}, [], []), - ok; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- -proxy_auth(doc) -> - ["Test the code for sending of proxy authorization."]; -proxy_auth(suite) -> - []; -proxy_auth(Config) when is_list(Config) -> - %% Our proxy seems to ignore the header, however our proxy - %% does not requirer an auth header, but we want to know - %% atleast the code for sending the header does not crash! - case ?config(skip, Config) of - undefined -> - case httpc:request(get, {?PROXY_URL, []}, - [{proxy_auth, {"foo", "bar"}}], []) of - {ok, {{_,200, _}, [_ | _], [_|_]}} -> - ok; - Unexpected -> - tsf({unexpected_result, Unexpected}) - end; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- http_server_does_not_exist(doc) -> ["Test that we get an error message back when the server " "does note exist."]; @@ -1835,39 +1494,6 @@ page_does_not_exist(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -proxy_page_does_not_exist(doc) -> - ["Test that we get a 404 when the page is not found."]; -proxy_page_does_not_exist(suite) -> - []; -proxy_page_does_not_exist(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - URL = ?PROXY_URL ++ "/doesnotexist.html", - {ok, {{_,404,_}, [_ | _], [_ | _]}} = - httpc:request(get, {URL, []}, [], []), - ok; - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- - -proxy_https_not_supported(doc) -> - []; -proxy_https_not_supported(suite) -> - []; -proxy_https_not_supported(Config) when is_list(Config) -> - Result = httpc:request(get, {"https://login.yahoo.com", []}, [], []), - case Result of - {error, https_through_proxy_is_not_currently_supported} -> - ok; - _ -> - tsf({unexpected_reason, Result}) - end. - - -%%------------------------------------------------------------------------- http_stream(doc) -> ["Test the option stream for asynchrony requests"]; @@ -1968,36 +1594,6 @@ once(URL) -> %%------------------------------------------------------------------------- -proxy_stream(doc) -> - ["Test the option stream for asynchrony requests"]; -proxy_stream(suite) -> - []; -proxy_stream(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - {ok, {{_,200,_}, [_ | _], Body}} = - httpc:request(get, {?PROXY_URL, []}, [], []), - - {ok, RequestId} = - httpc:request(get, {?PROXY_URL, []}, [], - [{sync, false}, {stream, self}]), - - receive - {http, {RequestId, stream_start, _Headers}} -> - ok; - {http, Msg} -> - tsf(Msg) - end, - - StreamedBody = receive_streamed_body(RequestId, <<>>), - - Body == binary_to_list(StreamedBody); - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- parse_url(doc) -> ["Test that an url is parsed correctly"]; parse_url(suite) -> @@ -2589,21 +2185,6 @@ transfer_encoding_otp_6807(Config) when is_list(Config) -> %%------------------------------------------------------------------------- -proxy_not_modified_otp_6821(doc) -> - ["If unmodified no body should be returned"]; -proxy_not_modified_otp_6821(suite) -> - []; -proxy_not_modified_otp_6821(Config) when is_list(Config) -> - case ?config(skip, Config) of - undefined -> - provocate_not_modified_bug(?PROXY_URL); - Reason -> - skip(Reason) - end. - - -%%------------------------------------------------------------------------- - empty_response_header_otp_6830(doc) -> ["Test the case that the HTTP server does not send any headers"]; empty_response_header_otp_6830(suite) -> @@ -3410,15 +2991,6 @@ create_config(FileName, ComType, Port, PrivDir, ServerRoot, DocRoot, cline(List) -> lists:flatten([List, "\r\n"]). -is_proxy_available(Proxy, Port) -> - case gen_tcp:connect(Proxy, Port, []) of - {ok, Socket} -> - gen_tcp:close(Socket), - true; - _ -> - false - end. - receive_streamed_body(RequestId, Body) -> receive {http, {RequestId, stream, BinBodyPart}} -> @@ -3912,42 +3484,6 @@ content_length(["content-length:" ++ Value | _]) -> content_length([_Head | Tail]) -> content_length(Tail). -provocate_not_modified_bug(Url) -> - Timeout = 15000, %% 15s should be plenty - - {ok, {{_, 200, _}, ReplyHeaders, _Body}} = - httpc:request(get, {Url, []}, [{timeout, Timeout}], []), - Etag = pick_header(ReplyHeaders, "ETag"), - Last = pick_header(ReplyHeaders, "last-modified"), - - case httpc:request(get, {Url, [{"If-None-Match", Etag}, - {"If-Modified-Since", Last}]}, - [{timeout, 15000}], - []) of - {ok, {{_, 304, _}, _, _}} -> %% The expected reply - page_unchanged; - {ok, {{_, 200, _}, _, _}} -> - %% If the page has changed since the - %% last request we retry to - %% trigger the bug - provocate_not_modified_bug(Url); - {error, timeout} -> - %% Not what we expected. Tcpdump can be used to - %% verify that we receive the complete http-reply - %% but still time out. - incorrect_result - end. - -pick_header(Headers, Name) -> - case lists:keysearch(string:to_lower(Name), 1, - [{string:to_lower(X), Y} || {X, Y} <- Headers]) of - false -> - []; - {value, {_Key, Val}} -> - Val - end. - - %% ------------------------------------------------------------------------- simple_request_and_verify(Config, diff --git a/lib/inets/test/httpc_cookie_SUITE.erl b/lib/inets/test/httpc_cookie_SUITE.erl index 93dbc270c5..3862bf7a20 100644 --- a/lib/inets/test/httpc_cookie_SUITE.erl +++ b/lib/inets/test/httpc_cookie_SUITE.erl @@ -276,8 +276,6 @@ secure_cookie(Config) when is_list(Config) -> tsp("secure_cookie -> entry with" "~n Config: ~p", [Config]), - inets:enable_trace(max, io, httpc), - %% httpc:reset_cookies(), tsp("secure_cookie -> Cookies 1: ~p", [httpc:which_cookies()]), @@ -309,7 +307,6 @@ secure_cookie(Config) when is_list(Config) -> tsp("secure_cookie -> Cookies 4: ~p", [httpc:which_cookies()]), - inets:disable_trace(), tsp("secure_cookie -> done"), ok. diff --git a/lib/inets/test/httpc_proxy_SUITE.erl b/lib/inets/test/httpc_proxy_SUITE.erl new file mode 100644 index 0000000000..84db39e76b --- /dev/null +++ b/lib/inets/test/httpc_proxy_SUITE.erl @@ -0,0 +1,575 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% + +%% +%% ts:run(inets, httpc_proxy_SUITE, [batch]). +%% ct:run("../inets_test", httpc_proxy_SUITE). +%% + +-module(httpc_proxy_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-include_lib("kernel/include/file.hrl"). +-include("inets_test_lib.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(LOCAL_PROXY_SCRIPT, "server_proxy.sh"). +-define(p(F, A), % Debug printout + begin + io:format( + "~w ~w: " ++ begin F end, + [self(),?MODULE] ++ begin A end) + end). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group,local_proxy}, + {group,local_proxy_https}]. + +groups() -> + [{local_proxy,[], + [http_emulate_lower_versions + |local_proxy_cases()]}, + {local_proxy_https,[], + local_proxy_cases()}]. + +%% internal functions + +local_proxy_cases() -> + [http_head, + http_get, + http_options, + http_trace, + http_post, + http_put, + http_delete, + http_headers, + http_proxy_auth, + http_doesnotexist, + http_stream, + http_not_modified_otp_6821]. + +%%-------------------------------------------------------------------- + +init_per_suite(Config0) -> + case init_apps([crypto,public_key], Config0) of + Config when is_list(Config) -> + make_cert_files(dsa, "server-", Config), + Config; + Other -> + Other + end. + +end_per_suite(_Config) -> + [app_stop(App) || App <- r(suite_apps())], + ok. + +%% internal functions + +suite_apps() -> + [crypto,public_key]. + +%%-------------------------------------------------------------------- + +init_per_group(local_proxy, Config) -> + init_local_proxy([{protocol,http}|Config]); +init_per_group(local_proxy_https, Config) -> + init_local_proxy([{protocol,https}|Config]). + +end_per_group(Group, Config) + when + Group =:= local_proxy; + Group =:= local_proxy_https -> + rcmd_local_proxy(["stop"], Config), + Config; +end_per_group(_, Config) -> + Config. + +%%-------------------------------------------------------------------- + +init_per_testcase(Case, Config0) -> + ct:timetrap({seconds,30}), + Apps = apps(Case, Config0), + case init_apps(Apps, Config0) of + Config when is_list(Config) -> + case app_start(inets, Config) of + ok -> + Config; + Error -> + [app_stop(N) || N <- [inets|r(Apps)]], + ct:fail({could_not_init_inets,Error}) + end; + E3 -> + E3 + end. + +end_per_testcase(_Case, Config) -> + app_stop(inets), + Config. + +%% internal functions + +apps(_Case, Config) -> + case ?config(protocol, Config) of + https -> + [ssl]; + _ -> + [] + end. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +http_head(doc) -> + ["Test http/https HEAD request."]; +http_head(Config) when is_list(Config) -> + Method = head, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},[_|_],[]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_get(doc) -> + ["Test http/https GET request."]; +http_get(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Request = {URL,[]}, + Timeout = timer:seconds(1), + ConnTimeout = Timeout + timer:seconds(1), + + HttpOpts1 = [{timeout,Timeout},{connect_timeout,ConnTimeout}], + Opts1 = [], + {ok,{{_,200,_},[_|_],[_|_]=B1}} = + httpc:request(Method, Request, HttpOpts1, Opts1), + inets_test_lib:check_body(B1), + + HttpOpts2 = [], + Opts2 = [{body_format,binary}], + {ok,{{_,200,_},[_|_],B2}} = + httpc:request(Method, Request, HttpOpts2, Opts2), + inets_test_lib:check_body(binary_to_list(B2)). + +%%-------------------------------------------------------------------- + +http_options(doc) -> + ["Perform an OPTIONS request."]; +http_options(Config) when is_list(Config) -> + Method = options, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},Headers,_}} = + httpc:request(Method, Request, HttpOpts, Opts), + {value,_} = lists:keysearch("allow", 1, Headers), + ok. + +%%-------------------------------------------------------------------- + +http_trace(doc) -> + ["Perform a TRACE request."]; +http_trace(Config) when is_list(Config) -> + Method = trace, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},[_|_],"TRACE "++_}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_post(doc) -> + ["Perform a POST request that goes through a proxy. When the " + "request goes to an ordinary file it seems the POST data " + "is ignored."]; +http_post(Config) when is_list(Config) -> + Method = post, + URL = url("/index.html", Config), + Request = {URL,[],"text/plain","foobar"}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_put(doc) -> + ["Perform a PUT request. The server will not allow it " + "but we only test sending the request."]; +http_put(Config) when is_list(Config) -> + Method = put, + URL = url("/put.html", Config), + Content = + "<html><body> <h1>foo</h1> <p>bar</p> </body></html>", + Request = {URL,[],"html",Content}, + HttpOpts = [], + Opts = [], + {ok,{{_,405,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_delete(doc) -> + ["Perform a DELETE request that goes through a proxy. Note the server " + "will reject the request with a 405 Method Not Allowed," + "but this is just a test of sending the request."]; +http_delete(Config) when is_list(Config) -> + Method = delete, + URL = url("/delete.html", Config), + Request = {URL,[]}, + HttpOpts = [], + Opts = [], + {ok,{{_,405,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_headers(doc) -> + ["Use as many request headers as possible"]; +http_headers(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Headers = + [{"Accept", + "text/*, text/html, text/html;level=1, */*"}, + {"Accept-Charset", + "iso-8859-5, unicode-1-1;q=0.8"}, + {"Accept-Encoding", "*"}, + {"Accept-Language", + "sv, en-gb;q=0.8, en;q=0.7"}, + {"User-Agent", "inets"}, + {"Max-Forwards","5"}, + {"Referer", + "http://otp.ericsson.se:8000/product/internal"}], + Request = {URL,Headers}, + HttpOpts = [], + Opts = [], + {ok,{{_,200,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_proxy_auth(doc) -> + ["Test the code for sending of proxy authorization."]; +http_proxy_auth(Config) when is_list(Config) -> + %% Our proxy seems to ignore the header, however our proxy + %% does not requirer an auth header, but we want to know + %% atleast the code for sending the header does not crash! + Method = get, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [{proxy_auth,{"foo","bar"}}], + Opts = [], + {ok,{{_,200,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_doesnotexist(doc) -> + ["Test that we get a 404 when the page is not found."]; +http_doesnotexist(Config) when is_list(Config) -> + Method = get, + URL = url("/doesnotexist.html", Config), + Request = {URL,[]}, + HttpOpts = [{proxy_auth,{"foo","bar"}}], + Opts = [], + {ok,{{_,404,_},[_|_],[_|_]}} = + httpc:request(Method, Request, HttpOpts, Opts), + ok. + +%%-------------------------------------------------------------------- + +http_stream(doc) -> + ["Test the option stream for asynchronous requests"]; +http_stream(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Request = {URL,[]}, + HttpOpts = [], + + Opts1 = [{body_format,binary}], + {ok,{{_,200,_},[_|_],Body}} = + httpc:request(Method, Request, HttpOpts, Opts1), + + Opts2 = [{sync,false},{stream,self}], + {ok,RequestId} = + httpc:request(Method, Request, HttpOpts, Opts2), + receive + {http,{RequestId,stream_start,[_|_]}} -> + ok + end, + case http_stream(RequestId, <<>>) of + Body -> ok + end. + %% StreamedBody = http_stream(RequestId, <<>>), + %% Body =:= StreamedBody, + %% ok. + +http_stream(RequestId, Body) -> + receive + {http,{RequestId,stream,Bin}} -> + http_stream(RequestId, <<Body/binary,Bin/binary>>); + {http,{RequestId,stream_end,_Headers}} -> + Body + end. + +%%-------------------------------------------------------------------- + +http_emulate_lower_versions(doc) -> + ["Perform requests as 0.9 and 1.0 clients."]; +http_emulate_lower_versions(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Request = {URL,[]}, + Opts = [], + + HttpOpts1 = [{version,"HTTP/0.9"}], + {ok,[_|_]=B1} = + httpc:request(Method, Request, HttpOpts1, Opts), + inets_test_lib:check_body(B1), + + HttpOpts2 = [{version,"HTTP/1.0"}], + {ok,{{_,200,_},[_|_],[_|_]=B2}} = + httpc:request(Method, Request, HttpOpts2, Opts), + inets_test_lib:check_body(B2), + + HttpOpts3 = [{version,"HTTP/1.1"}], + {ok,{{_,200,_},[_|_],[_|_]=B3}} = + httpc:request(Method, Request, HttpOpts3, Opts), + inets_test_lib:check_body(B3), + + ok. + +%%-------------------------------------------------------------------- +http_not_modified_otp_6821(doc) -> + ["If unmodified no body should be returned"]; +http_not_modified_otp_6821(Config) when is_list(Config) -> + Method = get, + URL = url("/index.html", Config), + Opts = [], + + Request1 = {URL,[]}, + HttpOpts1 = [], + {ok,{{_,200,_},ReplyHeaders,[_|_]}} = + httpc:request(Method, Request1, HttpOpts1, Opts), + ETag = header_value("etag", ReplyHeaders), + LastModified = header_value("last-modified", ReplyHeaders), + + Request2 = + {URL, + [{"If-None-Match",ETag}, + {"If-Modified-Since",LastModified}]}, + HttpOpts2 = [{timeout,15000}], % Limit wait for bug result + {ok,{{_,304,_},_,[]}} = % Page Unchanged + httpc:request(Method, Request2, HttpOpts2, Opts), + + ok. + +header_value(Name, [{HeaderName,HeaderValue}|Headers]) -> + case string:to_lower(HeaderName) of + Name -> + HeaderValue; + _ -> + header_value(Name, Headers) + end. + +%%-------------------------------------------------------------------- +%% Internal Functions ------------------------------------------------ +%%-------------------------------------------------------------------- + +init_apps([], Config) -> + Config; +init_apps([App|Apps], Config) -> + case app_start(App, Config) of + ok -> + init_apps(Apps, Config); + Error -> + Msg = + lists:flatten( + io_lib:format( + "Could not start ~p due to ~p.~n", + [App, Error])), + {skip,Msg} + end. + +app_start(App, Config) -> + try + case App of + crypto -> + crypto:stop(), + ok = crypto:start(); + inets -> + application:stop(App), + ok = application:start(App), + case ?config(proxy, Config) of + undefined -> ok; + {_,ProxySpec} -> + ok = httpc:set_options([{proxy,ProxySpec}]) + end; + _ -> + application:stop(App), + ok = application:start(App) + end + catch + Class:Reason -> + {exception,Class,Reason} + end. + +app_stop(App) -> + application:stop(App). + +make_cert_files(Alg, Prefix, Config) -> + PrivDir = ?config(priv_dir, Config), + CaInfo = {CaCert,_} = erl_make_certs:make_cert([{key,Alg}]), + {Cert,CertKey} = erl_make_certs:make_cert([{key,Alg},{issuer,CaInfo}]), + CaCertFile = filename:join(PrivDir, Prefix++"cacerts.pem"), + CertFile = filename:join(PrivDir, Prefix++"cert.pem"), + KeyFile = filename:join(PrivDir, Prefix++"key.pem"), + der_to_pem(CaCertFile, [{'Certificate', CaCert, not_encrypted}]), + der_to_pem(CertFile, [{'Certificate', Cert, not_encrypted}]), + der_to_pem(KeyFile, [CertKey]), + ok. + +der_to_pem(File, Entries) -> + PemBin = public_key:pem_encode(Entries), + file:write_file(File, PemBin). + + + +url(AbsPath, Config) -> + Protocol = ?config(protocol, Config), + {ServerName,ServerPort} = ?config(Protocol, Config), + atom_to_list(Protocol) ++ "://" ++ + ServerName ++ ":" ++ integer_to_list(ServerPort) ++ + AbsPath. + +%%-------------------------------------------------------------------- + +init_local_proxy(Config) -> + case os:type() of + {unix,_} -> + case rcmd_local_proxy(["start"], Config) of + {0,[":STARTED:"++String]} -> + init_local_proxy_string(String, Config); + {_,[":SKIP:"++_|_]}=Reason -> + {skip,Reason}; + Error -> + rcmd_local_proxy(["stop"], Config), + ct:fail({local_proxy_start_failed,Error}) + end; + _ -> + {skip,"Platform can not run local proxy start script"} + end. + +init_local_proxy_string(String, Config) -> + {Proxy,Server} = split($|, String), + {ProxyName,ProxyPort} = split($:, Proxy), + {ServerName,ServerPorts} = split($:, Server), + {ServerHttpPort,ServerHttpsPort} = split($:, ServerPorts), + [{proxy,{local,{{ProxyName,list_to_integer(ProxyPort)},[]}}}, + {http,{ServerName,list_to_integer(ServerHttpPort)}}, + {https,{ServerName,list_to_integer(ServerHttpsPort)}} + |Config]. + +rcmd_local_proxy(Args, Config) -> + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + Script = filename:join(DataDir, ?LOCAL_PROXY_SCRIPT), + rcmd(Script, Args, [{cd,PrivDir}]). + +rcmd(Cmd, Args, Opts) -> + Port = + erlang:open_port( + {spawn_executable,Cmd}, + [{args,Args},{line,80},exit_status,eof,hide|Opts]), + rcmd_loop(Port, [], [], undefined, false). + +rcmd_loop(Port, Lines, Buf, Exit, EOF) -> + receive + {Port,{data,{Flag,Line}}} -> + case Flag of + noeol -> + rcmd_loop(Port, Lines, r(Line, Buf), Exit, EOF); + eol -> + rcmd_loop(Port, [r(Buf, Line)|Lines], [], Exit, EOF) + end; + {Port,{exit_status,Status}} when Exit =:= undefined -> + case EOF of + true -> + rcmd_close(Port, Lines, Buf, Status); + false -> + rcmd_loop(Port, Lines, Buf, Status, EOF) + end; + {Port,eof} when EOF =:= false -> + case Exit of + undefined -> + rcmd_loop(Port, Lines, Buf, Exit, true); + Status -> + rcmd_close(Port, Lines, Buf, Status) + end; + {Port,_}=Unexpected -> + ct:fail({unexpected_from_port,Unexpected}) + end. + +rcmd_close(Port, Lines, Buf, Status) -> + catch port_close(Port), + case Buf of + [] -> + {Status,Lines}; + _ -> + {Status,[r(Buf)|Lines]} + end. + +%%-------------------------------------------------------------------- + +%% Split on first match of X in Ys, do not include X in neither part +split(X, Ys) -> + split(X, Ys, []). +%% +split(X, [X|Ys], Rs) -> + {r(Rs),Ys}; +split(X, [Y|Ys], Rs) -> + split(X, Ys, [Y|Rs]). + +r(L) -> lists:reverse(L). +r(L, R) -> lists:reverse(L, R). diff --git a/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf b/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf new file mode 100644 index 0000000000..37af88c510 --- /dev/null +++ b/lib/inets/test/httpc_proxy_SUITE_data/apache2/apache2.conf @@ -0,0 +1,87 @@ +## Simple Apache 2 configuration file for daily test very local http server +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2012. All Rights Reserved. +## +## The contents of this file are subject to the Erlang Public License, +## Version 1.1, (the "License"); you may not use this file except in +## compliance with the License. You should have received a copy of the +## Erlang Public License along with this software. If not, it can be +## retrieved online at http://www.erlang.org/. +## +## Software distributed under the License is distributed on an "AS IS" +## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +## the License for the specific language governing rights and limitations +## under the License. +## +## %CopyrightEnd% +## +## Author: Raimo Niskanen, Erlang/OTP +# +LockFile ${APACHE_LOCK_DIR}/accept.lock +PidFile ${APACHE_PID_FILE} + +Timeout 300 + +User ${APACHE_RUN_USER} +Group ${APACHE_RUN_GROUP} + +DefaultType text/plain +HostnameLookups Off +ErrorLog ${APACHE_LOG_DIR}/error.log +LogLevel warn + +Include ${APACHE_MODS_DIR}/*.load +Include ${APACHE_MODS_DIR}/*.conf + +Listen ${APACHE_HTTP_PORT} http + +<IfModule mod_ssl.c> + Listen ${APACHE_HTTPS_PORT} https + SSLMutex file:${APACHE_LOCK_DIR}/ssl_mutex +</IfModule> + +#<IfModule mod_gnutls.c> +# Listen 8443 +#</IfModule> + +#LogFormat "%v:%p %h %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"" vhost_combined +LogFormat "%h %l %u %t \"%r\" %>s %O \"%{Referer}i\" \"%{User-Agent}i\"" combined +#LogFormat "%h %l %u %t \"%r\" %>s %O" common +#LogFormat "%{Referer}i -> %U" referer +#LogFormat "%{User-agent}i" agent + +CustomLog ${APACHE_LOG_DIR}/access.log combined + +<Directory /> + AllowOverride None + Order Deny,Allow + Deny from all +</Directory> + +ServerTokens Minimal +ServerSignature Off +KeepAlive On +KeepAliveTimeout 5 + +ServerName ${APACHE_SERVER_NAME} +ServerAdmin webmaster@${APACHE_SERVER_NAME} +DocumentRoot ${APACHE_DOCROOT} +<Directory ${APACHE_DOCROOT}> + Options Indexes FollowSymLinks MultiViews + AllowOverride None + Order allow,deny + Allow from all +</Directory> + +<VirtualHost *:${APACHE_HTTP_PORT}> +</VirtualHost> + +<IfModule mod_ssl.c> + <VirtualHost *:${APACHE_HTTPS_PORT}> + SSLCertificateFile ${APACHE_CERTS_DIR}/server-cert.pem + SSLCertificateKeyFile ${APACHE_CERTS_DIR}/server-key.pem + SSLEngine on + </VirtualHost> +</IfModule> diff --git a/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html b/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html new file mode 100644 index 0000000000..1c70d95348 --- /dev/null +++ b/lib/inets/test/httpc_proxy_SUITE_data/apache2/htdocs/index.html @@ -0,0 +1,4 @@ +<html><body><h1>It works!</h1> +<p>This is the default web page for this server.</p> +<p>The web server software is running but no content has been added, yet.</p> +</body></html> diff --git a/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh b/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh new file mode 100755 index 0000000000..4b05ea63ef --- /dev/null +++ b/lib/inets/test/httpc_proxy_SUITE_data/server_proxy.sh @@ -0,0 +1,198 @@ +#! /bin/sh +## +## Command file to handle external webserver and proxy +## apache2 and tinyproxy. +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2012. All Rights Reserved. +## +## The contents of this file are subject to the Erlang Public License, +## Version 1.1, (the "License"); you may not use this file except in +## compliance with the License. You should have received a copy of the +## Erlang Public License along with this software. If not, it can be +## retrieved online at http://www.erlang.org/. +## +## Software distributed under the License is distributed on an "AS IS" +## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +## the License for the specific language governing rights and limitations +## under the License. +## +## %CopyrightEnd% +## +## Author: Raimo Niskanen, Erlang/OTP +# + +PATH=/usr/local/bin:/usr/local/sbin:/bin:/usr/bin:/sbin:/usr/sbin +SHELL=/bin/sh +unset CDPATH ENV BASH_ENV +IFS=' + ' + +APACHE_MODS_AVAILABLE_DIR="/etc/apache2/mods-available" +MODS="authz_host.load mime.conf mime.load ssl.conf ssl.load" + +APACHE_HTTP_PORT=8080 +APACHE_HTTPS_PORT=8443 +APACHE_SERVER_NAME=localhost +export APACHE_HTTP_PORT APACHE_HTTPS_PORT APACHE_SERVER_NAME + +PROXY_SERVER_NAME=localhost +PROXY_PORT=8000 +export PROXY_SERVER_NAME PROXY_PORT + +# All stdout goes to the calling erlang port, therefore +# these helpers push all side info to stderr. +status () { echo "$@"; } +info () { echo "$@" 1>&2; } +die () { REASON="$?"; status "$@"; exit "$REASON"; } +cmd () { "$@" 1>&2; } +silent () { "$@" 1>/dev/null 2>&1; } + +wait_for_pidfile () { + PIDFILE="${1:?Missing argument: PidFile}" + for t in 1 1 1 2 2 3 3 3 4; do + PID="`head -1 "$1" 2>/dev/null`" && [ :"$PID" != : ] && break + sleep $t + done + [ :"$PID" = : ] && die ":ERROR:No or empty PidFile: $1" + info "Started $PIDFILE[$PID]." +} + +kill_and_wait () { + PID_FILE="${1:?Missing argument: PidFile}" + if [ -f "$PID_FILE" ]; then + PID="`head -1 "$PID_FILE" 2>/dev/null`" + [ :"$PID" = : ] && \ + info "Empty Pid file: $1" + info "Stopping $1 [$PID]..." + shift + case :"${1:?Missing argument: kill command}" in + :kill) + [ :"$PID" = : ] || cmd kill "$PID";; + :*) + cmd "$@";; + esac + wait "$PID" + for t in 1 1 1 2; do + sleep $t + [ -e "$PID_FILE" ] || break + done + silent rm "$PID_FILE" + else + info "No pid file: $1" + fi +} + + +PRIV_DIR="`pwd`" +DATA_DIR="`dirname "$0"`" +DATA_DIR="`cd "$DATA_DIR" && pwd`" + +silent type apache2ctl || \ + die ":SKIP: Can not find apache2ctl." +silent type tinyproxy || \ + die ":SKIP: Can not find tinyproxy." + +[ -d "$APACHE_MODS_AVAILABLE_DIR" ] || \ + die ":SKIP:Can not locate modules dir $APACHE_MODS_AVAILABLE_DIR." + +silent mkdir apache2 tinyproxy +cd apache2 || \ + die ":ERROR:Can not cd to apache2" +CWD="`pwd`" +(cd ../tinyproxy) || \ + die ":ERROR:Can not cd to ../tinyproxy" + +unset APACHE_HTTPD APACHE_LYNX APACHE_STATUSURL + +## apache2ctl envvars variables +APACHE_CONFDIR="$DATA_DIR/apache2" +[ -f "$APACHE_CONFDIR"/apache2.conf ] || \ + die ":SKIP:No config file: $APACHE_CONFDIR/apache2.conf." +APACHE_RUN_USER=`id | sed 's/^uid=[0-9]\{1,\}(\([^)]*\)).*/\1/'` +APACHE_RUN_GROUP=`id | sed 's/.*[ ]gid=[0-9]\{1,\}(\([^)]*\)).*/\1/'` +APACHE_RUN_DIR="$CWD/run" +APACHE_PID_FILE="$APACHE_RUN_DIR/pid" +APACHE_LOCK_DIR="$CWD/lock" +APACHE_LOG_DIR="$CWD/log" +export APACHE_CONFDIR APACHE_RUN_USER APACHE_RUN_GROUP +export APACHE_RUN_DIR APACHE_PID_FILE +export APACHE_LOCK_DIR APACHE_LOG_DIR +silent cmd mkdir "$APACHE_CONFDIR" +silent cmd mkdir "$APACHE_RUN_DIR" "$APACHE_LOCK_DIR" "$APACHE_LOG_DIR" + +## Our apache2.conf additional variables +APACHE_MODS_DIR="$CWD/mods" +APACHE_DOCROOT="$APACHE_CONFDIR/htdocs" +APACHE_CERTS_DIR="$PRIV_DIR" +export APACHE_MODS_DIR APACHE_DOCROOT APACHE_CERTS_DIR +[ -d "$APACHE_MODS_DIR" ] || { + cmd mkdir "$APACHE_MODS_DIR" + for MOD in $MODS; do + cmd ln -s "$APACHE_MODS_AVAILABLE_DIR/$MOD" "$APACHE_MODS_DIR" || { + die ":ERROR:ln of apache 2 module $MOD failed" + } + done +} + +case :"${1:?}" in + + :start) + info "Starting apache2..." + cmd apache2ctl start + [ $? = 0 ] || \ + die ":ERROR: apache2 did not start." + wait_for_pidfile "$APACHE_PID_FILE" + + info "Starting tinyproxy..." + cmd cd ../tinyproxy || \ + die ":ERROR:Can not cd to `pwd`/../tinyproxy" + cat >tinyproxy.conf <<EOF +Port $PROXY_PORT + +Listen 127.0.0.1 +BindSame yes +Timeout 600 + +DefaultErrorFile "default.html" +Logfile "tinyproxy.log" +PidFile "tinyproxy.pid" + +MaxClients 100 +MinSpareServers 2 +MaxSpareServers 8 +StartServers 2 +MaxRequestsPerChild 0 + +ViaProxyName "tinyproxy" + +ConnectPort $APACHE_HTTPS_PORT +EOF + (tinyproxy -d -c tinyproxy.conf 1>/dev/null 2>&1 </dev/null &)& + wait_for_pidfile tinyproxy.pid + + status ":STARTED:$PROXY_SERVER_NAME:$PROXY_PORT|\ +$APACHE_SERVER_NAME:$APACHE_HTTP_PORT:$APACHE_HTTPS_PORT" + exit 0 + ;; + + :stop) + kill_and_wait ../tinyproxy/tinyproxy.pid kill + kill_and_wait "$APACHE_PID_FILE" apache2ctl stop + + status ":STOPPED:" + exit 0 + ;; + + :apache2ctl) + shift + cmd apache2ctl ${1+"$@"} + exit + ;; + + :*) + (exit 1); die ":ERROR: I do not know of command '$1'." + ;; + +esac diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 58f7d4fa25..592469a12f 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -530,24 +530,10 @@ init_per_testcase3(Case, Config) -> application:stop(inets), application:stop(ssl), cleanup_mnesia(), - - %% Set trace level - case lists:reverse(atom_to_list(Case)) of - "tset_emit" ++ _Rest -> % test-cases ending with time_test - tsp("init_per_testcase3(~w) -> disabling trace", [Case]), - inets:disable_trace(); - _ -> - tsp("init_per_testcase3(~w) -> enabling trace", [Case]), - %% TraceLevel = 70, - TraceLevel = max, - TraceDest = io, - inets:enable_trace(TraceLevel, TraceDest, httpd) - end, - + %% Start initialization tsp("init_per_testcase3(~w) -> start init", [Case]), - - + Dog = test_server:timetrap(inets_test_lib:minutes(10)), NewConfig = lists:keydelete(watchdog, 1, Config), TcTopDir = ?config(tc_top_dir, Config), diff --git a/lib/inets/test/inets_SUITE.erl b/lib/inets/test/inets_SUITE.erl index 6fa0f44d77..069c68fa1e 100644 --- a/lib/inets/test/inets_SUITE.erl +++ b/lib/inets/test/inets_SUITE.erl @@ -363,8 +363,6 @@ start_ftpc(suite) -> []; start_ftpc(Config) when is_list(Config) -> process_flag(trap_exit, true), - inets:disable_trace(), - inets:enable_trace(max, io, ftpc), ok = inets:start(), try begin @@ -393,16 +391,13 @@ start_ftpc(Config) when is_list(Config) -> tsf(stand_alone_not_shutdown) end, ok = inets:stop(), - inets:disable_trace(), ok; _ -> - inets:disable_trace(), {skip, "Unable to reach selected FTP server " ++ FtpdHost} end end catch throw:{error, not_found} -> - inets:disable_trace(), {skip, "No available FTP servers"} end. @@ -462,8 +457,6 @@ httpd_reload(Config) when is_list(Config) -> {document_root, PrivDir}, {bind_address, "localhost"}], - inets:enable_trace(max, io), - i("httpd_reload -> start inets"), ok = inets:start(), diff --git a/lib/inets/test/inets_sup_SUITE.erl b/lib/inets/test/inets_sup_SUITE.erl index 1d262a2739..65f0f0e09a 100644 --- a/lib/inets/test/inets_sup_SUITE.erl +++ b/lib/inets/test/inets_sup_SUITE.erl @@ -226,8 +226,6 @@ ftpc_worker(doc) -> ftpc_worker(suite) -> []; ftpc_worker(Config) when is_list(Config) -> - inets:disable_trace(), - inets:enable_trace(max, io, ftpc), [] = supervisor:which_children(ftp_sup), try begin @@ -239,20 +237,16 @@ ftpc_worker(Config) when is_list(Config) -> inets:stop(ftpc, Pid), test_server:sleep(5000), [] = supervisor:which_children(ftp_sup), - inets:disable_trace(), ok; Children -> - inets:disable_trace(), exit({unexpected_children, Children}) end; _ -> - inets:disable_trace(), {skip, "Unable to reach test FTP server"} end end catch throw:{error, not_found} -> - inets:disable_trace(), {skip, "No available FTP servers"} end. diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java index b9b43481ee..ae5f4ee072 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpInputStream.java @@ -1112,12 +1112,16 @@ public class OtpInputStream extends ByteArrayInputStream { final int size = read4BE(); final byte[] buf = new byte[size]; final java.util.zip.InflaterInputStream is = - new java.util.zip.InflaterInputStream(this); + new java.util.zip.InflaterInputStream(this, new java.util.zip.Inflater(), size); + int curPos = 0; try { - final int dsize = is.read(buf, 0, size); - if (dsize != size) { + int curRead; + while(curPos < size && (curRead = is.read(buf, curPos, size - curPos)) != -1) { + curPos += curRead; + } + if (curPos != size) { throw new OtpErlangDecodeException("Decompression gave " - + dsize + " bytes, not " + size); + + curPos + " bytes, not " + size); } } catch (final IOException e) { throw new OtpErlangDecodeException("Cannot read from input stream"); diff --git a/lib/jinterface/test/jitu.erl b/lib/jinterface/test/jitu.erl index c57fb9bfad..fb262cf9d7 100644 --- a/lib/jinterface/test/jitu.erl +++ b/lib/jinterface/test/jitu.erl @@ -89,13 +89,19 @@ classpath(Dir) -> {win32, _} -> ";"; _ -> ":" end, - Dir++PS++ + es(Dir++PS++ filename:join([code:lib_dir(jinterface),"priv","OtpErlang.jar"])++PS++ case os:getenv("CLASSPATH") of false -> ""; Classpath -> Classpath - end. - + end). + +es(L) -> + lists:flatmap(fun($ ) -> + "\\ "; + (C) -> + [C] + end,lists:flatten(L)). cmd(Cmd) -> PortOpts = [{line,80},eof,exit_status,stderr_to_stdout], diff --git a/lib/jinterface/test/nc_SUITE.erl b/lib/jinterface/test/nc_SUITE.erl index 9c88400c2a..d5388e54f4 100644 --- a/lib/jinterface/test/nc_SUITE.erl +++ b/lib/jinterface/test/nc_SUITE.erl @@ -89,7 +89,7 @@ end_per_suite(Config) -> init_per_testcase(Case, Config) -> T = case atom_to_list(Case) of "unicode"++_ -> 240; - _ -> 20 + _ -> 30 end, WatchDog = test_server:timetrap(test_server:seconds(T)), [{watchdog, WatchDog}| Config]. @@ -187,10 +187,18 @@ binary_roundtrip(Config) when is_list(Config) -> decompress_roundtrip(doc) -> []; decompress_roundtrip(suite) -> []; decompress_roundtrip(Config) when is_list(Config) -> + RandomBin = erlang:term_to_binary(lists:seq(1, 5 * 1024 * 1024)), % roughly 26MB + <<RandomBin1k:1024/binary,_/binary>> = RandomBin, + <<RandomBin1M:1048576/binary,_/binary>> = RandomBin, + <<RandomBin10M:10485760/binary,_/binary>> = RandomBin, Terms = [0.0, math:sqrt(2), <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,31:5>>, + RandomBin1k, + RandomBin1M, + RandomBin10M, + RandomBin, make_ref()], OutTrans = fun (D) -> @@ -205,10 +213,18 @@ decompress_roundtrip(Config) when is_list(Config) -> compress_roundtrip(doc) -> []; compress_roundtrip(suite) -> []; compress_roundtrip(Config) when is_list(Config) -> + RandomBin = erlang:term_to_binary(lists:seq(1, 5 * 1024 * 1024)), % roughly 26MB + <<RandomBin1k:1024/binary,_/binary>> = RandomBin, + <<RandomBin1M:1048576/binary,_/binary>> = RandomBin, + <<RandomBin10M:10485760/binary,_/binary>> = RandomBin, Terms = [0.0, math:sqrt(2), <<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,31:5>>, + RandomBin1k, + RandomBin1M, + RandomBin10M, + RandomBin, make_ref()], OutTrans = fun (D) -> diff --git a/lib/kernel/doc/src/global.xml b/lib/kernel/doc/src/global.xml index 304a9b1d88..9c50049503 100644 --- a/lib/kernel/doc/src/global.xml +++ b/lib/kernel/doc/src/global.xml @@ -163,7 +163,8 @@ <fsummary>Globally register a name for a pid</fsummary> <type name="method"/> <type_desc name="method">{<c>Module</c>, <c>Function</c>} - is also allowed + is currently also allowed for backward compatibility, but its use is + deprecated </type_desc> <desc> <p>Globally associates the name <c><anno>Name</anno></c> with a pid, that is, @@ -180,6 +181,15 @@ unregistered. This function is called once for each name clash.</p> + <warning> + <p>If you plan to change code without restarting your system, + you must use an external fun (<c>fun Module:Function/Arity</c>) + as the <c><anno>Resolve</anno></c> function; if you use a + local fun you can never replace the code for the module that + the fun belongs to. + </p> + </warning> + <p>There are three pre-defined resolve functions: <c>random_exit_name/3</c>, <c>random_notify_name/3</c>, and <c>notify_all_name/3</c>. If no <c><anno>Resolve</anno></c> function is diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml index 26d1e27822..2826d3d00a 100644 --- a/lib/kernel/doc/src/heart.xml +++ b/lib/kernel/doc/src/heart.xml @@ -71,6 +71,39 @@ timeout and try to reboot the system. This can happen, for example, if the system clock is adjusted automatically by use of NTP (Network Time Protocol).</p> + + <p> If a crash occurs, an <c><![CDATA[erl_crash.dump]]></c> will <em>not</em> be written + unless the environment variable <c><![CDATA[ERL_CRASH_DUMP_SECONDS]]></c> is set. + </p> + + <pre> +% <input>erl -heart -env ERL_CRASH_DUMP_SECONDS 10 ...</input></pre> + <p> + Furthermore, <c><![CDATA[ERL_CRASH_DUMP_SECONDS]]></c> has the following behaviour on + <c>heart</c>: + </p> + <taglist> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=0]]></c></tag> + <item><p> + Suppresses the writing a crash dump file entirely, + thus rebooting the runtime system immediately. + This is the same as not setting the environment variable. + </p> + </item> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=-1]]></c></tag> + <item><p> Setting the environment variable to a negative value will not reboot + the runtime system until the crash dump file has been completly written. + </p> + </item> + <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=S]]></c></tag> + <item><p> + Heart will wait for <c>S</c> seconds to let the crash dump file be written. + After <c>S</c> seconds <c>heart</c> will reboot the runtime system regardless of + the crash dump file has been written or not. + </p> + </item> + </taglist> + <p>In the following descriptions, all function fails with reason <c>badarg</c> if <c>heart</c> is not started.</p> </description> diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index c299fb085c..9b7c4aa7b8 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -37,8 +37,7 @@ -type application_opt() :: {'description', Description :: string()} | {'vsn', Vsn :: string()} | {'id', Id :: string()} - | {'modules', [(Module :: module()) | - {Module :: module(), Version :: term()}]} + | {'modules', [Module :: module()]} | {'registered', Names :: [Name :: atom()]} | {'applications', [Application :: atom()]} | {'included_applications', [Application :: atom()]} diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index ebfe84463a..68cd26ec10 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -162,7 +162,7 @@ %% appl_opt() = {description, string()} | %% {vsn, string()} | %% {id, string()}, | -%% {modules, [Module|{Module,Vsn}]} | +%% {modules, [Module]} | %% {registered, [atom()]} | %% {applications, [atom()]} | %% {included_applications, [atom()]} | @@ -172,7 +172,6 @@ %% {maxP, integer()|infinity} | %% {mod, {Module, term()}} %% Module = atom() -%% Vsn = term() %% Purpose: Starts the application_controller. This process starts all %% application masters for the applications. %% The kernel application is the only application that is @@ -446,7 +445,7 @@ get_application_module(Module) -> get_application_module(Module, AppModules). get_application_module(Module, [[AppName, Modules]|AppModules]) -> - case in_modules(Module, Modules) of + case lists:member(Module, Modules) of true -> {ok, AppName}; false -> @@ -455,16 +454,6 @@ get_application_module(Module, [[AppName, Modules]|AppModules]) -> get_application_module(_Module, []) -> undefined. -%% 'modules' key in .app is a list of Module or {Module,Vsn} -in_modules(Module, [Module|_Modules]) -> - true; -in_modules(Module, [{Module, _Vsn}|_Modules]) -> - true; -in_modules(Module, [_Module|Modules]) -> - in_modules(Module, Modules); -in_modules(_Module, []) -> - false. - permit_application(ApplName, Flag) -> gen_server:call(?AC, {permit_application, ApplName, Flag}, diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 5b1efcd395..1513fdaec0 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -44,6 +44,8 @@ %% To be used for debugging only: -export([pid2name/1]). +-export_type([continuation/0]). + -type dlog_state_error() :: 'ok' | {'error', term()}. -record(state, {queue = [], diff --git a/lib/kernel/src/erl_ddll.erl b/lib/kernel/src/erl_ddll.erl index f967fcc2ef..e03d280cd8 100644 --- a/lib/kernel/src/erl_ddll.erl +++ b/lib/kernel/src/erl_ddll.erl @@ -54,9 +54,7 @@ info(_, _) -> erlang:nif_error(undef). -spec format_error_int(ErrSpec) -> string() when - ErrSpec :: inconsisten | linked_in_driver | permanent - | not_loaded | not_loaded_by_this_process | not_pending - | already_loaded | unloading. + ErrSpec :: term(). format_error_int(_) -> erlang:nif_error(undef). diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 36cb713ee1..b24a9d5eac 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -232,7 +232,8 @@ register_name(Name, Pid) when is_pid(Pid) -> Name :: term(), Pid :: pid(), Resolve :: method(). -register_name(Name, Pid, Method) when is_pid(Pid) -> +register_name(Name, Pid, Method0) when is_pid(Pid) -> + Method = allow_tuple_fun(Method0), Fun = fun(Nodes) -> case (where(Name) =:= undefined) andalso check_dupname(Name, Pid) of true -> @@ -290,7 +291,8 @@ re_register_name(Name, Pid) when is_pid(Pid) -> Name :: term(), Pid :: pid(), Resolve :: method(). -re_register_name(Name, Pid, Method) when is_pid(Pid) -> +re_register_name(Name, Pid, Method0) when is_pid(Pid) -> + Method = allow_tuple_fun(Method0), Fun = fun(Nodes) -> gen_server:multi_call(Nodes, global_name_server, @@ -2218,3 +2220,9 @@ intersection(_, []) -> []; intersection(L1, L2) -> L1 -- (L1 -- L2). + +%% Support legacy tuple funs as resolve functions. +allow_tuple_fun({M, F}) when is_atom(M), is_atom(F) -> + fun M:F/3; +allow_tuple_fun(Fun) when is_function(Fun, 3) -> + Fun. diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index 28452a377e..de287bfa43 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -42,6 +42,7 @@ -define(CLEAR_CMD, 5). -define(GET_CMD, 6). -define(HEART_CMD, 7). +-define(PREPARING_CRASH, 8). % Used in beam vm -define(TIMEOUT, 5000). -define(CYCLE_TIMEOUT, 10000). @@ -130,6 +131,8 @@ start_portprogram() -> Port when is_port(Port) -> case wait_ack(Port) of ok -> + %% register port so the vm can find it if need be + register(heart_port, Port), {ok, Port}; {error, Reason} -> report_problem({{port_problem, Reason}, diff --git a/lib/kernel/src/pg2.erl b/lib/kernel/src/pg2.erl index 0d5838716e..1ff10eb303 100644 --- a/lib/kernel/src/pg2.erl +++ b/lib/kernel/src/pg2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -159,7 +159,7 @@ get_closest_pid(Name) -> -record(state, {}). --opaque state() :: #state{}. +-type state() :: #state{}. -spec init(Arg :: []) -> {'ok', state()}. diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index 0b1fc6e939..7c965ca384 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -62,6 +62,8 @@ %% Internals -export([proxy_user_flush/0]). +-export_type([key/0]). + %%------------------------------------------------------------------------ -type state() :: gb_tree(). diff --git a/lib/kernel/src/wrap_log_reader.erl b/lib/kernel/src/wrap_log_reader.erl index c41e0091e4..689269fc28 100644 --- a/lib/kernel/src/wrap_log_reader.erl +++ b/lib/kernel/src/wrap_log_reader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2011. All Rights Reserved. +%% Copyright Ericsson AB 1998-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,6 +30,8 @@ -export([open/1, open/2, chunk/1, chunk/2, close/1]). +-export_type([continuation/0]). + -include("disk_log.hrl"). -record(wrap_reader, diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index bcc2f0b840..2a886b2efc 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -31,22 +31,24 @@ [basic/1, api_open_close/1,api_listen/1,api_connect_init/1,api_opts/1, xfer_min/1,xfer_active/1,def_sndrcvinfo/1,implicit_inet6/1, - basic_stream/1, xfer_stream_min/1, peeloff/1, buffers/1, open_multihoming_ipv4_socket/1, open_unihoming_ipv6_socket/1, open_multihoming_ipv6_socket/1, - open_multihoming_ipv4_and_ipv6_socket/1]). + open_multihoming_ipv4_and_ipv6_socket/1, + basic_stream/1, xfer_stream_min/1, peeloff_active_once/1, + peeloff_active_true/1, buffers/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, api_open_close, api_listen, api_connect_init, api_opts, xfer_min, xfer_active, def_sndrcvinfo, implicit_inet6, - basic_stream, xfer_stream_min, peeloff, buffers, open_multihoming_ipv4_socket, open_unihoming_ipv6_socket, open_multihoming_ipv6_socket, - open_multihoming_ipv4_and_ipv6_socket]. + open_multihoming_ipv4_and_ipv6_socket, + basic_stream, xfer_stream_min, peeloff_active_once, + peeloff_active_true, buffers]. groups() -> []. @@ -923,23 +925,34 @@ do_from_other_process(Fun) -> end. +peeloff_active_once(doc) -> + "Peel off an SCTP stream socket ({active,once})"; +peeloff_active_once(suite) -> + []; + +peeloff_active_once(Config) -> + peeloff(Config, [{active,once}]). -peeloff(doc) -> - "Peel off an SCTP stream socket"; -peeloff(suite) -> +peeloff_active_true(doc) -> + "Peel off an SCTP stream socket ({active,true})"; +peeloff_active_true(suite) -> []; -peeloff(Config) when is_list(Config) -> + +peeloff_active_true(Config) -> + peeloff(Config, [{active,true}]). + +peeloff(Config, SockOpts) when is_list(Config) -> ?line Addr = {127,0,0,1}, ?line Stream = 0, ?line Timeout = 333, - ?line S1 = socket_open([{ifaddr,Addr}], Timeout), + ?line S1 = socket_open([{ifaddr,Addr}|SockOpts], Timeout), ?line ?LOGVAR(S1), ?line P1 = socket_call(S1, get_port), ?line ?LOGVAR(P1), ?line Socket1 = socket_call(S1, get_socket), ?line ?LOGVAR(Socket1), ?line socket_call(S1, {listen,true}), - ?line S2 = socket_open([{ifaddr,Addr}], Timeout), + ?line S2 = socket_open([{ifaddr,Addr}|SockOpts], Timeout), ?line ?LOGVAR(S2), ?line P2 = socket_call(S2, get_port), ?line ?LOGVAR(P2), @@ -983,7 +996,7 @@ peeloff(Config) when is_list(Config) -> socket_bailout([S1,S2]) end, %% - ?line S3 = socket_peeloff(Socket1, S1Ai, Timeout), + ?line S3 = socket_peeloff(Socket1, S1Ai, SockOpts, Timeout), ?line ?LOGVAR(S3), ?line P3_X = socket_call(S3, get_port), ?line ?LOGVAR(P3_X), @@ -1302,8 +1315,15 @@ recv_comm_up_eventually(S) -> %%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% socket gen_server ultra light -socket_open(SocketOpts, Timeout) -> - Opts = [{type,seqpacket},{active,once},binary|SocketOpts], +socket_open(SockOpts0, Timeout) -> + SockOpts = + case lists:keyfind(active,1,SockOpts0) of + false -> + [{active,once}|SockOpts0]; + _ -> + SockOpts0 + end, + Opts = [{type,seqpacket},binary|SockOpts], Starter = fun () -> {ok,Socket} = @@ -1312,8 +1332,8 @@ socket_open(SocketOpts, Timeout) -> end, s_start(Starter, Timeout). -socket_peeloff(Socket, AssocId, Timeout) -> - Opts = [{active,once},binary], +socket_peeloff(Socket, AssocId, SocketOpts, Timeout) -> + Opts = [binary|SocketOpts], Starter = fun () -> {ok,NewSocket} = diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 31005a01e2..970a03cfd5 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -22,7 +22,10 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, start/1, restart/1, - reboot/1, set_cmd/1, clear_cmd/1, get_cmd/1, + reboot/1, + node_start_immediately_after_crash/1, + node_start_soon_after_crash/1, + set_cmd/1, clear_cmd/1, get_cmd/1, dont_drop/1, kill_pid/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -38,15 +41,15 @@ init_per_testcase(_Func, Config) -> end_per_testcase(_Func, Config) -> Nodes = nodes(), lists:foreach(fun(X) -> - NNam = list_to_atom(hd(string:tokens(atom_to_list(X),"@"))), - case NNam of - heart_test -> - ?t:format(1, "WARNING: Killed ~p~n", [X]), - rpc:cast(X, erlang, halt, []); - _ -> - ok - end - end, Nodes), + NNam = list_to_atom(hd(string:tokens(atom_to_list(X),"@"))), + case NNam of + heart_test -> + ?t:format(1, "WARNING: Killed ~p~n", [X]), + rpc:cast(X, erlang, halt, []); + _ -> + ok + end + end, Nodes), Dog=?config(watchdog, Config), test_server:timetrap_cancel(Dog). @@ -57,8 +60,13 @@ end_per_testcase(_Func, Config) -> %%----------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> - [start, restart, reboot, set_cmd, clear_cmd, get_cmd, kill_pid]. +all() -> [ + start, restart, reboot, + node_start_immediately_after_crash, + node_start_soon_after_crash, + set_cmd, clear_cmd, get_cmd, + kill_pid + ]. groups() -> []. @@ -80,17 +88,22 @@ init_per_suite(Config) when is_list(Config) -> end_per_suite(Config) when is_list(Config) -> Config. + start_check(Type, Name) -> + start_check(Type, Name, []). +start_check(Type, Name, Envs) -> Args = case ?t:os_type() of - {win32,_} -> "-heart -env HEART_COMMAND no_reboot"; - _ -> "-heart" - end, + {win32,_} -> + "-heart " ++ env_encode([{"HEART_COMMAND", no_reboot}|Envs]); + _ -> + "-heart " ++ env_encode(Envs) + end, {ok, Node} = case Type of - loose -> - loose_node:start(Name, Args, ?DEFAULT_TIMEOUT_SECS); - _ -> - ?t:start_node(Name, Type, [{args, Args}]) - end, + loose -> + loose_node:start(Name, Args, ?DEFAULT_TIMEOUT_SECS); + _ -> + ?t:start_node(Name, Type, [{args, Args}]) + end, erlang:monitor_node(Node, true), case rpc:call(Node, erlang, whereis, [heart]) of Pid when is_pid(Pid) -> @@ -103,21 +116,19 @@ start_check(Type, Name) -> start(doc) -> []; start(suite) -> {req, [{time, 10}]}; start(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(slave, heart_test), - ?line rpc:call(Node, init, reboot, []), + {ok, Node} = start_check(slave, heart_test), + rpc:call(Node, init, reboot, []), receive - {nodedown, Node} -> - ok - after 2000 -> - test_server:fail(node_not_closed) + {nodedown, Node} -> ok + after 2000 -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - ?line case net_adm:ping(Node) of - pang -> - ok; - _ -> - test_server:fail(node_rebooted) - end, + case net_adm:ping(Node) of + pang -> + ok; + _ -> + test_server:fail(node_rebooted) + end, test_server:stop_node(Node). %% Also test fixed bug in R1B (it was not possible to @@ -125,6 +136,10 @@ start(Config) when is_list(Config) -> %% Slave executes erlang:halt() on master nodedown. %% Therefore the slave process has to be killed %% before restart. + +%% restart +%% Purpose: +%% Check that a node is up and running after a init:restart/0 restart(doc) -> []; restart(suite) -> case ?t:os_type() of @@ -134,8 +149,8 @@ restart(suite) -> {skip, "Only run on unix and win32"} end; restart(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(loose, heart_test), - ?line rpc:call(Node, init, restart, []), + {ok, Node} = start_check(loose, heart_test), + rpc:call(Node, init, restart, []), receive {nodedown, Node} -> ok @@ -143,32 +158,21 @@ restart(Config) when is_list(Config) -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - - ?line case net_adm:ping(Node) of - pong -> - erlang:monitor_node(Node, true), - ?line rpc:call(Node, init, stop, []), - receive - {nodedown, Node} -> - ok - after 2000 -> - test_server:fail(node_not_closed2) - end, - ok; - _ -> - test_server:fail(node_not_restarted) - end, + node_check_up_down(Node, 2000), loose_node:stop(Node). +%% reboot +%% Purpose: +%% Check that a node is up and running after a init:reboot/0 reboot(doc) -> []; reboot(suite) -> {req, [{time, 10}]}; reboot(Config) when is_list(Config) -> {ok, Node} = start_check(slave, heart_test), - ?line ok = rpc:call(Node, heart, set_cmd, + ok = rpc:call(Node, heart, set_cmd, [atom_to_list(lib:progname()) ++ " -noshell -heart " ++ name(Node) ++ "&"]), - ?line rpc:call(Node, init, reboot, []), + rpc:call(Node, init, reboot, []), receive {nodedown, Node} -> ok @@ -176,44 +180,119 @@ reboot(Config) when is_list(Config) -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - ?line case net_adm:ping(Node) of - pong -> - erlang:monitor_node(Node, true), - ?line rpc:call(Node, init, reboot, []), - receive - {nodedown, Node} -> - ok - after 2000 -> - test_server:fail(node_not_closed2) - end, - ok; - _ -> - test_server:fail(node_not_rebooted) - end, + node_check_up_down(Node, 2000), ok. +%% node_start_immediately_after_crash +%% Purpose: +%% Check that a node is up and running after a crash. +%% This test exhausts the atom table on the remote node. +%% ERL_CRASH_DUMP_SECONDS=0 will force beam not to dump an erl_crash.dump. +node_start_immediately_after_crash(suite) -> {req, [{time, 10}]}; +node_start_immediately_after_crash(Config) when is_list(Config) -> + {ok, Node} = start_check(loose, heart_test_imm, [{"ERL_CRASH_DUMP_SECONDS", "0"}]), + + ok = rpc:call(Node, heart, set_cmd, + [atom_to_list(lib:progname()) ++ + " -noshell -heart " ++ name(Node) ++ "&"]), + + Mod = exhaust_atoms, + + Code = generate(Mod, [], [ + "do() -> " + " Set = lists:seq($a,$z), " + " [ list_to_atom([A,B,C,D,E]) || " + " A <- Set, B <- Set, C <- Set, E <- Set, D <- Set ]." + ]), + + %% crash it with atom exhaustion + rpc:call(Node, erlang, load_module, [Mod, Code]), + rpc:cast(Node, Mod, do, []), + + T0 = now(), + + receive {nodedown, Node} -> + test_server:format("Took ~.2f s. for node to go down~n", [timer:now_diff(now(), T0)/1000000]), + ok + %% timeout is very liberal here. nodedown is received in about 1 s. on linux (palantir) + %% and in about 10 s. on solaris (carcharoth) + after (15000*test_server:timetrap_scale_factor()) -> test_server:fail(node_not_closed) + end, + test_server:sleep(3000), + node_check_up_down(Node, 2000), + loose_node:stop(Node). + +%% node_start_soon_after_crash +%% Purpose: +%% Check that a node is up and running after a crash. +%% This test exhausts the atom table on the remote node. +%% ERL_CRASH_DUMP_SECONDS=10 will force beam +%% to only dump an erl_crash.dump for 10 seconds. +node_start_soon_after_crash(suite) -> {req, [{time, 10}]}; +node_start_soon_after_crash(Config) when is_list(Config) -> + {ok, Node} = start_check(loose, heart_test_soon, [{"ERL_CRASH_DUMP_SECONDS", "10"}]), + + ok = rpc:call(Node, heart, set_cmd, + [atom_to_list(lib:progname()) ++ + " -noshell -heart " ++ name(Node) ++ "&"]), + + Mod = exhaust_atoms, + + Code = generate(Mod, [], [ + "do() -> " + " Set = lists:seq($a,$z), " + " [ list_to_atom([A,B,C,D,E]) || " + " A <- Set, B <- Set, C <- Set, E <- Set, D <- Set ]." + ]), + + %% crash it with atom exhaustion + rpc:call(Node, erlang, load_module, [Mod, Code]), + rpc:cast(Node, Mod, do, []), + + receive {nodedown, Node} -> ok + after (15000*test_server:timetrap_scale_factor()) -> test_server:fail(node_not_closed) + end, + test_server:sleep(20000), + node_check_up_down(Node, 15000), + loose_node:stop(Node). + + +node_check_up_down(Node, Tmo) -> + case net_adm:ping(Node) of + pong -> + erlang:monitor_node(Node, true), + rpc:call(Node, init, reboot, []), + receive + {nodedown, Node} -> ok + after Tmo -> + test_server:fail(node_not_closed2) + end; + _ -> + test_server:fail(node_not_rebooted) + end. + %% Only tests bad command, correct behaviour is tested in reboot/1. set_cmd(suite) -> []; set_cmd(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(slave, heart_test), + {ok, Node} = start_check(slave, heart_test), Cmd = wrong_atom, - ?line {error, {bad_cmd, Cmd}} = rpc:call(Node, heart, set_cmd, [Cmd]), + {error, {bad_cmd, Cmd}} = rpc:call(Node, heart, set_cmd, [Cmd]), Cmd1 = lists:duplicate(2047, $a), - ?line {error, {bad_cmd, Cmd1}} = rpc:call(Node, heart, set_cmd, [Cmd1]), + {error, {bad_cmd, Cmd1}} = rpc:call(Node, heart, set_cmd, [Cmd1]), Cmd2 = lists:duplicate(28, $a), - ?line ok = rpc:call(Node, heart, set_cmd, [Cmd2]), + ok = rpc:call(Node, heart, set_cmd, [Cmd2]), Cmd3 = lists:duplicate(2000, $a), - ?line ok = rpc:call(Node, heart, set_cmd, [Cmd3]), + ok = rpc:call(Node, heart, set_cmd, [Cmd3]), stop_node(Node), ok. clear_cmd(suite) -> {req,[{time,15}]}; clear_cmd(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(slave, heart_test), - ?line ok = rpc:call(Node, heart, set_cmd, + {ok, Node} = start_check(slave, heart_test), + ok = rpc:call(Node, heart, set_cmd, [atom_to_list(lib:progname()) ++ " -noshell -heart " ++ name(Node) ++ "&"]), - ?line rpc:call(Node, init, reboot, []), + rpc:call(Node, init, reboot, []), receive {nodedown, Node} -> ok @@ -221,16 +300,16 @@ clear_cmd(Config) when is_list(Config) -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - ?line case net_adm:ping(Node) of - pong -> - erlang:monitor_node(Node, true); - _ -> - test_server:fail(node_not_rebooted) - end, - ?line ok = rpc:call(Node, heart, set_cmd, + case net_adm:ping(Node) of + pong -> + erlang:monitor_node(Node, true); + _ -> + test_server:fail(node_not_rebooted) + end, + ok = rpc:call(Node, heart, set_cmd, ["erl -noshell -heart " ++ name(Node) ++ "&"]), - ?line ok = rpc:call(Node, heart, clear_cmd, []), - ?line rpc:call(Node, init, reboot, []), + ok = rpc:call(Node, heart, clear_cmd, []), + rpc:call(Node, init, reboot, []), receive {nodedown, Node} -> ok @@ -238,20 +317,20 @@ clear_cmd(Config) when is_list(Config) -> test_server:fail(node_not_closed) end, test_server:sleep(5000), - ?line case net_adm:ping(Node) of - pang -> - ok; - _ -> - test_server:fail(node_rebooted) - end, + case net_adm:ping(Node) of + pang -> + ok; + _ -> + test_server:fail(node_rebooted) + end, ok. get_cmd(suite) -> []; get_cmd(Config) when is_list(Config) -> - ?line {ok, Node} = start_check(slave, heart_test), + {ok, Node} = start_check(slave, heart_test), Cmd = "test", - ?line ok = rpc:call(Node, heart, set_cmd, [Cmd]), - ?line {ok, Cmd} = rpc:call(Node, heart, get_cmd, []), + ok = rpc:call(Node, heart, set_cmd, [Cmd]), + {ok, Cmd} = rpc:call(Node, heart, get_cmd, []), stop_node(Node), ok. @@ -269,57 +348,53 @@ dont_drop(Config) when is_list(Config) -> [ok,ok,ok,ok,ok,ok,ok,ok,ok,ok] = do_dont_drop(Config,10), ok. -do_dont_drop(_,0) -> - []; +do_dont_drop(_,0) -> []; do_dont_drop(Config,N) -> %% Name of first slave node - ?line NN1 = atom_to_list(?MODULE) ++ "slave_1", + NN1 = atom_to_list(?MODULE) ++ "slave_1", %% Name of node started by heart on failure - ?line NN2 = atom_to_list(?MODULE) ++ "slave_2", + NN2 = atom_to_list(?MODULE) ++ "slave_2", %% Name of node started by heart on success - ?line NN3 = atom_to_list(?MODULE) ++ "slave_3", - ?line Host = hd(tl(string:tokens(atom_to_list(node()),"@"))), + NN3 = atom_to_list(?MODULE) ++ "slave_3", + Host = hd(tl(string:tokens(atom_to_list(node()),"@"))), %% The initial heart command - ?line FirstCmd = erl() ++ name(NN2 ++ "@" ++ Host), + FirstCmd = erl() ++ name(NN2 ++ "@" ++ Host), %% Separated the parameters to start_node_run for clarity... - ?line Name = list_to_atom(NN1), - ?line Env = [{"HEART_COMMAND", FirstCmd}], - ?line Func = "start_heart_stress", - ?line Arg = NN3 ++ "@" ++ Host ++ " " ++ + Name = list_to_atom(NN1), + Env = [{"HEART_COMMAND", FirstCmd}], + Func = "start_heart_stress", + Arg = NN3 ++ "@" ++ Host ++ " " ++ filename:join(?config(data_dir, Config), "simple_echo"), - ?line start_node_run(Name,Env,Func,Arg), - ?line case wait_for_any_of(list_to_atom(NN2 ++ "@" ++ Host), - list_to_atom(NN3 ++ "@" ++ Host)) of - 2 -> - ?line [ok | do_dont_drop(Config,N-1)]; - _ -> - ?line false - end. + start_node_run(Name,Env,Func,Arg), + case wait_for_any_of(list_to_atom(NN2 ++ "@" ++ Host), + list_to_atom(NN3 ++ "@" ++ Host)) of + 2 -> + [ok | do_dont_drop(Config,N-1)]; + _ -> + false + end. wait_for_any_of(N1,N2) -> - ?line wait_for_any_of(N1,N2,45). + wait_for_any_of(N1,N2,45). wait_for_any_of(_N1,_N2,0) -> - ?line false; + false; wait_for_any_of(N1,N2,Times) -> - ?line receive - after 1000 -> - ?line ok - end, - ?line case net_adm:ping(N1) of - pang -> - ?line case net_adm:ping(N2) of - pang -> - ?line wait_for_any_of(N1,N2,Times - 1); - pong -> - ?line rpc:call(N2,init,stop,[]), - ?line 2 - end; - pong -> - ?line rpc:call(N1,init,stop,[]), - ?line 1 - end. + receive after 1000 -> ok end, + case net_adm:ping(N1) of + pang -> + case net_adm:ping(N2) of + pang -> + wait_for_any_of(N1,N2,Times - 1); + pong -> + rpc:call(N2,init,stop,[]), + 2 + end; + pong -> + rpc:call(N1,init,stop,[]), + 1 + end. kill_pid(suite) -> @@ -336,9 +411,7 @@ do_kill_pid(_Config) -> {ok,Node} = start_node_run(Name,Env,suicide_by_heart,[]), ok = wait_for_node(Node,15), erlang:monitor_node(Node, true), - receive - {nodedown,Node} -> - ok + receive {nodedown,Node} -> ok after 30000 -> false end. @@ -346,23 +419,16 @@ do_kill_pid(_Config) -> wait_for_node(_,0) -> false; wait_for_node(Node,N) -> - receive - after 1000 -> - ok - end, + receive after 1000 -> ok end, case net_adm:ping(Node) of - pong -> - ok; - pang -> - wait_for_node(Node,N-1) + pong -> ok; + pang -> wait_for_node(Node,N-1) end. erl() -> case os:type() of - {win32,_} -> - "werl "; - _ -> - "erl " + {win32,_} -> "werl "; + _ -> "erl " end. name(Node) when is_list(Node) -> name(Node,[]); @@ -379,15 +445,13 @@ name([H|T], Name) -> name(T, [H|Name]). -atom_conv(A) when is_atom(A) -> - atom_to_list(A); -atom_conv(A) when is_list(A) -> - A. +enc(A) when is_atom(A) -> atom_to_list(A); +enc(A) when is_binary(A) -> binary_to_list(A); +enc(A) when is_list(A) -> A. -env_conv([]) -> - []; -env_conv([{X,Y}|T]) -> - atom_conv(X) ++ " \"" ++ atom_conv(Y) ++ "\" " ++ env_conv(T). +env_encode([]) -> []; +env_encode([{X,Y}|T]) -> + "-env " ++ enc(X) ++ " \"" ++ enc(Y) ++ "\" " ++ env_encode(T). %%% %%% Starts a node and runs a function in this @@ -398,12 +462,12 @@ env_conv([{X,Y}|T]) -> %%% Argument is the argument(s) to send through erl -s %%% start_node_run(Name, Env, Function, Argument) -> - ?line PA = filename:dirname(code:which(?MODULE)), - ?line Params = "-heart -env " ++ env_conv(Env) ++ " -pa " ++ PA ++ - " -s " ++ - atom_conv(?MODULE) ++ " " ++ atom_conv(Function) ++ " " ++ - atom_conv(Argument), - ?line start_node(Name, Params). + PA = filename:dirname(code:which(?MODULE)), + Params = "-heart " ++ env_encode(Env) ++ " -pa " ++ PA ++ + " -s " ++ + enc(?MODULE) ++ " " ++ enc(Function) ++ " " ++ + enc(Argument), + start_node(Name, Params). start_node(Name, Param) -> test_server:start_node(Name, slave, [{args, Param}]). @@ -469,3 +533,24 @@ suicide_by_heart() -> {makaronipudding} -> sallad end. + + +%% generate a module from binary +generate(Module, Attributes, FunStrings) -> + FunForms = function_forms(FunStrings), + Forms = [ + {attribute,1,module,Module}, + {attribute,2,export,[FA || {FA,_} <- FunForms]} + ] ++ [{attribute, 3, A, V}|| {A, V} <- Attributes] ++ + [ Function || {_, Function} <- FunForms], + {ok, Module, Bin} = compile:forms(Forms), + Bin. + + +function_forms([]) -> []; +function_forms([S|Ss]) -> + {ok, Ts,_} = erl_scan:string(S), + {ok, Form} = erl_parse:parse_form(Ts), + Fun = element(3, Form), + Arity = element(4, Form), + [{{Fun,Arity}, Form}|function_forms(Ss)]. diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index 4787f19250..da57867a54 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -29,7 +29,7 @@ -export([toerl_server/3]). init_per_testcase(_Func, Config) -> - Dog = test_server:timetrap(test_server:seconds(60)), + Dog = test_server:timetrap(test_server:minutes(3)), Term = case os:getenv("TERM") of List when is_list(List) -> List; diff --git a/lib/mnesia/test/mnesia_recovery_test.erl b/lib/mnesia/test/mnesia_recovery_test.erl index 625e6e824c..c4910a4b11 100644 --- a/lib/mnesia/test/mnesia_recovery_test.erl +++ b/lib/mnesia/test/mnesia_recovery_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -99,21 +99,21 @@ groups() -> async_dirty_post_kill_coord_node, async_dirty_post_kill_coord_pid]}, {asym_trans, [], - [asym_trans_kill_part_ask, - asym_trans_kill_part_commit_vote, - asym_trans_kill_part_pre_commit, - asym_trans_kill_part_log_commit, - asym_trans_kill_part_do_commit, - asym_trans_kill_coord_got_votes, - asym_trans_kill_coord_pid_got_votes, - asym_trans_kill_coord_log_commit_rec, - asym_trans_kill_coord_pid_log_commit_rec, - asym_trans_kill_coord_log_commit_dec, - asym_trans_kill_coord_pid_log_commit_dec, - asym_trans_kill_coord_rec_acc_pre_commit_log_commit, - asym_trans_kill_coord_pid_rec_acc_pre_commit_log_commit, - asym_trans_kill_coord_rec_acc_pre_commit_done_commit, - asym_trans_kill_coord_pid_rec_acc_pre_commit_done_commit]}, + [asymtrans_part_ask, + asymtrans_part_commit_vote, + asymtrans_part_pre_commit, + asymtrans_part_log_commit, + asymtrans_part_do_commit, + asymtrans_coord_got_votes, + asymtrans_coord_pid_got_votes, + asymtrans_coord_log_commit_rec, + asymtrans_coord_pid_log_commit_rec, + asymtrans_coord_log_commit_dec, + asymtrans_coord_pid_log_commit_dec, + asymtrans_coord_rec_acc_pre_commit_log_commit, + asymtrans_coord_pid_rec_acc_pre_commit_log_commit, + asymtrans_coord_rec_acc_pre_commit_done_commit, + asymtrans_coord_pid_rec_acc_pre_commit_done_commit]}, {after_corrupt_files, [], [after_corrupt_files_decision_log_head, after_corrupt_files_decision_log_tail, @@ -978,8 +978,8 @@ do_async_dirty([Tab], _Fahter) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -asym_trans_kill_part_ask(suite) -> []; -asym_trans_kill_part_ask(Config) when is_list(Config) -> +asymtrans_part_ask(suite) -> []; +asymtrans_part_ask(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -989,8 +989,8 @@ asym_trans_kill_part_ask(Config) when is_list(Config) -> kill_after_debug_point(Part1, {Part1, {mnesia_tm, doit_ask_commit}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_part_commit_vote(suite) -> []; -asym_trans_kill_part_commit_vote(Config) when is_list(Config) -> +asymtrans_part_commit_vote(suite) -> []; +asymtrans_part_commit_vote(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1000,8 +1000,8 @@ asym_trans_kill_part_commit_vote(Config) when is_list(Config) -> kill_after_debug_point(Part1, {Part1, {mnesia_tm, commit_participant, vote_yes}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_part_pre_commit(suite) -> []; -asym_trans_kill_part_pre_commit(Config) when is_list(Config) -> +asymtrans_part_pre_commit(suite) -> []; +asymtrans_part_pre_commit(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1011,8 +1011,8 @@ asym_trans_kill_part_pre_commit(Config) when is_list(Config) -> kill_after_debug_point(Part1, {Part1, {mnesia_tm, commit_participant, pre_commit}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_part_log_commit(suite) -> []; -asym_trans_kill_part_log_commit(Config) when is_list(Config) -> +asymtrans_part_log_commit(suite) -> []; +asymtrans_part_log_commit(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1022,8 +1022,8 @@ asym_trans_kill_part_log_commit(Config) when is_list(Config) -> kill_after_debug_point(Part1, {Part1, {mnesia_tm, commit_participant, log_commit}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_part_do_commit(suite) -> []; -asym_trans_kill_part_do_commit(Config) when is_list(Config) -> +asymtrans_part_do_commit(suite) -> []; +asymtrans_part_do_commit(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1033,8 +1033,8 @@ asym_trans_kill_part_do_commit(Config) when is_list(Config) -> kill_after_debug_point(Part1, {Part1, {mnesia_tm, commit_participant, do_commit}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_got_votes(suite) -> []; -asym_trans_kill_coord_got_votes(Config) when is_list(Config) -> +asymtrans_coord_got_votes(suite) -> []; +asymtrans_coord_got_votes(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1044,8 +1044,8 @@ asym_trans_kill_coord_got_votes(Config) when is_list(Config) -> kill_after_debug_point(Coord, {Coord, {mnesia_tm, multi_commit_asym_got_votes}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_pid_got_votes(suite) -> []; -asym_trans_kill_coord_pid_got_votes(Config) when is_list(Config) -> +asymtrans_coord_pid_got_votes(suite) -> []; +asymtrans_coord_pid_got_votes(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1055,8 +1055,8 @@ asym_trans_kill_coord_pid_got_votes(Config) when is_list(Config) -> kill_after_debug_point(coord_pid, {Coord, {mnesia_tm, multi_commit_asym_got_votes}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_log_commit_rec(suite) -> []; -asym_trans_kill_coord_log_commit_rec(Config) when is_list(Config) -> +asymtrans_coord_log_commit_rec(suite) -> []; +asymtrans_coord_log_commit_rec(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1066,8 +1066,8 @@ asym_trans_kill_coord_log_commit_rec(Config) when is_list(Config) -> kill_after_debug_point(Coord, {Coord, {mnesia_tm, multi_commit_asym_log_commit_rec}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_pid_log_commit_rec(suite) -> []; -asym_trans_kill_coord_pid_log_commit_rec(Config) when is_list(Config) -> +asymtrans_coord_pid_log_commit_rec(suite) -> []; +asymtrans_coord_pid_log_commit_rec(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1077,8 +1077,8 @@ asym_trans_kill_coord_pid_log_commit_rec(Config) when is_list(Config) -> kill_after_debug_point(coord_pid, {Coord, {mnesia_tm, multi_commit_asym_log_commit_rec}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_log_commit_dec(suite) -> []; -asym_trans_kill_coord_log_commit_dec(Config) when is_list(Config) -> +asymtrans_coord_log_commit_dec(suite) -> []; +asymtrans_coord_log_commit_dec(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1088,8 +1088,8 @@ asym_trans_kill_coord_log_commit_dec(Config) when is_list(Config) -> kill_after_debug_point(Coord, {Coord, {mnesia_tm, multi_commit_asym_log_commit_dec}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_pid_log_commit_dec(suite) -> []; -asym_trans_kill_coord_pid_log_commit_dec(Config) when is_list(Config) -> +asymtrans_coord_pid_log_commit_dec(suite) -> []; +asymtrans_coord_pid_log_commit_dec(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1099,8 +1099,8 @@ asym_trans_kill_coord_pid_log_commit_dec(Config) when is_list(Config) -> kill_after_debug_point(coord_pid, {Coord, {mnesia_tm, multi_commit_asym_log_commit_dec}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_rec_acc_pre_commit_log_commit(suite) -> []; -asym_trans_kill_coord_rec_acc_pre_commit_log_commit(Config) when is_list(Config) -> +asymtrans_coord_rec_acc_pre_commit_log_commit(suite) -> []; +asymtrans_coord_rec_acc_pre_commit_log_commit(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1110,8 +1110,8 @@ asym_trans_kill_coord_rec_acc_pre_commit_log_commit(Config) when is_list(Config) kill_after_debug_point(Coord, {Coord, {mnesia_tm, rec_acc_pre_commit_log_commit}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_pid_rec_acc_pre_commit_log_commit(suite) -> []; -asym_trans_kill_coord_pid_rec_acc_pre_commit_log_commit(Config) when is_list(Config) -> +asymtrans_coord_pid_rec_acc_pre_commit_log_commit(suite) -> []; +asymtrans_coord_pid_rec_acc_pre_commit_log_commit(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1121,8 +1121,8 @@ asym_trans_kill_coord_pid_rec_acc_pre_commit_log_commit(Config) when is_list(Con kill_after_debug_point(coord_pid, {Coord, {mnesia_tm, rec_acc_pre_commit_log_commit}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_rec_acc_pre_commit_done_commit(suite) -> []; -asym_trans_kill_coord_rec_acc_pre_commit_done_commit(Config) when is_list(Config) -> +asymtrans_coord_rec_acc_pre_commit_done_commit(suite) -> []; +asymtrans_coord_rec_acc_pre_commit_done_commit(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, @@ -1132,8 +1132,8 @@ asym_trans_kill_coord_rec_acc_pre_commit_done_commit(Config) when is_list(Config kill_after_debug_point(Coord, {Coord, {mnesia_tm, rec_acc_pre_commit_done_commit}}, TransFun, [Tab1, Tab2], Nodes). -asym_trans_kill_coord_pid_rec_acc_pre_commit_done_commit(suite) -> []; -asym_trans_kill_coord_pid_rec_acc_pre_commit_done_commit(Config) when is_list(Config) -> +asymtrans_coord_pid_rec_acc_pre_commit_done_commit(suite) -> []; +asymtrans_coord_pid_rec_acc_pre_commit_done_commit(Config) when is_list(Config) -> ?is_debug_compiled, Nodes = ?acquire_nodes(3, Config ++ [{tc_timeout, timer:minutes(2)}]), [Coord, Part1, Part2] = Nodes, diff --git a/lib/odbc/c_src/odbcserver.c b/lib/odbc/c_src/odbcserver.c index 6d4460014f..fe81d1dd3a 100644 --- a/lib/odbc/c_src/odbcserver.c +++ b/lib/odbc/c_src/odbcserver.c @@ -104,6 +104,7 @@ #ifdef UNIX #include <unistd.h> +#include <netinet/tcp.h> #endif #if defined WIN32 @@ -201,6 +202,7 @@ static byte *receive_msg(int socket); static Boolean receive_msg_part(int socket, byte * buffer, size_t msg_len); static Boolean send_msg_part(int socket, byte * buffer, size_t msg_len); static void close_socket(int socket); +static void tcp_nodelay(int sock); #endif static void clean_socket_lib(void); @@ -1782,6 +1784,10 @@ static int connect_to_erlang(const char *port) sin6.sin6_addr = in6addr_loopback; if (connect(sock, (struct sockaddr*)&sin6, sizeof(sin6)) == 0) { + /* Enable TCP_NODELAY to disable Nagel's socket algorithm. (Removes ~40ms delay on Redhat ES 6). */ + #ifdef UNIX + tcp_nodelay(sock); + #endif return sock; } close_socket(sock); @@ -1797,9 +1803,24 @@ static int connect_to_erlang(const char *port) close_socket(sock); DO_EXIT(EXIT_SOCKET_CONNECT); } + + /* Enable TCP_NODELAY to disable Nagel's socket algorithm. (Removes ~40ms delay on Redhat ES 6). */ + #ifdef UNIX + tcp_nodelay(sock); + #endif return sock; } +#ifdef UNIX +static void tcp_nodelay(int sock) +{ + int flag = 1; + int result = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY, (char *) &flag, sizeof(int)); + if (result < 0) { + DO_EXIT(EXIT_SOCKET_CONNECT); + } +} +#endif #ifdef WIN32 static void close_socket(SOCKET socket) { diff --git a/lib/os_mon/test/Makefile b/lib/os_mon/test/Makefile index 9c5f2c1820..461bebc102 100644 --- a/lib/os_mon/test/Makefile +++ b/lib/os_mon/test/Makefile @@ -86,6 +86,7 @@ release_spec: release_tests_spec: make_emakefile $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) os_mon.spec os_mon.cover $(EMAKEFILE) $(SOURCE) "$(RELSYSDIR)" + $(INSTALL_DATA) os_mon_mib_SUITE.cfg "$(RELSYSDIR)" ## tar chf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/os_mon/test/os_mon.spec b/lib/os_mon/test/os_mon.spec index d292b258f3..4b4286b313 100644 --- a/lib/os_mon/test/os_mon.spec +++ b/lib/os_mon/test/os_mon.spec @@ -1 +1,2 @@ {suites,"../os_mon_test",all}. +{config,"os_mon_mib_SUITE.cfg"}.
\ No newline at end of file diff --git a/lib/os_mon/test/os_mon_mib_SUITE.cfg b/lib/os_mon/test/os_mon_mib_SUITE.cfg new file mode 100644 index 0000000000..a33c23530b --- /dev/null +++ b/lib/os_mon/test/os_mon_mib_SUITE.cfg @@ -0,0 +1,8 @@ +%% -*- erlang -*- +{snmp, [{start_agent,true}, + {users,[{os_mon_mib_test,[snmpm_user_default,[]]}]}, + {managed_agents,[{os_mon_mib_test, + [os_mon_mib_test, {127,0,0,1}, 4000, []]}]}, + {agent_sysname,"Test os_mon_mibs"}, + {mgr_port,5001} + ]}. diff --git a/lib/os_mon/test/os_mon_mib_SUITE.erl b/lib/os_mon/test/os_mon_mib_SUITE.erl index a137efc441..08f5532d50 100644 --- a/lib/os_mon/test/os_mon_mib_SUITE.erl +++ b/lib/os_mon/test/os_mon_mib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -18,16 +18,20 @@ %% -module(os_mon_mib_SUITE). -%-define(STANDALONE,1). +%%----------------------------------------------------------------- +%% This suite can no longer be executed standalone, i.e. it must be +%% executed with common test. The reason is that ct_snmp is used +%% instead of the snmp application directly. The suite requires a +%% config file, os_mon_mib_SUITE.cfg, found in the same directory as +%% the suite. +%% +%% Execute with: +%% > ct_run -suite os_mon_mib_SUITE -config os_mon_mib_SUITE.cfg +%%----------------------------------------------------------------- --ifdef(STANDALONE). --define(line,erlang:display({line,?LINE}),). --define(config(A,B), config(A,B)). --else. -include_lib("test_server/include/test_server.hrl"). -include_lib("os_mon/include/OTP-OS-MON-MIB.hrl"). -include_lib("snmp/include/snmp_types.hrl"). --endif. % Test server specific exports -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, @@ -60,15 +64,6 @@ -define(MGR_PORT, 5001). %%--------------------------------------------------------------------- --ifdef(STANDALONE). --export([run/0]). -run() -> - catch init_per_suite([]), - Ret = (catch update_load_table([])), - catch end_per_suite([]), - Ret. --else. - init_per_testcase(_Case, Config) when is_list(Config) -> Dog = test_server:timetrap(test_server:minutes(6)), [{watchdog, Dog}|Config]. @@ -78,7 +73,8 @@ end_per_testcase(_Case, Config) when is_list(Config) -> test_server:timetrap_cancel(Dog), Config. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> [{ct_hooks,[ts_install_cth]}, + {require, snmp_mgr_agent, snmp}]. all() -> [load_unload, get_mem_sys_mark, get_mem_proc_mark, @@ -104,8 +100,6 @@ end_per_group(_GroupName, Config) -> Config. - --endif. %%--------------------------------------------------------------------- %%-------------------------------------------------------------------- %% Function: init_per_suite(Config) -> Config @@ -121,50 +115,13 @@ init_per_suite(Config) -> ?line application:start(mnesia), ?line application:start(os_mon), - %% Create initial configuration data for the snmp application - ?line PrivDir = ?config(priv_dir, Config), - ?line ConfDir = filename:join(PrivDir, "conf"), - ?line DbDir = filename:join(PrivDir,"db"), - ?line MgrDir = filename:join(PrivDir,"mgr"), - - ?line file:make_dir(ConfDir), - ?line file:make_dir(DbDir), - ?line file:make_dir(MgrDir), - - {ok, HostName} = inet:gethostname(), - {ok, Addr} = inet:getaddr(HostName, inet), - - ?line snmp_config:write_agent_snmp_files(ConfDir, ?CONF_FILE_VER, - tuple_to_list(Addr), ?TRAP_UDP, - tuple_to_list(Addr), - ?AGENT_UDP, ?SYS_NAME), - - ?line snmp_config:write_manager_snmp_files(MgrDir, tuple_to_list(Addr), - ?MGR_PORT, ?MAX_MSG_SIZE, - ?ENGINE_ID, [], [], []), - - %% To make sure application:set_env is not overwritten by any - %% app-file settings. - ?line ok = application:load(snmp), - - ?line application:set_env(snmp, agent, [{db_dir, DbDir}, - {config, [{dir, ConfDir}]}, - {agent_type, master}, - {agent_verbosity, trace}, - {net_if, [{verbosity, trace}]}]), - ?line application:set_env(snmp, manager, [{config, [{dir, MgrDir}, - {db_dir, MgrDir}, - {verbosity, trace}]}, - {server, [{verbosity, trace}]}, - {net_if, [{verbosity, trace}]}, - {versions, [v1, v2, v3]}]), - application:start(snmp), + ok = ct_snmp:start(Config,snmp_mgr_agent), %% Load the mibs that should be tested otp_mib:load(snmp_master_agent), os_mon_mib:load(snmp_master_agent), - [{agent_ip, Addr}| Config]. + Config. %%-------------------------------------------------------------------- %% Function: end_per_suite(Config) -> _ %% Config - [tuple()] @@ -197,7 +154,7 @@ end_per_suite(Config) -> load_unload(doc) -> ["Test to unload and the reload the OTP.mib "]; load_unload(suite) -> []; -load_unload(Config) when list(Config) -> +load_unload(Config) when is_list(Config) -> ?line os_mon_mib:unload(snmp_master_agent), ?line os_mon_mib:load(snmp_master_agent), ok. @@ -424,7 +381,7 @@ cpu_load(doc) -> []; cpu_load(suite) -> []; -cpu_load(Config) when list(Config) -> +cpu_load(Config) when is_list(Config) -> ?line [{[?loadCpuLoad, Len | NodeStr], Load}] = os_mon_mib:load_table(get_next,[], [?loadCpuLoad]), ?line Len = length(NodeStr), @@ -640,32 +597,24 @@ disk_capacity(Config) when is_list(Config) -> %%--------------------------------------------------------------------- real_snmp_request(doc) -> - ["Starts an snmp manager and sends a real snmp-reques. i.e. " + ["Starts an snmp manager and sends a real snmp-request. i.e. " "sends a udp message on the correct format."]; real_snmp_request(suite) -> []; -real_snmp_request(Config) when list(Config) -> - Agent_ip = ?config(agent_ip, Config), - - ?line ok = snmpm:register_user(os_mon_mib_test, snmpm_user_default, []), - ?line ok = snmpm:register_agent(os_mon_mib_test, Agent_ip, ?AGENT_UDP), - +real_snmp_request(Config) when is_list(Config) -> NodStr = atom_to_list(node()), Len = length(NodStr), {_, _, {Pid, _}} = memsup:get_memory_data(), PidStr = lists:flatten(io_lib:format("~w", [Pid])), io:format("FOO: ~p~n", [PidStr]), - ?line ok = snmp_get(Agent_ip, - [?loadEntry ++ + ?line ok = snmp_get([?loadEntry ++ [?loadLargestErlProcess, Len | NodStr]], PidStr), - ?line ok = snmp_get_next(Agent_ip, - [?loadEntry ++ + ?line ok = snmp_get_next([?loadEntry ++ [?loadSystemUsedMemory, Len | NodStr]], ?loadEntry ++ [?loadSystemUsedMemory + 1, Len | NodStr], PidStr), - ?line ok = snmp_set(Agent_ip, [?loadEntry ++ - [?loadLargestErlProcess, Len | NodStr]], - s, "<0.101.0>"), + ?line ok = snmp_set([?loadEntry ++ [?loadLargestErlProcess, Len | NodStr]], + s, "<0.101.0>", Config), ok. otp_7441(doc) -> @@ -674,34 +623,17 @@ otp_7441(doc) -> otp_7441(suite) -> []; otp_7441(Config) when is_list(Config) -> - Agent_ip = ?config(agent_ip, Config), - - NodStr = atom_to_list(node()), Len = length(NodStr), Oids = [Oid|_] = [?loadEntry ++ [?loadSystemTotalMemory, Len | NodStr]], - ?line { ok, {noError,0,[#varbind{oid = Oid, variabletype = 'Unsigned32'}]}, _} = - snmpm:g(os_mon_mib_test, Agent_ip, ?AGENT_UDP, Oids), + {noError,0,[#varbind{oid = Oid, variabletype = 'Unsigned32'}]} = + ct_snmp:get_values(os_mon_mib_test, Oids, snmp_mgr_agent), ok. %%--------------------------------------------------------------------- %% Internal functions %%--------------------------------------------------------------------- --ifdef(STANDALONE). -config(priv_dir,_) -> - "/tmp". - -start_node() -> - Host = hd(tl(string:tokens(atom_to_list(node()),"@"))), - {ok,Node} = slave:start(Host,testnisse), - net_adm:ping(testnisse), - Node. - - -stop_node(Node) -> - rpc:call(Node,erlang,halt,[]). --else. start_node() -> ?line Pa = filename:dirname(code:which(?MODULE)), ?line {ok,Node} = test_server:start_node(testnisse, slave, @@ -711,8 +643,6 @@ start_node() -> stop_node(Node) -> test_server:stop_node(Node). --endif. - del_dir(Dir) -> io:format("Deleting: ~s~n",[Dir]), {ok, Files} = file:list_dir(Dir), @@ -722,21 +652,22 @@ del_dir(Dir) -> file:del_dir(Dir). %%--------------------------------------------------------------------- -snmp_get(Agent_ip, Oids = [Oid |_], Result) -> - ?line {ok,{noError,0,[#varbind{oid = Oid, - variabletype = 'OCTET STRING', - value = Result}]}, _} = - snmpm:g(os_mon_mib_test, Agent_ip, ?AGENT_UDP, Oids), +snmp_get(Oids = [Oid |_], Result) -> + {noError,0,[#varbind{oid = Oid, + variabletype = 'OCTET STRING', + value = Result}]} = + ct_snmp:get_values(os_mon_mib_test, Oids, snmp_mgr_agent), ok. -snmp_get_next(Agent_ip, Oids, NextOid, Result) -> - ?line {ok,{noError,0,[#varbind{oid = NextOid, - variabletype = 'OCTET STRING', - value = Result}]},_} = - snmpm:gn(os_mon_mib_test, Agent_ip, ?AGENT_UDP, Oids), +snmp_get_next(Oids, NextOid, Result) -> + {noError,0,[#varbind{oid = NextOid, + variabletype = 'OCTET STRING', + value = Result}]} = + ct_snmp:get_next_values(os_mon_mib_test, Oids, snmp_mgr_agent), ok. -snmp_set(Agent_ip, Oid, ValuType, Value) -> - ?line {ok, {notWritable, _, _}, _} = - snmpm:s(os_mon_mib_test,Agent_ip,?AGENT_UDP,[{Oid, ValuType, Value}]), +snmp_set(Oid, ValuType, Value, Config) -> + {notWritable, _, _} = + ct_snmp:set_values(os_mon_mib_test, [{Oid, ValuType, Value}], + snmp_mgr_agent, Config), ok. diff --git a/lib/percept/src/percept.app.src b/lib/percept/src/percept.app.src index c70fede721..7b20093ece 100644 --- a/lib/percept/src/percept.app.src +++ b/lib/percept/src/percept.app.src @@ -17,14 +17,26 @@ %% %CopyrightEnd% %% -{application,percept, - [{description, "PERCEPT Erlang Concurrency Profiling Tool"}, - {vsn, "%VSN%"}, - {modules, [percept,percept_db,percept_html,percept_graph,percept_analyzer]}, - {registered, [percept_db,percept_port]}, - {applications, [kernel,stdlib]}, - {env, []} - ]}. - +{application,percept, [ + {description, "PERCEPT Erlang Concurrency Profiling Tool"}, + {vsn, "%VSN%"}, + {modules, [ + egd, + egd_font, + egd_png, + egd_primitives, + egd_render, + percept, + percept_analyzer, + percept_db, + percept_graph, + percept_html, + percept_image + ]}, + {registered, [percept_db,percept_port]}, + {applications, [kernel,stdlib]}, + {env,[]} +]}. +%% vim: syntax=erlang diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index e94a77a3e7..4f20208bce 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -119,6 +119,7 @@ IMPORTS md2WithRSAEncryption, md5WithRSAEncryption, sha1WithRSAEncryption, + sha224WithRSAEncryption, sha256WithRSAEncryption, sha384WithRSAEncryption, sha512WithRSAEncryption @@ -317,6 +318,7 @@ PublicKeyAlgorithm ::= SEQUENCE { SupportedSignatureAlgorithms SIGNATURE-ALGORITHM-CLASS ::= { dsa-with-sha1 | md2-with-rsa-encryption | md5-with-rsa-encryption | sha1-with-rsa-encryption | + sha224-with-rsa-encryption | sha256-with-rsa-encryption | sha384-with-rsa-encryption | sha512-with-rsa-encryption | @@ -365,6 +367,10 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { ID sha1WithRSAEncryption TYPE NULL } + sha224-with-rsa-encryption SIGNATURE-ALGORITHM-CLASS ::= { + ID sha224WithRSAEncryption + TYPE NULL } + sha256-with-rsa-encryption SIGNATURE-ALGORITHM-CLASS ::= { ID sha256WithRSAEncryption TYPE NULL } diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index b76e32a2a0..f9e2025479 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -376,8 +376,12 @@ encoded_tbs_cert(Cert) -> digest_type(?sha1WithRSAEncryption) -> sha; +digest_type(?sha224WithRSAEncryption) -> + sha224; digest_type(?sha256WithRSAEncryption) -> sha256; +digest_type(?sha384WithRSAEncryption) -> + sha384; digest_type(?sha512WithRSAEncryption) -> sha512; digest_type(?md5WithRSAEncryption) -> diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl index f0c94e29a5..008ea96dd3 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.erl @@ -47,7 +47,7 @@ decode(Bin, public_key)-> rfc4716_decode(Bin) end; decode(Bin, rfc4716_public_key) -> - rfc4716_decode(Bin); + rfc4716_decode(Bin); decode(Bin, Type) -> openssh_decode(Bin, Type). @@ -58,7 +58,7 @@ decode(Bin, Type) -> %% Description: Encodes a list of ssh file entries. %%-------------------------------------------------------------------- encode(Entries, Type) -> - erlang:iolist_to_binary(lists:map(fun({Key, Attributes}) -> + iolist_to_binary(lists:map(fun({Key, Attributes}) -> do_encode(Type, Key, Attributes) end, Entries)). @@ -106,7 +106,7 @@ rfc4716_decode_line(Line, Lines, Acc) -> _ -> {Body, Rest} = join_entry([Line | Lines], []), {lists:reverse(Acc), rfc4716_pubkey_decode(base64:mime_decode(Body)), Rest} - end. + end. join_entry([<<"---- END SSH2 PUBLIC KEY ----", _/binary>>| Lines], Entry) -> {lists:reverse(Entry), Lines}; @@ -115,16 +115,16 @@ join_entry([Line | Lines], Entry) -> rfc4716_pubkey_decode(<<?UINT32(Len), Type:Len/binary, - ?UINT32(SizeE), E:SizeE/binary, - ?UINT32(SizeN), N:SizeN/binary>>) when Type == <<"ssh-rsa">> -> + ?UINT32(SizeE), E:SizeE/binary, + ?UINT32(SizeN), N:SizeN/binary>>) when Type == <<"ssh-rsa">> -> #'RSAPublicKey'{modulus = erlint(SizeN, N), publicExponent = erlint(SizeE, E)}; rfc4716_pubkey_decode(<<?UINT32(Len), Type:Len/binary, - ?UINT32(SizeP), P:SizeP/binary, - ?UINT32(SizeQ), Q:SizeQ/binary, - ?UINT32(SizeG), G:SizeG/binary, - ?UINT32(SizeY), Y:SizeY/binary>>) when Type == <<"ssh-dss">> -> + ?UINT32(SizeP), P:SizeP/binary, + ?UINT32(SizeQ), Q:SizeQ/binary, + ?UINT32(SizeG), G:SizeG/binary, + ?UINT32(SizeY), Y:SizeY/binary>>) when Type == <<"ssh-dss">> -> {erlint(SizeY, Y), #'Dss-Parms'{p = erlint(SizeP, P), q = erlint(SizeQ, Q), @@ -143,94 +143,63 @@ do_openssh_decode(FileType, [<<>> | Lines], Acc) -> do_openssh_decode(FileType,[<<"#", _/binary>> | Lines], Acc) -> do_openssh_decode(FileType, Lines, Acc); do_openssh_decode(auth_keys = FileType, [Line | Lines], Acc) -> - Split = binary:split(Line, <<" ">>, [global]), - case mend_split(Split, []) of - %% ssh2 - [KeyType, Base64Enc, Comment] -> + case decode_auth_keys(Line) of + {ssh2, {options, [Options, KeyType, Base64Enc| Comment]}} -> do_openssh_decode(FileType, Lines, - [{openssh_pubkey_decode(KeyType, Base64Enc), - [{comment, string_decode(Comment)}]} | Acc]); - %% ssh1 - [Options, Bits, Exponent, Modulus, Comment] -> + [{openssh_pubkey_decode(KeyType, Base64Enc), + decode_comment(Comment) ++ [{options, comma_list_decode(Options)}]} | Acc]); + {ssh2, {no_options, [KeyType, Base64Enc| Comment]}} -> + do_openssh_decode(FileType, Lines, + [{openssh_pubkey_decode(KeyType, Base64Enc), + decode_comment(Comment)} | Acc]); + {ssh1, {options, [Options, Bits, Exponent, Modulus | Comment]}} -> do_openssh_decode(FileType, Lines, [{ssh1_rsa_pubkey_decode(Modulus, Exponent), - [{comment, string_decode(Comment)}, - {options, comma_list_decode(Options)}, - {bits, integer_decode(Bits)}]} | Acc]); - [A, B, C, D] -> - ssh_2_or_1(FileType, Lines, Acc, A,B,C,D) + decode_comment(Comment) ++ [{options, comma_list_decode(Options)}, + {bits, integer_decode(Bits)}] + } | Acc]); + {ssh1, {no_options, [Bits, Exponent, Modulus | Comment]}} -> + do_openssh_decode(FileType, Lines, + [{ssh1_rsa_pubkey_decode(Modulus, Exponent), + decode_comment(Comment) ++ [{bits, integer_decode(Bits)}] + } | Acc]) end; do_openssh_decode(known_hosts = FileType, [Line | Lines], Acc) -> - Split = binary:split(Line, <<" ">>, [global]), - case mend_split(Split, []) of - %% ssh 2 - [HostNames, KeyType, Base64Enc] -> + case decode_known_hosts(Line) of + {ssh2, [HostNames, KeyType, Base64Enc| Comment]} -> do_openssh_decode(FileType, Lines, - [{openssh_pubkey_decode(KeyType, Base64Enc), - [{hostnames, comma_list_decode(HostNames)}]}| Acc]); - [A, B, C, D] -> - ssh_2_or_1(FileType, Lines, Acc, A, B, C, D); - %% ssh 1 - [HostNames, Bits, Exponent, Modulus, Comment] -> + [{openssh_pubkey_decode(KeyType, Base64Enc), + decode_comment(Comment) ++ + [{hostnames, comma_list_decode(HostNames)}]}| Acc]); + {ssh1, [HostNames, Bits, Exponent, Modulus | Comment]} -> do_openssh_decode(FileType, Lines, - [{ssh1_rsa_pubkey_decode(Modulus, Exponent), - [{comment, string_decode(Comment)}, - {hostnames, comma_list_decode(HostNames)}, - {bits, integer_decode(Bits)}]} | Acc]) - end; + [{ssh1_rsa_pubkey_decode(Modulus, Exponent), + decode_comment(Comment) ++ + [{hostnames, comma_list_decode(HostNames)}, + {bits, integer_decode(Bits)}]} + | Acc]) + end; do_openssh_decode(openssh_public_key = FileType, [Line | Lines], Acc) -> - Split = binary:split(Line, <<" ">>, [global]), - case mend_split(Split, []) of - [KeyType, Base64Enc, Comment0] when KeyType == <<"ssh-rsa">>; - KeyType == <<"ssh-dss">> -> - Comment = string:strip(binary_to_list(Comment0), right, $\n), + case split_n(2, Line, []) of + [KeyType, Base64Enc] when KeyType == <<"ssh-rsa">>; + KeyType == <<"ssh-dss">> -> + do_openssh_decode(FileType, Lines, + [{openssh_pubkey_decode(KeyType, Base64Enc), + []} | Acc]); + [KeyType, Base64Enc | Comment0] when KeyType == <<"ssh-rsa">>; + KeyType == <<"ssh-dss">> -> + Comment = string:strip(string_decode(iolist_to_binary(Comment0)), right, $\n), do_openssh_decode(FileType, Lines, [{openssh_pubkey_decode(KeyType, Base64Enc), [{comment, Comment}]} | Acc]) end. -ssh_2_or_1(known_hosts = FileType, Lines, Acc, A, B, C, D) -> - try integer_decode(B) of - Int -> - file_type_decode_ssh1(FileType, Lines, Acc, A, Int, C,D) - catch - error:badarg -> - file_type_decode_ssh2(FileType, Lines, Acc, A,B,C,D) - end; -ssh_2_or_1(auth_keys = FileType, Lines, Acc, A, B, C, D) -> - try integer_decode(A) of - Int -> - file_type_decode_ssh1(FileType, Lines, Acc, Int, B, C,D) - catch - error:badarg -> - file_type_decode_ssh2(FileType, Lines, Acc, A,B,C,D) - end. - -file_type_decode_ssh1(known_hosts = FileType, Lines, Acc, HostNames, Bits, Exponent, Modulus) -> - do_openssh_decode(FileType, Lines, - [{ssh1_rsa_pubkey_decode(Modulus, Exponent), - [{comment, []}, - {hostnames, comma_list_decode(HostNames)}, - {bits, Bits}]} | Acc]); -file_type_decode_ssh1(auth_keys = FileType, Lines, Acc, Bits, Exponent, Modulus, Comment) -> - do_openssh_decode(FileType, Lines, - [{ssh1_rsa_pubkey_decode(Modulus, Exponent), - [{comment, string_decode(Comment)}, - {bits, Bits}]} | Acc]). - -file_type_decode_ssh2(known_hosts = FileType, Lines, Acc, HostNames, KeyType, Base64Enc, Comment) -> - do_openssh_decode(FileType, Lines, - [{openssh_pubkey_decode(KeyType, Base64Enc), - [{comment, string_decode(Comment)}, - {hostnames, comma_list_decode(HostNames)}]} | Acc]); -file_type_decode_ssh2(auth_keys = FileType, Lines, Acc, Options, KeyType, Base64Enc, Comment) -> - do_openssh_decode(FileType, Lines, - [{openssh_pubkey_decode(KeyType, Base64Enc), - [{comment, string_decode(Comment)}, - {options, comma_list_decode(Options)}]} - | Acc]). +decode_comment([]) -> + []; +decode_comment(Comment) -> + [{comment, string_decode(iolist_to_binary(Comment))}]. openssh_pubkey_decode(<<"ssh-rsa">>, Base64Enc) -> <<?UINT32(StrLen), _:StrLen/binary, @@ -267,7 +236,7 @@ integer_decode(BinStr) -> list_to_integer(binary_to_list(BinStr)). string_decode(BinStr) -> - binary_to_list(BinStr). + unicode_decode(BinStr). unicode_decode(BinStr) -> unicode:characters_to_list(BinStr). @@ -285,11 +254,11 @@ do_encode(Type, Key, Attributes) -> openssh_encode(Type, Key, Attributes). rfc4716_encode(Key, [],[]) -> - erlang:iolist_to_binary([begin_marker(),"\n", + iolist_to_binary([begin_marker(),"\n", split_lines(base64:encode(ssh2_pubkey_encode(Key))), "\n", end_marker(), "\n"]); rfc4716_encode(Key, [], [_|_] = Acc) -> - erlang:iolist_to_binary([begin_marker(), "\n", + iolist_to_binary([begin_marker(), "\n", lists:reverse(Acc), split_lines(base64:encode(ssh2_pubkey_encode(Key))), "\n", end_marker(), "\n"]); @@ -319,9 +288,9 @@ rfc4716_encode_value(Value) -> end. openssh_encode(openssh_public_key, Key, Attributes) -> - Comment = proplists:get_value(comment, Attributes), + Comment = proplists:get_value(comment, Attributes, ""), Enc = base64:encode(ssh2_pubkey_encode(Key)), - erlang:iolist_to_binary([key_type(Key), " ", Enc, " ", Comment, "\n"]); + iolist_to_binary([key_type(Key), " ", Enc, " ", Comment, "\n"]); openssh_encode(auth_keys, Key, Attributes) -> Comment = proplists:get_value(comment, Attributes, ""), @@ -345,30 +314,30 @@ openssh_encode(known_hosts, Key, Attributes) -> end. openssh_ssh2_auth_keys_encode(undefined, Key, Comment) -> - erlang:iolist_to_binary([key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]); + iolist_to_binary([key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]); openssh_ssh2_auth_keys_encode(Options, Key, Comment) -> - erlang:iolist_to_binary([comma_list_encode(Options, []), " ", + iolist_to_binary([comma_list_encode(Options, []), " ", key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]). openssh_ssh1_auth_keys_encode(undefined, Bits, #'RSAPublicKey'{modulus = N, publicExponent = E}, Comment) -> - erlang:iolist_to_binary([integer_to_list(Bits), " ", integer_to_list(E), " ", integer_to_list(N), + iolist_to_binary([integer_to_list(Bits), " ", integer_to_list(E), " ", integer_to_list(N), line_end(Comment)]); openssh_ssh1_auth_keys_encode(Options, Bits, #'RSAPublicKey'{modulus = N, publicExponent = E}, Comment) -> - erlang:iolist_to_binary([comma_list_encode(Options, []), " ", integer_to_list(Bits), + iolist_to_binary([comma_list_encode(Options, []), " ", integer_to_list(Bits), " ", integer_to_list(E), " ", integer_to_list(N), line_end(Comment)]). openssh_ssh2_know_hosts_encode(Hostnames, Key, Comment) -> - erlang:iolist_to_binary([comma_list_encode(Hostnames, []), " ", + iolist_to_binary([comma_list_encode(Hostnames, []), " ", key_type(Key)," ", base64:encode(ssh2_pubkey_encode(Key)), line_end(Comment)]). openssh_ssh1_known_hosts_encode(Hostnames, Bits, - #'RSAPublicKey'{modulus = N, publicExponent = E}, - Comment) -> - erlang:iolist_to_binary([comma_list_encode(Hostnames, [])," ", integer_to_list(Bits)," ", + #'RSAPublicKey'{modulus = N, publicExponent = E}, + Comment) -> + iolist_to_binary([comma_list_encode(Hostnames, [])," ", integer_to_list(Bits)," ", integer_to_list(E)," ", integer_to_list(N), line_end(Comment)]). line_end("") -> @@ -411,24 +380,6 @@ ssh2_pubkey_encode({Y, #'Dss-Parms'{p = P, q = Q, g = G}}) -> GBin/binary, YBin/binary>>. -mend_split([Part1, Part2 | Rest] = List, Acc) -> - case option_end(Part1, Part2) of - true -> - lists:reverse(Acc) ++ List; - false -> - case length(binary:matches(Part1, <<"\"">>)) of - N when N rem 2 == 0 -> - mend_split(Rest, [Part1 | Acc]); - _ -> - mend_split([<<Part1/binary, Part2/binary>> | Rest], Acc) - end - end. - -option_end(Part1, Part2) -> - (is_key_field(Part1) orelse is_bits_field(Part1)) - orelse - (is_key_field(Part2) orelse is_bits_field(Part2)). - is_key_field(<<"ssh-dss">>) -> true; is_key_field(<<"ssh-rsa">>) -> @@ -456,3 +407,72 @@ split_lines(<<Text:?ENCODED_LINE_LENGTH/binary, Rest/binary>>) -> [Text, $\n | split_lines(Rest)]; split_lines(Bin) -> [Bin]. + +decode_auth_keys(Line) -> + [First, Rest] = binary:split(Line, <<" ">>, []), + case is_key_field(First) of + true -> + {ssh2, decode_auth_keys_ssh2(First, Rest)}; + false -> + case is_bits_field(First) of + true -> + {ssh1, decode_auth_keys_ssh1(First, Rest)}; + false -> + decode_auth_keys(First, Rest) + end + end. + +decode_auth_keys(First, Line) -> + [Second, Rest] = binary:split(Line, <<" ">>, []), + case is_key_field(Second) of + true -> + {ssh2, decode_auth_keys_ssh2(First, Second, Rest)}; + false -> + case is_bits_field(Second) of + true -> + {ssh1, decode_auth_keys_ssh1(First, Second, Rest)}; + false -> + decode_auth_keys(<<First/binary, Second/binary>>, Rest) + end + end. + +decode_auth_keys_ssh2(KeyType, Rest) -> + {no_options, [KeyType | split_n(1, Rest, [])]}. + +decode_auth_keys_ssh2(Options, Next, Rest) -> + {options, [Options, Next | split_n(1, Rest, [])]}. + +decode_auth_keys_ssh1(Options, Next, Rest) -> + {options, [Options, Next | split_n(2, Rest, [])]}. + +decode_auth_keys_ssh1(First, Rest) -> + {no_options, [First | split_n(2, Rest, [])]}. + +decode_known_hosts(Line) -> + [First, Rest] = binary:split(Line, <<" ">>, []), + [Second, Rest1] = binary:split(Rest, <<" ">>, []), + + case is_bits_field(Second) of + true -> + {ssh1, decode_known_hosts_ssh1(First, Second, Rest1)}; + false -> + {ssh2, decode_known_hosts_ssh2(First, Second, Rest1)} + end. + +decode_known_hosts_ssh1(Hostnames, Bits, Rest) -> + [Hostnames, Bits | split_n(2, Rest, [])]. + +decode_known_hosts_ssh2(Hostnames, KeyType, Rest) -> + [Hostnames, KeyType | split_n(1, Rest, [])]. + +split_n(0, <<>>, Acc) -> + lists:reverse(Acc); +split_n(0, Bin, Acc) -> + lists:reverse([Bin | Acc]); +split_n(N, Bin, Acc) -> + case binary:split(Bin, <<" ">>, []) of + [First, Rest] -> + split_n(N-1, Rest, [First | Acc]); + [Last] -> + split_n(0, <<>>, [Last | Acc]) + end. diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index 6a879867e1..f2f30dad6e 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -405,9 +405,20 @@ ssh_known_hosts(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), {ok, SshKnownHosts} = file:read_file(filename:join(Datadir, "known_hosts")), - [{#'RSAPublicKey'{}, Attributes1}, {#'RSAPublicKey'{}, Attributes2}] = Decoded = + [{#'RSAPublicKey'{}, Attributes1}, {#'RSAPublicKey'{}, Attributes2}, + {#'RSAPublicKey'{}, Attributes3}, {#'RSAPublicKey'{}, Attributes4}] = Decoded = public_key:ssh_decode(SshKnownHosts, known_hosts), + Comment1 = undefined, + Comment2 = "[email protected]", + Comment3 = "Comment with whitespaces", + Comment4 = "[email protected] Comment with whitespaces", + + Comment1 = proplists:get_value(comment, Attributes1, undefined), + Comment2 = proplists:get_value(comment, Attributes2), + Comment3 = proplists:get_value(comment, Attributes3), + Comment4 = proplists:get_value(comment, Attributes4), + Value1 = proplists:get_value(hostnames, Attributes1, undefined), Value2 = proplists:get_value(hostnames, Attributes2, undefined), true = (Value1 =/= undefined) and (Value2 =/= undefined), @@ -425,13 +436,16 @@ ssh1_known_hosts(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), {ok, SshKnownHosts} = file:read_file(filename:join(Datadir, "ssh1_known_hosts")), - [{#'RSAPublicKey'{}, Attributes1}, {#'RSAPublicKey'{}, Attributes2}] = Decoded = - public_key:ssh_decode(SshKnownHosts, known_hosts), + [{#'RSAPublicKey'{}, Attributes1}, {#'RSAPublicKey'{}, Attributes2},{#'RSAPublicKey'{}, Attributes3}] + = Decoded = public_key:ssh_decode(SshKnownHosts, known_hosts), Value1 = proplists:get_value(hostnames, Attributes1, undefined), Value2 = proplists:get_value(hostnames, Attributes2, undefined), true = (Value1 =/= undefined) and (Value2 =/= undefined), + Comment ="dhopson@VMUbuntu-DSH comment with whitespaces", + Comment = proplists:get_value(comment, Attributes3), + Encoded = public_key:ssh_encode(Decoded, known_hosts), Decoded = public_key:ssh_decode(Encoded, known_hosts). @@ -444,12 +458,22 @@ ssh_auth_keys(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), {ok, SshAuthKeys} = file:read_file(filename:join(Datadir, "auth_keys")), - [{#'RSAPublicKey'{}, Attributes1}, {{_, #'Dss-Parms'{}}, _Attributes2}] = Decoded = + [{#'RSAPublicKey'{}, Attributes1}, {{_, #'Dss-Parms'{}}, Attributes2}, + {#'RSAPublicKey'{}, Attributes3}, {{_, #'Dss-Parms'{}}, Attributes4} + ] = Decoded = public_key:ssh_decode(SshAuthKeys, auth_keys), Value1 = proplists:get_value(options, Attributes1, undefined), true = Value1 =/= undefined, + Comment1 = Comment2 = "dhopson@VMUbuntu-DSH", + Comment3 = Comment4 ="dhopson@VMUbuntu-DSH comment with whitespaces", + + Comment1 = proplists:get_value(comment, Attributes1), + Comment2 = proplists:get_value(comment, Attributes2), + Comment3 = proplists:get_value(comment, Attributes3), + Comment4 = proplists:get_value(comment, Attributes4), + Encoded = public_key:ssh_encode(Decoded, auth_keys), Decoded = public_key:ssh_decode(Encoded, auth_keys). @@ -462,13 +486,24 @@ ssh1_auth_keys(Config) when is_list(Config) -> Datadir = ?config(data_dir, Config), {ok, SshAuthKeys} = file:read_file(filename:join(Datadir, "ssh1_auth_keys")), - [{#'RSAPublicKey'{}, Attributes1}, {#'RSAPublicKey'{}, Attributes2}] = Decoded = + [{#'RSAPublicKey'{}, Attributes1}, + {#'RSAPublicKey'{}, Attributes2}, {#'RSAPublicKey'{}, Attributes3}, + {#'RSAPublicKey'{}, Attributes4}, {#'RSAPublicKey'{}, Attributes5}] = Decoded = public_key:ssh_decode(SshAuthKeys, auth_keys), - Value1 = proplists:get_value(bits, Attributes1, undefined), - Value2 = proplists:get_value(bits, Attributes2, undefined), + Value1 = proplists:get_value(bits, Attributes2, undefined), + Value2 = proplists:get_value(bits, Attributes3, undefined), true = (Value1 =/= undefined) and (Value2 =/= undefined), + Comment2 = Comment3 = "dhopson@VMUbuntu-DSH", + Comment4 = Comment5 ="dhopson@VMUbuntu-DSH comment with whitespaces", + + undefined = proplists:get_value(comment, Attributes1, undefined), + Comment2 = proplists:get_value(comment, Attributes2), + Comment3 = proplists:get_value(comment, Attributes3), + Comment4 = proplists:get_value(comment, Attributes4), + Comment5 = proplists:get_value(comment, Attributes5), + Encoded = public_key:ssh_encode(Decoded, auth_keys), Decoded = public_key:ssh_decode(Encoded, auth_keys). diff --git a/lib/public_key/test/public_key_SUITE_data/auth_keys b/lib/public_key/test/public_key_SUITE_data/auth_keys index 0c4b47edde..8be7357a06 100644 --- a/lib/public_key/test/public_key_SUITE_data/auth_keys +++ b/lib/public_key/test/public_key_SUITE_data/auth_keys @@ -1,3 +1,7 @@ command="dump /home",no-pty,no-port-forwarding ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAgEAwrr66r8n6B8Y0zMF3dOpXEapIQD9DiYQ6D6/zwor9o39jSkHNiMMER/GETBbzP83LOcekm02aRjo55ArO7gPPVvCXbrirJu9pkm4AC4BBre5xSLS7soyzwbigFruM8G63jSXqpHqJ/ooi168sKMC2b0Ncsi+JlTfNYlDXJVLKEeZgZOInQyMmtisaDTUQWTIv1snAizf4iIYENuAkGYGNCL77u5Y5VOu5eQipvFajTnps9QvUx/zdSFYn9e2sulWM3Bxc/S4IJ67JWHVRpfJxGi3hinRBH8WQdXuUwdJJTiJHKPyYrrM7Q6Xq4TOMFtcRuLDC6u3BXM1L0gBvHPNOnD5l2Lp5EjUkQ9CBf2j4A4gfH+iWQZyk08esAG/iwArAVxkl368+dkbMWOXL8BN4x5zYgdzoeypQZZ2RKH780MCTSo4WQ19DP8pw+9q3bSFC9H3xYAxrKAJNWjeTUJOTrTe+mWXXU770gYyQTxa2ycnYrlZucn1S3vsvn6eq7NZZ8NRbyv1n15Ocg+nHK4fuKOrwPhU3NbKQwtjb0Wsxx1gAmQqIOLTpAdsrAauPxC7TPYA5qQVCphvimKuhQM/1gMV225JrnjspVlthCzuFYUjXOKC3wxz6FFEtwnXu3uC5bVVkmkNadJmD21gD23yk4BraGXVYpRMIB+X+OTUUI8= dhopson@VMUbuntu-DSH ssh-dss AAAAB3NzaC1kc3MAAACBAPY8ZOHY2yFSJA6XYC9HRwNHxaehvx5wOJ0rzZdzoSOXxbETW6ToHv8D1UJ/z+zHo9Fiko5XybZnDIaBDHtblQ+Yp7StxyltHnXF1YLfKD1G4T6JYrdHYI14Om1eg9e4NnCRleaqoZPF3UGfZia6bXrGTQf3gJq2e7Yisk/gF+1VAAAAFQDb8D5cvwHWTZDPfX0D2s9Rd7NBvQAAAIEAlN92+Bb7D4KLYk3IwRbXblwXdkPggA4pfdtW9vGfJ0/RHd+NjB4eo1D+0dix6tXwYGN7PKS5R/FXPNwxHPapcj9uL1Jn2AWQ2dsknf+i/FAAvioUPkmdMc0zuWoSOEsSNhVDtX3WdvVcGcBq9cetzrtOKWOocJmJ80qadxTRHtUAAACBAN7CY+KKv1gHpRzFwdQm7HK9bb1LAo2KwaoXnadFgeptNBQeSXG1vO+JsvphVMBJc9HSn24VYtYtsMu74qXviYjziVucWKjjKEb11juqnF0GDlB3VVmxHLmxnAz643WK42Z7dLM5sY29ouezv4Xz2PuMch5VGPP+CDqzCM4loWgV dhopson@VMUbuntu-DSH + +command="dump /home",no-pty,no-port-forwarding ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAgEAwrr66r8n6B8Y0zMF3dOpXEapIQD9DiYQ6D6/zwor9o39jSkHNiMMER/GETBbzP83LOcekm02aRjo55ArO7gPPVvCXbrirJu9pkm4AC4BBre5xSLS7soyzwbigFruM8G63jSXqpHqJ/ooi168sKMC2b0Ncsi+JlTfNYlDXJVLKEeZgZOInQyMmtisaDTUQWTIv1snAizf4iIYENuAkGYGNCL77u5Y5VOu5eQipvFajTnps9QvUx/zdSFYn9e2sulWM3Bxc/S4IJ67JWHVRpfJxGi3hinRBH8WQdXuUwdJJTiJHKPyYrrM7Q6Xq4TOMFtcRuLDC6u3BXM1L0gBvHPNOnD5l2Lp5EjUkQ9CBf2j4A4gfH+iWQZyk08esAG/iwArAVxkl368+dkbMWOXL8BN4x5zYgdzoeypQZZ2RKH780MCTSo4WQ19DP8pw+9q3bSFC9H3xYAxrKAJNWjeTUJOTrTe+mWXXU770gYyQTxa2ycnYrlZucn1S3vsvn6eq7NZZ8NRbyv1n15Ocg+nHK4fuKOrwPhU3NbKQwtjb0Wsxx1gAmQqIOLTpAdsrAauPxC7TPYA5qQVCphvimKuhQM/1gMV225JrnjspVlthCzuFYUjXOKC3wxz6FFEtwnXu3uC5bVVkmkNadJmD21gD23yk4BraGXVYpRMIB+X+OTUUI8= dhopson@VMUbuntu-DSH comment with whitespaces + +ssh-dss AAAAB3NzaC1kc3MAAACBAPY8ZOHY2yFSJA6XYC9HRwNHxaehvx5wOJ0rzZdzoSOXxbETW6ToHv8D1UJ/z+zHo9Fiko5XybZnDIaBDHtblQ+Yp7StxyltHnXF1YLfKD1G4T6JYrdHYI14Om1eg9e4NnCRleaqoZPF3UGfZia6bXrGTQf3gJq2e7Yisk/gF+1VAAAAFQDb8D5cvwHWTZDPfX0D2s9Rd7NBvQAAAIEAlN92+Bb7D4KLYk3IwRbXblwXdkPggA4pfdtW9vGfJ0/RHd+NjB4eo1D+0dix6tXwYGN7PKS5R/FXPNwxHPapcj9uL1Jn2AWQ2dsknf+i/FAAvioUPkmdMc0zuWoSOEsSNhVDtX3WdvVcGcBq9cetzrtOKWOocJmJ80qadxTRHtUAAACBAN7CY+KKv1gHpRzFwdQm7HK9bb1LAo2KwaoXnadFgeptNBQeSXG1vO+JsvphVMBJc9HSn24VYtYtsMu74qXviYjziVucWKjjKEb11juqnF0GDlB3VVmxHLmxnAz643WK42Z7dLM5sY29ouezv4Xz2PuMch5VGPP+CDqzCM4loWgV dhopson@VMUbuntu-DSH comment with whitespaces diff --git a/lib/public_key/test/public_key_SUITE_data/known_hosts b/lib/public_key/test/public_key_SUITE_data/known_hosts index 30fc3b1fe8..3c3af68178 100644 --- a/lib/public_key/test/public_key_SUITE_data/known_hosts +++ b/lib/public_key/test/public_key_SUITE_data/known_hosts @@ -1,3 +1,8 @@ hostname.domain.com,192.168.0.1 ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAIEA1XY18+zA8VNK2YkzygOkMqUxHSTfxT1Xxx8CgDZgcQH8HUhPssW5ttvG8nKetlPQZAVk1C4WkWS1y5b3ekBhZTIxocp9Joc6V1+f2EOfO2mSLRwB16RGrdw6q7msrBXTC/dl+hF45kMMzVNzqxnSMVOa0sEPK2zK6Sg3Vi9fCSM= |1|BWO5qDxk/cFH0wa05JLdHn+j6xQ=|rXQvIxh5cDD3C43k5DPDamawVNA= ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAIEA1XY18+zA8VNK2YkzygOkMqUxHSTfxT1Xxx8CgDZgcQH8HUhPssW5ttvG8nKetlPQZAVk1C4WkWS1y5b3ekBhZTIxocp9Joc6V1+f2EOfO2mSLRwB16RGrdw6q7msrBXTC/dl+hF45kMMzVNzqxnSMVOa0sEPK2zK6Sg3Vi9fCSM= [email protected] + +hostname.domain.com,192.168.0.1 ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAIEA1XY18+zA8VNK2YkzygOkMqUxHSTfxT1Xxx8CgDZgcQH8HUhPssW5ttvG8nKetlPQZAVk1C4WkWS1y5b3ekBhZTIxocp9Joc6V1+f2EOfO2mSLRwB16RGrdw6q7msrBXTC/dl+hF45kMMzVNzqxnSMVOa0sEPK2zK6Sg3Vi9fCSM= Comment with whitespaces + +|1|BWO5qDxk/cFH0wa05JLdHn+j6xQ=|rXQvIxh5cDD3C43k5DPDamawVNA= ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAIEA1XY18+zA8VNK2YkzygOkMqUxHSTfxT1Xxx8CgDZgcQH8HUhPssW5ttvG8nKetlPQZAVk1C4WkWS1y5b3ekBhZTIxocp9Joc6V1+f2EOfO2mSLRwB16RGrdw6q7msrBXTC/dl+hF45kMMzVNzqxnSMVOa0sEPK2zK6Sg3Vi9fCSM= [email protected] Comment with whitespaces + diff --git a/lib/public_key/test/public_key_SUITE_data/ssh1_auth_keys b/lib/public_key/test/public_key_SUITE_data/ssh1_auth_keys index c91f4e4679..ac3d61b4c7 100644 --- a/lib/public_key/test/public_key_SUITE_data/ssh1_auth_keys +++ b/lib/public_key/test/public_key_SUITE_data/ssh1_auth_keys @@ -1,3 +1,9 @@ +1024 35 794430685278501116412873221867658581245241426828503388129294124540165981586596106773643485704743298698207838825035605868404742682423919455523383721081589378970796492944950066480951790660582889972423189943567111507801410254720228911513553205592856585541922662924268445466959576882300405064708497308004255650466014242855505233634626075778108365396568863197935915425650388910408127232583533503834009244199384570662092164277923946411149853110048365318587554141774139652307149492021035538341281427025252592933784473453522113124752189378715431529801894015739903371171585194505182320772654217490509848165365152457990491089951560694728469571221819385402117009544812199223715540348068497710535492913376699508575875577554607325905000745578091554027803374110357015655416894607641289462159580964951182385869168785183135763253784745647466464331174922663455073627501620274348748413309761116542324505123795743603781806636788810617169341018091186028310551725315297135354426735951943325476221811539822892501042385411792050504283745898099390893596941969752683246939665141002098430129617772928840718016009187577151479855846883928332010147501182201528575840364152774917950524127063432334646746291719251739989499132767590205934821590545762802261107691663 + 1024 35 794430685278501116412873221867658581245241426828503388129294124540165981586596106773643485704743298698207838825035605868404742682423919455523383721081589378970796492944950066480951790660582889972423189943567111507801410254720228911513553205592856585541922662924268445466959576882300405064708497308004255650466014242855505233634626075778108365396568863197935915425650388910408127232583533503834009244199384570662092164277923946411149853110048365318587554141774139652307149492021035538341281427025252592933784473453522113124752189378715431529801894015739903371171585194505182320772654217490509848165365152457990491089951560694728469571221819385402117009544812199223715540348068497710535492913376699508575875577554607325905000745578091554027803374110357015655416894607641289462159580964951182385869168785183135763253784745647466464331174922663455073627501620274348748413309761116542324505123795743603781806636788810617169341018091186028310551725315297135354426735951943325476221811539822892501042385411792050504283745898099390893596941969752683246939665141002098430129617772928840718016009187577151479855846883928332010147501182201528575840364152774917950524127063432334646746291719251739989499132767590205934821590545762802261107691663 dhopson@VMUbuntu-DSH command="dump /home",no-pty,no-port-forwarding 1024 35 794430685278501116412873221867658581245241426828503388129294124540165981586596106773643485704743298698207838825035605868404742682423919455523383721081589378970796492944950066480951790660582889972423189943567111507801410254720228911513553205592856585541922662924268445466959576882300405064708497308004255650466014242855505233634626075778108365396568863197935915425650388910408127232583533503834009244199384570662092164277923946411149853110048365318587554141774139652307149492021035538341281427025252592933784473453522113124752189378715431529801894015739903371171585194505182320772654217490509848165365152457990491089951560694728469571221819385402117009544812199223715540348068497710535492913376699508575875577554607325905000745578091554027803374110357015655416894607641289462159580964951182385869168785183135763253784745647466464331174922663455073627501620274348748413309761116542324505123795743603781806636788810617169341018091186028310551725315297135354426735951943325476221811539822892501042385411792050504283745898099390893596941969752683246939665141002098430129617772928840718016009187577151479855846883928332010147501182201528575840364152774917950524127063432334646746291719251739989499132767590205934821590545762802261107691663 dhopson@VMUbuntu-DSH + +1024 35 794430685278501116412873221867658581245241426828503388129294124540165981586596106773643485704743298698207838825035605868404742682423919455523383721081589378970796492944950066480951790660582889972423189943567111507801410254720228911513553205592856585541922662924268445466959576882300405064708497308004255650466014242855505233634626075778108365396568863197935915425650388910408127232583533503834009244199384570662092164277923946411149853110048365318587554141774139652307149492021035538341281427025252592933784473453522113124752189378715431529801894015739903371171585194505182320772654217490509848165365152457990491089951560694728469571221819385402117009544812199223715540348068497710535492913376699508575875577554607325905000745578091554027803374110357015655416894607641289462159580964951182385869168785183135763253784745647466464331174922663455073627501620274348748413309761116542324505123795743603781806636788810617169341018091186028310551725315297135354426735951943325476221811539822892501042385411792050504283745898099390893596941969752683246939665141002098430129617772928840718016009187577151479855846883928332010147501182201528575840364152774917950524127063432334646746291719251739989499132767590205934821590545762802261107691663 dhopson@VMUbuntu-DSH comment with whitespaces + +command="dump /home",no-pty,no-port-forwarding 1024 35 794430685278501116412873221867658581245241426828503388129294124540165981586596106773643485704743298698207838825035605868404742682423919455523383721081589378970796492944950066480951790660582889972423189943567111507801410254720228911513553205592856585541922662924268445466959576882300405064708497308004255650466014242855505233634626075778108365396568863197935915425650388910408127232583533503834009244199384570662092164277923946411149853110048365318587554141774139652307149492021035538341281427025252592933784473453522113124752189378715431529801894015739903371171585194505182320772654217490509848165365152457990491089951560694728469571221819385402117009544812199223715540348068497710535492913376699508575875577554607325905000745578091554027803374110357015655416894607641289462159580964951182385869168785183135763253784745647466464331174922663455073627501620274348748413309761116542324505123795743603781806636788810617169341018091186028310551725315297135354426735951943325476221811539822892501042385411792050504283745898099390893596941969752683246939665141002098430129617772928840718016009187577151479855846883928332010147501182201528575840364152774917950524127063432334646746291719251739989499132767590205934821590545762802261107691663 dhopson@VMUbuntu-DSH comment with whitespaces diff --git a/lib/public_key/test/public_key_SUITE_data/ssh1_known_hosts b/lib/public_key/test/public_key_SUITE_data/ssh1_known_hosts index ec668fe05b..835b16ab67 100644 --- a/lib/public_key/test/public_key_SUITE_data/ssh1_known_hosts +++ b/lib/public_key/test/public_key_SUITE_data/ssh1_known_hosts @@ -1,2 +1,3 @@ hostname.domain.com,192.168.0.1 1024 35 794430685278501116412873221867658581245241426828503388129294124540165981586596106773643485704743298698207838825035605868404742682423919455523383721081589378970796492944950066480951790660582889972423189943567111507801410254720228911513553205592856585541922662924268445466959576882300405064708497308004255650466014242855505233634626075778108365396568863197935915425650388910408127232583533503834009244199384570662092164277923946411149853110048365318587554141774139652307149492021035538341281427025252592933784473453522113124752189378715431529801894015739903371171585194505182320772654217490509848165365152457990491089951560694728469571221819385402117009544812199223715540348068497710535492913376699508575875577554607325905000745578091554027803374110357015655416894607641289462159580964951182385869168785183135763253784745647466464331174922663455073627501620274348748413309761116542324505123795743603781806636788810617169341018091186028310551725315297135354426735951943325476221811539822892501042385411792050504283745898099390893596941969752683246939665141002098430129617772928840718016009187577151479855846883928332010147501182201528575840364152774917950524127063432334646746291719251739989499132767590205934821590545762802261107691663 dhopson@VMUbuntu-DSH hostname2.domain.com,192.168.0.2 1024 35 794430685278501116412873221867658581245241426828503388129294124540165981586596106773643485704743298698207838825035605868404742682423919455523383721081589378970796492944950066480951790660582889972423189943567111507801410254720228911513553205592856585541922662924268445466959576882300405064708497308004255650466014242855505233634626075778108365396568863197935915425650388910408127232583533503834009244199384570662092164277923946411149853110048365318587554141774139652307149492021035538341281427025252592933784473453522113124752189378715431529801894015739903371171585194505182320772654217490509848165365152457990491089951560694728469571221819385402117009544812199223715540348068497710535492913376699508575875577554607325905000745578091554027803374110357015655416894607641289462159580964951182385869168785183135763253784745647466464331174922663455073627501620274348748413309761116542324505123795743603781806636788810617169341018091186028310551725315297135354426735951943325476221811539822892501042385411792050504283745898099390893596941969752683246939665141002098430129617772928840718016009187577151479855846883928332010147501182201528575840364152774917950524127063432334646746291719251739989499132767590205934821590545762802261107691663 +hostname3.domain.com,192.168.0.3 1024 35 794430685278501116412873221867658581245241426828503388129294124540165981586596106773643485704743298698207838825035605868404742682423919455523383721081589378970796492944950066480951790660582889972423189943567111507801410254720228911513553205592856585541922662924268445466959576882300405064708497308004255650466014242855505233634626075778108365396568863197935915425650388910408127232583533503834009244199384570662092164277923946411149853110048365318587554141774139652307149492021035538341281427025252592933784473453522113124752189378715431529801894015739903371171585194505182320772654217490509848165365152457990491089951560694728469571221819385402117009544812199223715540348068497710535492913376699508575875577554607325905000745578091554027803374110357015655416894607641289462159580964951182385869168785183135763253784745647466464331174922663455073627501620274348748413309761116542324505123795743603781806636788810617169341018091186028310551725315297135354426735951943325476221811539822892501042385411792050504283745898099390893596941969752683246939665141002098430129617772928840718016009187577151479855846883928332010147501182201528575840364152774917950524127063432334646746291719251739989499132767590205934821590545762802261107691663 dhopson@VMUbuntu-DSH comment with whitespaces diff --git a/lib/reltool/doc/src/reltool.xml b/lib/reltool/doc/src/reltool.xml index 2567a72999..fbe29753be 100644 --- a/lib/reltool/doc/src/reltool.xml +++ b/lib/reltool/doc/src/reltool.xml @@ -51,8 +51,18 @@ defines library directories where additional applications may reside and it defaults to the directories listed by the operating system environment variable - <c>ERL_LIBS</c>. See the module <c>code</c> for more info. - Finally single modules and entire applications may be read from + <c>ERL_LIBS</c>. See the module <c>code</c> for more info.</p> + + <p>An application directory <c>AppDir</c> under a library + directory is recognized by the existence of an <c>AppDir/ebin</c> + directory. If this does not exist, <c>reltool</c> will not + consider <c>AppDir</c> at all when looking for applications.</p> + + <p>It is recommended that application directories are named as the + application, possibly followed by a dash and the version + number. For example <c>myapp</c> or <c>myapp-1.1</c>.</p> + + <p>Finally single modules and entire applications may be read from Escripts.</p> <p>Some configuration parameters control the behavior of Reltool @@ -372,6 +382,11 @@ <p>This parameter is mutual exclusive with <c>lib_dir</c>. If <c>vsn</c> and <c>lib_dir</c> are both omitted, the latest version will be chosen.</p> + <p>Note that in order for reltool to sort application versions + and thereby be able to select the latest, it is required that + the version id for the application consits of integers and + dots only, for example <c>1</c>, <c>2.0</c> or + <c>3.17.1</c>.</p> </item> <tag><c>lib_dir</c></tag> <item> @@ -383,6 +398,11 @@ <p>This parameter is mutual exclusive with <c>vsn</c>. If <c>vsn</c> and <c>lib_dir</c> are both omitted, the latest version will be chosen.</p> + <p>Note that in order for reltool to sort application versions + and thereby be able to select the latest, it is required that + the version id for the application consits of integers and + dots only, for example <c>1</c>, <c>2.0</c> or + <c>3.17.1</c>.</p> </item> <tag><c>mod</c></tag> <item> @@ -446,7 +466,7 @@ <tag><c>incl_cond</c></tag> <item> <p>This parameter controls whether the module is included or not. By - default the <c>mod_incl</c> parameter on application and system level + default the <c>mod_cond</c> parameter on application and system level will be used to control whether the module is included or not. The value of <c>incl_cond</c> overrides the module inclusion policy. <c>include</c> implies that the module is included, while diff --git a/lib/reltool/doc/src/reltool_usage.xml b/lib/reltool/doc/src/reltool_usage.xml index d128e80a77..0041e60d8f 100644 --- a/lib/reltool/doc/src/reltool_usage.xml +++ b/lib/reltool/doc/src/reltool_usage.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2009</year> - <year>2011</year> + <year>2012</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -257,6 +257,11 @@ policy</c> part of the page. By default the latest version of the application is selected, but it is possible to override this by explicitly selecting another version.</p> + + <p>Note that in order for reltool to sort application versions and + thereby be able to select the latest, it is required that the + version id for the application consits of integers and dots only, + for example <c>1</c>, <c>2.0</c> or <c>3.17.1</c>.</p> <p>By default the <c>Application inclusion policy</c> on system level is used for all applications. Set the value to @@ -335,7 +340,7 @@ <p>There are two categories of modules on the <c>Module dependencies</c> page. If the module is used by other modules, - these are listed under <c>Modules used by others</c>. If the + these are listed under <c>Modules using this</c>. If the module uses other modules, these are listed under <c>Used modules</c>.</p> @@ -365,7 +370,7 @@ <p>There are two categories of modules on the <c>Dependencies</c> page. If the module is used by other modules, these are listed - under <c>Modules used by others</c>. If the module uses other + under <c>Modules using this</c>. If the module uses other modules, these are listed under <c>Used modules</c>.</p> <p>Double click on an module name to launch a module window.</p> diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl index 3d1d7e54bf..c56e29152d 100644 --- a/lib/reltool/src/reltool_server.erl +++ b/lib/reltool/src/reltool_server.erl @@ -674,6 +674,8 @@ mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> true; exclude -> false; + derived -> + undefined; undefined -> %% print(M#mod.name, hipe, "mod_cond -> ~p\n", %% [ModCond]), @@ -693,6 +695,8 @@ mod_init_is_included(ModTab, M, ModCond, AppCond, Default, Status) -> true; exclude -> false; + derived -> + undefined; undefined -> Default end @@ -783,9 +787,10 @@ mod_mark_is_included(#state{app_tab=AppTab, mod_tab=ModTab, sys=Sys} = S, M#mod{is_pre_included = true, is_included = true}; exclude -> - M#mod{is_pre_included = true, - is_included = true}; - undefined -> + M#mod{is_pre_included = false, + is_included = false}; + ModInclCond when ModInclCond==undefined; + ModInclCond==derived -> M#mod{is_included = true} end, ets:insert(ModTab, M2), @@ -979,7 +984,7 @@ refresh_app(#app{name = AppName, %% Add info from .app file Base = get_base(AppName, ActiveDir), - {_, DefaultVsn} = reltool_utils:split_app_name(Base), + DefaultVsn = get_vsn_from_dir(AppName,Base), Ebin = filename:join([ActiveDir, "ebin"]), AppFile = filename:join([Ebin, @@ -1680,8 +1685,7 @@ app_dirs2([Lib | Libs], Acc) -> EbinDir = filename:join([AppDir, "ebin"]), case filelib:is_dir(EbinDir, erl_prim_loader) of true -> - {Name, _Vsn} = - reltool_utils:split_app_name(Base), + Name = find_app_name(Base,EbinDir), case Name of erts -> false; _ -> {true, {Name, AppDir}} @@ -1699,17 +1703,74 @@ app_dirs2([Lib | Libs], Acc) -> app_dirs2([], Acc) -> lists:sort(lists:append(Acc)). +find_app_name(Base,EbinDir) -> + {ok,EbinFiles} = erl_prim_loader:list_dir(EbinDir), + AppFile = + case [F || F <- EbinFiles, filename:extension(F)=:=".app"] of + [AF] -> + AF; + _ -> + undefined + end, + find_app_name1(Base,AppFile). + +find_app_name1(Base,undefined) -> + {Name,_} = reltool_utils:split_app_name(Base), + Name; +find_app_name1(_Base,AppFile) -> + list_to_atom(filename:rootname(AppFile)). + +get_vsn_from_dir(AppName,Base) -> + Prefix = atom_to_list(AppName) ++ "-", + case lists:prefix(Prefix,Base) of + true -> + lists:nthtail(length(Prefix),Base); + false -> + "" + end. + + escripts_to_apps([Escript | Escripts], Apps, Status) -> {EscriptAppName, _Label} = split_escript_name(Escript), Ext = code:objfile_extension(), + + %% First find all .app files and associate the app name to the app + %% label - this is in order to now which application a module + %% belongs to in the next round. + AppFun = fun(FullName, _GetInfo, _GetBin, AppFiles) -> + Components = filename:split(FullName), + case Components of + [AppLabel, "ebin", File] -> + case filename:extension(File) of + ".app" -> + [{AppLabel,File}|AppFiles]; + _ -> + AppFiles + end; + _ -> + AppFiles + end + end, + AppFiles = + case reltool_utils:escript_foldl(AppFun, [], Escript) of + {ok, AF} -> + AF; + {error, Reason1} -> + reltool_utils:throw_error("Illegal escript ~p: ~p", + [Escript,Reason1]) + end, + + %% Next, traverse all files... Fun = fun(FullName, _GetInfo, GetBin, {FileAcc, StatusAcc}) -> Components = filename:split(FullName), case Components of [AppLabel, "ebin", File] -> case filename:extension(File) of ".app" -> - {AppName, DefaultVsn} = - reltool_utils:split_app_name(AppLabel), + AppName = + list_to_atom(filename:rootname(File)), + DefaultVsn = + get_vsn_from_dir(AppName,AppLabel), AppFileName = filename:join([Escript, FullName]), {Info, StatusAcc2} = @@ -1722,8 +1783,9 @@ escripts_to_apps([Escript | Escripts], Apps, Status) -> {[{AppName, app, Dir, Info} | FileAcc], StatusAcc2}; E when E =:= Ext -> - {AppName, _} = - reltool_utils:split_app_name(AppLabel), + AppFile = + proplists:get_value(AppLabel,AppFiles), + AppName = find_app_name1(AppLabel,AppFile), Mod = init_mod(AppName, File, {File, GetBin()}, @@ -1760,6 +1822,7 @@ escripts_to_apps([Escript | Escripts], Apps, Status) -> {FileAcc, StatusAcc} end end, + case reltool_utils:escript_foldl(Fun, {[], Status}, Escript) of {ok, {Files, Status2}} -> EscriptApp = @@ -1774,8 +1837,9 @@ escripts_to_apps([Escript | Escripts], Apps, Status) -> Apps, Status2), escripts_to_apps(Escripts, Apps2, Status3); - {error, Reason} -> - reltool_utils:throw_error("Illegal escript ~p: ~p", [Escript,Reason]) + {error, Reason2} -> + reltool_utils:throw_error("Illegal escript ~p: ~p", + [Escript,Reason2]) end; escripts_to_apps([], Apps, Status) -> {Apps, Status}. @@ -1934,7 +1998,7 @@ ensure_app_info(#app{name = Name, fun(Dir, StatusAcc) -> Base = get_base(Name, Dir), Ebin = filename:join([Dir, "ebin"]), - {_, DefaultVsn} = reltool_utils:split_app_name(Base), + DefaultVsn = get_vsn_from_dir(Name,Base), AppFile = filename:join([Ebin, atom_to_list(Name) ++ ".app"]), read_app_info(AppFile, AppFile, Name, DefaultVsn, StatusAcc) end, diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl index c39ed0ecd5..6cb7ba0163 100644 --- a/lib/reltool/src/reltool_target.erl +++ b/lib/reltool/src/reltool_target.erl @@ -333,7 +333,9 @@ merge_apps(#rel{name = RelName, A#app.name =/= ?MISSING_APP_NAME, not lists:keymember(A#app.name, #app.name, MergedApps2)], MergedApps3 = do_merge_apps(RelName, Embedded, Apps, EmbAppType, MergedApps2), - sort_apps(lists:reverse(MergedApps3)). + RevMerged = lists:reverse(MergedApps3), + MergedSortedUsedAndIncs = sort_used_and_incl_apps(RevMerged,RevMerged), + sort_apps(MergedSortedUsedAndIncs). do_merge_apps(RelName, [#rel_app{name = Name} = RA | RelApps], Apps, RelAppType, Acc) -> case is_already_merged(Name, RelApps, Acc) of @@ -342,9 +344,11 @@ do_merge_apps(RelName, [#rel_app{name = Name} = RA | RelApps], Apps, RelAppType, false -> {value, App} = lists:keysearch(Name, #app.name, Apps), MergedApp = merge_app(RelName, RA, RelAppType, App), - MoreNames = (MergedApp#app.info)#app_info.applications, + ReqNames = (MergedApp#app.info)#app_info.applications, + IncNames = (MergedApp#app.info)#app_info.incl_apps, Acc2 = [MergedApp | Acc], - do_merge_apps(RelName, MoreNames ++ RelApps, Apps, RelAppType, Acc2) + do_merge_apps(RelName, ReqNames ++ IncNames ++ RelApps, + Apps, RelAppType, Acc2) end; do_merge_apps(RelName, [Name | RelApps], Apps, RelAppType, Acc) -> case is_already_merged(Name, RelApps, Acc) of @@ -507,6 +511,56 @@ load_app_mods(#app{mods = Mods} = App, Mand, PathFlag, Variables) -> SplitMods). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% sort_used_and_incl_apps(Apps, OrderedApps) -> Apps +%% Apps = [#app{}] +%% OrderedApps = [#app{}] +%% +%% OTP-4121, OTP-9984 +%% (Tickets are written for systools, but needs to be implemented here +%% as well.) +%% Make sure that used and included applications are given in the same +%% order as in the release resource file (.rel). Otherwise load and +%% start instructions in the boot script, and consequently release +%% upgrade instructions in relup, may end up in the wrong order. + +sort_used_and_incl_apps([#app{info=Info} = App|Apps], OrderedApps) -> + Incls2 = + case Info#app_info.incl_apps of + Incls when length(Incls)>1 -> + sort_appl_list(Incls, OrderedApps); + Incls -> + Incls + end, + Uses2 = + case Info#app_info.applications of + Uses when length(Uses)>1 -> + sort_appl_list(Uses, OrderedApps); + Uses -> + Uses + end, + App2 = App#app{info=Info#app_info{incl_apps=Incls2, applications=Uses2}}, + [App2|sort_used_and_incl_apps(Apps, OrderedApps)]; +sort_used_and_incl_apps([], _OrderedApps) -> + []. + +sort_appl_list(List, Order) -> + IndexedList = find_pos(List, Order), + SortedIndexedList = lists:keysort(1, IndexedList), + lists:map(fun({_Index,Name}) -> Name end, SortedIndexedList). + +find_pos([Name|Incs], OrderedApps) -> + [find_pos(1, Name, OrderedApps)|find_pos(Incs, OrderedApps)]; +find_pos([], _OrderedApps) -> + []. + +find_pos(N, Name, [#app{name=Name}|_OrderedApps]) -> + {N, Name}; +find_pos(N, Name, [_OtherAppl|OrderedApps]) -> + find_pos(N+1, Name, OrderedApps). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Function: sort_apps(Apps) -> {ok, Apps'} | throw({error, Error}) %% Types: Apps = {{Name, Vsn}, #application}] %% Purpose: Sort applications according to dependencies among @@ -1420,12 +1474,10 @@ do_install(RelName, TargetDir) -> BinDir = filename:join([TargetDir2, "bin"]), case os:type() of {win32, _} -> - NativeRootDir = filename:nativename(TargetDir2), - %% NativeBinDir = - %% filename:nativename(filename:join([BinDir, "win32"])), - NativeBinDir = filename:nativename(BinDir), + NativeRootDir = nativename(TargetDir2), + NativeErtsBinDir = nativename(ErtsBinDir), IniData = ["[erlang]\r\n", - "Bindir=", NativeBinDir, "\r\n", + "Bindir=", NativeErtsBinDir, "\r\n", "Progname=erl\r\n", "Rootdir=", NativeRootDir, "\r\n"], IniFile = filename:join([BinDir, "erl.ini"]), @@ -1445,6 +1497,15 @@ do_install(RelName, TargetDir) -> reltool_utils:throw_error("~s: Illegal data file syntax", [DataFile]) end. +nativename(Dir) -> + escape_backslash(filename:nativename(Dir)). +escape_backslash([$\\|T]) -> + [$\\,$\\|escape_backslash(T)]; +escape_backslash([H|T]) -> + [H|escape_backslash(T)]; +escape_backslash([]) -> + []. + subst_src_scripts(Scripts, SrcDir, DestDir, Vars, Opts) -> Fun = fun(Script) -> subst_src_script(Script, SrcDir, DestDir, Vars, Opts) diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index f29f6049a5..8d71865508 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -90,8 +90,10 @@ all() -> gen_rel_files, save_config, dependencies, + mod_incl_cond_derived, use_selected_vsn, - use_selected_vsn_relative_path]. + use_selected_vsn_relative_path, + non_standard_vsn_id]. groups() -> []. @@ -106,6 +108,15 @@ end_per_group(_GroupName, Config) -> %% The test cases %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% A dummy break test case which is NOT in all(), but can be run +%% directly from the command line with ct_run. It just does a +%% test_server:break()... +break(_Config) -> + test_server:break(""), + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Start a server process and check that it does not crash start_server(_Config) -> @@ -298,7 +309,6 @@ create_release(_Config) -> %% started before the including application. %% Circular dependencies shall also be detected and cause error. -create_release_sort(_Config) -> {skip, "Two bugs related to sorting"}; create_release_sort(Config) -> DataDir = ?config(data_dir,Config), %% Configure the server @@ -307,11 +317,12 @@ create_release_sort(Config) -> RelName3 = "Include-both", RelName4 = "Include-only-app", RelName5 = "Include-only-rel", - RelName6 = "Include-missing-app", + RelName6 = "Auto-add-missing-apps", RelName7 = "Circular", - RelName8 = "Include-both-missing-app", - RelName9 = "Include-overwrite", + RelName8 = "Include-rel-alter-order", + RelName9 = "Include-none-overwrite", RelName10= "Uses-order-as-rel", + RelName11= "Auto-add-dont-overwrite-load", RelVsn = "1.0", %% Application z (.app file): %% includes [tools, mnesia] @@ -326,11 +337,12 @@ create_release_sort(Config) -> {rel, RelName3, RelVsn, [stdlib, kernel, {z,[tools]}, tools, mnesia]}, {rel, RelName4, RelVsn, [stdlib, kernel, z, mnesia, tools]}, {rel, RelName5, RelVsn, [stdlib, kernel, {sasl,[tools]}]}, - {rel, RelName6, RelVsn, [stdlib, kernel, z]}, + {rel, RelName6, RelVsn, [z]}, {rel, RelName7, RelVsn, [stdlib, kernel, mnesia, y, sasl, x]}, - {rel, RelName8, RelVsn, [stdlib, kernel, {z,[tools]}]}, + {rel, RelName8, RelVsn, [stdlib, kernel, {z,[mnesia,tools]}]}, {rel, RelName9, RelVsn, [stdlib, kernel, {z,[]}]}, {rel, RelName10, RelVsn, [stdlib, kernel, {z,[]}, inets, sasl]}, + {rel, RelName11, RelVsn, [stdlib, kernel, z, {inets, load}]}, {incl_cond,exclude}, {mod_cond,app}, {app,kernel,[{incl_cond,include}]}, @@ -372,7 +384,6 @@ create_release_sort(Config) -> {mnesia, _}]}}, reltool:get_rel([{config, Sys}], RelName3)), - %%! BUG: same as OTP-4121, but for reltool???? Or revert tools and mnesia ?msym({ok, {release, {RelName4, RelVsn}, {erts, _}, [{kernel, _}, @@ -389,13 +400,29 @@ create_release_sort(Config) -> "in the app file: [tools]"}, reltool:get_rel([{config, Sys}], RelName5)), - ?m({error, "Undefined applications: [tools,mnesia]"}, + ?msym({ok, {release, {RelName6, RelVsn}, + {erts, _}, + [{kernel, _}, + {stdlib, _}, + {sasl, _}, + {inets, _}, + {tools, _}, + {mnesia, _}, + {z, _}]}}, reltool:get_rel([{config, Sys}], RelName6)), ?m({error,"Circular dependencies: [x,y]"}, reltool:get_rel([{config, Sys}], RelName7)), - ?m({error,"Undefined applications: [tools]"}, + ?msym({ok, {release, {RelName8, RelVsn}, + {erts, _}, + [{kernel, _}, + {stdlib, _}, + {sasl, _}, + {inets, _}, + {mnesia, _}, + {tools, _}, + {z, _, [mnesia,tools]}]}}, reltool:get_rel([{config, Sys}], RelName8)), ?msym({ok,{release,{RelName9,RelVsn}, @@ -407,7 +434,6 @@ create_release_sort(Config) -> {z,_,[]}]}}, reltool:get_rel([{config, Sys}], RelName9)), - %%! BUG: same as OTP-9984, but for reltool???? Or revert inets and sasl? ?msym({ok,{release,{RelName10,RelVsn}, {erts,_}, [{kernel,_}, @@ -417,6 +443,17 @@ create_release_sort(Config) -> {z,_,[]}]}}, reltool:get_rel([{config, Sys}], RelName10)), + ?msym({ok,{release,{RelName11,RelVsn}, + {erts,_}, + [{kernel,_}, + {stdlib,_}, + {sasl, _}, + {inets, _, load}, + {tools, _}, + {mnesia, _}, + {z,_}]}}, + reltool:get_rel([{config, Sys}], RelName11)), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -477,12 +514,16 @@ create_script_sort(Config) -> RelName3 = "Include-both", RelName4 = "Include-only-app", RelName5 = "Include-only-rel", - RelName6 = "Include-missing-app", + RelName6 = "Auto-add-missing-apps", RelName7 = "Circular", - RelName8 = "Include-both-missing-app", - RelName9 = "Include-overwrite", + RelName8 = "Include-rel-alter-order", + RelName9 = "Include-none-overwrite", + RelName10= "Uses-order-as-rel", RelVsn = "1.0", LibDir = filename:join(DataDir,"sort_apps"), + %% Application z (.app file): + %% includes [tools, mnesia] + %% uses [kernel, stdlib, sasl, inets] Sys = {sys, [ @@ -493,10 +534,11 @@ create_script_sort(Config) -> {rel, RelName3, RelVsn, [stdlib, kernel, {z,[tools]}, tools, mnesia]}, {rel, RelName4, RelVsn, [stdlib, kernel, z, mnesia, tools]}, {rel, RelName5, RelVsn, [stdlib, kernel, {sasl,[tools]}]}, - {rel, RelName6, RelVsn, [stdlib, kernel, z]}, + {rel, RelName6, RelVsn, [z]}, {rel, RelName7, RelVsn, [stdlib, kernel, mnesia, y, sasl, x]}, - {rel, RelName8, RelVsn, [stdlib, kernel, {z,[tools]}]}, + {rel, RelName8, RelVsn, [stdlib, kernel, {z,[mnesia,tools]}]}, {rel, RelName9, RelVsn, [stdlib, kernel, {z,[]}]}, + {rel, RelName10, RelVsn, [stdlib, kernel, {z,[]}, inets, sasl]}, {incl_cond,exclude}, {mod_cond,app}, {app,kernel,[{incl_cond,include}]}, @@ -553,8 +595,8 @@ create_script_sort(Config) -> [{kernel,KernelVsn}, {stdlib,StdlibVsn}, {z,"1.0"}, - {tools,ToolsVsn}, {mnesia,MnesiaVsn}, + {tools,ToolsVsn}, {sasl,SaslVsn}, {inets,InetsVsn}]}, FullName4 = filename:join(?WORK_DIR,RelName4), @@ -569,6 +611,10 @@ create_script_sort(Config) -> Rel6 = {release, {RelName6,RelVsn}, {erts,ErtsVsn}, [{kernel,KernelVsn}, {stdlib,StdlibVsn}, + {sasl,SaslVsn}, + {inets,InetsVsn}, + {tools,ToolsVsn}, + {mnesia,MnesiaVsn}, {z,"1.0"}]}, FullName6 = filename:join(?WORK_DIR,RelName6), ?m(ok, file:write_file(FullName6 ++ ".rel", io_lib:format("~p.\n", [Rel6]))), @@ -584,7 +630,11 @@ create_script_sort(Config) -> Rel8 = {release, {RelName8,RelVsn}, {erts,ErtsVsn}, [{kernel,KernelVsn}, {stdlib,StdlibVsn}, - {z,"1.0",[tools]}]}, + {z,"1.0",[mnesia,tools]}, + {sasl,SaslVsn}, + {inets,InetsVsn}, + {mnesia,MnesiaVsn}, + {tools,ToolsVsn}]}, FullName8 = filename:join(?WORK_DIR,RelName8), ?m(ok, file:write_file(FullName8 ++ ".rel", io_lib:format("~p.\n", [Rel8]))), Rel9 = {release, {RelName9,RelVsn}, {erts,ErtsVsn}, @@ -595,6 +645,14 @@ create_script_sort(Config) -> {inets,InetsVsn}]}, FullName9 = filename:join(?WORK_DIR,RelName9), ?m(ok, file:write_file(FullName9 ++ ".rel", io_lib:format("~p.\n", [Rel9]))), + Rel10 = {release, {RelName10,RelVsn}, {erts,ErtsVsn}, + [{kernel,KernelVsn}, + {stdlib,StdlibVsn}, + {z,"1.0",[]}, + {inets,InetsVsn}, + {sasl,SaslVsn}]}, + FullName10 = filename:join(?WORK_DIR,RelName10), + ?m(ok, file:write_file(FullName10 ++ ".rel", io_lib:format("~p.\n", [Rel10]))), %% Generate script files with systools and reltool and compare ZPath = filename:join([LibDir,"*",ebin]), @@ -626,26 +684,31 @@ create_script_sort(Config) -> "in the app file: [tools]"}, reltool:get_script(Pid, RelName5)), - ?msym({error,_,{undefined_applications,_}}, - systools_make_script(FullName6,ZPath)), - ?m({error, "Undefined applications: [tools,mnesia]"}, - reltool:get_script(Pid, RelName6)), + ?msym({ok,_,_}, systools_make_script(FullName6,ZPath)), + {ok, [SystoolsScript6]} = ?msym({ok,[_]}, file:consult(FullName6++".script")), + {ok, Script6} = ?msym({ok, _}, reltool:get_script(Pid, RelName6)), + ?m(equal, diff_script(SystoolsScript6, Script6)), ?msym({error,_,{circular_dependencies,_}}, systools_make_script(FullName7,ZPath)), ?m({error,"Circular dependencies: [x,y]"}, reltool:get_script(Pid, RelName7)), - ?msym({error,_,{undefined_applications,_}}, - systools_make_script(FullName8,ZPath)), - ?m({error, "Undefined applications: [tools]"}, - reltool:get_script(Pid, RelName8)), + ?msym({ok,_,_}, systools_make_script(FullName8,ZPath)), + {ok, [SystoolsScript8]} = ?msym({ok,[_]}, file:consult(FullName8++".script")), + {ok, Script8} = ?msym({ok, _}, reltool:get_script(Pid, RelName8)), + ?m(equal, diff_script(SystoolsScript8, Script8)), ?msym({ok,_,_}, systools_make_script(FullName9,ZPath)), {ok, [SystoolsScript9]} = ?msym({ok,[_]}, file:consult(FullName9++".script")), {ok, Script9} = ?msym({ok, _}, reltool:get_script(Pid, RelName9)), ?m(equal, diff_script(SystoolsScript9, Script9)), + ?msym({ok,_,_}, systools_make_script(FullName10,ZPath)), + {ok, [SystoolsScript10]} = ?msym({ok,[_]}, file:consult(FullName10++".script")), + {ok, Script10} = ?msym({ok, _}, reltool:get_script(Pid, RelName10)), + ?m(equal, diff_script(SystoolsScript10, Script10)), + %% Stop server ?m(ok, reltool:stop(Pid)), ok. @@ -951,8 +1014,6 @@ create_multiple_standalone(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Generate old type of target system - -create_old_target(_Config) -> {skip, "Old style of target"}; create_old_target(_Config) -> %% Configure the server @@ -975,8 +1036,7 @@ create_old_target(_Config) -> ?m(ok, reltool_utils:recursive_delete(TargetDir)), ?m(ok, file:make_dir(TargetDir)), ok = ?m(ok, reltool:create_target([{config, Config}], TargetDir)), - - %% io:format("Will fail on Windows (should patch erl.ini)\n", []), + ok = ?m(ok, reltool:install(RelName2, TargetDir)), Erl = filename:join([TargetDir, "bin", "erl"]), @@ -1024,9 +1084,14 @@ create_slim(Config) -> RootDir = code:root_dir(), Erl = filename:join([RootDir, "bin", "erl"]), - Args = "-boot_var RELTOOL_EXT_LIB " ++ TargetLibDir ++ - " -boot " ++ filename:join(TargetRelVsnDir,RelName) ++ - " -sasl releases_dir \\\"" ++ TargetRelDir ++ "\\\"", + EscapedQuote = + case os:type() of + {win32,_} -> "\\\""; + _ -> "\"" + end, + Args = ["-boot_var", "RELTOOL_EXT_LIB", TargetLibDir, + "-boot", filename:join(TargetRelVsnDir,RelName), + "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote], {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)), ?msym(RootDir, rpc:call(Node, code, root_dir, [])), ?msym([{RelName,RelVsn,_,permanent}], @@ -1942,7 +2007,7 @@ save_config(Config) -> %% %% x-1.0: x1.erl x2.erl x3.erl %% \ / (x2 calls y1, x3 calls y2) -%% y-1.0: y1.erl y2.erl +%% y-1.0: y0.erl y1.erl y2.erl %% \ (y1 calls z1) %% z-1.0 z1.erl %% @@ -2072,6 +2137,47 @@ dependencies(Config) -> ok. +%% Test that incl_cond on mod level overwrites mod_cond on app level +%% Uses same test applications as dependencies/1 above +mod_incl_cond_derived(Config) -> + %% In app y: mod_cond=none means no module shall be included + %% but mod_cond is overwritten by incl_cond on mod level + Sys = {sys,[{lib_dirs,[filename:join(datadir(Config),"dependencies")]}, + {incl_cond, exclude}, + {app,kernel,[{incl_cond,include}]}, + {app,sasl,[{incl_cond,include}]}, + {app,stdlib,[{incl_cond,include}]}, + {app,x,[{incl_cond,include}]}, + {app,y,[{incl_cond,include}, + {mod_cond,none}, + {mod,y0,[{incl_cond,derived}]}, + {mod,y2,[{incl_cond,derived}]}]}]}, + {ok, Pid} = ?msym({ok, _}, reltool:start_server([{config, Sys}])), + + ?msym({ok,[#app{name=kernel}, + #app{name=sasl}, + #app{name=stdlib}, + #app{name=x,uses_apps=[y]}, + #app{name=y,uses_apps=[]}]}, + reltool_server:get_apps(Pid,whitelist)), + {ok, Der} = ?msym({ok,_},reltool_server:get_apps(Pid,derived)), + ?msym([], rm_missing_app(Der)), + ?msym({ok,[]}, reltool_server:get_apps(Pid,source)), + + %% 1. check that y0 is not included since it has + %% incl_cond=derived, but is not used by any other module. + ?msym({ok,#mod{is_included=undefined}}, reltool_server:get_mod(Pid,y0)), + + %% 2. check that y1 is excluded since it has undefined incl_cond + %% on mod level, so mod_cond on app level shall be used. + ?msym({ok,#mod{is_included=false}}, reltool_server:get_mod(Pid,y1)), + + %% 3. check that y2 is included since it has incl_cond=derived and + %% is used by x3. + ?msym({ok,#mod{is_included=true}}, reltool_server:get_mod(Pid,y2)), + + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% use_selected_vsn(Config) -> LibDir1 = filename:join(datadir(Config),"use_selected_vsn"), @@ -2196,6 +2302,39 @@ use_selected_vsn_relative_path(Config) -> ok = file:set_cwd(Cwd), ok. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Test that reltool recognizes an application with its real name even +%% though it uses non standard format for its version number (in the +%% directory name) +non_standard_vsn_id(Config) -> + LibDir = filename:join(datadir(Config),"non_standard_vsn_id"), + B1Dir = filename:join(LibDir,"b-first"), + B2Dir = filename:join(LibDir,"b-second"), + + %%----------------------------------------------------------------- + %% Default vsn of app b + Sys1 = {sys,[{lib_dirs,[LibDir]}, + {incl_cond, exclude}, + {app,kernel,[{incl_cond,include}]}, + {app,sasl,[{incl_cond,include}]}, + {app,stdlib,[{incl_cond,include}]}, + {app,b,[{incl_cond,include}]}]}, + {ok, Pid1} = ?msym({ok, _}, reltool:start_server([{config, Sys1}])), + ?msym({ok,#app{vsn="first",active_dir=B1Dir,sorted_dirs=[B1Dir,B2Dir]}}, + reltool_server:get_app(Pid1,b)), + + %%----------------------------------------------------------------- + %% Pre-selected vsn of app b + Sys2 = {sys,[{lib_dirs,[LibDir]}, + {incl_cond, exclude}, + {app,kernel,[{incl_cond,include}]}, + {app,sasl,[{incl_cond,include}]}, + {app,stdlib,[{incl_cond,include}]}, + {app,b,[{incl_cond,include},{vsn,"second"}]}]}, + {ok, Pid2} = ?msym({ok, _}, reltool:start_server([{config, Sys2}])), + ?msym({ok,#app{vsn="second",active_dir=B2Dir,sorted_dirs=[B1Dir,B2Dir]}}, + reltool_server:get_app(Pid2,b)), + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2278,11 +2417,13 @@ mod_path(Node,Mod) -> start_node(Name, ErlPath) -> start_node(Name, ErlPath, []). -start_node(Name, ErlPath, Args) -> +start_node(Name, ErlPath, Args0) -> FullName = full_node_name(Name), - CmdLine = mk_node_cmdline(Name, ErlPath, Args), - io:format("Starting node ~p: ~s~n", [FullName, CmdLine]), - case open_port({spawn, CmdLine}, []) of + Args = mk_node_args(Name, Args0), + io:format("Starting node ~p: ~s~n", + [FullName, lists:flatten([[X," "] || X <- [ErlPath|Args]])]), + %io:format("open_port({spawn_executable, ~p}, [{args,~p}])~n",[ErlPath,Args]), + case open_port({spawn_executable, ErlPath}, [{args,Args}]) of Port when is_port(Port) -> unlink(Port), erlang:port_close(Port), @@ -2299,23 +2440,21 @@ stop_node(Node) -> spawn(Node, fun () -> halt() end), receive {nodedown, Node} -> ok end. -mk_node_cmdline(Name, Prog, Args) -> - Static = "-detached -noinput", +mk_node_args(Name, Args) -> Pa = filename:dirname(code:which(?MODULE)), NameSw = case net_kernel:longnames() of - false -> "-sname "; - true -> "-name "; + false -> "-sname"; + true -> "-name"; _ -> exit(not_distributed_node) end, {ok, Pwd} = file:get_cwd(), NameStr = atom_to_list(Name), - Prog ++ " " - ++ Static ++ " " - ++ NameSw ++ " " ++ NameStr ++ " " - ++ "-pa " ++ Pa ++ " " - ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ NameStr ++ " " - ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()) - ++ " " ++ Args. + ["-detached", "-noinput", + NameSw, NameStr, + "-pa", Pa, + "-env", "ERL_CRASH_DUMP", Pwd ++ "/erl_crash_dump." ++ NameStr, + "-setcookie", atom_to_list(erlang:get_cookie()) + | Args]. full_node_name(PreName) -> HostSuffix = lists:dropwhile(fun ($@) -> false; (_) -> true end, diff --git a/lib/reltool/test/reltool_server_SUITE_data/dependencies/y-1.0/ebin/y.app b/lib/reltool/test/reltool_server_SUITE_data/dependencies/y-1.0/ebin/y.app index d9dac371d7..39fdabeea4 100644 --- a/lib/reltool/test/reltool_server_SUITE_data/dependencies/y-1.0/ebin/y.app +++ b/lib/reltool/test/reltool_server_SUITE_data/dependencies/y-1.0/ebin/y.app @@ -2,6 +2,6 @@ {application, y, [{description, "Library application in reltool dependency test"}, {vsn, "1.0"}, - {modules, [y1,y2]}, + {modules, [y0,y1,y2]}, {registered, []}, {applications, [kernel, stdlib]}]}. diff --git a/lib/reltool/test/reltool_server_SUITE_data/dependencies/y-1.0/src/y0.erl b/lib/reltool/test/reltool_server_SUITE_data/dependencies/y-1.0/src/y0.erl new file mode 100644 index 0000000000..dc188ba7b6 --- /dev/null +++ b/lib/reltool/test/reltool_server_SUITE_data/dependencies/y-1.0/src/y0.erl @@ -0,0 +1,5 @@ +-module(y0). +-compile(export_all). + +f() -> + ok. diff --git a/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-first/ebin/b.app b/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-first/ebin/b.app new file mode 100644 index 0000000000..55550a8190 --- /dev/null +++ b/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-first/ebin/b.app @@ -0,0 +1,6 @@ +%% -*- erlang -*- +{application, b, + [{description, "Reltool test app for using selected version of app"}, + {vsn, "first"}, + {modules, [b]}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-first/src/b.erl b/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-first/src/b.erl new file mode 100644 index 0000000000..a6b4ff1c05 --- /dev/null +++ b/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-first/src/b.erl @@ -0,0 +1,4 @@ +-module(b). +-compile(export_all). + +foo() -> ok. diff --git a/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-second/ebin/b.app b/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-second/ebin/b.app new file mode 100644 index 0000000000..91e1365df7 --- /dev/null +++ b/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-second/ebin/b.app @@ -0,0 +1,6 @@ +%% -*- erlang -*- +{application, b, + [{description, "Reltool test app for using selected version of app"}, + {vsn, "second"}, + {modules, [b]}, + {applications, [kernel, stdlib]}]}. diff --git a/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-second/src/b.erl b/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-second/src/b.erl new file mode 100644 index 0000000000..a6b4ff1c05 --- /dev/null +++ b/lib/reltool/test/reltool_server_SUITE_data/non_standard_vsn_id/b-second/src/b.erl @@ -0,0 +1,4 @@ +-module(b). +-compile(export_all). + +foo() -> ok. diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index 84cd6ee10d..60be9ed7c9 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -17,14 +17,13 @@ %% %CopyrightEnd% %% {application, runtime_tools, - [{description, "RUNTIME_TOOLS version 1"}, + [{description, "RUNTIME_TOOLS"}, {vsn, "%VSN%"}, {modules, [dbg,observer_backend,percept_profile, runtime_tools,runtime_tools_sup,erts_alloc_config, ttb_autostart,dyntrace]}, - {registered, [runtime_tools_sup,inviso_rt,inviso_rt_meta]}, + {registered, [runtime_tools_sup]}, {applications, [kernel, stdlib]}, -% {env, [{inviso_autostart_mod,your_own_autostart_module}]}, {env, []}, {mod, {runtime_tools, []}}]}. diff --git a/lib/runtime_tools/src/runtime_tools_sup.erl b/lib/runtime_tools/src/runtime_tools_sup.erl index 913719c449..c8dab250dd 100644 --- a/lib/runtime_tools/src/runtime_tools_sup.erl +++ b/lib/runtime_tools/src/runtime_tools_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -31,15 +31,11 @@ %% ============================================================================= %% The runtime tools top most supervisor starts: -%% -The inviso runtime component. This is the only way to get the runtime component -%% started automatically (if for instance autostart is wanted). -%% Note that it is not impossible that the runtime component terminates it self -%% should it discover that no autostart is configured. +%% -The ttb_autostart component. This is used for tracing at startup +%% using observer/ttb. init(AutoModArgs) -> Flags = {one_for_one, 0, 3600}, - Children = [{inviso_rt, {inviso_rt, start_link_auto, [AutoModArgs]}, - temporary, 3000, worker, [inviso_rt]}, - {ttb_autostart, {ttb_autostart, start_link, []}, + Children = [{ttb_autostart, {ttb_autostart, start_link, []}, temporary, 3000, worker, [ttb_autostart]}], {ok, {Flags, Children}}. %% ----------------------------------------------------------------------------- diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl index 4071b159a1..dfae52ed1d 100644 --- a/lib/runtime_tools/test/dbg_SUITE.erl +++ b/lib/runtime_tools/test/dbg_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -514,7 +514,7 @@ file_port_schedfix1(Config) when is_list(Config) -> %% Cleanup %% ?line ToBeDeleted = filelib:wildcard(FName++"*"++".wraplog"), - ?line lists:map({file, delete}, ToBeDeleted), + ?line lists:map(fun file:delete/1, ToBeDeleted), % io:format("ToBeDeleted=~p", [ToBeDeleted]), %% %% Present the result diff --git a/lib/runtime_tools/test/runtime_tools_SUITE.erl b/lib/runtime_tools/test/runtime_tools_SUITE.erl index b26f3dd881..62497ab527 100644 --- a/lib/runtime_tools/test/runtime_tools_SUITE.erl +++ b/lib/runtime_tools/test/runtime_tools_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,7 +25,7 @@ -export([init_per_testcase/2, end_per_testcase/2]). %% Test cases --export([app_file/1]). +-export([app_file/1, start_stop_app/1]). %% Default timetrap timeout (set in init_per_testcase) -define(default_timeout, ?t:minutes(1)). @@ -42,7 +42,8 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [app_file]. + [app_file, + start_stop_app]. groups() -> []. @@ -60,10 +61,14 @@ end_per_group(_GroupName, Config) -> Config. -app_file(suite) -> - []; -app_file(doc) -> - ["Testing .app file"]; -app_file(Config) when is_list(Config) -> +app_file(_Config) -> ?line ok = ?t:app_test(runtime_tools), ok. + +start_stop_app(_Config) -> + ok = application:start(runtime_tools), + Sup = whereis(runtime_tools_sup), + true = is_pid(Sup), + Ref = erlang:monitor(process,Sup), + ok = application:stop(runtime_tools), + receive {'DOWN', Ref, process, Sup, shutdown} -> ok end. diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl index 5efd932c92..1ff3eb96eb 100644 --- a/lib/sasl/src/release_handler.erl +++ b/lib/sasl/src/release_handler.erl @@ -494,10 +494,10 @@ find_script(App, Dir, OldVsn, UpOrDown) -> up -> UpFromScripts; down -> DownToScripts end, - case lists:keysearch(OldVsn, 1, Scripts) of - {value, {_OldVsn, Script}} -> - {NewVsn, Script}; - false -> + case systools_relup:appup_search_for_version(OldVsn,Scripts) of + {ok,Script} -> + {NewVsn,Script}; + error -> throw({version_not_in_appup, OldVsn}) end; {error, enoent} -> diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 61e660e918..e8b28998c1 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -673,7 +673,7 @@ check_item({_,{registered,Regs}},I) -> _ -> throw({bad_param, I}) end; check_item({_,{modules,Mods}},I) -> - case mod_list_p(Mods) of + case a_list_p(Mods) of true -> Mods; _ -> throw({bad_param, I}) end; @@ -900,11 +900,10 @@ find_pos(N, Name, [_OtherAppl|OrderedAppls]) -> check_modules(Appls, Path, TestP, Machine) -> %% first check that all the module names are unique - %% Make a list M1 = [{Mod,Vsn,App,AppVsn,Dir}] - %% where Vsn = '$$ignore$$' | Specified - M1 = [{Mod,Vsn,App,Appv,A#application.dir} || - {{App,Appv},A} <- Appls, - {Mod,Vsn} <- get_mod_vsn(A#application.modules)], + %% Make a list M1 = [{Mod,App,Dir}] + M1 = [{Mod,App,A#application.dir} || + {{App,_Appv},A} <- Appls, + Mod <- A#application.modules], case duplicates(M1) of [] -> case check_mods(M1, Appls, Path, TestP, Machine) of @@ -918,16 +917,8 @@ check_modules(Appls, Path, TestP, Machine) -> throw({error, {duplicate_modules, Dups}}) end. -get_mod_vsn([{Mod,Vsn}|Mods]) -> - [{Mod,Vsn}|get_mod_vsn(Mods)]; -get_mod_vsn([Mod|Mods]) -> - [{Mod,'$$ignore$$'}|get_mod_vsn(Mods)]; -get_mod_vsn([]) -> - []. - %%______________________________________________________________________ -%% Check that all modules exists and that the specified version -%% corresponds to the version in the module's source code. +%% Check that all modules exists. %% Use the module extension of the running machine as extension for %% the checked modules. @@ -952,7 +943,7 @@ check_src(Modules, Appls, Path, true, Machine) -> Ext = objfile_extension(Machine), IncPath = create_include_path(Appls, Path), append(map(fun(ModT) -> - {Mod,_Vsn,App,_,Dir} = ModT, + {Mod,App,Dir} = ModT, case check_mod(Mod,App,Dir,Ext,IncPath) of ok -> []; @@ -1421,10 +1412,7 @@ create_mandatory_path(Appls, PathFlag, Variables) -> %% Load all modules, except those in Mandatory_modules. load_appl_mods([{{Name,Vsn},A}|Appls], Mand, PathFlag, Variables) -> - Mods = map(fun({Mod,_}) -> Mod; - (Mod) -> Mod - end, - A#application.modules), + Mods = A#application.modules, load_commands(filter(fun(Mod) -> not member(Mod, Mand) end, Mods), cr_path(Name, Vsn, A, PathFlag, Variables)) ++ load_appl_mods(Appls, Mand, PathFlag, Variables); @@ -1784,9 +1772,7 @@ add_appl(Name, Vsn, App, Tar, Variables, Flags, Var) -> add_to_tar(Tar, filename:join(AppDir, Name ++ ".app"), filename:join(BinDir, Name ++ ".app")), - add_modules(map(fun({Mod,_}) -> to_list(Mod); - (Mod) -> to_list(Mod) - end, + add_modules(map(fun(Mod) -> to_list(Mod) end, App#application.modules), Tar, AppDir, @@ -2026,14 +2012,6 @@ t_list_p([{A,_}|T]) when is_atom(A) -> t_list_p(T); t_list_p([]) -> true; t_list_p(_) -> false. -% check if a term is a list of atoms or two-tuples with the first -% element as an atom. - -mod_list_p([{A,_}|T]) when is_atom(A) -> mod_list_p(T); -mod_list_p([A|T]) when is_atom(A) -> mod_list_p(T); -mod_list_p([]) -> true; -mod_list_p(_) -> false. - % check if a term is a list of atoms. a_list_p([A|T]) when is_atom(A) -> a_list_p(T); diff --git a/lib/sasl/src/systools_rc.erl b/lib/sasl/src/systools_rc.erl index c16f6aa845..cf5cca7cb3 100644 --- a/lib/sasl/src/systools_rc.erl +++ b/lib/sasl/src/systools_rc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -326,8 +326,7 @@ translate_application_instrs(Script, Appls, PreAppls) -> fun({add_application, Appl, Type}) -> case lists:keysearch(Appl, #application.name, Appls) of {value, Application} -> - Mods = - remove_vsn(Application#application.modules), + Mods = Application#application.modules, ApplyL = case Type of none -> []; load -> [{apply, {application, load, [Appl]}}]; @@ -349,9 +348,11 @@ translate_application_instrs(Script, Appls, PreAppls) -> end, case lists:keysearch(Appl, #application.name, PreAppls) of {value, RemApplication} -> - Mods = remove_vsn(RemApplication#application.modules), + Mods = RemApplication#application.modules, + [{apply, {application, stop, [Appl]}}] ++ - [{remove, {M, brutal_purge, brutal_purge}} || M <- Mods] ++ + [{remove, {M, brutal_purge, brutal_purge}} + || M <- Mods] ++ [{purge, Mods}, {apply, {application, unload, [Appl]}}]; false -> @@ -360,16 +361,14 @@ translate_application_instrs(Script, Appls, PreAppls) -> ({restart_application, Appl}) -> case lists:keysearch(Appl, #application.name, PreAppls) of {value, PreApplication} -> - PreMods = - remove_vsn(PreApplication#application.modules), - + PreMods = PreApplication#application.modules, case lists:keysearch(Appl, #application.name, Appls) of {value, PostApplication} -> - PostMods = - remove_vsn(PostApplication#application.modules), - + PostMods = PostApplication#application.modules, + [{apply, {application, stop, [Appl]}}] ++ - [{remove, {M, brutal_purge, brutal_purge}} || M <- PreMods] ++ + [{remove, {M, brutal_purge, brutal_purge}} + || M <- PreMods] ++ [{purge, PreMods}] ++ [{add_module, M, []} || M <- PostMods] ++ [{apply, {application, start, @@ -385,11 +384,6 @@ translate_application_instrs(Script, Appls, PreAppls) -> end, Script), lists:flatten(L). -remove_vsn(Mods) -> - lists:map(fun({Mod, _Vsn}) -> Mod; - (Mod) -> Mod - end, Mods). - %%----------------------------------------------------------------- %% Translates add_module into load_module (high-level transformation) %%----------------------------------------------------------------- @@ -654,15 +648,9 @@ translate_dep_to_low(Mode, Instructions, Appls) -> end. get_lib(Mod, [#application{name = Name, vsn = Vsn, modules = Modules} | T]) -> - %% Module = {Mod, Vsn} | Mod - case lists:keysearch(Mod, 1, Modules) of - {value, _} -> - {Name, Vsn}; - false -> - case lists:member(Mod, Modules) of - true -> {Name, Vsn}; - false -> get_lib(Mod, T) - end + case lists:member(Mod, Modules) of + true -> {Name, Vsn}; + false -> get_lib(Mod, T) end; get_lib(Mod, []) -> throw({error, {no_such_module, Mod}}). diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index 7fb623bb85..7048184426 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -114,7 +114,8 @@ -define(R15_SASL_VSN,"2.2"). -%% For test purposes only - used by kernel, stdlib and sasl tests +%% Used by release_handler:find_script/4. +%% Also used by kernel, stdlib and sasl tests -export([appup_search_for_version/2]). %%----------------------------------------------------------------- diff --git a/lib/sasl/test/rb_SUITE.erl b/lib/sasl/test/rb_SUITE.erl index 35a4eb7e7b..b0e43be3a2 100644 --- a/lib/sasl/test/rb_SUITE.erl +++ b/lib/sasl/test/rb_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -66,23 +66,31 @@ init_per_group(running_error_logger,Config) -> restart_sasl(), Config. -end_per_group(running_error_logger,Config) -> +end_per_group(running_error_logger,_Config) -> %% Remove log_mf_h??? ok. init_per_testcase(_Case,Config) -> case whereis(?SUP) of - undefined -> ok; - Pid -> kill(Pid) + undefined -> + ok; + Sup -> + Server = whereis(?MODULE), + exit(Sup,kill), + wait_for_down([Server,Sup]) end, empty_error_logs(Config), Config. -kill(Pid) -> +wait_for_down([]) -> + ok; +wait_for_down([undefined|Rest]) -> + wait_for_down(Rest); +wait_for_down([Pid|Rest]) -> Ref = erlang:monitor(process,Pid), - exit(Pid,kill), - receive {'DOWN', Ref, process, Pid, _Info} -> ok end. + receive {'DOWN', Ref, process, Pid, _Info} -> ok end, + wait_for_down(Rest). end_per_testcase(Case,Config) -> try apply(?MODULE,Case,[cleanup,Config]) @@ -96,8 +104,9 @@ end_per_testcase(Case,Config) -> help(_Config) -> Help = capture(fun() -> rb:h() end), - "Report Browser Tool - usage" = hd(Help), - "rb:stop - stop the rb_server" = lists:last(Help), + %% Check that first and last line is there + true = lists:member("Report Browser Tool - usage", Help), + true = lists:member("rb:stop - stop the rb_server", Help), ok. %% Test that all three sasl env vars must be set for a successful start of rb diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index a8e3cc3d88..94cffc988d 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -63,7 +63,8 @@ cases() -> instructions, eval_appup, eval_appup_with_restart, supervisor_which_children_timeout, release_handler_which_releases, install_release_syntax_check, - upgrade_supervisor, upgrade_supervisor_fail, otp_9864]. + upgrade_supervisor, upgrade_supervisor_fail, otp_9864, + otp_10463_upgrade_script_regexp]. groups() -> [{release,[], @@ -1206,12 +1207,25 @@ otp_9395_rm_many_mods(cleanup,_Conf) -> stop_node(node_name(otp_9395_rm_many_mods)). otp_9864(Conf) -> + case os:type() of + {win32,_} -> + {skip,"Testing handling of symlinks - skipped on windows"}; + _ -> + do_otp_9864(Conf) + end. +do_otp_9864(Conf) -> %% Set some paths PrivDir = priv_dir(Conf), Dir = filename:join(PrivDir,"otp_9864"), RelDir = filename:join(?config(data_dir, Conf), "app1_app2"), - LibDir1 = filename:join(RelDir, "lib1"), - LibDir2 = filename:join(RelDir, "lib2"), + + %% Copy libs to priv_dir because remove_release will remove some + %% of these again, and we don't want to remove anything from + %% data_dir + copy_tree(Conf,filename:join(RelDir, "lib1"),Dir), + copy_tree(Conf,filename:join(RelDir, "lib2"),Dir), + LibDir1 = filename:join(Dir, "lib1"), + LibDir2 = filename:join(Dir, "lib2"), %% Create the releases Rel1 = create_and_install_fake_first_release(Dir, @@ -1229,10 +1243,6 @@ otp_9864(Conf) -> {ok, Node} = t_start_node(otp_9864, Rel1, filename:join(Rel1Dir,"sys.config")), %% Unpack rel2 (make sure it does not work if an AppDir is bad) - LibDir3 = filename:join(RelDir, "lib3"), - {error, {no_such_directory, _}} = - rpc:call(Node, release_handler, set_unpacked, - [Rel2++".rel", [{app1,"2.0",LibDir2}, {app2,"1.0",LibDir3}]]), {ok, RelVsn2} = rpc:call(Node, release_handler, set_unpacked, [Rel2++".rel", [{app1,"2.0",LibDir2}, {app2,"1.0",LibDir2}]]), @@ -1243,22 +1253,27 @@ otp_9864(Conf) -> ok = rpc:call(Node, release_handler, install_file, [RelVsn2, filename:join(Rel2Dir, "sys.config")]), - %% Install RelVsn2 without {update_paths, true} option + %% Install RelVsn2 {ok, RelVsn1, []} = rpc:call(Node, release_handler, install_release, [RelVsn2]), - %% Install RelVsn1 again + %% Create a symlink inside release 2 + Releases2Dir = filename:join([Dir,"releases","2"]), + Link = filename:join(Releases2Dir,"foo_symlink_dir"), + file:make_symlink(Releases2Dir,Link), + + %% Back down to RelVsn1 {ok, RelVsn1, []} = rpc:call(Node, release_handler, install_release, [RelVsn1]), - TempRel2Dir = filename:join(Dir,"releases/2"), - file:make_symlink(TempRel2Dir, filename:join(TempRel2Dir, "foo_symlink_dir")), - %% This will fail if symlinks are not handled ok = rpc:call(Node, release_handler, remove_release, [RelVsn2]), ok. +otp_9864(cleanup,_Conf) -> + stop_node(node_name(otp_9864)). + upgrade_supervisor(Conf) when is_list(Conf) -> %% Set some paths @@ -1646,6 +1661,15 @@ upgrade_gg(cleanup,Config) -> ok = stop_nodes(NodeNames). +%%%----------------------------------------------------------------- +%%% OTP-10463, Bug - release_handler could not handle regexp in appup +%%% files. +otp_10463_upgrade_script_regexp(_Config) -> + %% Assuming that kernel always has a regexp in it's appup + KernelVsn = vsn(kernel,current), + {ok,KernelVsn,_} = + release_handler:upgrade_script(kernel,code:lib_dir(kernel)), + ok. %%%================================================================= diff --git a/lib/sasl/test/release_handler_SUITE_data/Makefile.src b/lib/sasl/test/release_handler_SUITE_data/Makefile.src index 55d20aa8b6..b794aa0e6f 100644 --- a/lib/sasl/test/release_handler_SUITE_data/Makefile.src +++ b/lib/sasl/test/release_handler_SUITE_data/Makefile.src @@ -1,9 +1,5 @@ EFLAGS=+debug_info -P2B= \ - P2B/a-2.0/ebin/a.@EMULATOR@ \ - P2B/a-2.0/ebin/a_sup.@EMULATOR@ - LIB= \ lib/a-9.1/ebin/a.@EMULATOR@ \ lib/a-9.1/ebin/a_sup.@EMULATOR@ \ @@ -80,13 +76,7 @@ SUP= \ release_handler_timeouts/dummy-0.1/ebin/dummy_sup.@EMULATOR@ \ release_handler_timeouts/dummy-0.1/ebin/dummy_sup_2.@EMULATOR@ -all: $(P2B) $(LIB) $(APP) $(OTP2740) $(C) $(SUP) - -P2B/a-2.0/ebin/a.@EMULATOR@: P2B/a-2.0/src/a.erl - erlc $(EFLAGS) -oP2B/a-2.0/ebin P2B/a-2.0/src/a.erl -P2B/a-2.0/ebin/a_sup.@EMULATOR@: P2B/a-2.0/src/a_sup.erl - erlc $(EFLAGS) -oP2B/a-2.0/ebin P2B/a-2.0/src/a_sup.erl - +all: $(LIB) $(APP) $(OTP2740) $(C) $(SUP) 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 diff --git a/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/ebin/a.app b/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/ebin/a.app deleted file mode 100644 index 200cfcfe47..0000000000 --- a/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/ebin/a.app +++ /dev/null @@ -1,8 +0,0 @@ -{application, a, - [{description, "A CXC 138 11"}, - {vsn, "2.0"}, - {modules, [{a, 1}, {a_sup,1}]}, - {registered, [a_sup]}, - {applications, [kernel, stdlib]}, - {env, [{key1, val1}]}, - {mod, {a_sup, []}}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/src/a.erl b/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/src/a.erl deleted file mode 100644 index cfe38b55ce..0000000000 --- a/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/src/a.erl +++ /dev/null @@ -1,47 +0,0 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% 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(a). - - --behaviour(gen_server). - -%% External exports --export([start_link/0, a/0]). -%% Internal exports --export([init/1, handle_call/3, handle_info/2, terminate/2]). - -start_link() -> gen_server:start_link({local, aa}, a, [], []). - -a() -> gen_server:call(aa, a). - -%%----------------------------------------------------------------- -%% Callback functions from gen_server -%%----------------------------------------------------------------- -init([]) -> - process_flag(trap_exit, true), - {ok, state}. - -handle_call(a, _From, State) -> - X = application:get_all_env(a), - {reply, X, State}. - -handle_info(_, State) -> - {noreply, State}. - -terminate(_Reason, _State) -> - ok. diff --git a/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/src/a_sup.erl b/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/src/a_sup.erl deleted file mode 100644 index a141c1767b..0000000000 --- a/lib/sasl/test/release_handler_SUITE_data/P2B/a-2.0/src/a_sup.erl +++ /dev/null @@ -1,37 +0,0 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% 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(a_sup). - - --behaviour(supervisor). - -%% External exports --export([start/2]). - -%% Internal exports --export([init/1]). - -start(_, _) -> - supervisor:start_link({local, a_sup}, a_sup, []). - -init([]) -> - SupFlags = {one_for_one, 4, 3600}, - Config = {a, - {a, start_link, []}, - permanent, 2000, worker, [a]}, - {ok, {SupFlags, [Config]}}. diff --git a/lib/sasl/test/release_handler_SUITE_data/c/c.app b/lib/sasl/test/release_handler_SUITE_data/c/c.app index 908a94cf2d..2f56196918 100644 --- a/lib/sasl/test/release_handler_SUITE_data/c/c.app +++ b/lib/sasl/test/release_handler_SUITE_data/c/c.app @@ -1,7 +1,7 @@ {application, c, [{description, "C CXC 138 11"}, {vsn, "1.0"}, - {modules, [b, {aa, 1}, {c_sup,1}]}, + {modules, [b, aa, c_sup]}, {registered, [cc,bb,c_sup]}, {applications, [kernel, stdlib]}, {env, [{key1, val1}]}, diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.0/ebin/a.app b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.0/ebin/a.app index e938137f67..7ae189a36a 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.0/ebin/a.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.0/ebin/a.app @@ -1,7 +1,7 @@ {application, a, [{description, "A CXC 138 11"}, {vsn, "1.0"}, - {modules, [{a, 1}, {a_sup,1}]}, + {modules, [a, a_sup]}, {registered, [a_sup]}, {applications, [kernel, stdlib]}, {env, [{key1, val1}]}, diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.1/ebin/a.app b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.1/ebin/a.app index 1c3053b2fa..f8ab31fab9 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.1/ebin/a.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.1/ebin/a.app @@ -1,7 +1,7 @@ {application, a, [{description, "A CXC 138 11"}, {vsn, "1.1"}, - {modules, [{a, 2}, {a_sup,1}]}, + {modules, [a, a_sup]}, {registered, [a_sup]}, {applications, [kernel, stdlib]}, {env, [{key1, val1}]}, diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.app b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.app index b38722f06d..2393af0493 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/a-1.2/ebin/a.app @@ -1,7 +1,7 @@ {application, a, [{description, "A CXC 138 11"}, {vsn, "1.2"}, - {modules, [{a, 2}, {a_sup,1}]}, + {modules, [a, a_sup]}, {registered, [a_sup]}, {applications, [kernel, stdlib]}, {env, [{key1, val1}]}, diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/ebin/b.app b/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/ebin/b.app index 00347b2754..e2eada00a4 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/ebin/b.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-1.0/ebin/b.app @@ -2,6 +2,6 @@ {application, b, [{description, "B CXC 138 12"}, {vsn, "1.0"}, - {modules, [{b_server, 1},{b_lib, 1}]}, + {modules, [b_server,b_lib]}, {registered, [b_server]}, {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.app b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.app index 73c8e42b32..e4f8369ae5 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/b-2.0/ebin/b.app @@ -2,6 +2,6 @@ {application, b, [{description, "B CXC 138 12"}, {vsn, "2.0"}, - {modules, [{b_server, 1}]}, + {modules, [b_server]}, {registered, [b_server]}, {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/ebin/many_mods.app b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/ebin/many_mods.app index aa39adfffa..5c56c4cd74 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/ebin/many_mods.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.0/ebin/many_mods.app @@ -2,16 +2,6 @@ {application, many_mods, [{description, "Application with many modules CXC 138 11"}, {vsn, "1.0"}, - {modules, [{m, 1}, - {m1,1}, - {m2,1}, - {m3,1}, - {m4,1}, - {m5,1}, - {m6,1}, - {m7,1}, - {m8,1}, - {m9,1}, - {m10,1}]}, + {modules, [m,m1,m2,m3,m4,m5,m6,m7,m8,m9,m10]}, {registered, []}, {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.app b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.app index 36c50caf2f..87fdfe8442 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-1.1/ebin/many_mods.app @@ -2,16 +2,6 @@ {application, many_mods, [{description, "Application with many modules CXC 138 11"}, {vsn, "1.1"}, - {modules, [{m, 1}, - {m1,1}, - {m2,1}, - {m3,1}, - {m4,1}, - {m5,1}, - {m6,1}, - {m7,1}, - {m8,1}, - {m9,1}, - {m10,1}]}, + {modules, [m,m1,m2,m3,m4,m5,m6,m7,m8,m9,m10]}, {registered, []}, {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.app b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.app index 98f6527750..aba906d667 100644 --- a/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.app +++ b/lib/sasl/test/release_handler_SUITE_data/lib/many_mods-2.0/ebin/many_mods.app @@ -2,6 +2,6 @@ {application, many_mods, [{description, "Application with many modules CXC 138 11"}, {vsn, "2.0"}, - {modules, [{m, 1}]}, + {modules, [m]}, {registered, []}, {applications, [kernel, stdlib]}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_bad_app_vsn/lib/db-2.1/ebin/db.app b/lib/sasl/test/systools_SUITE_data/d_bad_app_vsn/lib/db-2.1/ebin/db.app index d375768b99..0878b80cb5 100644 --- a/lib/sasl/test/systools_SUITE_data/d_bad_app_vsn/lib/db-2.1/ebin/db.app +++ b/lib/sasl/test/systools_SUITE_data/d_bad_app_vsn/lib/db-2.1/ebin/db.app @@ -1,7 +1,7 @@ {application, db, [{description, "ERICSSON NR FOR DB"}, {vsn, "2.0"}, - {modules, [{db1, "1.0"}, {db2, "1.0"}]}, + {modules, [db1, db2]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_bad_app_vsn/lib/fe-3.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_bad_app_vsn/lib/fe-3.1/ebin/fe.app index d3bd85cda6..33d44805bd 100644 --- a/lib/sasl/test/systools_SUITE_data/d_bad_app_vsn/lib/fe-3.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_bad_app_vsn/lib/fe-3.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "3.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_bad_appup/lib/fe-2.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_bad_appup/lib/fe-2.1/ebin/fe.app index 3cb0b0c2cf..d7fae9e092 100644 --- a/lib/sasl/test/systools_SUITE_data/d_bad_appup/lib/fe-2.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_bad_appup/lib/fe-2.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "2.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {mod, {fe1, []}}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_bad_appup/lib/fe-3.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_bad_appup/lib/fe-3.1/ebin/fe.app index 0696e2494c..682d40eb12 100644 --- a/lib/sasl/test/systools_SUITE_data/d_bad_appup/lib/fe-3.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_bad_appup/lib/fe-3.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "3.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {mod, {fe1, []}}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_bad_mod+warn/lib/db-2.1/ebin/db.app b/lib/sasl/test/systools_SUITE_data/d_bad_mod+warn/lib/db-2.1/ebin/db.app index 191919f8d3..a1025c306a 100644 --- a/lib/sasl/test/systools_SUITE_data/d_bad_mod+warn/lib/db-2.1/ebin/db.app +++ b/lib/sasl/test/systools_SUITE_data/d_bad_mod+warn/lib/db-2.1/ebin/db.app @@ -1,7 +1,7 @@ {application, db, [{description, "ERICSSON NR FOR DB"}, {vsn, "2.1"}, - {modules, [{db1, "1.0"}, {db2, "1.0"}]}, + {modules, [db1, db2]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_bad_mod+warn/lib/fe-3.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_bad_mod+warn/lib/fe-3.1/ebin/fe.app index d3bd85cda6..33d44805bd 100644 --- a/lib/sasl/test/systools_SUITE_data/d_bad_mod+warn/lib/fe-3.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_bad_mod+warn/lib/fe-3.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "3.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_links/lib/db-2.1/ebin/db.app b/lib/sasl/test/systools_SUITE_data/d_links/lib/db-2.1/ebin/db.app index 3e0ac3c3c9..28d0f80d34 100644 --- a/lib/sasl/test/systools_SUITE_data/d_links/lib/db-2.1/ebin/db.app +++ b/lib/sasl/test/systools_SUITE_data/d_links/lib/db-2.1/ebin/db.app @@ -1,7 +1,7 @@ {application, db, [{description, "ERICSSON NR FOR DB"}, {vsn, "2.1"}, - {modules, [{db1, "1.0"}, {db2, "1.0"}, {db3, "2.0"}]}, + {modules, [db1, db2, db3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_missing_src/lib/db-2.1/ebin/db.app b/lib/sasl/test/systools_SUITE_data/d_missing_src/lib/db-2.1/ebin/db.app index 191919f8d3..a1025c306a 100644 --- a/lib/sasl/test/systools_SUITE_data/d_missing_src/lib/db-2.1/ebin/db.app +++ b/lib/sasl/test/systools_SUITE_data/d_missing_src/lib/db-2.1/ebin/db.app @@ -1,7 +1,7 @@ {application, db, [{description, "ERICSSON NR FOR DB"}, {vsn, "2.1"}, - {modules, [{db1, "1.0"}, {db2, "1.0"}]}, + {modules, [db1, db2]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_missing_src/lib/fe-3.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_missing_src/lib/fe-3.1/ebin/fe.app index d3bd85cda6..33d44805bd 100644 --- a/lib/sasl/test/systools_SUITE_data/d_missing_src/lib/fe-3.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_missing_src/lib/fe-3.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "3.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-2.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-2.1/ebin/fe.app index 47ea248720..717d30cf45 100644 --- a/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-2.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-2.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "2.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-3.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-3.1/ebin/fe.app index 0696e2494c..682d40eb12 100644 --- a/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-3.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-3.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "3.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {mod, {fe1, []}}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-500.18.7/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-500.18.7/ebin/fe.app index 3a5c0ddd9b..77b97979cb 100644 --- a/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-500.18.7/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_no_appup/lib/fe-500.18.7/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "500.18.7"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {mod, {fe1, []}}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-1.0/ebin/db.app b/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-1.0/ebin/db.app index 22530ee335..3968ce3c32 100644 --- a/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-1.0/ebin/db.app +++ b/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-1.0/ebin/db.app @@ -1,7 +1,7 @@ {application, db, [{description, "ERICSSON NR FOR DB"}, {vsn, "1.0"}, - {modules, [{db1, "1.0"}, {db2, "1.0"}]}, + {modules, [db1, db2]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-1.1/ebin/db.app b/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-1.1/ebin/db.app index 7243a0a96a..0f0c926fbd 100644 --- a/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-1.1/ebin/db.app +++ b/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-1.1/ebin/db.app @@ -1,7 +1,7 @@ {application, db, [{description, "ERICSSON NR FOR DB"}, {vsn, "1.1"}, - {modules, [{db1, "1.0"}, {db2, "1.0"}]}, + {modules, [db1, db2]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-2.1/ebin/db.app b/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-2.1/ebin/db.app index 202d7f1234..6901d225e2 100644 --- a/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-2.1/ebin/db.app +++ b/lib/sasl/test/systools_SUITE_data/d_normal/lib/db-2.1/ebin/db.app @@ -1,7 +1,7 @@ {application, db, [{description, "ERICSSON NR FOR DB"}, {vsn, "2.1"}, - {modules, [{db1, "1.0"}, {db2, "1.0"}]}, + {modules, [db1, db2]}, {registered, []}, {applications, []}, {mod, {db1, []}}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-2.1.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-2.1.1/ebin/fe.app index c7ba1dfe91..d963a7e7fa 100644 --- a/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-2.1.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-2.1.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "2.1.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-2.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-2.1/ebin/fe.app index 47ea248720..717d30cf45 100644 --- a/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-2.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-2.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "2.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-3.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-3.1/ebin/fe.app index 0696e2494c..682d40eb12 100644 --- a/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-3.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_normal/lib/fe-3.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "3.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {mod, {fe1, []}}]}. diff --git a/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-2.1.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-2.1.1/ebin/fe.app index c7ba1dfe91..d963a7e7fa 100644 --- a/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-2.1.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-2.1.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "2.1.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-2.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-2.1/ebin/fe.app index 47ea248720..717d30cf45 100644 --- a/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-2.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-2.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "2.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {env, []}, diff --git a/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-3.1/ebin/fe.app b/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-3.1/ebin/fe.app index 0696e2494c..682d40eb12 100644 --- a/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-3.1/ebin/fe.app +++ b/lib/sasl/test/systools_SUITE_data/d_regexp_appup/lib/fe-3.1/ebin/fe.app @@ -1,7 +1,7 @@ {application, fe, [{description, "ERICSSON NR FOR FE"}, {vsn, "3.1"}, - {modules, [{fe1, "1.0"}, {fe2, "1.0"}, {fe3, "2.0"}]}, + {modules, [fe1, fe2, fe3]}, {registered, []}, {applications, []}, {mod, {fe1, []}}]}. diff --git a/lib/sasl/test/systools_rc_SUITE.erl b/lib/sasl/test/systools_rc_SUITE.erl index bd4aa9e7a7..0cb6e63cf3 100644 --- a/lib/sasl/test/systools_rc_SUITE.erl +++ b/lib/sasl/test/systools_rc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2011. All Rights Reserved. +%% Copyright Ericsson AB 2010-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,7 +46,7 @@ syntax_check(Config) when is_list(Config) -> [#application{name = test, description = "TEST", vsn = "0.1", - modules = [{foo,1},{bar,1},{baz,1},{old_mod,1}], + modules = [foo,bar,baz,old_mod], regs = [], mod = {sasl, []}}, #application{name = snmp, @@ -59,7 +59,7 @@ syntax_check(Config) when is_list(Config) -> [#application{name = test, description = "TEST", vsn = "1.0", - modules = [{foo,1},{bar,1},{baz,1},{new_mod,1}], + modules = [foo,bar,baz,new_mod], regs = [], mod = {sasl, []}}], S1 = [ @@ -128,8 +128,8 @@ translate(Config) when is_list(Config) -> [#application{name = test, description = "TEST", vsn = "1.0", - modules = [{foo,1},{bar,1},{baz,1}, - {x,1},{y,1},{z,1}], + modules = [foo,bar,baz, + x,y,z], regs = [], mod = {sasl, []}}], %% Simple translation (1) @@ -439,7 +439,7 @@ translate_app(Config) when is_list(Config) -> [#application{name = test, description = "TEST", vsn = "1.0", - modules = [{foo,1},{bar,1},{baz,1}], + modules = [foo,bar,baz], regs = [], mod = {sasl, []}}, #application{name = pelle, @@ -452,7 +452,7 @@ translate_app(Config) when is_list(Config) -> [#application{name = test, description = "TEST", vsn = "1.0", - modules = [{foo,1},{bar,1},{baz,1}], + modules = [foo,bar,baz], regs = [], mod = {sasl, []}}], %% Simple translation (1) @@ -492,13 +492,13 @@ translate_emulator_restarts(_Config) -> [#application{name = test, description = "TEST", vsn = "1.0", - modules = [{foo,1},{bar,1},{baz,1}], + modules = [foo,bar,baz], regs = [], mod = {sasl, []}}, #application{name = test, description = "TEST2", vsn = "1.0", - modules = [{x,1},{y,1},{z,1}], + modules = [x,y,z], regs = [], mod = {sasl, []}}], %% restart_new_emulator diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index b84b3a3dcb..0133250979 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -265,7 +265,7 @@ <item> <p>Comma separated string that determines which authentication methodes that the server should support and in what order they will be tried. Defaults to - <c><![CDATA["publickey,keyboard_interactive,password"]]></c></p> + <c><![CDATA["publickey,keyboard-interactive,password"]]></c></p> </item> <tag><c><![CDATA[{user_passwords, [{string() = User, string() = Password}]}]]></c></tag> <item> diff --git a/lib/ssh/doc/src/ssh_connection.xml b/lib/ssh/doc/src/ssh_connection.xml index 9942306b93..a9ae13d556 100644 --- a/lib/ssh/doc/src/ssh_connection.xml +++ b/lib/ssh/doc/src/ssh_connection.xml @@ -196,7 +196,7 @@ <name>send(ConnectionRef, ChannelId, Data, Timeout) -></name> <name>send(ConnectionRef, ChannelId, Type, Data) -></name> <name>send(ConnectionRef, ChannelId, Type, Data, TimeOut) -> - ok | {error, timeout}</name> + ok | {error, timeout} | {error, closed}</name> <fsummary>Sends channel data </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> @@ -212,7 +212,7 @@ </func> <func> - <name>send_eof(ConnectionRef, ChannelId) -> ok </name> + <name>send_eof(ConnectionRef, ChannelId) -> ok | {error, closed}</name> <fsummary>Sends eof on the channel <c>ChannelId</c>. </fsummary> <type> <v> ConnectionRef = ssh_connection_ref() </v> diff --git a/lib/ssh/src/ssh_auth.hrl b/lib/ssh/src/ssh_auth.hrl index 7d7bad4436..e74ee10041 100644 --- a/lib/ssh/src/ssh_auth.hrl +++ b/lib/ssh/src/ssh_auth.hrl @@ -21,7 +21,7 @@ %%% Description: Ssh User Authentication Protocol --define(SUPPORTED_AUTH_METHODS, "publickey,keyboard_interactive,password"). +-define(SUPPORTED_AUTH_METHODS, "publickey,keyboard-interactive,password"). -define(PREFERRED_PK_ALG, ssh_rsa). diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index 781e01b9d1..c8c610f8ef 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -81,7 +81,8 @@ handle_ssh_msg({ssh_cm, ConnectionManager, height = not_zero(Height, 24), pixel_width = PixWidth, pixel_height = PixHeight, - modes = Modes}}, + modes = Modes}, + buf = empty_buf()}, set_echo(State), ssh_connection:reply_request(ConnectionManager, WantReply, success, ChannelId), diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index c2a7c63cbe..9424cdd423 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -177,7 +177,7 @@ close(ConnectionManager, ChannelId) -> %% Description: Send status replies to requests that want such replies. %%-------------------------------------------------------------------- reply_request(ConnectionManager, true, Status, ChannelId) -> - ConnectionManager ! {ssh_cm, self(), {Status, ChannelId}}, + ssh_connection_manager:reply_request(ConnectionManager, Status, ChannelId), ok; reply_request(_,false, _, _) -> ok. @@ -318,21 +318,22 @@ channel_data(ChannelId, DataType, Data, From) -> case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = Id} = Channel0 -> - {SendList, Channel} = update_send_window(Channel0, DataType, + #channel{remote_id = Id, sent_close = false} = Channel0 -> + {SendList, Channel} = update_send_window(Channel0#channel{flow_control = From}, DataType, Data, Connection), Replies = lists:map(fun({SendDataType, SendData}) -> - {connection_reply, ConnectionPid, - channel_data_msg(Id, - SendDataType, - SendData)} + {connection_reply, ConnectionPid, + channel_data_msg(Id, + SendDataType, + SendData)} end, SendList), FlowCtrlMsgs = flow_control(Replies, - Channel#channel{flow_control = From}, + Channel, Cache), {{replies, Replies ++ FlowCtrlMsgs}, Connection}; - undefined -> + _ -> + gen_server:reply(From, {error, closed}), {noreply, Connection} end. @@ -386,20 +387,30 @@ handle_msg(#ssh_msg_channel_close{recipient_channel = ChannelId}, ConnectionPid, _) -> case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{sent_close = Closed, remote_id = RemoteId} = Channel -> + #channel{sent_close = Closed, remote_id = RemoteId, flow_control = FlowControl} = Channel -> ssh_channel:cache_delete(Cache, ChannelId), {CloseMsg, Connection} = reply_msg(Channel, Connection0, {closed, ChannelId}), + + ConnReplyMsgs = case Closed of - true -> - {{replies, [CloseMsg]}, Connection}; + true -> []; false -> RemoteCloseMsg = channel_close_msg(RemoteId), - {{replies, - [{connection_reply, - ConnectionPid, RemoteCloseMsg}, - CloseMsg]}, Connection} - end; + [{connection_reply, ConnectionPid, RemoteCloseMsg}] + end, + + %% if there was a send() in progress, make it fail + SendReplyMsgs = + case FlowControl of + undefined -> []; + From -> + [{flow_control, From, {error, closed}}] + end, + + Replies = ConnReplyMsgs ++ [CloseMsg] ++ SendReplyMsgs, + {{replies, Replies}, Connection}; + undefined -> {{replies, []}, Connection0} end; @@ -441,7 +452,7 @@ handle_msg(#ssh_msg_channel_window_adjust{recipient_channel = ChannelId, {SendList, Channel} = %% TODO: Datatype 0 ? update_send_window(Channel0#channel{send_window_size = Size + Add}, - 0, <<>>, Connection), + 0, undefined, Connection), Replies = lists:map(fun({Type, Data}) -> {connection_reply, ConnectionPid, @@ -1073,14 +1084,15 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid}, false -> {{channel_data, ChannelPid, Reply}, Connection} end. +update_send_window(Channel, _, undefined, + #connection{channel_cache = Cache}) -> + do_update_send_window(Channel, Channel#channel.send_buf, Cache); -update_send_window(Channel0, DataType, Data, - #connection{channel_cache = Cache}) -> - Buf0 = if Data == <<>> -> - Channel0#channel.send_buf; - true -> - Channel0#channel.send_buf ++ [{DataType, Data}] - end, +update_send_window(Channel, DataType, Data, + #connection{channel_cache = Cache}) -> + do_update_send_window(Channel, Channel#channel.send_buf ++ [{DataType, Data}], Cache). + +do_update_send_window(Channel0, Buf0, Cache) -> {Buf1, NewSz, Buf2} = get_window(Buf0, Channel0#channel.send_packet_size, Channel0#channel.send_window_size), @@ -1125,13 +1137,13 @@ flow_control(Channel, Cache) -> flow_control([], Channel, Cache) -> ssh_channel:cache_update(Cache, Channel), []; -flow_control([_|_], #channel{flow_control = From} = Channel, Cache) -> - case From of - undefined -> - []; - _ -> - [{flow_control, Cache, Channel, From, ok}] - end. + +flow_control([_|_], #channel{flow_control = From, + send_buf = []} = Channel, Cache) when From =/= undefined -> + [{flow_control, Cache, Channel, From, ok}]; +flow_control(_,_,_) -> + []. + encode_pty_opts(Opts) -> Bin = list_to_binary(encode_pty_opts2(Opts)), diff --git a/lib/ssh/src/ssh_connection_manager.erl b/lib/ssh/src/ssh_connection_manager.erl index e53cd4f4f7..422d9356d5 100644 --- a/lib/ssh/src/ssh_connection_manager.erl +++ b/lib/ssh/src/ssh_connection_manager.erl @@ -40,7 +40,7 @@ close/2, stop/1, send/5, send_eof/2]). --export([open_channel/6, request/6, request/7, global_request/4, event/2, +-export([open_channel/6, reply_request/3, request/6, request/7, global_request/4, event/2, cast/2]). %% Internal application API and spawn @@ -95,6 +95,9 @@ request(ConnectionManager, ChannelId, Type, true, Data, Timeout) -> request(ConnectionManager, ChannelId, Type, false, Data, _) -> cast(ConnectionManager, {request, ChannelId, Type, Data}). +reply_request(ConnectionManager, Status, ChannelId) -> + cast(ConnectionManager, {reply_request, Status, ChannelId}). + global_request(ConnectionManager, Type, true = Reply, Data) -> case call(ConnectionManager, {global_request, self(), Type, Reply, Data}) of @@ -163,7 +166,7 @@ send(ConnectionManager, ChannelId, Type, Data, Timeout) -> call(ConnectionManager, {data, ChannelId, Type, Data}, Timeout). send_eof(ConnectionManager, ChannelId) -> - cast(ConnectionManager, {eof, ChannelId}). + call(ConnectionManager, {eof, ChannelId}). %%==================================================================== %% gen_server callbacks @@ -295,6 +298,18 @@ handle_call({data, ChannelId, Type, Data}, From, channel_data(ChannelId, Type, Data, Connection0, ConnectionPid, From, State); +handle_call({eof, ChannelId}, _From, + #state{connection = Pid, connection_state = + #connection{channel_cache = Cache}} = State) -> + case ssh_channel:cache_lookup(Cache, ChannelId) of + #channel{remote_id = Id, sent_close = false} -> + send_msg({connection_reply, Pid, + ssh_connection:channel_eof_msg(Id)}), + {reply, ok, State}; + _ -> + {reply, {error,closed}, State} + end; + handle_call({connection_info, Options}, From, #state{connection = Connection} = State) -> ssh_connection_handler:connection_info(Connection, From, Options), @@ -431,6 +446,16 @@ handle_cast({request, ChannelId, Type, Data}, State0) -> lists:foreach(fun send_msg/1, Replies), {noreply, State}; +handle_cast({reply_request, Status, ChannelId}, #state{connection_state = + #connection{channel_cache = Cache}} = State0) -> + State = case ssh_channel:cache_lookup(Cache, ChannelId) of + #channel{remote_id = RemoteId} -> + cm_message({Status, RemoteId}, State0); + undefined -> + State0 + end, + {noreply, State}; + handle_cast({global_request, _, _, _, _} = Request, State0) -> State = handle_global_request(Request, State0), {noreply, State}; @@ -453,18 +478,6 @@ handle_cast({adjust_window, ChannelId, Bytes}, end, {noreply, State}; -handle_cast({eof, ChannelId}, - #state{connection = Pid, connection_state = - #connection{channel_cache = Cache}} = State) -> - case ssh_channel:cache_lookup(Cache, ChannelId) of - #channel{remote_id = Id} -> - send_msg({connection_reply, Pid, - ssh_connection:channel_eof_msg(Id)}), - {noreply, State}; - undefined -> - {noreply, State} - end; - handle_cast({success, ChannelId}, #state{connection = Pid} = State) -> Msg = ssh_connection:channel_success_msg(ChannelId), send_msg({connection_reply, Pid, Msg}), @@ -614,6 +627,8 @@ do_send_msg({connection_reply, Pid, Data}) -> ssh_connection_handler:send(Pid, Msg); do_send_msg({flow_control, Cache, Channel, From, Msg}) -> ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}), + gen_server:reply(From, Msg); +do_send_msg({flow_control, From, Msg}) -> gen_server:reply(From, Msg). handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 25072688ad..f5db31baee 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -36,7 +36,9 @@ MODULES= \ ssh_to_openssh_SUITE \ ssh_sftp_SUITE \ ssh_sftpd_SUITE \ - ssh_sftpd_erlclient_SUITE + ssh_sftpd_erlclient_SUITE \ + ssh_connection_SUITE \ + ssh_echo_server HRL_FILES_NEEDED_IN_TEST= \ $(ERL_TOP)/lib/ssh/src/ssh.hrl \ diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 2ceaa9daa5..7a641c92c1 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -22,7 +22,6 @@ -module(ssh_basic_SUITE). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -30,78 +29,12 @@ -define(NEWLINE, <<"\r\n">>). %%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initialization before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- -init_per_suite(Config) -> - case catch crypto:start() of - ok -> - Config; - _Else -> - {skip, "Crypto could not be started!"} - end. - -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- -end_per_suite(_Config) -> - ssh:stop(), - crypto:stop(), - ok. - -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(TestCase, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initialization before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%% Description: Initialization before each test case +%% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- -init_per_testcase(_TestCase, Config) -> - ssh:start(), - Config. -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(TestCase, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- +suite() -> + [{ct_hooks,[ts_install_cth]}]. -end_per_testcase(TestCase, Config) when TestCase == server_password_option; - TestCase == server_userpassword_option -> - UserDir = filename:join(?config(priv_dir, Config), nopubkey), - ssh_test_lib:del_dirs(UserDir), - end_per_testcase(Config); -end_per_testcase(_TestCase, Config) -> - end_per_testcase(Config). -end_per_testcase(_Config) -> - ssh:stop(), - ok. - -%%-------------------------------------------------------------------- -%% Function: all(Clause) -> TestCases -%% Clause - atom() - suite | doc -%% TestCases - [Case] -%% Case - atom() -%% Name of a test case. -%% Description: Returns a list of all test cases in this test suite -%%-------------------------------------------------------------------- all() -> [app_test, {group, dsa_key}, @@ -110,17 +43,29 @@ all() -> {group, rsa_pass_key}, {group, internal_error}, daemon_already_started, - server_password_option, server_userpassword_option, + server_password_option, + server_userpassword_option, close]. groups() -> - [{dsa_key, [], [exec, exec_compressed, shell, known_hosts]}, - {rsa_key, [], [exec, exec_compressed, shell, known_hosts]}, + [{dsa_key, [], [send, exec, exec_compressed, shell, known_hosts]}, + {rsa_key, [], [send, exec, exec_compressed, shell, known_hosts]}, {dsa_pass_key, [], [pass_phrase]}, {rsa_pass_key, [], [pass_phrase]}, {internal_error, [], [internal_error]} ]. - +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + case catch crypto:start() of + ok -> + Config; + _Else -> + {skip, "Crypto could not be started!"} + end. +end_per_suite(_Config) -> + ssh:stop(), + crypto:stop(). +%%-------------------------------------------------------------------- init_per_group(dsa_key, Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -173,11 +118,25 @@ end_per_group(internal_error, Config) -> end_per_group(_, Config) -> Config. +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + ssh:start(), + Config. + +end_per_testcase(TestCase, Config) when TestCase == server_password_option; + TestCase == server_userpassword_option -> + UserDir = filename:join(?config(priv_dir, Config), nopubkey), + ssh_test_lib:del_dirs(UserDir), + end_per_testcase(Config); +end_per_testcase(_TestCase, Config) -> + end_per_testcase(Config). +end_per_testcase(_Config) -> + ssh:stop(), + ok. -%% Test cases starts here. %%-------------------------------------------------------------------- -app_test(suite) -> - []; +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- app_test(doc) -> ["Application consistency test."]; app_test(Config) when is_list(Config) -> @@ -188,8 +147,6 @@ misc_ssh_options(doc) -> ["Test that we can set some misc options not tested elsewhere, " "some options not yet present are not decided if we should support or " "if they need thier own test case."]; -misc_ssh_options(suite) -> - []; misc_ssh_options(Config) when is_list(Config) -> SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), @@ -208,10 +165,6 @@ misc_ssh_options(Config) when is_list(Config) -> %%-------------------------------------------------------------------- exec(doc) -> ["Test api function ssh_connection:exec"]; - -exec(suite) -> - []; - exec(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -232,7 +185,7 @@ exec(Config) when is_list(Config) -> expected -> ok; Other0 -> - test_server:fail(Other0) + ct:fail(Other0) end, ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId0), @@ -246,7 +199,7 @@ exec(Config) when is_list(Config) -> expected -> ok; Other1 -> - test_server:fail(Other1) + ct:fail(Other1) end, ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId1), ssh:stop_daemon(Pid). @@ -254,10 +207,6 @@ exec(Config) when is_list(Config) -> %%-------------------------------------------------------------------- exec_compressed(doc) -> ["Test that compression option works"]; - -exec_compressed(suite) -> - []; - exec_compressed(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -279,7 +228,7 @@ exec_compressed(Config) when is_list(Config) -> expected -> ok; Other -> - test_server:fail(Other) + ct:fail(Other) end, ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId), ssh:stop_daemon(Pid). @@ -288,10 +237,6 @@ exec_compressed(Config) when is_list(Config) -> shell(doc) -> ["Test that ssh:shell/2 works"]; - -shell(suite) -> - []; - shell(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -299,76 +244,22 @@ shell(Config) when is_list(Config) -> {_Pid, _Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {failfun, fun ssh_test_lib:failfun/2}]), - test_server:sleep(500), + ct:sleep(500), IO = ssh_test_lib:start_io_server(), Shell = ssh_test_lib:start_shell(Port, IO, UserDir), receive {'EXIT', _, _} -> - test_server:fail(no_ssh_connection); + ct:fail(no_ssh_connection); ErlShellStart -> - test_server:format("Erlang shell start: ~p~n", [ErlShellStart]), + ct:pal("Erlang shell start: ~p~n", [ErlShellStart]), do_shell(IO, Shell) end. -do_shell(IO, Shell) -> - receive - ErlPrompt0 -> - test_server:format("Erlang prompt: ~p~n", [ErlPrompt0]) - end, - IO ! {input, self(), "1+1.\r\n"}, - receive - Echo0 -> - test_server:format("Echo: ~p ~n", [Echo0]) - end, - receive - ?NEWLINE -> - ok - end, - receive - Result0 = <<"2">> -> - test_server:format("Result: ~p~n", [Result0]) - end, - receive - ?NEWLINE -> - ok - end, - receive - ErlPrompt1 -> - test_server:format("Erlang prompt: ~p~n", [ErlPrompt1]) - end, - exit(Shell, kill), - %% Does not seem to work in the testserver! - %% IO ! {input, self(), "q().\r\n"}, - %% receive - %% ?NEWLINE -> - %% ok - %% end, - %% receive - %% Echo1 -> - %% test_server:format("Echo: ~p ~n", [Echo1]) - %% end, - %% receive - %% ?NEWLINE -> - %% ok - %% end, - %% receive - %% Result1 -> - %% test_server:format("Result: ~p~n", [Result1]) - %% end, - receive - {'EXIT', Shell, killed} -> - ok - end. - %%-------------------------------------------------------------------- daemon_already_started(doc) -> ["Test that get correct error message if you try to start a daemon", "on an adress that already runs a daemon see also seq10667" ]; - -daemon_already_started(suite) -> - []; - daemon_already_started(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), UserDir = ?config(priv_dir, Config), @@ -385,8 +276,6 @@ daemon_already_started(Config) when is_list(Config) -> %%-------------------------------------------------------------------- server_password_option(doc) -> ["validate to server that uses the 'password' option"]; -server_password_option(suite) -> - []; server_password_option(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth @@ -412,7 +301,7 @@ server_password_option(Config) when is_list(Config) -> {user_interaction, false}, {user_dir, UserDir}]), - test_server:format("Test of wrong password: Error msg: ~p ~n", [Reason]), + ct:pal("Test of wrong password: Error msg: ~p ~n", [Reason]), ssh:close(ConnectionRef), ssh:stop_daemon(Pid). @@ -421,8 +310,6 @@ server_password_option(Config) when is_list(Config) -> server_userpassword_option(doc) -> ["validate to server that uses the 'password' option"]; -server_userpassword_option(suite) -> - []; server_userpassword_option(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth @@ -459,8 +346,6 @@ server_userpassword_option(Config) when is_list(Config) -> %%-------------------------------------------------------------------- known_hosts(doc) -> ["check that known_hosts is updated correctly"]; -known_hosts(suite) -> - []; known_hosts(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -488,10 +373,6 @@ known_hosts(Config) when is_list(Config) -> pass_phrase(doc) -> ["Test that we can use keyes protected by pass phrases"]; - -pass_phrase(suite) -> - []; - pass_phrase(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -513,10 +394,6 @@ pass_phrase(Config) when is_list(Config) -> internal_error(doc) -> ["Test that client does not hang if disconnects due to internal error"]; - -internal_error(suite) -> - []; - internal_error(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), @@ -532,12 +409,29 @@ internal_error(Config) when is_list(Config) -> ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- -close(doc) -> - ["Simulate that we try to close an already closed connection"]; +send(doc) -> + ["Test ssh_connection:send/3"]; +send(Config) when is_list(Config) -> + process_flag(trap_exit, true), + SystemDir = filename:join(?config(priv_dir, Config), system), + UserDir = ?config(priv_dir, Config), + + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, + {user_dir, UserDir}, + {failfun, fun ssh_test_lib:failfun/2}]), + ConnectionRef = + ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user_dir, UserDir}, + {user_interaction, false}]), + {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:send(ConnectionRef, ChannelId, <<"Data">>), + ok = ssh_connection:send(ConnectionRef, ChannelId, << >>), + ssh:stop_daemon(Pid). -close(suite) -> - []; +%%-------------------------------------------------------------------- +close(doc) -> + ["Simulate that we try to close an already closed connection"]; close(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -557,10 +451,8 @@ close(Config) when is_list(Config) -> exit(CM, {shutdown, normal}), ok = ssh:close(CM). - - %%-------------------------------------------------------------------- -%% Internal functions +%% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- basic_test(Config) -> @@ -571,3 +463,53 @@ basic_test(Config) -> {ok, CM} = ssh:connect(Host, Port, ClientOpts), ok = ssh:close(CM), ssh:stop_daemon(Pid). + +do_shell(IO, Shell) -> + receive + ErlPrompt0 -> + ct:pal("Erlang prompt: ~p~n", [ErlPrompt0]) + end, + IO ! {input, self(), "1+1.\r\n"}, + receive + Echo0 -> + ct:pal("Echo: ~p ~n", [Echo0]) + end, + receive + ?NEWLINE -> + ok + end, + receive + Result0 = <<"2">> -> + ct:pal("Result: ~p~n", [Result0]) + end, + receive + ?NEWLINE -> + ok + end, + receive + ErlPrompt1 -> + ct:pal("Erlang prompt: ~p~n", [ErlPrompt1]) + end, + exit(Shell, kill). + %%Does not seem to work in the testserver! + %% IO ! {input, self(), "q().\r\n"}, + %% receive + %% ?NEWLINE -> + %% ok + %% end, + %% receive + %% Echo1 -> + %% ct:pal("Echo: ~p ~n", [Echo1]) + %% end, + %% receive + %% ?NEWLINE -> + %% ok + %% end, + %% receive + %% Result1 -> + %% ct:pal("Result: ~p~n", [Result1]) + %% end, + %% receive + %% {'EXIT', Shell, killed} -> + %% ok + %% end. diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl new file mode 100644 index 0000000000..acaf3d6eeb --- /dev/null +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -0,0 +1,313 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(ssh_connection_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +-compile(export_all). + +-define(SSH_DEFAULT_PORT, 22). +-define(EXEC_TIMEOUT, 10000). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [ + {group, openssh_payload}, + interrupted_send + ]. +groups() -> + [{openssh_payload, [], [simple_exec, + small_cat, + big_cat, + send_after_exit + ]}]. +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + case catch crypto:start() of + ok -> + Config; + _Else -> + {skip, "Crypto could not be started!"} + end. + +end_per_suite(_Config) -> + crypto:stop(). + +%%-------------------------------------------------------------------- +init_per_group(openssh_payload, _Config) -> + case gen_tcp:connect("localhost", 22, []) of + {error,econnrefused} -> + {skip,"No openssh deamon"}; + {ok, Socket} -> + gen_tcp:close(Socket) + end; +init_per_group(_, Config) -> + Config. + +end_per_group(_, Config) -> + Config. + +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + ssh:start(), + Config. + +end_per_testcase(_Config) -> + ssh:stop(). + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +simple_exec(doc) -> + ["Simple openssh connectivity test for ssh_connection:exec"]; + +simple_exec(Config) when is_list(Config) -> + ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, + {user_interaction, false}]), + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "echo testing", infinity), + + %% receive response to input + receive + {ssh_cm, ConnectionRef, {data, ChannelId0, 0, <<"testing\n">>}} -> + ok + end, + + %% receive close messages + receive + {ssh_cm, ConnectionRef, {eof, ChannelId0}} -> + ok + end, + receive + {ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}} -> + ok + end, + receive + {ssh_cm, ConnectionRef,{closed, ChannelId0}} -> + ok + end. + +%%-------------------------------------------------------------------- +small_cat(doc) -> + ["Use 'cat' to echo small data block back to us."]; + +small_cat(Config) when is_list(Config) -> + ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, + {user_interaction, false}]), + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "cat", infinity), + + Data = <<"I like spaghetti squash">>, + ok = ssh_connection:send(ConnectionRef, ChannelId0, Data), + ok = ssh_connection:send_eof(ConnectionRef, ChannelId0), + + %% receive response to input + receive + {ssh_cm, ConnectionRef, {data, ChannelId0, 0, Data}} -> + ok + end, + + %% receive close messages + receive + {ssh_cm, ConnectionRef, {eof, ChannelId0}} -> + ok + end, + receive + {ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}} -> + ok + end, + receive + {ssh_cm, ConnectionRef,{closed, ChannelId0}} -> + ok + end. + +%%-------------------------------------------------------------------- +big_cat(doc) -> + ["Use 'cat' to echo large data block back to us."]; + +big_cat(Config) when is_list(Config) -> + ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, + {user_interaction, false}]), + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "cat", infinity), + + %% build 10MB binary + Data = << <<X:32>> || X <- lists:seq(1,2500000)>>, + + %% pre-adjust receive window so the other end doesn't block + ssh_connection:adjust_window(ConnectionRef, ChannelId0, size(Data)), + + ct:pal("sending ~p byte binary~n",[size(Data)]), + ok = ssh_connection:send(ConnectionRef, ChannelId0, Data, 10000), + ok = ssh_connection:send_eof(ConnectionRef, ChannelId0), + + %% collect echoed data until eof + case big_cat_rx(ConnectionRef, ChannelId0) of + {ok, Data} -> + ok; + {ok, Other} -> + case size(Data) =:= size(Other) of + true -> + ct:pal("received and sent data are same" + "size but do not match~n",[]); + false -> + ct:pal("sent ~p but only received ~p~n", + [size(Data), size(Other)]) + end, + ct:fail(receive_data_mismatch); + Else -> + ct:fail(Else) + end, + + %% receive close messages (eof already consumed) + receive + {ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}} -> + ok + end, + receive + {ssh_cm, ConnectionRef,{closed, ChannelId0}} -> + ok + end. + +%%-------------------------------------------------------------------- +send_after_exit(doc) -> + ["Send channel data after the channel has been closed."]; + +send_after_exit(Config) when is_list(Config) -> + ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, + {user_interaction, false}]), + {ok, ChannelId0} = ssh_connection:session_channel(ConnectionRef, infinity), + + %% Shell command "false" will exit immediately + success = ssh_connection:exec(ConnectionRef, ChannelId0, + "false", infinity), + + timer:sleep(2000), %% Allow incoming eof/close/exit_status ssh messages to be processed + + Data = <<"I like spaghetti squash">>, + case ssh_connection:send(ConnectionRef, ChannelId0, Data, 2000) of + {error, closed} -> ok; + ok -> + ct:fail({expected,{error,closed}}); + {error, timeout} -> + ct:fail({expected,{error,closed}}); + Else -> + ct:fail(Else) + end, + + %% receive close messages + receive + {ssh_cm, ConnectionRef, {eof, ChannelId0}} -> + ok + end, + receive + {ssh_cm, ConnectionRef, {exit_status, ChannelId0, _}} -> + ok + end, + receive + {ssh_cm, ConnectionRef,{closed, ChannelId0}} -> + ok + end. +%%-------------------------------------------------------------------- +interrupted_send(doc) -> + ["Use a subsystem that echos n char and then sends eof to cause a channel exit partway through a large send."]; + +interrupted_send(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth + file:make_dir(UserDir), + SysDir = ?config(data_dir, Config), + {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, UserDir}, + {password, "morot"}, + {subsystems, [{"echo_n", {ssh_echo_server, [4000000]}}]}]), + + ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, + {user, "foo"}, + {password, "morot"}, + {user_interaction, false}, + {user_dir, UserDir}]), + + {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), + + success = ssh_connection:subsystem(ConnectionRef, ChannelId, "echo_n", infinity), + + %% build 10MB binary + Data = << <<X:32>> || X <- lists:seq(1,2500000)>>, + + %% expect remote end to send us 4MB back + <<ExpectedData:4000000/binary, _/binary>> = Data, + + %% pre-adjust receive window so the other end doesn't block + ssh_connection:adjust_window(ConnectionRef, ChannelId, size(ExpectedData) + 1), + + case ssh_connection:send(ConnectionRef, ChannelId, Data, 10000) of + {error, closed} -> + ok; + Msg -> + ct:fail({expected,{error,closed}, got, Msg}) + end, + receive_data(ExpectedData, ConnectionRef, ChannelId), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid). + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- +big_cat_rx(ConnectionRef, ChannelId) -> + big_cat_rx(ConnectionRef, ChannelId, []). + +big_cat_rx(ConnectionRef, ChannelId, Acc) -> + receive + {ssh_cm, ConnectionRef, {data, ChannelId, 0, Data}} -> + %% ssh_connection:adjust_window(ConnectionRef, ChannelId, size(Data)), + %% window was pre-adjusted, don't adjust again here + big_cat_rx(ConnectionRef, ChannelId, [Data | Acc]); + {ssh_cm, ConnectionRef, {eof, ChannelId}} -> + {ok, iolist_to_binary(lists:reverse(Acc))} + after ?EXEC_TIMEOUT -> + timeout + end. + +receive_data(ExpectedData, ConnectionRef, ChannelId) -> + ExpectedData = collect_data(ConnectionRef, ChannelId). + +collect_data(ConnectionRef, ChannelId) -> + collect_data(ConnectionRef, ChannelId, []). + +collect_data(ConnectionRef, ChannelId, Acc) -> + receive + {ssh_cm, ConnectionRef, {data, ChannelId, 0, Data}} -> + collect_data(ConnectionRef, ChannelId, [Data | Acc]); + {ssh_cm, ConnectionRef, {eof, ChannelId}} -> + iolist_to_binary(lists:reverse(Acc)) + after 5000 -> + timeout + end. diff --git a/lib/ssh/test/ssh_connection_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_connection_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..6ae7ee023d --- /dev/null +++ b/lib/ssh/test/ssh_connection_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_echo_server.erl b/lib/ssh/test/ssh_echo_server.erl new file mode 100644 index 0000000000..739aabe6fb --- /dev/null +++ b/lib/ssh/test/ssh_echo_server.erl @@ -0,0 +1,71 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +%%% Description: Example ssh server +-module(ssh_echo_server). +-behaviour(ssh_channel). +-record(state, { + n, + id, + cm + }). +-export([init/1, handle_msg/2, handle_ssh_msg/2, terminate/2]). + +init([N]) -> + {ok, #state{n = N}}. + +handle_msg({ssh_channel_up, ChannelId, ConnectionManager}, State) -> + {ok, State#state{id = ChannelId, + cm = ConnectionManager}}. + +handle_ssh_msg({ssh_cm, CM, {data, ChannelId, 0, Data}}, #state{n = N} = State) -> + M = N - size(Data), + case M > 0 of + true -> + ssh_connection:send(CM, ChannelId, Data), + {ok, State#state{n = M}}; + false -> + <<SendData:N/binary, _/binary>> = Data, + ssh_connection:send(CM, ChannelId, SendData), + ssh_connection:send_eof(CM, ChannelId), + {stop, ChannelId, State} + end; +handle_ssh_msg({ssh_cm, _ConnectionManager, + {data, _ChannelId, 1, Data}}, State) -> + error_logger:format("ssh: STDERR: ~s\n", [binary_to_list(Data)]), + {ok, State}; + +handle_ssh_msg({ssh_cm, _ConnectionManager, {eof, _ChannelId}}, State) -> + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {signal, _, _}}, State) -> + %% Ignore signals according to RFC 4254 section 6.9. + {ok, State}; + +handle_ssh_msg({ssh_cm, _, {exit_signal, ChannelId, _, _Error, _}}, + State) -> + {stop, ChannelId, State}; + +handle_ssh_msg({ssh_cm, _, {exit_status, ChannelId, _Status}}, State) -> + {stop, ChannelId, State}. + +terminate(_Reason, _State) -> + ok. diff --git a/lib/ssh/test/ssh_sftp_SUITE.erl b/lib/ssh/test/ssh_sftp_SUITE.erl index d40b1d544d..232161d029 100644 --- a/lib/ssh/test/ssh_sftp_SUITE.erl +++ b/lib/ssh/test/ssh_sftp_SUITE.erl @@ -24,7 +24,6 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). - -include_lib("kernel/include/file.hrl"). % Default timetrap timeout @@ -33,16 +32,18 @@ -define(USER, "Alladin"). -define(PASSWD, "Sesame"). -%% Test server callback functions %%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. +%% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group, erlang_server}, + {group, openssh_server}]. + + init_per_suite(Config) -> case (catch crypto:start()) of ok -> @@ -52,35 +53,58 @@ init_per_suite(Config) -> {skip,"Could not start crypto!"} end. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(Config) -> ssh:stop(), crypto:stop(), Config. %%-------------------------------------------------------------------- -%% Function: init_per_testcase(TestCase, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%% Description: Initiation before each test case +groups() -> + [{erlang_server, [], [open_close_file, open_close_dir, read_file, read_dir, + write_file, rename_file, mk_rm_dir, remove_file, links, + retrieve_attributes, set_attributes, async_read, + async_write, position, pos_read, pos_write]}, + {openssh_server, [], [open_close_file, open_close_dir, read_file, read_dir, + write_file, rename_file, mk_rm_dir, remove_file, links, + retrieve_attributes, set_attributes, async_read, + async_write, position, pos_read, pos_write]}]. + +init_per_group(erlang_server, Config) -> + PrivDir = ?config(priv_dir, Config), + SysDir = ?config(data_dir, Config), + Sftpd = + ssh_test_lib:daemon([{system_dir, SysDir}, + {user_dir, PrivDir}, + {user_passwords, + [{?USER, ?PASSWD}]}, + {failfun, + fun ssh_test_lib:failfun/2}]), + [{group, erlang_server}, {sftpd, Sftpd} | Config]; + +init_per_group(openssh_server, Config) -> + Host = ssh_test_lib:hostname(), + case (catch ssh_sftp:start_channel(Host, + [{user_interaction, false}, + {silently_accept_hosts, true}])) of + {ok, _ChannelPid, Connection} -> + ssh:close(Connection), + [{group, openssh_server} | Config]; + _ -> + {skip, "No openssh server"} + end. + +end_per_group(erlang_server, Config) -> + Config; +end_per_group(_, Config) -> + Config. + %%-------------------------------------------------------------------- + init_per_testcase(Case, Config) -> prep(Config), TmpConfig0 = lists:keydelete(watchdog, 1, Config), TmpConfig = lists:keydelete(sftp, 1, TmpConfig0), - Dog = test_server:timetrap(?default_timeout), + Dog = ct:timetrap(?default_timeout), case ?config(group, Config) of erlang_server -> @@ -105,14 +129,6 @@ init_per_testcase(Case, Config) -> [{sftp, Sftp}, {watchdog, Dog} | TmpConfig] end. -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(TestCase, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- end_per_testcase(rename_file, Config) -> PrivDir = ?config(priv_dir, Config), NewFileName = filename:join(PrivDir, "test.txt"), @@ -124,69 +140,13 @@ end_per_testcase(_, Config) -> end_per_testcase(Config) -> {Sftp, Connection} = ?config(sftp, Config), ssh_sftp:stop_channel(Sftp), - ssh:close(Connection), - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - ok. + ssh:close(Connection). %%-------------------------------------------------------------------- -%% Function: all(Clause) -> TestCases -%% Clause - atom() - suite | doc -%% TestCases - [Case] -%% Case - atom() -%% Name of a test case. -%% Description: Returns a list of all test cases in this test suite -%%-------------------------------------------------------------------- -all() -> - [{group, erlang_server}, - {group, openssh_server}]. - -groups() -> - [{erlang_server, [], [open_close_file, open_close_dir, read_file, read_dir, - write_file, rename_file, mk_rm_dir, remove_file, links, - retrieve_attributes, set_attributes, async_read, - async_write, position, pos_read, pos_write]}, - {openssh_server, [], [open_close_file, open_close_dir, read_file, read_dir, - write_file, rename_file, mk_rm_dir, remove_file, links, - retrieve_attributes, set_attributes, async_read, - async_write, position, pos_read, pos_write]}]. - -init_per_group(erlang_server, Config) -> - PrivDir = ?config(priv_dir, Config), - SysDir = ?config(data_dir, Config), - Sftpd = - ssh_test_lib:daemon([{system_dir, SysDir}, - {user_dir, PrivDir}, - {user_passwords, - [{?USER, ?PASSWD}]}, - {failfun, - fun ssh_test_lib:failfun/2}]), - [{group, erlang_server}, {sftpd, Sftpd} | Config]; - -init_per_group(openssh_server, Config) -> - Host = ssh_test_lib:hostname(), - case (catch ssh_sftp:start_channel(Host, - [{user_interaction, false}, - {silently_accept_hosts, true}])) of - {ok, _ChannelPid, Connection} -> - ssh:close(Connection), - [{group, openssh_server} | Config]; - _ -> - {skip, "No openssh server"} - end. - -end_per_group(erlang_server, Config) -> - Config; -end_per_group(_, Config) -> - Config. - - -%% Test cases starts here. +%% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- open_close_file(doc) -> ["Test API functions open/3 and close/2"]; -open_close_file(suite) -> - []; open_close_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "sftp.txt"), @@ -198,21 +158,15 @@ open_close_file(Config) when is_list(Config) -> ok = open_close_file(Sftp, FileName, [write, creat]), ok = open_close_file(Sftp, FileName, [write, trunc]), ok = open_close_file(Sftp, FileName, [append]), - ok = open_close_file(Sftp, FileName, [read, binary]), - - ok. + ok = open_close_file(Sftp, FileName, [read, binary]). open_close_file(Server, File, Mode) -> {ok, Handle} = ssh_sftp:open(Server, File, Mode), - ok = ssh_sftp:close(Server, Handle), - ok. - + ok = ssh_sftp:close(Server, Handle). %%-------------------------------------------------------------------- open_close_dir(doc) -> ["Test API functions opendir/2 and close/2"]; -open_close_dir(suite) -> - []; open_close_dir(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), {Sftp, _} = ?config(sftp, Config), @@ -220,138 +174,92 @@ open_close_dir(Config) when is_list(Config) -> {ok, Handle} = ssh_sftp:opendir(Sftp, PrivDir), ok = ssh_sftp:close(Sftp, Handle), - {error, _} = ssh_sftp:opendir(Sftp, FileName), + {error, _} = ssh_sftp:opendir(Sftp, FileName). - ok. %%-------------------------------------------------------------------- read_file(doc) -> ["Test API funtion read_file/2"]; -read_file(suite) -> - []; read_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "sftp.txt"), - {Sftp, _} = ?config(sftp, Config), - {ok, Data} = ssh_sftp:read_file(Sftp, FileName), + {ok, Data} = file:read_file(FileName). - {ok, Data} = file:read_file(FileName), - - ok. %%-------------------------------------------------------------------- read_dir(doc) -> ["Test API function list_dir/2"]; -read_dir(suite) -> - []; read_dir(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), {Sftp, _} = ?config(sftp, Config), {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), - test_server:format("sftp list dir: ~p~n", [Files]), - ok. + ct:pal("sftp list dir: ~p~n", [Files]). %%-------------------------------------------------------------------- write_file(doc) -> ["Test API function write_file/2"]; -write_file(suite) -> - []; write_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "sftp.txt"), - {Sftp, _} = ?config(sftp, Config), Data = list_to_binary("Hej hopp!"), - ssh_sftp:write_file(Sftp, FileName, [Data]), - - {ok, Data} = file:read_file(FileName), - - ok. + {ok, Data} = file:read_file(FileName). %%-------------------------------------------------------------------- remove_file(doc) -> ["Test API function delete/2"]; -remove_file(suite) -> - []; remove_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "sftp.txt"), - {Sftp, _} = ?config(sftp, Config), {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), - true = lists:member(filename:basename(FileName), Files), - ok = ssh_sftp:delete(Sftp, FileName), - {ok, NewFiles} = ssh_sftp:list_dir(Sftp, PrivDir), - false = lists:member(filename:basename(FileName), NewFiles), - - {error, _} = ssh_sftp:delete(Sftp, FileName), - - ok. - + {error, _} = ssh_sftp:delete(Sftp, FileName). %%-------------------------------------------------------------------- rename_file(doc) -> ["Test API function rename_file/2"]; -rename_file(suite) -> - []; rename_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "sftp.txt"), NewFileName = filename:join(PrivDir, "test.txt"), {Sftp, _} = ?config(sftp, Config), - {ok, Files} = ssh_sftp:list_dir(Sftp, PrivDir), - - test_server:format("FileName: ~p, Files: ~p~n", [FileName, Files]), - + ct:pal("FileName: ~p, Files: ~p~n", [FileName, Files]), true = lists:member(filename:basename(FileName), Files), false = lists:member(filename:basename(NewFileName), Files), - ok = ssh_sftp:rename(Sftp, FileName, NewFileName), - {ok, NewFiles} = ssh_sftp:list_dir(Sftp, PrivDir), - - test_server:format("FileName: ~p, Files: ~p~n", [FileName, NewFiles]), + ct:pal("FileName: ~p, Files: ~p~n", [FileName, NewFiles]), false = lists:member(filename:basename(FileName), NewFiles), - true = lists:member(filename:basename(NewFileName), NewFiles), - - ok. + true = lists:member(filename:basename(NewFileName), NewFiles). %%-------------------------------------------------------------------- mk_rm_dir(doc) -> ["Test API functions make_dir/2, del_dir/2"]; -mk_rm_dir(suite) -> - []; mk_rm_dir(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), {Sftp, _} = ?config(sftp, Config), + DirName = filename:join(PrivDir, "test"), - ok = ssh_sftp:make_dir(Sftp, DirName), ok = ssh_sftp:del_dir(Sftp, DirName), - NewDirName = filename:join(PrivDir, "foo/bar"), - {error, _} = ssh_sftp:make_dir(Sftp, NewDirName), - {error, _} = ssh_sftp:del_dir(Sftp, PrivDir), - - ok. + {error, _} = ssh_sftp:del_dir(Sftp, PrivDir). %%-------------------------------------------------------------------- links(doc) -> ["Tests API function make_symlink/3"]; -links(suite) -> - []; links(Config) when is_list(Config) -> - case test_server:os_type() of + case os:type() of {win32, _} -> {skip, "Links are not fully supported by windows"}; _ -> @@ -361,74 +269,60 @@ links(Config) when is_list(Config) -> LinkFileName = filename:join(PrivDir, "link_test.txt"), ok = ssh_sftp:make_symlink(Sftp, LinkFileName, FileName), - {ok, FileName} = ssh_sftp:read_link(Sftp, LinkFileName), - ok + {ok, FileName} = ssh_sftp:read_link(Sftp, LinkFileName) end. %%-------------------------------------------------------------------- retrieve_attributes(doc) -> ["Test API function read_file_info/3"]; -retrieve_attributes(suite) -> - []; retrieve_attributes(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "sftp.txt"), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = ?config(sftp, Config), {ok, FileInfo} = ssh_sftp:read_file_info(Sftp, FileName), - {ok, NewFileInfo} = file:read_file_info(FileName), %% TODO comparison. There are some differences now is that ok? - test_server:format("SFTP: ~p FILE: ~p~n", [FileInfo, NewFileInfo]), - ok. + ct:pal("SFTP: ~p FILE: ~p~n", [FileInfo, NewFileInfo]). %%-------------------------------------------------------------------- set_attributes(doc) -> ["Test API function write_file_info/3"]; -set_attributes(suite) -> - []; set_attributes(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), - {Sftp, _} = ?config(sftp, Config), + {Sftp, _} = ?config(sftp, Config), {ok,Fd} = file:open(FileName, write), io:put_chars(Fd,"foo"), - ok = ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#400}), {error, eacces} = file:write_file(FileName, "hello again"), ssh_sftp:write_file_info(Sftp, FileName, #file_info{mode=8#600}), - ok = file:write_file(FileName, "hello again"), - - ok. + ok = file:write_file(FileName, "hello again"). %%-------------------------------------------------------------------- async_read(doc) -> ["Test API aread/3"]; -async_read(suite) -> - []; async_read(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, "sftp.txt"), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {async, Ref} = ssh_sftp:aread(Sftp, Handle, 20), receive {async_reply, Ref, {ok, Data}} -> - test_server:format("Data: ~p~n", [Data]), + ct:pal("Data: ~p~n", [Data]), ok; Msg -> - test_server:fail(Msg) - end, - ok. + ct:fail(Msg) + end. %%-------------------------------------------------------------------- async_write(doc) -> ["Test API awrite/3"]; -async_write(suite) -> - []; async_write(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), PrivDir = ?config(priv_dir, Config), @@ -441,16 +335,13 @@ async_write(Config) when is_list(Config) -> {async_reply, Ref, ok} -> {ok, Data} = file:read_file(FileName); Msg -> - test_server:fail(Msg) - end, - ok. + ct:fail(Msg) + end. %%-------------------------------------------------------------------- position(doc) -> ["Test API functions position/3"]; -position(suite) -> - []; position(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), @@ -458,7 +349,6 @@ position(Config) when is_list(Config) -> Data = list_to_binary("1234567890"), ssh_sftp:write_file(Sftp, FileName, [Data]), - {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), {ok, 3} = ssh_sftp:position(Sftp, Handle, {bof, 3}), @@ -477,15 +367,11 @@ position(Config) when is_list(Config) -> {ok, "1"} = ssh_sftp:read(Sftp, Handle, 1), {ok, 1} = ssh_sftp:position(Sftp, Handle, cur), - {ok, "2"} = ssh_sftp:read(Sftp, Handle, 1), - - ok. + {ok, "2"} = ssh_sftp:read(Sftp, Handle, 1). %%-------------------------------------------------------------------- pos_read(doc) -> ["Test API functions pread/3 and apread/3"]; -pos_read(suite) -> - []; pos_read(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), @@ -494,7 +380,6 @@ pos_read(Config) when is_list(Config) -> ssh_sftp:write_file(Sftp, FileName, [Data]), {ok, Handle} = ssh_sftp:open(Sftp, FileName, [read]), - {async, Ref} = ssh_sftp:apread(Sftp, Handle, {bof, 5}, 4), NewData = "opp!", @@ -503,21 +388,17 @@ pos_read(Config) when is_list(Config) -> {async_reply, Ref, {ok, NewData}} -> ok; Msg -> - test_server:fail(Msg) + ct:fail(Msg) end, NewData1 = "hopp", - {ok, NewData1} = ssh_sftp:pread(Sftp, Handle, {bof, 4}, 4), + {ok, NewData1} = ssh_sftp:pread(Sftp, Handle, {bof, 4}, 4). - ok. %%-------------------------------------------------------------------- pos_write(doc) -> ["Test API functions pwrite/4 and apwrite/4"]; -pos_write(suite) -> - []; pos_write(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), {Sftp, _} = ?config(sftp, Config), @@ -533,17 +414,16 @@ pos_write(Config) when is_list(Config) -> {async_reply, Ref, ok} -> ok; Msg -> - test_server:fail(Msg) + ct:fail(Msg) end, ok = ssh_sftp:pwrite(Sftp, Handle, eof, list_to_binary("!")), NewData1 = list_to_binary("Bye, see you tomorrow!"), - {ok, NewData1} = ssh_sftp:read_file(Sftp, FileName), + {ok, NewData1} = ssh_sftp:read_file(Sftp, FileName). - ok. - -%% Internal functions +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- prep(Config) -> PrivDir = ?config(priv_dir, Config), diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 695a7caa7d..b995eb9f0e 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -24,12 +24,10 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). +-include_lib("kernel/include/file.hrl"). -include("ssh_xfer.hrl"). -include("ssh.hrl"). --include_lib("kernel/include/file.hrl"). - -define(USER, "Alladin"). -define(PASSWD, "Sesame"). -define(XFER_PACKET_SIZE, 32768). @@ -41,16 +39,32 @@ -define(is_set(F, Bits), ((F) band (Bits)) == (F)). -%% Test server callback functions %%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. +%% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- + +all() -> + [open_close_file, + open_close_dir, + read_file, + read_dir, + write_file, + rename_file, + mk_rm_dir, + remove_file, + real_path, + retrieve_attributes, + set_attributes, + links, + ver3_rename, + relpath, + sshd_read_file]. + +groups() -> + []. + +%%-------------------------------------------------------------------- + init_per_suite(Config) -> case (catch crypto:start()) of ok -> @@ -66,34 +80,24 @@ init_per_suite(Config) -> {skip,"Could not start crypto!"} end. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(Config) -> SysDir = ?config(priv_dir, Config), ssh_test_lib:clean_dsa(SysDir), UserDir = filename:join(?config(priv_dir, Config), nopubkey), file:del_dir(UserDir), ssh:stop(), - crypto:stop(), - ok. + crypto:stop(). %%-------------------------------------------------------------------- -%% Function: init_per_testcase(TestCase, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%% Description: Initiation before each test case + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + %%-------------------------------------------------------------------- + init_per_testcase(TestCase, Config) -> ssh:start(), prep(Config), @@ -138,56 +142,22 @@ init_per_testcase(TestCase, Config) -> {ok, <<?SSH_FXP_VERSION, ?UINT32(Version), _Ext/binary>>, _} = reply(Cm, Channel), - test_server:format("Client: ~p Server ~p~n", [ProtocolVer, Version]), + ct:pal("Client: ~p Server ~p~n", [ProtocolVer, Version]), [{sftp, {Cm, Channel}}, {sftpd, Sftpd }| Config]. -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(TestCase, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- end_per_testcase(_TestCase, Config) -> ssh_sftpd:stop(?config(sftpd, Config)), {Cm, Channel} = ?config(sftp, Config), ssh_connection:close(Cm, Channel), ssh:close(Cm), - ssh:stop(), - ok. + ssh:stop(). %%-------------------------------------------------------------------- -%% Function: all(Clause) -> TestCases -%% Clause - atom() - suite | doc -%% TestCases - [Case] -%% Case - atom() -%% Name of a test case. -%% Description: Returns a list of all test cases in this test suite -%%-------------------------------------------------------------------- -all() -> - [open_close_file, open_close_dir, read_file, read_dir, - write_file, rename_file, mk_rm_dir, remove_file, - real_path, retrieve_attributes, set_attributes, links, - ver3_rename_OTP_6352, seq10670, sshd_read_file]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%% Test cases starts here. +%% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- open_close_file(doc) -> ["Test SSH_FXP_OPEN and SSH_FXP_CLOSE commands"]; -open_close_file(suite) -> - []; open_close_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), @@ -214,15 +184,11 @@ open_close_file(Config) when is_list(Config) -> ?UINT32(?SSH_FX_FAILURE), _/binary>>, _} = open_file(PrivDir, Cm, Channel, NewReqId1, ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, - ?SSH_FXF_OPEN_EXISTING), - - ok. + ?SSH_FXF_OPEN_EXISTING). %%-------------------------------------------------------------------- open_close_dir(doc) -> ["Test SSH_FXP_OPENDIR and SSH_FXP_CLOSE commands"]; -open_close_dir(suite) -> - []; open_close_dir(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), {Cm, Channel} = ?config(sftp, Config), @@ -250,8 +216,6 @@ open_close_dir(Config) when is_list(Config) -> %%-------------------------------------------------------------------- read_file(doc) -> ["Test SSH_FXP_READ command"]; -read_file(suite) -> - []; read_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), @@ -270,28 +234,22 @@ read_file(Config) when is_list(Config) -> Data/binary>>, _} = read_file(Handle, 100, 0, Cm, Channel, NewReqId), - {ok, Data} = file:read_file(FileName), + {ok, Data} = file:read_file(FileName). - ok. %%-------------------------------------------------------------------- read_dir(doc) -> ["Test SSH_FXP_READDIR command"]; -read_dir(suite) -> - []; read_dir(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), {Cm, Channel} = ?config(sftp, Config), ReqId = 0, {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = open_dir(PrivDir, Cm, Channel, ReqId), - ok = read_dir(Handle, Cm, Channel, ReqId), - ok. + ok = read_dir(Handle, Cm, Channel, ReqId). %%-------------------------------------------------------------------- write_file(doc) -> ["Test SSH_FXP_WRITE command"]; -write_file(suite) -> - []; write_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), @@ -311,15 +269,11 @@ write_file(Config) when is_list(Config) -> _/binary>>, _} = write_file(Handle, Data, 0, Cm, Channel, NewReqId), - {ok, Data} = file:read_file(FileName), - - ok. + {ok, Data} = file:read_file(FileName). %%-------------------------------------------------------------------- remove_file(doc) -> ["Test SSH_FXP_REMOVE command"]; -remove_file(suite) -> - []; remove_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), @@ -336,15 +290,11 @@ remove_file(Config) when is_list(Config) -> {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId), ?UINT32(?SSH_FX_FAILURE), _/binary>>, _} = - remove(PrivDir, Cm, Channel, NewReqId), - - ok. + remove(PrivDir, Cm, Channel, NewReqId). %%-------------------------------------------------------------------- rename_file(doc) -> ["Test SSH_FXP_RENAME command"]; -rename_file(suite) -> - []; rename_file(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), @@ -377,15 +327,11 @@ rename_file(Config) when is_list(Config) -> {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId2), ?UINT32(?SSH_FX_OP_UNSUPPORTED), _/binary>>, _} = rename(FileName, NewFileName, Cm, Channel, NewReqId2, 6, - ?SSH_FXP_RENAME_ATOMIC), - - ok. + ?SSH_FXP_RENAME_ATOMIC). %%-------------------------------------------------------------------- mk_rm_dir(doc) -> ["Test SSH_FXP_MKDIR and SSH_FXP_RMDIR command"]; -mk_rm_dir(suite) -> - []; mk_rm_dir(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), {Cm, Channel} = ?config(sftp, Config), @@ -404,16 +350,13 @@ mk_rm_dir(Config) when is_list(Config) -> NewReqId2 = 3, {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId2), ?UINT32(?SSH_FX_NO_SUCH_FILE), - _/binary>>, _} = rmdir(DirName, Cm, Channel, NewReqId2), + _/binary>>, _} = rmdir(DirName, Cm, Channel, NewReqId2). - ok. %%-------------------------------------------------------------------- real_path(doc) -> ["Test SSH_FXP_REALPATH command"]; -real_path(suite) -> - []; real_path(Config) when is_list(Config) -> - case test_server:os_type() of + case os:type() of {win32, _} -> {skip, "Not a relevant test on windows"}; _ -> @@ -432,20 +375,16 @@ real_path(Config) when is_list(Config) -> RealPath = filename:absname(binary_to_list(Path)), AbsPrivDir = filename:absname(PrivDir), - test_server:format("Path: ~p PrivDir: ~p~n", [RealPath, AbsPrivDir]), - - true = RealPath == AbsPrivDir, + ct:pal("Path: ~p PrivDir: ~p~n", [RealPath, AbsPrivDir]), - ok + true = RealPath == AbsPrivDir end. %%-------------------------------------------------------------------- links(doc) -> []; -links(suite) -> - []; links(Config) when is_list(Config) -> - case test_server:os_type() of + case os:type() of {win32, _} -> {skip, "Links are not fully supported by windows"}; _ -> @@ -467,15 +406,12 @@ links(Config) when is_list(Config) -> true = binary_to_list(Path) == FileName, - test_server:format("Path: ~p~n", [binary_to_list(Path)]), - ok + ct:pal("Path: ~p~n", [binary_to_list(Path)]) end. %%-------------------------------------------------------------------- retrieve_attributes(doc) -> ["Test SSH_FXP_STAT, SSH_FXP_LSTAT AND SSH_FXP_FSTAT commands"]; -retrieve_attributes(suite) -> - []; retrieve_attributes(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), @@ -536,16 +472,13 @@ retrieve_attributes(Config) when is_list(Config) -> Owner = list_to_integer(binary_to_list(BinOwner)), Group = list_to_integer(binary_to_list(BinGroup)) - end, AttrValues), + end, AttrValues). - ok. %%-------------------------------------------------------------------- set_attributes(doc) -> ["Test SSH_FXP_SETSTAT AND SSH_FXP_FSETSTAT commands"]; -set_attributes(suite) -> - []; set_attributes(Config) when is_list(Config) -> - case test_server:os_type() of + case os:type() of {win32, _} -> {skip, "Known error bug in erts file:read_file_info"}; _ -> @@ -574,10 +507,10 @@ set_attributes(Config) when is_list(Config) -> %% Can not test that NewPermissions = Permissions as %% on Unix platforms, other bits than those listed in the %% API may be set. - test_server:format("Org: ~p New: ~p~n", [OrigPermissions, NewPermissions]), + ct:pal("Org: ~p New: ~p~n", [OrigPermissions, NewPermissions]), true = OrigPermissions =/= NewPermissions, - test_server:format("Try to open the file"), + ct:pal("Try to open the file"), NewReqId = 2, {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId), Handle/binary>>, _} = open_file(FileName, Cm, Channel, NewReqId, @@ -589,25 +522,20 @@ set_attributes(Config) when is_list(Config) -> NewReqId1 = 3, - test_server:format("Set original permissions on the now open file"), + ct:pal("Set original permissions on the now open file"), {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId1), ?UINT32(?SSH_FX_OK), _/binary>>, _} = set_attributes_open_file(Handle, NewAtters, Cm, Channel, NewReqId1), {ok, NewFileInfo1} = file:read_file_info(FileName), - OrigPermissions = NewFileInfo1#file_info.mode, - ok + OrigPermissions = NewFileInfo1#file_info.mode end. %%-------------------------------------------------------------------- -ver3_rename_OTP_6352(doc) -> - ["Test that ver3 rename message is handled"]; - -ver3_rename_OTP_6352(suite) -> - []; - -ver3_rename_OTP_6352(Config) when is_list(Config) -> +ver3_rename(doc) -> + ["Test that ver3 rename message is handled OTP 6352"]; +ver3_rename(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), FileName = filename:join(PrivDir, "test.txt"), NewFileName = filename:join(PrivDir, "test1.txt"), @@ -616,22 +544,16 @@ ver3_rename_OTP_6352(Config) when is_list(Config) -> {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), ?UINT32(?SSH_FX_OK), _/binary>>, _} = - rename(FileName, NewFileName, Cm, Channel, ReqId, 3, 0), - - ok. + rename(FileName, NewFileName, Cm, Channel, ReqId, 3, 0). %%-------------------------------------------------------------------- -seq10670(doc) -> - ["Check that realpath works ok"]; - -seq10670(suite) -> - []; - -seq10670(Config) when is_list(Config) -> +relpath(doc) -> + ["Check that realpath works ok seq10670"]; +relpath(Config) when is_list(Config) -> ReqId = 0, {Cm, Channel} = ?config(sftp, Config), - case test_server:os_type() of + case os:type() of {win32, _} -> {skip, "Not a relevant test on windows"}; _ -> @@ -644,11 +566,34 @@ seq10670(Config) when is_list(Config) -> {ok, <<?SSH_FXP_NAME, ?UINT32(ReqId), ?UINT32(_), ?UINT32(Len), Path:Len/binary, _/binary>>, _} = real_path("/usr/bin/../..", Cm, Channel, ReqId), - Root = Path end. -%% Internal functions +%%-------------------------------------------------------------------- +sshd_read_file(doc) -> + ["Test SSH_FXP_READ command, using sshd-server"]; +sshd_read_file(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, "test.txt"), + + ReqId = 0, + {Cm, Channel} = ?config(sftp, Config), + + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = + open_file(FileName, Cm, Channel, ReqId, + ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, + ?SSH_FXF_OPEN_EXISTING), + + NewReqId = 1, + + {ok, <<?SSH_FXP_DATA, ?UINT32(NewReqId), ?UINT32(_Length), + Data/binary>>, _} = + read_file(Handle, 100, 0, Cm, Channel, NewReqId), + + {ok, Data} = file:read_file(FileName). + +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- prep(Config) -> PrivDir = ?config(priv_dir, Config), @@ -684,7 +629,7 @@ reply(Cm, Channel, RBuf) -> {ssh_cm, Cm, {closed, Channel}} -> closed; {ssh_cm, Cm, Msg} -> - test_server:fail(Msg) + ct:fail(Msg) end. @@ -778,7 +723,7 @@ read_dir(Handle, Cm, Channel, ReqId) -> case reply(Cm, Channel) of {ok, <<?SSH_FXP_NAME, ?UINT32(ReqId), ?UINT32(Count), ?UINT32(Len), Listing:Len/binary, _/binary>>, _} -> - test_server:format("Count: ~p Listing: ~p~n", + ct:pal("Count: ~p Listing: ~p~n", [Count, binary_to_list(Listing)]), read_dir(Handle, Cm, Channel, ReqId); {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), @@ -921,32 +866,5 @@ encode_file_type(Type) -> undefined -> ?SSH_FILEXFER_TYPE_UNKNOWN end. -%%-------------------------------------------------------------------- -sshd_read_file(doc) -> - ["Test SSH_FXP_READ command, using sshd-server"]; -sshd_read_file(suite) -> - []; -sshd_read_file(Config) when is_list(Config) -> - PrivDir = ?config(priv_dir, Config), - FileName = filename:join(PrivDir, "test.txt"), - - ReqId = 0, - {Cm, Channel} = ?config(sftp, Config), - - {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = - open_file(FileName, Cm, Channel, ReqId, - ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, - ?SSH_FXF_OPEN_EXISTING), - - NewReqId = 1, - - {ok, <<?SSH_FXP_DATA, ?UINT32(NewReqId), ?UINT32(_Length), - Data/binary>>, _} = - read_file(Handle, 100, 0, Cm, Channel, NewReqId), - - {ok, Data} = file:read_file(FileName), - - ok. - not_default_permissions() -> 8#600. %% User read-write-only diff --git a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl index 4c469ed5f7..7fc2312661 100644 --- a/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_erlclient_SUITE.erl @@ -24,24 +24,31 @@ -compile(export_all). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). - -include_lib("kernel/include/file.hrl"). -define(USER, "Alladin"). -define(PASSWD, "Sesame"). -define(SSH_MAX_PACKET_SIZE, 32768). -%% Test server callback functions %%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. +%% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [close_file, + quit, + file_cb, + root_dir, + list_dir_limited]. + +groups() -> + []. + +%%-------------------------------------------------------------------- + init_per_suite(Config) -> catch ssh:stop(), case catch crypto:start() of @@ -60,12 +67,6 @@ init_per_suite(Config) -> {skip,"Could not start ssh!"} end. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- end_per_suite(Config) -> UserDir = filename:join(?config(priv_dir, Config), nopubkey), file:del_dir(UserDir), @@ -75,18 +76,14 @@ end_per_suite(Config) -> ok. %%-------------------------------------------------------------------- -%% Function: init_per_testcase(TestCase, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initiation before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%% Description: Initiation before each test case + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. %%-------------------------------------------------------------------- + init_per_testcase(TestCase, Config) -> ssh:start(), PrivDir = ?config(priv_dir, Config), @@ -132,53 +129,21 @@ init_per_testcase(TestCase, Config) -> NewConfig = lists:keydelete(sftpd, 1, TmpConfig), [{port, Port}, {sftp, {ChannelPid, Connection}}, {sftpd, Sftpd} | NewConfig]. -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(TestCase, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case -%%-------------------------------------------------------------------- end_per_testcase(_TestCase, Config) -> catch ssh_sftpd:stop(?config(sftpd, Config)), {Sftp, Connection} = ?config(sftp, Config), catch ssh_sftp:stop_channel(Sftp), catch ssh:close(Connection), - ssh:stop(), - ok. + ssh:stop(). %%-------------------------------------------------------------------- -%% Function: all(Clause) -> TestCases -%% Clause - atom() - suite | doc -%% TestCases - [Case] -%% Case - atom() -%% Name of a test case. -%% Description: Returns a list of all test cases in this test suite -%%-------------------------------------------------------------------- -all() -> - [close_file_OTP_6350, quit_OTP_6349, file_cb_OTP_6356, - root_dir, list_dir_limited]. - -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -%% Test cases starts here. +%% Test cases starts here. ------------------------------------------- %%-------------------------------------------------------------------- -close_file_OTP_6350(doc) -> +close_file(doc) -> ["Test that sftpd closes its fildescriptors after compleating the " - "transfer"]; - -close_file_OTP_6350(suite) -> - []; + "transfer OTP-6350"]; -close_file_OTP_6350(Config) when is_list(Config) -> +close_file(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), FileName = filename:join(DataDir, "test.txt"), @@ -186,28 +151,20 @@ close_file_OTP_6350(Config) when is_list(Config) -> NumOfPorts = length(erlang:ports()), - test_server:format("Number of open ports: ~p~n", [NumOfPorts]), + ct:pal("Number of open ports: ~p~n", [NumOfPorts]), {ok, <<_/binary>>} = ssh_sftp:read_file(Sftp, FileName), - NumOfPorts = length(erlang:ports()), - - test_server:format("Number of open ports: ~p~n", - [length(erlang:ports())]), - - ok. + NumOfPorts = length(erlang:ports()). %%-------------------------------------------------------------------- -quit_OTP_6349(doc) -> +quit(doc) -> [" When the sftp client ends the session the " "server will now behave correctly and not leave the " - "client hanging."]; - -quit_OTP_6349(suite) -> - []; + "client hanging. OTP-6349"]; -quit_OTP_6349(Config) when is_list(Config) -> +quit(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), FileName = filename:join(DataDir, "test.txt"), UserDir = ?config(priv_dir, Config), @@ -230,19 +187,15 @@ quit_OTP_6349(Config) when is_list(Config) -> {ok, <<_/binary>>} = ssh_sftp:read_file(NewSftp, FileName), - ok = ssh_sftp:stop_channel(NewSftp), - ok. + ok = ssh_sftp:stop_channel(NewSftp). %%-------------------------------------------------------------------- -file_cb_OTP_6356(doc) -> +file_cb(doc) -> ["Test that it is possible to change the callback module for" - " the sftpds filehandling."]; - -file_cb_OTP_6356(suite) -> - []; + " the sftpds filehandling. OTP-6356"]; -file_cb_OTP_6356(Config) when is_list(Config) -> +file_cb(Config) when is_list(Config) -> DataDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), FileName = filename:join(DataDir, "test.txt"), @@ -283,13 +236,11 @@ file_cb_OTP_6356(Config) when is_list(Config) -> ok = ssh_sftp:del_dir(Sftp, NewDir), alt_file_handler_check(alt_read_link_info), alt_file_handler_check(alt_write_file_info), - alt_file_handler_check(alt_del_dir), - ok. + alt_file_handler_check(alt_del_dir). +%%-------------------------------------------------------------------- root_dir(doc) -> [""]; -root_dir(suite) -> - []; root_dir(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), FileName = "test.txt", @@ -298,26 +249,27 @@ root_dir(Config) when is_list(Config) -> {ok, Bin} = ssh_sftp:read_file(Sftp, FileName), {ok, Listing} = ssh_sftp:list_dir(Sftp, "."), - test_server:format("Listing: ~p~n", [Listing]), - ok. + ct:pal("Listing: ~p~n", [Listing]). +%%-------------------------------------------------------------------- list_dir_limited(doc) -> [""]; -list_dir_limited(suite) -> - []; list_dir_limited(Config) when is_list(Config) -> {Sftp, _} = ?config(sftp, Config), {ok, Listing} = ssh_sftp:list_dir(Sftp, "."), - test_server:format("Listing: ~p~n", [Listing]), - ok. + ct:pal("Listing: ~p~n", [Listing]). +%%-------------------------------------------------------------------- +%% Internal functions ------------------------------------------------ +%%-------------------------------------------------------------------- + alt_file_handler_check(Msg) -> receive Msg -> ok; Other -> - test_server:fail({Msg, Other}) + ct:fail({Msg, Other}) after 10000 -> - test_server:fail("Not alt file handler") + ct:fail("Not alt file handler") end. diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 609663c87a..6ed3dfa68c 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -25,8 +25,7 @@ -compile(export_all). -include_lib("public_key/include/public_key.hrl"). --include("test_server.hrl"). --include("test_server_line.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(TIMEOUT, 50000). @@ -129,16 +128,16 @@ reply(TestCase, Result) -> TestCase ! Result. receive_exec_result(Msg) -> - test_server:format("Expect data! ~p", [Msg]), + ct:pal("Expect data! ~p", [Msg]), receive {ssh_cm,_,{data,_,1, Data}} -> - test_server:format("StdErr: ~p~n", [Data]), + ct:pal("StdErr: ~p~n", [Data]), receive_exec_result(Msg); Msg -> - test_server:format("1: Collected data ~p", [Msg]), + ct:pal("1: Collected data ~p", [Msg]), expected; Other -> - test_server:format("Other ~p", [Other]), + ct:pal("Other ~p", [Other]), {unexpected_msg, Other} end. @@ -150,19 +149,19 @@ receive_exec_end(ConnectionRef, ChannelId) -> case receive_exec_result(ExitStatus) of {unexpected_msg, Eof} -> %% Open ssh seems to not allways send these messages %% in the same order! - test_server:format("2: Collected data ~p", [Eof]), + ct:pal("2: Collected data ~p", [Eof]), case receive_exec_result(ExitStatus) of expected -> expected = receive_exec_result(Closed); {unexpected_msg, Closed} -> - test_server:format("3: Collected data ~p", [Closed]) + ct:pal("3: Collected data ~p", [Closed]) end; expected -> - test_server:format("4: Collected data ~p", [ExitStatus]), + ct:pal("4: Collected data ~p", [ExitStatus]), expected = receive_exec_result(Eof), expected = receive_exec_result(Closed); Other -> - test_server:fail({unexpected_msg, Other}) + ct:fail({unexpected_msg, Other}) end. receive_exec_result(Data, ConnectionRef, ChannelId) -> diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index c337617ee4..99dc76e12d 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -21,7 +21,6 @@ -module(ssh_to_openssh_SUITE). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). %% Note: This directive should only be used in test suites. -compile(export_all). @@ -29,76 +28,10 @@ -define(TIMEOUT, 50000). -define(SSH_DEFAULT_PORT, 22). -%% Test server callback functions %%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initialization before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- -init_per_suite(Config) -> - case catch crypto:start() of - ok -> - case gen_tcp:connect("localhost", 22, []) of - {error,econnrefused} -> - {skip,"No openssh deamon"}; - _ -> - Config - end; - _Else -> - {skip,"Could not start crypto!"} - end. - -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- -end_per_suite(_Config) -> - crypto:stop(), - ok. - -%%-------------------------------------------------------------------- -%% Function: init_per_testcase(TestCase, Config) -> Config -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% -%% Description: Initialization before each test case -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%% Description: Initialization before each test case -%%-------------------------------------------------------------------- -init_per_testcase(_TestCase, Config) -> - ssh:start(), - Config. - -%%-------------------------------------------------------------------- -%% Function: end_per_testcase(TestCase, Config) -> _ -%% Case - atom() -%% Name of the test case that is about to be run. -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after each test case +%% Common Test interface functions ----------------------------------- %%-------------------------------------------------------------------- -end_per_testcase(_TestCase, _Config) -> - ssh:stop(), - ok. -%%-------------------------------------------------------------------- -%% Function: all(Clause) -> TestCases -%% Clause - atom() - suite | doc -%% TestCases - [Case] -%% Case - atom() -%% Name of a test case. -%% Description: Returns a list of all test cases in this test suite -%%-------------------------------------------------------------------- all() -> case os:find_executable("ssh") of false -> @@ -122,6 +55,23 @@ groups() -> erlang_server_openssh_client_pulic_key_dsa]} ]. +init_per_suite(Config) -> + case catch crypto:start() of + ok -> + case gen_tcp:connect("localhost", 22, []) of + {error,econnrefused} -> + {skip,"No openssh deamon"}; + _ -> + Config + end; + _Else -> + {skip,"Could not start crypto!"} + end. + +end_per_suite(_Config) -> + crypto:stop(), + ok. + init_per_group(erlang_server, Config) -> DataDir = ?config(data_dir, Config), UserDir = ?config(priv_dir, Config), @@ -137,14 +87,21 @@ end_per_group(erlang_server, Config) -> end_per_group(_, Config) -> Config. -%% TEST cases starts here. +init_per_testcase(_TestCase, Config) -> + ssh:start(), + Config. + +end_per_testcase(_TestCase, _Config) -> + ssh:stop(), + ok. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- + erlang_shell_client_openssh_server(doc) -> ["Test that ssh:shell/2 works"]; -erlang_shell_client_openssh_server(suite) -> - []; - erlang_shell_client_openssh_server(Config) when is_list(Config) -> process_flag(trap_exit, true), IO = ssh_test_lib:start_io_server(), @@ -159,22 +116,19 @@ erlang_shell_client_openssh_server(Config) when is_list(Config) -> ok end; Other0 -> - test_server:fail({unexpected_msg, Other0}) + ct:fail({unexpected_msg, Other0}) end, receive {'EXIT', Shell, normal} -> ok; Other1 -> - test_server:fail({unexpected_msg, Other1}) + ct:fail({unexpected_msg, Other1}) end. %-------------------------------------------------------------------- erlang_client_openssh_server_exec(doc) -> ["Test api function ssh_connection:exec"]; -erlang_client_openssh_server_exec(suite) -> - []; - erlang_client_openssh_server_exec(Config) when is_list(Config) -> ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, {user_interaction, false}]), @@ -187,11 +141,11 @@ erlang_client_openssh_server_exec(Config) when is_list(Config) -> ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId0); {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId0, 0}} = ExitStatus0} -> - test_server:format("0: Collected data ~p", [ExitStatus0]), + ct:pal("0: Collected data ~p", [ExitStatus0]), ssh_test_lib:receive_exec_result(Data0, ConnectionRef, ChannelId0); Other0 -> - test_server:fail(Other0) + ct:fail(Other0) end, {ok, ChannelId1} = ssh_connection:session_channel(ConnectionRef, infinity), @@ -203,20 +157,17 @@ erlang_client_openssh_server_exec(Config) when is_list(Config) -> ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId1); {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId1, 0}} = ExitStatus1} -> - test_server:format("0: Collected data ~p", [ExitStatus1]), + ct:pal("0: Collected data ~p", [ExitStatus1]), ssh_test_lib:receive_exec_result(Data1, ConnectionRef, ChannelId1); Other1 -> - test_server:fail(Other1) + ct:fail(Other1) end. %%-------------------------------------------------------------------- erlang_client_openssh_server_exec_compressed(doc) -> ["Test that compression option works"]; -erlang_client_openssh_server_exec_compressed(suite) -> - []; - erlang_client_openssh_server_exec_compressed(Config) when is_list(Config) -> ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, {user_interaction, false}, @@ -230,19 +181,16 @@ erlang_client_openssh_server_exec_compressed(Config) when is_list(Config) -> ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId); {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId, 0}} = ExitStatus} -> - test_server:format("0: Collected data ~p", [ExitStatus]), + ct:pal("0: Collected data ~p", [ExitStatus]), ssh_test_lib:receive_exec_result(Data, ConnectionRef, ChannelId); Other -> - test_server:fail(Other) + ct:fail(Other) end. %%-------------------------------------------------------------------- erlang_server_openssh_client_exec(doc) -> ["Test that exec command works."]; -erlang_server_openssh_client_exec(suite) -> - []; - erlang_server_openssh_client_exec(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -252,12 +200,12 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) -> {failfun, fun ssh_test_lib:failfun/2}]), - test_server:sleep(500), + ct:sleep(500), Cmd = "ssh -p " ++ integer_to_list(Port) ++ " -o UserKnownHostsFile=" ++ KnownHosts ++ " " ++ Host ++ " 1+1.", - test_server:format("Cmd: ~p~n", [Cmd]), + ct:pal("Cmd: ~p~n", [Cmd]), SshPort = open_port({spawn, Cmd}, [binary]), @@ -265,7 +213,7 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) -> {SshPort,{data, <<"2\n">>}} -> ok after ?TIMEOUT -> - test_server:fail("Did not receive answer") + ct:fail("Did not receive answer") end, ssh:stop_daemon(Pid). @@ -274,9 +222,6 @@ erlang_server_openssh_client_exec(Config) when is_list(Config) -> erlang_server_openssh_client_exec_compressed(doc) -> ["Test that exec command works."]; -erlang_server_openssh_client_exec_compressed(suite) -> - []; - erlang_server_openssh_client_exec_compressed(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -286,7 +231,7 @@ erlang_server_openssh_client_exec_compressed(Config) when is_list(Config) -> {compression, zlib}, {failfun, fun ssh_test_lib:failfun/2}]), - test_server:sleep(500), + ct:sleep(500), Cmd = "ssh -p " ++ integer_to_list(Port) ++ " -o UserKnownHostsFile=" ++ KnownHosts ++ " -C "++ Host ++ " 1+1.", @@ -296,7 +241,7 @@ erlang_server_openssh_client_exec_compressed(Config) when is_list(Config) -> {SshPort,{data, <<"2\n">>}} -> ok after ?TIMEOUT -> - test_server:fail("Did not receive answer") + ct:fail("Did not receive answer") end, ssh:stop_daemon(Pid). @@ -305,9 +250,6 @@ erlang_server_openssh_client_exec_compressed(Config) when is_list(Config) -> erlang_client_openssh_server_setenv(doc) -> ["Test api function ssh_connection:setenv"]; -erlang_client_openssh_server_setenv(suite) -> - []; - erlang_client_openssh_server_setenv(Config) when is_list(Config) -> ConnectionRef = ssh_test_lib:connect(?SSH_DEFAULT_PORT, [{silently_accept_hosts, true}, @@ -332,15 +274,15 @@ erlang_client_openssh_server_setenv(Config) when is_list(Config) -> {data,0,1, UnxpectedData}}} -> %% Some os may return things as %% ENV_TEST: Undefined variable.\n" - test_server:format("UnxpectedData: ~p", [UnxpectedData]), + ct:pal("UnxpectedData: ~p", [UnxpectedData]), ssh_test_lib:receive_exec_end(ConnectionRef, ChannelId); {unexpected_msg,{ssh_cm, ConnectionRef, {exit_status, ChannelId, 0}} = ExitStatus} -> - test_server:format("0: Collected data ~p", [ExitStatus]), + ct:pal("0: Collected data ~p", [ExitStatus]), ssh_test_lib:receive_exec_result(Data, ConnectionRef, ChannelId); Other -> - test_server:fail(Other) + ct:fail(Other) end. %%-------------------------------------------------------------------- @@ -350,8 +292,6 @@ erlang_client_openssh_server_setenv(Config) when is_list(Config) -> %%-------------------------------------------------------------------- erlang_client_openssh_server_publickey_rsa(doc) -> ["Validate using rsa publickey."]; -erlang_client_openssh_server_publickey_rsa(suite) -> - []; erlang_client_openssh_server_publickey_rsa(Config) when is_list(Config) -> {ok,[[Home]]} = init:get_argument(home), KeyFile = filename:join(Home, ".ssh/id_rsa"), @@ -379,8 +319,6 @@ erlang_client_openssh_server_publickey_rsa(Config) when is_list(Config) -> %%-------------------------------------------------------------------- erlang_client_openssh_server_publickey_dsa(doc) -> ["Validate using dsa publickey."]; -erlang_client_openssh_server_publickey_dsa(suite) -> - []; erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) -> {ok,[[Home]]} = init:get_argument(home), KeyFile = filename:join(Home, ".ssh/id_dsa"), @@ -406,10 +344,6 @@ erlang_client_openssh_server_publickey_dsa(Config) when is_list(Config) -> %%-------------------------------------------------------------------- erlang_server_openssh_client_pulic_key_dsa(doc) -> ["Validate using dsa publickey."]; - -erlang_server_openssh_client_pulic_key_dsa(suite) -> - []; - erlang_server_openssh_client_pulic_key_dsa(Config) when is_list(Config) -> SystemDir = ?config(data_dir, Config), PrivDir = ?config(priv_dir, Config), @@ -419,7 +353,7 @@ erlang_server_openssh_client_pulic_key_dsa(Config) when is_list(Config) -> {public_key_alg, ssh_dsa}, {failfun, fun ssh_test_lib:failfun/2}]), - test_server:sleep(500), + ct:sleep(500), Cmd = "ssh -p " ++ integer_to_list(Port) ++ " -o UserKnownHostsFile=" ++ KnownHosts ++ @@ -430,17 +364,13 @@ erlang_server_openssh_client_pulic_key_dsa(Config) when is_list(Config) -> {SshPort,{data, <<"2\n">>}} -> ok after ?TIMEOUT -> - test_server:fail("Did not receive answer") + ct:fail("Did not receive answer") end, ssh:stop_daemon(Pid). %%-------------------------------------------------------------------- erlang_client_openssh_server_password(doc) -> ["Test client password option"]; - -erlang_client_openssh_server_password(suite) -> - []; - erlang_client_openssh_server_password(Config) when is_list(Config) -> %% to make sure we don't public-key-auth UserDir = ?config(data_dir, Config), @@ -451,7 +381,7 @@ erlang_client_openssh_server_password(Config) when is_list(Config) -> {user_interaction, false}, {user_dir, UserDir}]), - test_server:format("Test of user foo that does not exist. " + ct:pal("Test of user foo that does not exist. " "Error msg: ~p~n", [Reason0]), User = string:strip(os:cmd("whoami"), right, $\n), @@ -465,10 +395,10 @@ erlang_client_openssh_server_password(Config) when is_list(Config) -> {password, "foo"}, {user_interaction, false}, {user_dir, UserDir}]), - test_server:format("Test of wrong Pasword. " + ct:pal("Test of wrong Pasword. " "Error msg: ~p~n", [Reason1]); _ -> - test_server:format("Whoami failed reason: ~n", []) + ct:pal("Whoami failed reason: ~n", []) end. %%-------------------------------------------------------------------- @@ -477,13 +407,13 @@ erlang_client_openssh_server_password(Config) when is_list(Config) -> %% %%-------------------------------------------------------------------- %%-------------------------------------------------------------------- -%%% Internal functions +%%% Internal functions ----------------------------------------------- %%-------------------------------------------------------------------- receive_hej() -> receive <<"Hej\n">> = Hej-> - test_server:format("Expected result: ~p~n", [Hej]); + ct:pal("Expected result: ~p~n", [Hej]); Info -> - test_server:format("Extra info: ~p~n", [Info]), + ct:pal("Extra info: ~p~n", [Info]), receive_hej() end. diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 5098d26a3a..f0eac76264 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -79,7 +79,9 @@ {keyfile, path()} | {password, string()} | {cacerts, [der_encoded()]} | {cacertfile, path()} | |{dh, der_encoded()} | {dhfile, path()} | {ciphers, ciphers()} | - {ssl_imp, ssl_imp()}| {reuse_sessions, boolean()} | {reuse_session, fun()} + {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | {reuse_session, fun()} + {next_protocols_advertised, list(binary()} | + {client_preferred_next_protocols, binary(), client | server, list(binary())} </c></p> <p><c>transportoption() = {CallbackModule, DataTag, ClosedTag} @@ -301,8 +303,29 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | when possible. </item> + <tag>{client_preferred_next_protocols, Precedence:: server | client, ClientPrefs::[binary()]} + {client_preferred_next_protocols, Precedence:: server | client, ClientPrefs::[binary()] , Default :: binary()}}</tag> + + <item> <p>Indicates the client will try to perform Next Protocol + Negotiation.</p> + + <p>If precedence is server the negaotiated protocol will be the + first protocol that appears on the server advertised list that is + also on the clients preference list.</p> + + <p>If the precedence is client the negaotiated protocol will be the + first protocol that appears on the clients preference list that is + also on the server advertised list.</p> + + <p> If the client does not support any of the servers advertised + protocols or the server does not advertise any protocols the + client will fallback to the first protocol in its list or if a + default is supplied it will fallback to that instead. If the + server does not support next protocol renegotiation the + connection will be aborted if no default protocol is supplied.</p> + </item> </taglist> - </section> + </section> <section> <title>SSL OPTION DESCRIPTIONS - SERVER SIDE</title> @@ -353,6 +376,14 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | SuggestedSessionId is a binary(), PeerCert is a DER encoded certificate, Compression is an enumeration integer and CipherSuite is of type ciphersuite(). + </item> + + <tag>{next_protocols_advertised, Protocols :: list(binary())}</tag> + <item>The list of protocols to send to the client if the client indicates + it supports the Next Protocol extension. The client may select a protocol + that is not on this list. The list of protocols must not contain an empty + binary. If the server negotiates a Next Protocol it can be accessed + using <c>negotiated_next_protocol/1</c> method. </item> </taglist> @@ -766,8 +797,23 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | ssl application.</p> </desc> </func> + <func> + <name>negotiated_next_protocol(Socket) -> {ok, Protocol} | {error, next_protocol_not_negotiated}</name> + <fsummary>Returns the Next Protocol negotiated.</fsummary> + <type> + <v>Socket = sslsocket()</v> + <v>Protocol = binary()</v> + </type> + <desc> + <p> + Returns the Next Protocol negotiated. + </p> + </desc> + </func> + + </funcs> - + <section> <title>SEE ALSO</title> <p><seealso marker="kernel:inet">inet(3) </seealso> and diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 40d933a256..7788f758ac 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -31,13 +31,15 @@ controlling_process/2, listen/2, pid/1, peername/1, peercert/1, recv/2, recv/3, send/2, getopts/2, setopts/2, sockname/1, versions/0, session_info/1, format_error/1, - renegotiate/1, prf/5, clear_pem_cache/0, random_bytes/1]). + renegotiate/1, prf/5, clear_pem_cache/0, random_bytes/1, negotiated_next_protocol/1]). + -deprecated({pid, 1, next_major_release}). -include("ssl_internal.hrl"). -include("ssl_record.hrl"). -include("ssl_cipher.hrl"). +-include("ssl_handshake.hrl"). -include_lib("public_key/include/public_key.hrl"). @@ -65,7 +67,9 @@ {keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} | {cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} | {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} | - {reuse_session, fun()} | {hibernate_after, integer()|undefined}. + {reuse_session, fun()} | {hibernate_after, integer()|undefined} | + {next_protocols_advertised, list(binary())} | + {client_preferred_next_protocols, binary(), client | server, list(binary())}. -type verify_type() :: verify_none | verify_peer. -type path() :: string(). @@ -161,7 +165,7 @@ listen(Port, Options0) -> #config{cb={CbModule, _, _, _},inet_user=Options} = Config, case CbModule:listen(Port, Options) of {ok, ListenSocket} -> - {ok, #sslsocket{pid = {ListenSocket, Config}, fd = new_ssl}}; + {ok, #sslsocket{pid = {ListenSocket, Config}}}; Err = {error, _} -> Err end @@ -241,18 +245,20 @@ ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) -> %% %% Description: Close an ssl connection %%-------------------------------------------------------------------- +close(#sslsocket{pid = Pid}) when is_pid(Pid) -> + ssl_connection:close(Pid); close(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}) -> - CbMod:close(ListenSocket); -close(#sslsocket{pid = Pid}) -> - ssl_connection:close(Pid). + CbMod:close(ListenSocket). %%-------------------------------------------------------------------- -spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- -send(#sslsocket{pid = Pid}, Data) -> - ssl_connection:send(Pid, Data). +send(#sslsocket{pid = Pid}, Data) when is_pid(Pid) -> + ssl_connection:send(Pid, Data); +send(#sslsocket{pid = {ListenSocket, #config{cb={CbModule, _, _, _}}}}, Data) -> + CbModule:send(ListenSocket, Data). %% {error,enotconn} %%-------------------------------------------------------------------- -spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}. @@ -262,8 +268,10 @@ send(#sslsocket{pid = Pid}, Data) -> %%-------------------------------------------------------------------- recv(Socket, Length) -> recv(Socket, Length, infinity). -recv(#sslsocket{pid = Pid, fd = new_ssl}, Length, Timeout) -> - ssl_connection:recv(Pid, Length, Timeout). +recv(#sslsocket{pid = Pid}, Length, Timeout) when is_pid(Pid) -> + ssl_connection:recv(Pid, Length, Timeout); +recv(#sslsocket{pid = {Listen, #config{cb={CbModule, _, _, _}}}}, _,_) when is_port(Listen)-> + CbModule:recv(Listen, 0). %% {error,enotconn} %%-------------------------------------------------------------------- -spec controlling_process(#sslsocket{}, pid()) -> ok | {error, reason()}. @@ -271,8 +279,12 @@ recv(#sslsocket{pid = Pid, fd = new_ssl}, Length, Timeout) -> %% Description: Changes process that receives the messages when active = true %% or once. %%-------------------------------------------------------------------- -controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid) -> - ssl_connection:new_user(Pid, NewOwner). +controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid), is_pid(NewOwner) -> + ssl_connection:new_user(Pid, NewOwner); +controlling_process(#sslsocket{pid = {Listen, + #config{cb={CbModule, _, _, _}}}}, NewOwner) when is_port(Listen), + is_pid(NewOwner) -> + CbModule:controlling_process(Listen, NewOwner). %%-------------------------------------------------------------------- -spec connection_info(#sslsocket{}) -> {ok, {tls_atom_version(), erl_cipher_suite()}} | @@ -280,29 +292,35 @@ controlling_process(#sslsocket{pid = Pid}, NewOwner) when is_pid(Pid) -> %% %% Description: Returns ssl protocol and cipher used for the connection %%-------------------------------------------------------------------- -connection_info(#sslsocket{pid = Pid}) -> - ssl_connection:info(Pid). +connection_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> + ssl_connection:info(Pid); +connection_info(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> + {error, enotconn}. %%-------------------------------------------------------------------- -spec peername(#sslsocket{}) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. %% %% Description: same as inet:peername/1. %%-------------------------------------------------------------------- -peername(#sslsocket{pid = Pid}) -> - ssl_connection:peername(Pid). +peername(#sslsocket{pid = Pid, fd = Socket}) when is_pid(Pid)-> + inet:peername(Socket); +peername(#sslsocket{pid = {ListenSocket, _}}) -> + inet:peername(ListenSocket). %% Will return {error, enotconn} %%-------------------------------------------------------------------- -spec peercert(#sslsocket{}) ->{ok, DerCert::binary()} | {error, reason()}. %% %% Description: Returns the peercert. %%-------------------------------------------------------------------- -peercert(#sslsocket{pid = Pid}) -> +peercert(#sslsocket{pid = Pid}) when is_pid(Pid) -> case ssl_connection:peer_certificate(Pid) of {ok, undefined} -> {error, no_peercert}; Result -> Result - end. + end; +peercert(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> + {error, enotconn}. %%-------------------------------------------------------------------- -spec suite_definition(cipher_suite()) -> erl_cipher_suite(). @@ -314,6 +332,14 @@ suite_definition(S) -> {KeyExchange, Cipher, Hash}. %%-------------------------------------------------------------------- +-spec negotiated_next_protocol(#sslsocket{}) -> {ok, binary()} | {error, reason()}. +%% +%% Description: Returns the next protocol that has been negotiated. If no +%% protocol has been negotiated will return {error, next_protocol_not_negotiated} +%%-------------------------------------------------------------------- +negotiated_next_protocol(#sslsocket{pid = Pid}) -> + ssl_connection:negotiated_next_protocol(Pid). + -spec cipher_suites() -> [erl_cipher_suite()]. -spec cipher_suites(erlang | openssl) -> [erl_cipher_suite()] | [string()]. @@ -384,8 +410,9 @@ setopts(#sslsocket{}, Options) -> %% %% Description: Same as gen_tcp:shutdown/2 %%-------------------------------------------------------------------- -shutdown(#sslsocket{pid = {ListenSocket, #config{cb={CbMod,_, _, _}}}}, How) -> - CbMod:shutdown(ListenSocket, How); +shutdown(#sslsocket{pid = {Listen, #config{cb={CbMod,_, _, _}}}}, + How) when is_port(Listen) -> + CbMod:shutdown(Listen, How); shutdown(#sslsocket{pid = Pid}, How) -> ssl_connection:shutdown(Pid, How). @@ -394,11 +421,11 @@ shutdown(#sslsocket{pid = Pid}, How) -> %% %% Description: Same as inet:sockname/1 %%-------------------------------------------------------------------- -sockname(#sslsocket{pid = {ListenSocket, _}}) -> - inet:sockname(ListenSocket); +sockname(#sslsocket{pid = {Listen, _}}) when is_port(Listen) -> + inet:sockname(Listen); -sockname(#sslsocket{pid = Pid}) -> - ssl_connection:sockname(Pid). +sockname(#sslsocket{pid = Pid, fd = Socket}) when is_pid(Pid) -> + inet:sockname(Socket). %%--------------------------------------------------------------- -spec session_info(#sslsocket{}) -> {ok, list()} | {error, reason()}. @@ -406,12 +433,14 @@ sockname(#sslsocket{pid = Pid}) -> %% Description: Returns list of session info currently [{session_id, session_id(), %% {cipher_suite, cipher_suite()}] %%-------------------------------------------------------------------- -session_info(#sslsocket{pid = Pid, fd = new_ssl}) -> - ssl_connection:session_info(Pid). +session_info(#sslsocket{pid = Pid}) when is_pid(Pid) -> + ssl_connection:session_info(Pid); +session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> + {error, enotconn}. %%--------------------------------------------------------------- -spec versions() -> [{ssl_app, string()} | {supported, [tls_atom_version()]} | - {available, [tls_atom_version()]}]. + {available, [tls_atom_version()]}]. %% %% Description: Returns a list of relevant versions. %%-------------------------------------------------------------------- @@ -427,8 +456,10 @@ versions() -> %% %% Description: Initiates a renegotiation. %%-------------------------------------------------------------------- -renegotiate(#sslsocket{pid = Pid, fd = new_ssl}) -> - ssl_connection:renegotiation(Pid). +renegotiate(#sslsocket{pid = Pid}) when is_pid(Pid) -> + ssl_connection:renegotiation(Pid); +renegotiate(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> + {error, enotconn}. %%-------------------------------------------------------------------- -spec prf(#sslsocket{}, binary() | 'master_secret', binary(), @@ -437,10 +468,11 @@ renegotiate(#sslsocket{pid = Pid, fd = new_ssl}) -> %% %% Description: use a ssl sessions TLS PRF to generate key material %%-------------------------------------------------------------------- -prf(#sslsocket{pid = Pid, fd = new_ssl}, - Secret, Label, Seed, WantedLength) -> - ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength). - +prf(#sslsocket{pid = Pid}, + Secret, Label, Seed, WantedLength) when is_pid(Pid) -> + ssl_connection:prf(Pid, Secret, Label, Seed, WantedLength); +prf(#sslsocket{pid = {Listen,_}}, _,_,_,_) when is_port(Listen) -> + {error, enotconn}. %%-------------------------------------------------------------------- -spec clear_pem_cache() -> ok. @@ -594,7 +626,9 @@ handle_options(Opts0, _Role) -> renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), debug = handle_option(debug, Opts, []), hibernate_after = handle_option(hibernate_after, Opts, undefined), - erl_dist = handle_option(erl_dist, Opts, false) + erl_dist = handle_option(erl_dist, Opts, false), + next_protocols_advertised = handle_option(next_protocols_advertised, Opts, undefined), + next_protocol_selector = make_next_protocol_selector(handle_option(client_preferred_next_protocols, Opts, undefined)) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -603,7 +637,8 @@ handle_options(Opts0, _Role) -> depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, ciphers, debug, reuse_session, reuse_sessions, ssl_imp, - cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist], + cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised, + client_preferred_next_protocols], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -728,12 +763,64 @@ validate_option(hibernate_after, undefined) -> undefined; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> Value; -validate_option(erl_dist,Value) when Value == true; +validate_option(erl_dist,Value) when Value == true; Value == false -> Value; +validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols} = Value) + when is_list(PreferredProtocols) -> + case ssl_record:highest_protocol_version([]) of + {3,0} -> + throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + _ -> + validate_binary_list(client_preferred_next_protocols, PreferredProtocols), + validate_npn_ordering(Precedence), + {Precedence, PreferredProtocols, ?NO_PROTOCOL} + end; +validate_option(client_preferred_next_protocols = Opt, {Precedence, PreferredProtocols, Default} = Value) + when is_list(PreferredProtocols), is_binary(Default), + byte_size(Default) > 0, byte_size(Default) < 256 -> + case ssl_record:highest_protocol_version([]) of + {3,0} -> + throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + _ -> + validate_binary_list(client_preferred_next_protocols, PreferredProtocols), + validate_npn_ordering(Precedence), + Value + end; + +validate_option(client_preferred_next_protocols, undefined) -> + undefined; +validate_option(next_protocols_advertised = Opt, Value) when is_list(Value) -> + case ssl_record:highest_protocol_version([]) of + {3,0} -> + throw({error, {eoptions, {not_supported_in_sslv3, {Opt, Value}}}}); + _ -> + validate_binary_list(next_protocols_advertised, Value), + Value + end; + +validate_option(next_protocols_advertised, undefined) -> + undefined; validate_option(Opt, Value) -> throw({error, {eoptions, {Opt, Value}}}). - + +validate_npn_ordering(client) -> + ok; +validate_npn_ordering(server) -> + ok; +validate_npn_ordering(Value) -> + throw({error, {eoptions, {client_preferred_next_protocols, {invalid_precedence, Value}}}}). + +validate_binary_list(Opt, List) -> + lists:foreach( + fun(Bin) when is_binary(Bin), + byte_size(Bin) > 0, + byte_size(Bin) < 256 -> + ok; + (Bin) -> + throw({error, {eoptions, {Opt, {invalid_protocol, Bin}}}}) + end, List). + validate_versions([], Versions) -> Versions; validate_versions([Version | Rest], Versions) when Version == 'tlsv1.2'; @@ -839,6 +926,34 @@ cipher_suites(Version, Ciphers0) -> no_format(Error) -> lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])). + +detect(_Pred, []) -> + undefined; +detect(Pred, [H|T]) -> + case Pred(H) of + true -> + H; + _ -> + detect(Pred, T) + end. + +make_next_protocol_selector(undefined) -> + undefined; +make_next_protocol_selector({client, AllProtocols, DefaultProtocol}) -> + fun(AdvertisedProtocols) -> + case detect(fun(PreferredProtocol) -> lists:member(PreferredProtocol, AdvertisedProtocols) end, AllProtocols) of + undefined -> DefaultProtocol; + PreferredProtocol -> PreferredProtocol + end + end; + +make_next_protocol_selector({server, AllProtocols, DefaultProtocol}) -> + fun(AdvertisedProtocols) -> + case detect(fun(PreferredProtocol) -> lists:member(PreferredProtocol, AllProtocols) end, AdvertisedProtocols) of + undefined -> DefaultProtocol; + PreferredProtocol -> PreferredProtocol + end + end. %% Only used to remove exit messages from old ssl %% First is a nonsense clause to provide some @@ -846,7 +961,5 @@ no_format(Error) -> %% function in a none recommended way, but will %% work correctly if a valid pid is returned. %% Deprcated to be removed in r16 -pid(#sslsocket{fd = new_ssl}) -> - whereis(ssl_connection_sup); -pid(#sslsocket{pid = Pid}) -> - Pid. +pid(#sslsocket{})-> + whereis(ssl_connection_sup). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index ff2556c488..1319b54d6b 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -40,8 +40,7 @@ -export([send/2, recv/3, connect/7, ssl_accept/6, handshake/2, socket_control/3, close/1, shutdown/2, new_user/2, get_opts/2, set_opts/2, info/1, session_info/1, - peer_certificate/1, sockname/1, peername/1, renegotiation/1, - prf/5]). + peer_certificate/1, renegotiation/1, negotiated_next_protocol/1, prf/5]). %% Called by ssl_connection_sup -export([start_link/7]). @@ -92,7 +91,9 @@ start_or_recv_from, % "gen_fsm From" send_queue, % queue() terminated = false, % - allow_renegotiate = true + allow_renegotiate = true, + expecting_next_protocol_negotiation = false :: boolean(), + next_protocol = undefined :: undefined | binary() }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, @@ -179,7 +180,7 @@ handshake(#sslsocket{pid = Pid}, Timeout) -> socket_control(Socket, Pid, CbModule) -> case CbModule:controlling_process(Socket, Pid) of ok -> - {ok, sslsocket(Pid)}; + {ok, sslsocket(Pid, Socket)}; {error, Reason} -> {error, Reason} end. @@ -213,20 +214,15 @@ shutdown(ConnectionPid, How) -> %%-------------------------------------------------------------------- new_user(ConnectionPid, User) -> sync_send_all_state_event(ConnectionPid, {new_user, User}). + %%-------------------------------------------------------------------- --spec sockname(pid()) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. -%% -%% Description: Same as inet:sockname/1 -%%-------------------------------------------------------------------- -sockname(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, sockname). -%%-------------------------------------------------------------------- --spec peername(pid()) -> {ok, {inet:ip_address(), inet:port_number()}} | {error, reason()}. +-spec negotiated_next_protocol(pid()) -> {ok, binary()} | {error, reason()}. %% -%% Description: Same as inet:peername/1 +%% Description: Returns the negotiated protocol %%-------------------------------------------------------------------- -peername(ConnectionPid) -> - sync_send_all_state_event(ConnectionPid, peername). +negotiated_next_protocol(ConnectionPid) -> + sync_send_all_state_event(ConnectionPid, negotiated_next_protocol). + %%-------------------------------------------------------------------- -spec get_opts(pid(), list()) -> {ok, list()} | {error, reason()}. %% @@ -374,31 +370,41 @@ hello(#server_hello{cipher_suite = CipherSuite, renegotiation = {Renegotiation, _}, ssl_options = SslOptions} = State0) -> case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of - {Version, NewId, ConnectionStates} -> + #alert{} = Alert -> + handle_own_alert(Alert, ReqVersion, hello, State0), + {stop, normal, State0}; + + {Version, NewId, ConnectionStates, NextProtocol} -> {KeyAlgorithm, _, _, _} = ssl_cipher:suite_definition(CipherSuite), - + PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), - + + NewNextProtocol = case NextProtocol of + undefined -> + State0#state.next_protocol; + _ -> + NextProtocol + end, + State = State0#state{key_algorithm = KeyAlgorithm, hashsign_algorithm = default_hashsign(Version, KeyAlgorithm), negotiated_version = Version, connection_states = ConnectionStates, - premaster_secret = PremasterSecret}, - + premaster_secret = PremasterSecret, + expecting_next_protocol_negotiation = NextProtocol =/= undefined, + next_protocol = NewNextProtocol}, + case ssl_session:is_new(OldId, NewId) of true -> handle_new_session(NewId, CipherSuite, Compression, State#state{connection_states = ConnectionStates}); false -> - handle_resumed_session(NewId, State#state{connection_states = ConnectionStates}) - end; - #alert{} = Alert -> - handle_own_alert(Alert, ReqVersion, hello, State0), - {stop, normal, State0} + handle_resumed_session(NewId, State#state{connection_states = ConnectionStates}) + end end; -hello(Hello = #client_hello{client_version = ClientVersion}, +hello(Hello = #client_hello{client_version = ClientVersion}, State = #state{connection_states = ConnectionStates0, port = Port, session = #session{own_certificate = Cert} = Session0, renegotiation = {Renegotiation, _}, @@ -407,8 +413,8 @@ hello(Hello = #client_hello{client_version = ClientVersion}, ssl_options = SslOpts}) -> case ssl_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) of - {Version, {Type, Session}, ConnectionStates} -> - do_server_hello(Type, State#state{connection_states = + {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise} -> + do_server_hello(Type, ProtocolsToAdvertise, State#state{connection_states = ConnectionStates, negotiated_version = Version, session = Session}); @@ -593,6 +599,7 @@ certify(#client_key_exchange{exchange_keys = Keys}, {stop, normal, State} end; + certify(timeout, State) -> { next_state, certify, State, hibernate }; @@ -662,6 +669,12 @@ cipher(#certificate_verify{signature = Signature, hashsign_algorithm = CertHashS {stop, normal, State0} end; +% client must send a next protocol message if we are expecting it +cipher(#finished{}, #state{role = server, expecting_next_protocol_negotiation = true, + next_protocol = undefined, negotiated_version = Version} = State0) -> + handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, cipher, State0), + {stop, normal, State0}; + cipher(#finished{verify_data = Data} = Finished, #state{negotiated_version = Version, host = Host, @@ -683,6 +696,13 @@ cipher(#finished{verify_data = Data} = Finished, {stop, normal, State} end; +% only allowed to send next_protocol message after change cipher spec +% & before finished message and it is not allowed during renegotiation +cipher(#next_protocol{selected_protocol = SelectedProtocol}, + #state{role = server, expecting_next_protocol_negotiation = true} = State0) -> + {Record, State} = next_record(State0#state{next_protocol = SelectedProtocol}), + next_state(cipher, cipher, Record, State); + cipher(timeout, State) -> { next_state, cipher, State, hibernate }; @@ -837,15 +857,10 @@ handle_sync_event({get_opts, OptTags}, _From, StateName, OptsReply = get_socket_opts(Socket, OptTags, SockOpts, []), {reply, OptsReply, StateName, State, get_timeout(State)}; -handle_sync_event(sockname, _From, StateName, - #state{socket = Socket} = State) -> - SockNameReply = inet:sockname(Socket), - {reply, SockNameReply, StateName, State, get_timeout(State)}; - -handle_sync_event(peername, _From, StateName, - #state{socket = Socket} = State) -> - PeerNameReply = inet:peername(Socket), - {reply, PeerNameReply, StateName, State, get_timeout(State)}; +handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = undefined} = State) -> + {reply, {error, next_protocol_not_negotiated}, StateName, State, get_timeout(State)}; +handle_sync_event(negotiated_next_protocol, _From, StateName, #state{next_protocol = NextProtocol} = State) -> + {reply, {ok, NextProtocol}, StateName, State, get_timeout(State)}; handle_sync_event({set_opts, Opts0}, _From, StateName, #state{socket_options = Opts1, @@ -974,7 +989,7 @@ handle_info({CloseTag, Socket}, StateName, handle_info({ErrorTag, Socket, econnaborted}, StateName, #state{socket = Socket, start_or_recv_from = StartFrom, role = Role, error_tag = ErrorTag} = State) when StateName =/= connection -> - alert_user(StartFrom, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Role), + alert_user(Socket, StartFrom, ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Role), {stop, normal, State}; handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket, @@ -1274,17 +1289,18 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, verify_client_cert(#state{client_certificate_requested = false} = State) -> State. -do_server_hello(Type, #state{negotiated_version = Version, - session = #session{session_id = SessId}, - connection_states = ConnectionStates0, - renegotiation = {Renegotiation, _}} - = State0) when is_atom(Type) -> +do_server_hello(Type, NextProtocolsToSend, #state{negotiated_version = Version, + session = #session{session_id = SessId}, + connection_states = ConnectionStates0, + renegotiation = {Renegotiation, _}} + = State0) when is_atom(Type) -> ServerHello = ssl_handshake:server_hello(SessId, Version, - ConnectionStates0, Renegotiation), - State = server_hello(ServerHello, State0), - + ConnectionStates0, Renegotiation, NextProtocolsToSend), + State = server_hello(ServerHello, + State0#state{expecting_next_protocol_negotiation = + NextProtocolsToSend =/= undefined}), case Type of new -> new_server_hello(ServerHello, State); @@ -1538,12 +1554,33 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_none}} = State. finalize_handshake(State, StateName) -> - ConnectionStates0 = cipher_protocol(State), + ConnectionStates0 = cipher_protocol(State), + ConnectionStates = ssl_record:activate_pending_connection_state(ConnectionStates0, write), - finished(State#state{connection_states = ConnectionStates}, StateName). - + + State1 = State#state{connection_states = ConnectionStates}, + State2 = next_protocol(State1), + finished(State2, StateName). + +next_protocol(#state{role = server} = State) -> + State; +next_protocol(#state{next_protocol = undefined} = State) -> + State; +next_protocol(#state{expecting_next_protocol_negotiation = false} = State) -> + State; +next_protocol(#state{transport_cb = Transport, socket = Socket, + negotiated_version = Version, + next_protocol = NextProtocol, + connection_states = ConnectionStates0, + tls_handshake_history = Handshake0} = State) -> + NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol), + {BinMsg, ConnectionStates, Handshake} = encode_handshake(NextProtocolMessage, Version, ConnectionStates0, Handshake0), + Transport:send(Socket, BinMsg), + State#state{connection_states = ConnectionStates, + tls_handshake_history = Handshake}. + cipher_protocol(#state{connection_states = ConnectionStates0, socket = Socket, negotiated_version = Version, @@ -1728,10 +1765,11 @@ passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) -> end. read_application_data(Data, #state{user_application = {_Mon, Pid}, - socket_options = SOpts, - bytes_to_read = BytesToRead, - start_or_recv_from = RecvFrom, - user_data_buffer = Buffer0} = State0) -> + socket = Socket, + socket_options = SOpts, + bytes_to_read = BytesToRead, + start_or_recv_from = RecvFrom, + user_data_buffer = Buffer0} = State0) -> Buffer1 = if Buffer0 =:= <<>> -> Data; Data =:= <<>> -> Buffer0; @@ -1739,7 +1777,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, end, case get_data(SOpts, BytesToRead, Buffer1) of {ok, ClientData, Buffer} -> % Send data - SocketOpt = deliver_app_data(SOpts, ClientData, Pid, RecvFrom), + SocketOpt = deliver_app_data(Socket, SOpts, ClientData, Pid, RecvFrom), State = State0#state{user_data_buffer = Buffer, start_or_recv_from = undefined, bytes_to_read = 0, @@ -1756,7 +1794,7 @@ read_application_data(Data, #state{user_application = {_Mon, Pid}, {more, Buffer} -> % no reply, we need more data next_record(State0#state{user_data_buffer = Buffer}); {error,_Reason} -> %% Invalid packet in packet mode - deliver_packet_error(SOpts, Buffer1, Pid, RecvFrom), + deliver_packet_error(Socket, SOpts, Buffer1, Pid, RecvFrom), {stop, normal, State0} end. @@ -1835,9 +1873,9 @@ decode_packet(Type, Buffer, PacketOpts) -> %% Note that if the user has explicitly configured the socket to expect %% HTTP headers using the {packet, httph} option, we don't do any automatic %% switching of states. -deliver_app_data(SOpts = #socket_options{active=Active, packet=Type}, - Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_reply(SOpts, Data)), +deliver_app_data(Socket, SOpts = #socket_options{active=Active, packet=Type}, + Data, Pid, From) -> + send_or_reply(Active, Pid, From, format_reply(Socket, SOpts, Data)), SO = case Data of {P, _, _, _} when ((P =:= http_request) or (P =:= http_response)), ((Type =:= http) or (Type =:= http_bin)) -> @@ -1856,31 +1894,31 @@ deliver_app_data(SOpts = #socket_options{active=Active, packet=Type}, SO end. -format_reply(#socket_options{active = false, mode = Mode, packet = Packet, +format_reply(_,#socket_options{active = false, mode = Mode, packet = Packet, header = Header}, Data) -> - {ok, format_reply(Mode, Packet, Header, Data)}; -format_reply(#socket_options{active = _, mode = Mode, packet = Packet, + {ok, do_format_reply(Mode, Packet, Header, Data)}; +format_reply(Socket, #socket_options{active = _, mode = Mode, packet = Packet, header = Header}, Data) -> - {ssl, sslsocket(), format_reply(Mode, Packet, Header, Data)}. + {ssl, sslsocket(self(), Socket), do_format_reply(Mode, Packet, Header, Data)}. -deliver_packet_error(SO= #socket_options{active = Active}, Data, Pid, From) -> - send_or_reply(Active, Pid, From, format_packet_error(SO, Data)). +deliver_packet_error(Socket, SO= #socket_options{active = Active}, Data, Pid, From) -> + send_or_reply(Active, Pid, From, format_packet_error(Socket, SO, Data)). -format_packet_error(#socket_options{active = false, mode = Mode}, Data) -> - {error, {invalid_packet, format_reply(Mode, raw, 0, Data)}}; -format_packet_error(#socket_options{active = _, mode = Mode}, Data) -> - {ssl_error, sslsocket(), {invalid_packet, format_reply(Mode, raw, 0, Data)}}. +format_packet_error(_,#socket_options{active = false, mode = Mode}, Data) -> + {error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}; +format_packet_error(Socket, #socket_options{active = _, mode = Mode}, Data) -> + {ssl_error, sslsocket(self(), Socket), {invalid_packet, do_format_reply(Mode, raw, 0, Data)}}. -format_reply(binary, _, N, Data) when N > 0 -> % Header mode +do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode header(N, Data); -format_reply(binary, _, _, Data) -> +do_format_reply(binary, _, _, Data) -> Data; -format_reply(list, Packet, _, Data) +do_format_reply(list, Packet, _, Data) when Packet == http; Packet == {http, headers}; Packet == http_bin; Packet == {http_bin, headers}; Packet == httph; Packet == httph_bin -> Data; -format_reply(list, _,_, Data) -> +do_format_reply(list, _,_, Data) -> binary_to_list(Data). header(0, <<>>) -> @@ -2053,8 +2091,8 @@ next_state_is_connection(_, State = next_state_is_connection(StateName, State0) -> {Record, State} = next_record_if_active(State0), next_state(StateName, connection, Record, State#state{premaster_secret = undefined, - public_key_info = undefined, - tls_handshake_history = ssl_handshake:init_handshake_history()}). + public_key_info = undefined, + tls_handshake_history = ssl_handshake:init_handshake_history()}). register_session(client, Host, Port, #session{is_resumable = new} = Session0) -> Session = Session0#session{is_resumable = true}, @@ -2112,11 +2150,8 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User, send_queue = queue:new() }. -sslsocket(Pid) -> - #sslsocket{pid = Pid, fd = new_ssl}. - -sslsocket() -> - sslsocket(self()). +sslsocket(Pid, Socket) -> + #sslsocket{pid = Pid, fd = Socket}. get_socket_opts(_,[], _, Acc) -> {ok, Acc}; @@ -2212,12 +2247,12 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State, _Timeout}) -> handle_alerts(Alerts, handle_alert(Alert, StateName, State)). handle_alert(#alert{level = ?FATAL} = Alert, StateName, - #state{start_or_recv_from = From, host = Host, port = Port, session = Session, - user_application = {_Mon, Pid}, + #state{socket = Socket, start_or_recv_from = From, host = Host, + port = Port, session = Session, user_application = {_Mon, Pid}, log_alert = Log, role = Role, socket_options = Opts} = State) -> invalidate_session(Role, Host, Port, Session), log_alert(Log, StateName, Alert), - alert_user(StateName, Opts, Pid, From, Alert, Role), + alert_user(Socket, StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, @@ -2244,28 +2279,28 @@ handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, Sta {Record, State} = next_record(State0), next_state(StateName, StateName, Record, State). -alert_user(connection, Opts, Pid, From, Alert, Role) -> - alert_user(Opts#socket_options.active, Pid, From, Alert, Role); -alert_user(_, _, _, From, Alert, Role) -> - alert_user(From, Alert, Role). +alert_user(Socket, connection, Opts, Pid, From, Alert, Role) -> + alert_user(Socket, Opts#socket_options.active, Pid, From, Alert, Role); +alert_user(Socket,_, _, _, From, Alert, Role) -> + alert_user(Socket, From, Alert, Role). -alert_user(From, Alert, Role) -> - alert_user(false, no_pid, From, Alert, Role). +alert_user(Socket, From, Alert, Role) -> + alert_user(Socket, false, no_pid, From, Alert, Role). -alert_user(false = Active, Pid, From, Alert, Role) -> +alert_user(_Socket, false = Active, Pid, From, Alert, Role) -> %% If there is an outstanding ssl_accept | recv %% From will be defined and send_or_reply will %% send the appropriate error message. ReasonCode = ssl_alert:reason_code(Alert, Role), send_or_reply(Active, Pid, From, {error, ReasonCode}); -alert_user(Active, Pid, From, Alert, Role) -> +alert_user(Socket, Active, Pid, From, Alert, Role) -> case ssl_alert:reason_code(Alert, Role) of closed -> send_or_reply(Active, Pid, From, - {ssl_closed, sslsocket()}); + {ssl_closed, sslsocket(self(), Socket)}); ReasonCode -> send_or_reply(Active, Pid, From, - {ssl_error, sslsocket(), ReasonCode}) + {ssl_error, sslsocket(self(), Socket), ReasonCode}) end. log_alert(true, Info, Alert) -> @@ -2294,13 +2329,16 @@ handle_own_alert(Alert, Version, StateName, ok end. -handle_normal_shutdown(Alert, _, #state{start_or_recv_from = StartFrom, role = Role, renegotiation = {false, first}}) -> - alert_user(StartFrom, Alert, Role); +handle_normal_shutdown(Alert, _, #state{socket = Socket, + start_or_recv_from = StartFrom, + role = Role, renegotiation = {false, first}}) -> + alert_user(Socket, StartFrom, Alert, Role); -handle_normal_shutdown(Alert, StateName, #state{socket_options = Opts, +handle_normal_shutdown(Alert, StateName, #state{socket = Socket, + socket_options = Opts, user_application = {_Mon, Pid}, start_or_recv_from = RecvFrom, role = Role}) -> - alert_user(StateName, Opts, Pid, RecvFrom, Alert, Role). + alert_user(Socket, StateName, Opts, Pid, RecvFrom, Alert, Role). handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index bb26302fff..fa1784714f 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -30,21 +30,21 @@ -include("ssl_internal.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([master_secret/4, client_hello/8, server_hello/4, hello/4, +-export([master_secret/4, client_hello/8, server_hello/5, hello/4, hello_request/0, certify/7, certificate/4, client_certificate_verify/6, certificate_verify/6, certificate_request/3, key_exchange/3, server_key_exchange_hash/2, finished/5, verify_connection/6, get_tls_handshake/3, decode_client_key/3, server_hello_done/0, encode_handshake/2, init_handshake_history/0, update_handshake_history/2, - decrypt_premaster_secret/2, prf/5]). + decrypt_premaster_secret/2, prf/5, next_protocol/1]). -export([dec_hello_extensions/2]). -type tls_handshake() :: #client_hello{} | #server_hello{} | #server_hello_done{} | #certificate{} | #certificate_request{} | #client_key_exchange{} | #finished{} | #certificate_verify{} | - #hello_request{}. + #hello_request{} | #next_protocol{}. %%==================================================================== %% Internal application API @@ -77,18 +77,31 @@ client_hello(Host, Port, ConnectionStates, cipher_suites = cipher_suites(Ciphers, Renegotiation), compression_methods = ssl_record:compressions(), random = SecParams#security_parameters.client_random, + renegotiation_info = renegotiation_info(client, ConnectionStates, Renegotiation), - hash_signs = default_hash_signs() + hash_signs = default_hash_signs(), + next_protocol_negotiation = + encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, Renegotiation) }. +encode_protocol(Protocol, Acc) -> + Len = byte_size(Protocol), + <<Acc/binary, ?BYTE(Len), Protocol/binary>>. + +encode_protocols_advertised_on_server(undefined) -> + undefined; + +encode_protocols_advertised_on_server(Protocols) -> + #next_protocol_negotiation{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}. + %%-------------------------------------------------------------------- -spec server_hello(session_id(), tls_version(), #connection_states{}, - boolean()) -> #server_hello{}. + boolean(), [binary()] | undefined) -> #server_hello{}. %% %% Description: Creates a server hello message. %%-------------------------------------------------------------------- -server_hello(SessionId, Version, ConnectionStates, Renegotiation) -> +server_hello(SessionId, Version, ConnectionStates, Renegotiation, ProtocolsAdvertisedOnServer) -> Pending = ssl_record:pending_connection_state(ConnectionStates, read), SecParams = Pending#connection_state.security_parameters, #server_hello{server_version = Version, @@ -98,7 +111,8 @@ server_hello(SessionId, Version, ConnectionStates, Renegotiation) -> random = SecParams#security_parameters.server_random, session_id = SessionId, renegotiation_info = - renegotiation_info(server, ConnectionStates, Renegotiation) + renegotiation_info(server, ConnectionStates, Renegotiation), + next_protocol_negotiation = encode_protocols_advertised_on_server(ProtocolsAdvertisedOnServer) }. %%-------------------------------------------------------------------- @@ -113,20 +127,21 @@ hello_request() -> %%-------------------------------------------------------------------- -spec hello(#server_hello{} | #client_hello{}, #ssl_options{}, #connection_states{} | {inet:port_number(), #session{}, db_handle(), - atom(), #connection_states{}, binary()}, - boolean()) -> {tls_version(), session_id(), #connection_states{}}| - {tls_version(), {resumed | new, #session{}}, - #connection_states{}} | #alert{}. + atom(), #connection_states{}, binary()}, + boolean()) -> + {tls_version(), session_id(), #connection_states{}, binary() | undefined}| + {tls_version(), {resumed | new, #session{}}, #connection_states{}, list(binary()) | undefined} | + #alert{}. %% %% Description: Handles a recieved hello message %%-------------------------------------------------------------------- hello(#server_hello{cipher_suite = CipherSuite, server_version = Version, compression_method = Compression, random = Random, session_id = SessionId, renegotiation_info = Info, - hash_signs = _HashSigns}, - #ssl_options{secure_renegotiate = SecureRenegotation}, + hash_signs = _HashSigns} = Hello, + #ssl_options{secure_renegotiate = SecureRenegotation, next_protocol_selector = NextProtocolSelector}, ConnectionStates0, Renegotiation) -> -%%TODO: select hash and signature algorigthm + %%TODO: select hash and signature algorigthm case ssl_record:is_acceptable_version(Version) of true -> case handle_renegotiation_info(client, Info, ConnectionStates0, @@ -135,7 +150,12 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version, ConnectionStates = hello_pending_connection_states(client, Version, CipherSuite, Random, Compression, ConnectionStates1), - {Version, SessionId, ConnectionStates}; + case handle_next_protocol(Hello, NextProtocolSelector, Renegotiation) of + #alert{} = Alert -> + Alert; + Protocol -> + {Version, SessionId, ConnectionStates, Protocol} + end; #alert{} = Alert -> Alert end; @@ -145,9 +165,8 @@ hello(#server_hello{cipher_suite = CipherSuite, server_version = Version, hello(#client_hello{client_version = ClientVersion, random = Random, cipher_suites = CipherSuites, - renegotiation_info = Info, - hash_signs = _HashSigns} = Hello, - #ssl_options{versions = Versions, + renegotiation_info = Info} = Hello, + #ssl_options{versions = Versions, secure_renegotiate = SecureRenegotation} = SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert}, Renegotiation) -> %% TODO: select hash and signature algorithm @@ -173,7 +192,12 @@ hello(#client_hello{client_version = ClientVersion, random = Random, Random, Compression, ConnectionStates1), - {Version, {Type, Session}, ConnectionStates}; + case handle_next_protocol_on_server(Hello, Renegotiation, SslOpts) of + #alert{} = Alert -> + Alert; + ProtocolsToAdvertise -> + {Version, {Type, Session}, ConnectionStates, ProtocolsToAdvertise} + end; #alert{} = Alert -> Alert end @@ -427,6 +451,11 @@ master_secret(Version, PremasterSecret, ConnectionStates, Role) -> ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) end. +-spec next_protocol(binary()) -> #next_protocol{}. + +next_protocol(SelectedProtocol) -> + #next_protocol{selected_protocol = SelectedProtocol}. + %%-------------------------------------------------------------------- -spec finished(tls_version(), client | server, integer(), binary(), tls_handshake_history()) -> #finished{}. @@ -660,6 +689,57 @@ renegotiation_info(server, ConnectionStates, true) -> #renegotiation_info{renegotiated_connection = undefined} end. +decode_next_protocols({next_protocol_negotiation, Protocols}) -> + decode_next_protocols(Protocols, []). +decode_next_protocols(<<>>, Acc) -> + lists:reverse(Acc); +decode_next_protocols(<<?BYTE(Len), Protocol:Len/binary, Rest/binary>>, Acc) -> + case Len of + 0 -> + {error, invalid_next_protocols}; + _ -> + decode_next_protocols(Rest, [Protocol|Acc]) + end; +decode_next_protocols(_Bytes, _Acc) -> + {error, invalid_next_protocols}. + +next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) -> + NextProtocolSelector =/= undefined andalso not Renegotiating. + +handle_next_protocol_on_server(#client_hello{next_protocol_negotiation = undefined}, _Renegotiation, _SslOpts) -> + undefined; + +handle_next_protocol_on_server(#client_hello{next_protocol_negotiation = {next_protocol_negotiation, <<>>}}, + false, #ssl_options{next_protocols_advertised = Protocols}) -> + Protocols; + +handle_next_protocol_on_server(_Hello, _Renegotiation, _SSLOpts) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE). % unexpected next protocol extension + +handle_next_protocol(#server_hello{next_protocol_negotiation = undefined}, + _NextProtocolSelector, _Renegotiating) -> + undefined; + +handle_next_protocol(#server_hello{next_protocol_negotiation = Protocols}, + NextProtocolSelector, Renegotiating) -> + + case next_protocol_extension_allowed(NextProtocolSelector, Renegotiating) of + true -> + select_next_protocol(decode_next_protocols(Protocols), NextProtocolSelector); + false -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE) % unexpected next protocol extension + end. + +select_next_protocol({error, _Reason}, _NextProtocolSelector) -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); +select_next_protocol(Protocols, NextProtocolSelector) -> + case NextProtocolSelector(Protocols) of + ?NO_PROTOCOL -> + ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE); + Protocol when is_binary(Protocol) -> + Protocol + end. + handle_renegotiation_info(_, #renegotiation_info{renegotiated_connection = ?byte(0)}, ConnectionStates, false, _, _) -> {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)}; @@ -816,17 +896,21 @@ master_secret(Version, MasterSecret, #security_parameters{ ServerCipherState, Role)}. -dec_hs(_Version, ?HELLO_REQUEST, <<>>) -> +dec_hs(_, ?NEXT_PROTOCOL, <<?BYTE(SelectedProtocolLength), SelectedProtocol:SelectedProtocolLength/binary, + ?BYTE(PaddingLength), _Padding:PaddingLength/binary>>) -> + #next_protocol{selected_protocol = SelectedProtocol}; + +dec_hs(_, ?HELLO_REQUEST, <<>>) -> #hello_request{}; %% Client hello v2. %% The server must be able to receive such messages, from clients that %% are willing to use ssl v3 or higher, but have ssl v2 compatibility. dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), - ?UINT16(CSLength), ?UINT16(0), - ?UINT16(CDLength), - CipherSuites:CSLength/binary, - ChallengeData:CDLength/binary>>) -> + ?UINT16(CSLength), ?UINT16(0), + ?UINT16(CDLength), + CipherSuites:CSLength/binary, + ChallengeData:CDLength/binary>>) -> #client_hello{client_version = {Major, Minor}, random = ssl_ssl2:client_random(ChallengeData, CDLength), session_id = 0, @@ -839,20 +923,22 @@ dec_hs(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?UINT16(Cs_length), CipherSuites:Cs_length/binary, ?BYTE(Cm_length), Comp_methods:Cm_length/binary, Extensions/binary>>) -> - HelloExtensions = dec_hello_extensions(Extensions), - RenegotiationInfo = proplists:get_value(renegotiation_info, HelloExtensions, - undefined), - HashSigns = proplists:get_value(hash_signs, HelloExtensions, - undefined), + + DecodedExtensions = dec_hello_extensions(Extensions), + RenegotiationInfo = proplists:get_value(renegotiation_info, DecodedExtensions, undefined), + HashSigns = proplists:get_value(hash_signs, DecodedExtensions, undefined), + NextProtocolNegotiation = proplists:get_value(next_protocol_negotiation, DecodedExtensions, undefined), + #client_hello{ - client_version = {Major,Minor}, - random = Random, - session_id = Session_ID, - cipher_suites = from_2bytes(CipherSuites), - compression_methods = Comp_methods, - renegotiation_info = RenegotiationInfo, - hash_signs = HashSigns - }; + client_version = {Major,Minor}, + random = Random, + session_id = Session_ID, + cipher_suites = from_2bytes(CipherSuites), + compression_methods = Comp_methods, + renegotiation_info = RenegotiationInfo, + hash_signs = HashSigns, + next_protocol_negotiation = NextProtocolNegotiation + }; dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, @@ -868,7 +954,7 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, - Cipher_suite:2/binary, ?BYTE(Comp_method), + Cipher_suite:2/binary, ?BYTE(Comp_method), ?UINT16(ExtLen), Extensions:ExtLen/binary>>) -> HelloExtensions = dec_hello_extensions(Extensions, []), @@ -876,6 +962,8 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, undefined), HashSigns = proplists:get_value(hash_signs, HelloExtensions, undefined), + NextProtocolNegotiation = proplists:get_value(next_protocol_negotiation, HelloExtensions, undefined), + #server_hello{ server_version = {Major,Minor}, random = Random, @@ -883,7 +971,8 @@ dec_hs(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, cipher_suite = Cipher_suite, compression_method = Comp_method, renegotiation_info = RenegotiationInfo, - hash_signs = HashSigns}; + hash_signs = HashSigns, + next_protocol_negotiation = NextProtocolNegotiation}; dec_hs(_Version, ?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) -> #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; @@ -959,6 +1048,9 @@ dec_hello_extensions(_) -> dec_hello_extensions(<<>>, Acc) -> Acc; +dec_hello_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) -> + Prop = {next_protocol_negotiation, #next_protocol_negotiation{extension_data = ExtensionData}}, + dec_hello_extensions(Rest, [Prop | Acc]); dec_hello_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info:Len/binary, Rest/binary>>, Acc) -> RenegotiateInfo = case Len of 1 -> % Initial handshake @@ -982,6 +1074,7 @@ dec_hello_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), %% Ignore data following the ClientHello (i.e., %% extensions) if not understood. + dec_hello_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len/binary, Rest/binary>>, Acc) -> dec_hello_extensions(Rest, Acc); %% This theoretically should not happen if the protocol is followed, but if it does it is ignored. @@ -1014,6 +1107,11 @@ certs_from_list(ACList) -> <<?UINT24(CertLen), Cert/binary>> end || Cert <- ACList]). +enc_hs(#next_protocol{selected_protocol = SelectedProtocol}, _Version) -> + PaddingLength = 32 - ((byte_size(SelectedProtocol) + 2) rem 32), + + {?NEXT_PROTOCOL, <<?BYTE((byte_size(SelectedProtocol))), SelectedProtocol/binary, + ?BYTE(PaddingLength), 0:(PaddingLength * 8)>>}; enc_hs(#hello_request{}, _Version) -> {?HELLO_REQUEST, <<>>}; enc_hs(#client_hello{client_version = {Major, Minor}, @@ -1022,19 +1120,21 @@ enc_hs(#client_hello{client_version = {Major, Minor}, cipher_suites = CipherSuites, compression_methods = CompMethods, renegotiation_info = RenegotiationInfo, - hash_signs = HashSigns}, _Version) -> + hash_signs = HashSigns, + next_protocol_negotiation = NextProtocolNegotiation}, _Version) -> SIDLength = byte_size(SessionID), BinCompMethods = list_to_binary(CompMethods), CmLength = byte_size(BinCompMethods), BinCipherSuites = list_to_binary(CipherSuites), CsLength = byte_size(BinCipherSuites), - Extensions0 = hello_extensions(RenegotiationInfo), + Extensions0 = hello_extensions(RenegotiationInfo, NextProtocolNegotiation), Extensions1 = if Major == 3, Minor >=3 -> Extensions0 ++ hello_extensions(HashSigns); true -> Extensions0 end, ExtensionsBin = enc_hello_extensions(Extensions1), - {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, + + {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SIDLength), SessionID/binary, ?UINT16(CsLength), BinCipherSuites/binary, ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>}; @@ -1044,9 +1144,10 @@ enc_hs(#server_hello{server_version = {Major, Minor}, session_id = Session_ID, cipher_suite = Cipher_suite, compression_method = Comp_method, - renegotiation_info = RenegotiationInfo}, _Version) -> + renegotiation_info = RenegotiationInfo, + next_protocol_negotiation = NextProtocolNegotiation}, _Version) -> SID_length = byte_size(Session_ID), - Extensions = hello_extensions(RenegotiationInfo), + Extensions = hello_extensions(RenegotiationInfo, NextProtocolNegotiation), ExtensionsBin = enc_hello_extensions(Extensions), {?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID/binary, @@ -1119,8 +1220,9 @@ enc_sign(_HashSign, Sign, _Version) -> SignLen = byte_size(Sign), <<?UINT16(SignLen), Sign/binary>>. -hello_extensions(undefined) -> - []; +hello_extensions(RenegotiationInfo, NextProtocolNegotiation) -> + hello_extensions(RenegotiationInfo) ++ next_protocol_extension(NextProtocolNegotiation). + %% Renegotiation info hello_extensions(#renegotiation_info{renegotiated_connection = undefined}) -> []; @@ -1129,6 +1231,11 @@ hello_extensions(#renegotiation_info{} = Info) -> hello_extensions(#hash_sign_algos{} = Info) -> [Info]. +next_protocol_extension(undefined) -> + []; +next_protocol_extension(#next_protocol_negotiation{} = Info) -> + [Info]. + enc_hello_extensions(Extensions) -> enc_hello_extensions(Extensions, <<>>). enc_hello_extensions([], <<>>) -> @@ -1137,6 +1244,9 @@ enc_hello_extensions([], Acc) -> Size = byte_size(Acc), <<?UINT16(Size), Acc/binary>>; +enc_hello_extensions([#next_protocol_negotiation{extension_data = ExtensionData} | Rest], Acc) -> + Len = byte_size(ExtensionData), + enc_hello_extensions(Rest, <<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData/binary, Acc/binary>>); enc_hello_extensions([#renegotiation_info{renegotiated_connection = ?byte(0) = Info} | Rest], Acc) -> Len = byte_size(Info), enc_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info/binary, Acc/binary>>); @@ -1151,8 +1261,15 @@ enc_hello_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Rest], {Hash, Sign} <- HashSignAlgos >>, ListLen = byte_size(SignAlgoList), Len = ListLen + 2, - enc_hello_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), ?UINT16(ListLen), SignAlgoList/binary, Acc/binary>>). - + enc_hello_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT), + ?UINT16(Len), ?UINT16(ListLen), SignAlgoList/binary, Acc/binary>>). + +encode_client_protocol_negotiation(undefined, _) -> + undefined; +encode_client_protocol_negotiation(_, false) -> + #next_protocol_negotiation{extension_data = <<>>}; +encode_client_protocol_negotiation(_, _) -> + undefined. from_3bytes(Bin3) -> from_3bytes(Bin3, []). diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index cc17dc2975..9af6511d68 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -33,6 +33,8 @@ -type public_key_info() :: {algo_oid(), #'RSAPublicKey'{} | integer() , public_key_params()}. -type tls_handshake_history() :: {[binary()], [binary()]}. +-define(NO_PROTOCOL, <<>>). + %% Signature algorithms -define(ANON, 0). -define(RSA, 1). @@ -97,7 +99,8 @@ cipher_suites, % cipher_suites<2..2^16-1> compression_methods, % compression_methods<1..2^8-1>, renegotiation_info, - hash_signs % supported combinations of hashes/signature algos + hash_signs, % supported combinations of hashes/signature algos + next_protocol_negotiation = undefined % [binary()] }). -record(server_hello, { @@ -107,7 +110,8 @@ cipher_suite, % cipher_suites compression_method, % compression_method renegotiation_info, - hash_signs % supported combinations of hashes/signature algos + hash_signs, % supported combinations of hashes/signature algos + next_protocol_negotiation = undefined % [binary()] }). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -234,6 +238,18 @@ hash_sign_algos }). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Next Protocol Negotiation +%% (http://tools.ietf.org/html/draft-agl-tls-nextprotoneg-02) +%% (http://technotes.googlecode.com/git/nextprotoneg.html) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(NEXTPROTONEG_EXT, 13172). +-define(NEXT_PROTOCOL, 67). +-record(next_protocol_negotiation, {extension_data}). + +-record(next_protocol, {selected_protocol}). + -endif. % -ifdef(ssl_handshake). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index b8f2ae3b51..a5db2dcee7 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -106,7 +106,9 @@ % after which ssl_connection will % go into hibernation %% This option should only be set to true by inet_tls_dist - erl_dist = false + erl_dist = false, + next_protocols_advertised = undefined, %% [binary()], + next_protocol_selector = undefined %% fun([binary()]) -> binary()) }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index af2bfa394d..0cf4f2ce33 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -191,7 +191,7 @@ init([Name, Opts]) -> proplists:get_value(session_lifetime, Opts, ?'24H_in_sec'), CertDb = ssl_certificate_db:create(), SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])), - Timer = erlang:send_after(SessionLifeTime * 1000, + Timer = erlang:send_after(SessionLifeTime * 1000 + 5000, self(), validate_sessions), erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache), {ok, #state{certificate_db = CertDb, diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 343157b22e..d36dcb588b 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -44,6 +44,8 @@ MODULES = \ ssl_to_openssl_SUITE \ ssl_session_cache_SUITE \ ssl_dist_SUITE \ + ssl_npn_hello_SUITE \ + ssl_npn_handshake_SUITE \ make_certs\ erl_make_certs diff --git a/lib/ssl/test/make_certs.erl b/lib/ssl/test/make_certs.erl index 693289990c..4603a9f846 100644 --- a/lib/ssl/test/make_certs.erl +++ b/lib/ssl/test/make_certs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -121,7 +121,19 @@ create_self_signed_cert(Root, OpenSSLCmd, CAName, Cnf) -> " -keyout ", KeyFile, " -out ", CertFile], Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env). + cmd(Cmd, Env), + fix_key_file(OpenSSLCmd, KeyFile). + +% openssl 1.0 generates key files in pkcs8 format by default and we don't handle this format +fix_key_file(OpenSSLCmd, KeyFile) -> + KeyFileTmp = KeyFile ++ ".tmp", + Cmd = [OpenSSLCmd, " rsa", + " -in ", + KeyFile, + " -out ", + KeyFileTmp], + cmd(Cmd, []), + ok = file:rename(KeyFileTmp, KeyFile). create_ca_dir(Root, CAName, Cnf) -> CARoot = filename:join([Root, CAName]), @@ -139,7 +151,8 @@ create_req(Root, OpenSSLCmd, CnfFile, KeyFile, ReqFile) -> " -keyout ", KeyFile, " -out ", ReqFile], Env = [{"ROOTDIR", Root}], - cmd(Cmd, Env). + cmd(Cmd, Env), + fix_key_file(OpenSSLCmd, KeyFile). sign_req(Root, OpenSSLCmd, CA, CertType, ReqFile, CertFile) -> CACnfFile = filename:join([Root, CA, "ca.cnf"]), diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 93f7209aea..a202aca943 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -39,6 +39,7 @@ -define(EXPIRE, 10). -define(SLEEP, 500). -define(RENEGOTIATION_DISABLE_TIME, 12000). +-define(CLEAN_SESSION_DB, 60000). %% Test server callback functions %%-------------------------------------------------------------------- @@ -108,12 +109,12 @@ init_per_testcase(protocol_versions, Config) -> init_per_testcase(reuse_session_expired, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), - Dog = ssl_test_lib:timetrap(?EXPIRE * 1000 * 5), ssl:stop(), application:load(ssl), application:set_env(ssl, session_lifetime, ?EXPIRE), + application:set_env(ssl, session_delay_cleanup_time, 500), ssl:start(), - [{watchdog, Dog} | Config]; + Config; init_per_testcase(empty_protocol_versions, Config) -> ssl:stop(), @@ -141,6 +142,7 @@ init_per_testcase(_TestCase, Config0) -> %%-------------------------------------------------------------------- end_per_testcase(reuse_session_expired, Config) -> application:unset_env(ssl, session_lifetime), + application:unset_env(ssl, session_delay_cleanup_time), end_per_testcase(default_action, Config); end_per_testcase(_TestCase, Config) -> @@ -255,7 +257,8 @@ api_tests() -> shutdown_write, shutdown_both, shutdown_error, - hibernate + hibernate, + listen_socket ]. certificate_verify_tests() -> @@ -2089,13 +2092,14 @@ reuse_session_expired(Config) when is_list(Config) -> %% Make sure session is unregistered due to expiration test_server:sleep((?EXPIRE+1)), [{session_id, Id} |_] = SessionInfo, + make_sure_expired(Hostname, Port, Id), Client2 = ssl_test_lib:start_client([{node, ClientNode}, - {port, Port}, {host, Hostname}, + {port, Port}, {host, Hostname}, {mfa, {ssl_test_lib, session_info_result, []}}, - {from, self()}, {options, ClientOpts}]), + {from, self()}, {options, ClientOpts}]), receive {Client2, SessionInfo} -> test_server:fail(session_reused_when_session_expired); @@ -2113,16 +2117,16 @@ make_sure_expired(Host, Port, Id) -> [_, _,_, _, Prop] = StatusInfo, State = ssl_test_lib:state(Prop), Cache = element(2, State), - case ssl_session_cache:lookup(Cache, {{Host, Port}, Id}) of + + case ssl_session_cache:lookup(Cache, {{Host, Port}, Id}) of undefined -> - ok; + ok; #session{is_resumable = false} -> - ok; + ok; _ -> test_server:sleep(?SLEEP), make_sure_expired(Host, Port, Id) - end. - + end. %%-------------------------------------------------------------------- server_does_not_want_to_reuse_session(doc) -> @@ -3774,6 +3778,35 @@ hibernate(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +listen_socket(doc) -> + ["Check error handling and inet compliance when calling API functions with listen sockets."]; + +listen_socket(suite) -> + []; + +listen_socket(Config) -> + ServerOpts = ?config(server_opts, Config), + {ok, ListenSocket} = ssl:listen(0, ServerOpts), + + %% This can be a valid thing to do as + %% options are inherited by the accept socket + ok = ssl:controlling_process(ListenSocket, self()), + + {ok, _} = ssl:sockname(ListenSocket), + + {error, enotconn} = ssl:send(ListenSocket, <<"data">>), + {error, enotconn} = ssl:recv(ListenSocket, 0), + {error, enotconn} = ssl:connection_info(ListenSocket), + {error, enotconn} = ssl:peername(ListenSocket), + {error, enotconn} = ssl:peercert(ListenSocket), + {error, enotconn} = ssl:session_info(ListenSocket), + {error, enotconn} = ssl:renegotiate(ListenSocket), + {error, enotconn} = ssl:prf(ListenSocket, 'master_secret', <<"Label">>, client_random, 256), + {error, enotconn} = ssl:shutdown(ListenSocket, read_write), + + ok = ssl:close(ListenSocket). + +%%-------------------------------------------------------------------- connect_twice(doc) -> [""]; diff --git a/lib/ssl/test/ssl_npn_handshake_SUITE.erl b/lib/ssl/test/ssl_npn_handshake_SUITE.erl new file mode 100644 index 0000000000..8597aa6740 --- /dev/null +++ b/lib/ssl/test/ssl_npn_handshake_SUITE.erl @@ -0,0 +1,310 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(ssl_npn_handshake_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). +-include_lib("common_test/include/ct.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [{group, 'tlsv1.2'}, + {group, 'tlsv1.1'}, + {group, 'tlsv1'}, + {group, 'sslv3'}]. + +groups() -> + [ + {'tlsv1.2', [], next_protocol_tests()}, + {'tlsv1.1', [], next_protocol_tests()}, + {'tlsv1', [], next_protocol_tests()}, + {'sslv3', [], next_protocol_not_supported()} + ]. + +next_protocol_tests() -> + [validate_empty_protocols_are_not_allowed, + validate_empty_advertisement_list_is_allowed, + validate_advertisement_must_be_a_binary_list, + validate_client_protocols_must_be_a_tuple, + normal_npn_handshake_server_preference, + normal_npn_handshake_client_preference, + fallback_npn_handshake, + fallback_npn_handshake_server_preference, + client_negotiate_server_does_not_support, + no_client_negotiate_but_server_supports_npn, + renegotiate_from_client_after_npn_handshake + ]. + +next_protocol_not_supported() -> + [npn_not_supported_client, + npn_not_supported_server + ]. + +init_per_suite(Config) -> + catch crypto:stop(), + try crypto:start() of + ok -> + application:start(public_key), + ssl:start(), + Result = + (catch make_certs:all(?config(data_dir, Config), + ?config(priv_dir, Config))), + test_server:format("Make certs ~p~n", [Result]), + ssl_test_lib:cert_options(Config) + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + ssl:stop(), + application:stop(crypto). + + +init_per_group(GroupName, Config) -> + case ssl_test_lib:is_tls_version(GroupName) of + true -> + case ssl_test_lib:sufficient_crypto_support(GroupName) of + true -> + ssl_test_lib:init_tls_version(GroupName), + Config; + false -> + {skip, "Missing crypto support"} + end; + _ -> + ssl:start(), + Config + end. + + +end_per_group(_GroupName, Config) -> + Config. + + +%% Test cases starts here. +%%-------------------------------------------------------------------- + +validate_empty_protocols_are_not_allowed(Config) when is_list(Config) -> + {error, {eoptions, {next_protocols_advertised, {invalid_protocol, <<>>}}}} + = (catch ssl:listen(9443, + [{next_protocols_advertised, [<<"foo/1">>, <<"">>]}])), + {error, {eoptions, {client_preferred_next_protocols, {invalid_protocol, <<>>}}}} + = (catch ssl:connect({127,0,0,1}, 9443, + [{client_preferred_next_protocols, + {client, [<<"foo/1">>, <<"">>], <<"foox/1">>}}], infinity)), + Option = {client_preferred_next_protocols, {invalid_protocol, <<"">>}}, + {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option], infinity)). + +%-------------------------------------------------------------------------------- + +validate_empty_advertisement_list_is_allowed(Config) when is_list(Config) -> + Option = {next_protocols_advertised, []}, + {ok, Socket} = ssl:listen(0, [Option]), + ssl:close(Socket). +%-------------------------------------------------------------------------------- + +validate_advertisement_must_be_a_binary_list(Config) when is_list(Config) -> + Option = {next_protocols_advertised, blah}, + {error, {eoptions, Option}} = (catch ssl:listen(9443, [Option])). +%-------------------------------------------------------------------------------- + +validate_client_protocols_must_be_a_tuple(Config) when is_list(Config) -> + Option = {client_preferred_next_protocols, [<<"foo/1">>]}, + {error, {eoptions, Option}} = (catch ssl:connect({127,0,0,1}, 9443, [Option])). + +%-------------------------------------------------------------------------------- + +normal_npn_handshake_server_preference(Config) when is_list(Config) -> + run_npn_handshake(Config, + [{client_preferred_next_protocols, + {server, [<<"http/1.0">>, <<"http/1.1">>], <<"http/1.1">>}}], + [{next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). +%-------------------------------------------------------------------------------- + +normal_npn_handshake_client_preference(Config) when is_list(Config) -> + run_npn_handshake(Config, + [{client_preferred_next_protocols, + {client, [<<"http/1.0">>, <<"http/1.1">>], <<"http/1.1">>}}], + [{next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.0">>}). + +%-------------------------------------------------------------------------------- + +fallback_npn_handshake(Config) when is_list(Config) -> + run_npn_handshake(Config, + [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}], + [{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). +%-------------------------------------------------------------------------------- + +fallback_npn_handshake_server_preference(Config) when is_list(Config) -> + run_npn_handshake(Config, + [{client_preferred_next_protocols, {server, [<<"spdy/2">>], <<"http/1.1">>}}], + [{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}], + {ok, <<"http/1.1">>}). + +%-------------------------------------------------------------------------------- + +no_client_negotiate_but_server_supports_npn(Config) when is_list(Config) -> + run_npn_handshake(Config, + [], + [{next_protocols_advertised, [<<"spdy/1">>, <<"http/1.1">>, <<"http/1.0">>]}], + {error, next_protocol_not_negotiated}). +%-------------------------------------------------------------------------------- + + +client_negotiate_server_does_not_support(Config) when is_list(Config) -> + run_npn_handshake(Config, + [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}], + [], + {error, next_protocol_not_negotiated}). + +%-------------------------------------------------------------------------------- +renegotiate_from_client_after_npn_handshake(Config) when is_list(Config) -> + Data = "hello world", + + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{client_preferred_next_protocols, + {client, [<<"http/1.0">>], <<"http/1.1">>}}] ++ ClientOpts0, + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{next_protocols_advertised, + [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}] ++ ServerOpts0, + ExpectedProtocol = {ok, <<"http/1.0">>}, + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, ssl_receive_and_assert_npn, [ExpectedProtocol, Data]}}, + {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, assert_npn_and_renegotiate_and_send_data, [ExpectedProtocol, Data]}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + +%-------------------------------------------------------------------------------- +npn_not_supported_client(Config) when is_list(Config) -> + ClientOpts0 = ?config(client_opts, Config), + PrefProtocols = {client_preferred_next_protocols, + {client, [<<"http/1.0">>], <<"http/1.1">>}}, + ClientOpts = [PrefProtocols] ++ ClientOpts0, + {ClientNode, _ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, + {port, 8888}, {host, Hostname}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:check_result(Client, {error, + {eoptions, + {not_supported_in_sslv3, PrefProtocols}}}). + +%-------------------------------------------------------------------------------- +npn_not_supported_server(Config) when is_list(Config)-> + ServerOpts0 = ?config(server_opts, Config), + AdvProtocols = {next_protocols_advertised, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}, + ServerOpts = [AdvProtocols] ++ ServerOpts0, + + {error, {eoptions, {not_supported_in_sslv3, AdvProtocols}}} = ssl:listen(0, ServerOpts). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- + +run_npn_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) -> + Data = "hello world", + + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = ClientExtraOpts ++ ClientOpts0, + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = ServerExtraOpts ++ ServerOpts0, + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, ssl_receive_and_assert_npn, [ExpectedProtocol, Data]}}, + {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, ssl_send_and_assert_npn, [ExpectedProtocol, Data]}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok). + + +assert_npn(Socket, Protocol) -> + test_server:format("Negotiated Protocol ~p, Expecting: ~p ~n", + [ssl:negotiated_next_protocol(Socket), Protocol]), + Protocol = ssl:negotiated_next_protocol(Socket). + +assert_npn_and_renegotiate_and_send_data(Socket, Protocol, Data) -> + assert_npn(Socket, Protocol), + test_server:format("Renegotiating ~n", []), + ok = ssl:renegotiate(Socket), + ssl:send(Socket, Data), + assert_npn(Socket, Protocol), + ok. + +ssl_send_and_assert_npn(Socket, Protocol, Data) -> + assert_npn(Socket, Protocol), + ssl_send(Socket, Data). + +ssl_receive_and_assert_npn(Socket, Protocol, Data) -> + assert_npn(Socket, Protocol), + ssl_receive(Socket, Data). + +ssl_send(Socket, Data) -> + test_server:format("Connection info: ~p~n", + [ssl:connection_info(Socket)]), + ssl:send(Socket, Data). + +ssl_receive(Socket, Data) -> + ssl_receive(Socket, Data, []). + +ssl_receive(Socket, Data, Buffer) -> + test_server:format("Connection info: ~p~n", + [ssl:connection_info(Socket)]), + receive + {ssl, Socket, MoreData} -> + test_server:format("Received ~p~n",[MoreData]), + NewBuffer = Buffer ++ MoreData, + case NewBuffer of + Data -> + ssl:send(Socket, "Got it"), + ok; + _ -> + ssl_receive(Socket, Data, NewBuffer) + end; + Other -> + test_server:fail({unexpected_message, Other}) + after 4000 -> + test_server:fail({did_not_get, Data}) + end. + + +connection_info_result(Socket) -> + ssl:connection_info(Socket). diff --git a/lib/ssl/test/ssl_npn_hello_SUITE.erl b/lib/ssl/test/ssl_npn_hello_SUITE.erl new file mode 100644 index 0000000000..5102c74e87 --- /dev/null +++ b/lib/ssl/test/ssl_npn_hello_SUITE.erl @@ -0,0 +1,117 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssl_npn_hello_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). +-include("ssl_handshake.hrl"). +-include("ssl_record.hrl"). +-include_lib("common_test/include/ct.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [encode_and_decode_npn_client_hello_test, + encode_and_decode_npn_server_hello_test, + encode_and_decode_client_hello_test, + encode_and_decode_server_hello_test, + create_server_hello_with_advertised_protocols_test, + create_server_hello_with_no_advertised_protocols_test]. + + +create_client_handshake(Npn) -> + ssl_handshake:encode_handshake(#client_hello{ + client_version = {1, 2}, + random = <<1:256>>, + session_id = <<>>, + cipher_suites = "", + compression_methods = "", + next_protocol_negotiation = Npn, + renegotiation_info = #renegotiation_info{} + }, vsn). + + +encode_and_decode_client_hello_test(_Config) -> + HandShakeData = create_client_handshake(undefined), + Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + {[{DecodedHandshakeMessage, _Raw}], _} = ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation, + NextProtocolNegotiation = undefined. + +encode_and_decode_npn_client_hello_test(_Config) -> + HandShakeData = create_client_handshake(#next_protocol_negotiation{extension_data = <<>>}), + Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + {[{DecodedHandshakeMessage, _Raw}], _} = ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + NextProtocolNegotiation = DecodedHandshakeMessage#client_hello.next_protocol_negotiation, + NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<>>}. + +create_server_handshake(Npn) -> + ssl_handshake:encode_handshake(#server_hello{ + server_version = {1, 2}, + random = <<1:256>>, + session_id = <<>>, + cipher_suite = <<1,2>>, + compression_method = 1, + next_protocol_negotiation = Npn, + renegotiation_info = #renegotiation_info{} + }, vsn). + +encode_and_decode_server_hello_test(_Config) -> + HandShakeData = create_server_handshake(undefined), + Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + {[{DecodedHandshakeMessage, _Raw}], _} = + ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation, + NextProtocolNegotiation = undefined. + +encode_and_decode_npn_server_hello_test(_Config) -> + HandShakeData = create_server_handshake(#next_protocol_negotiation{extension_data = <<6, "spdy/2">>}), + Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + {[{DecodedHandshakeMessage, _Raw}], _} = ssl_handshake:get_tls_handshake(Version, list_to_binary(HandShakeData), <<>>), + NextProtocolNegotiation = DecodedHandshakeMessage#server_hello.next_protocol_negotiation, + ct:print("~p ~n", [NextProtocolNegotiation]), + NextProtocolNegotiation = #next_protocol_negotiation{extension_data = <<6, "spdy/2">>}. + +create_connection_states() -> + #connection_states{ + pending_read = #connection_state{ + security_parameters = #security_parameters{ + server_random = <<1:256>>, + compression_algorithm = 1, + cipher_suite = <<1, 2>> + } + }, + + current_read = #connection_state { + secure_renegotiation = false + } + }. + +create_server_hello_with_no_advertised_protocols_test(_Config) -> + Hello = ssl_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), false, undefined), + undefined = Hello#server_hello.next_protocol_negotiation. + +create_server_hello_with_advertised_protocols_test(_Config) -> + Hello = ssl_handshake:server_hello(<<>>, {3, 0}, create_connection_states(), + false, [<<"spdy/1">>, <<"http/1.0">>, <<"http/1.1">>]), + #next_protocol_negotiation{extension_data = <<6, "spdy/1", 8, "http/1.0", 8, "http/1.1">>} = + Hello#server_hello.next_protocol_negotiation. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index d446014f7b..98ef050b14 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -29,7 +29,7 @@ -define(TIMEOUT, 120000). -define(LONG_TIMEOUT, 600000). -define(SLEEP, 1000). --define(OPENSSL_RENEGOTIATE, "r\n"). +-define(OPENSSL_RENEGOTIATE, "R\n"). -define(OPENSSL_QUIT, "Q\n"). -define(OPENSSL_GARBAGE, "P\n"). -define(EXPIRE, 10). @@ -114,6 +114,17 @@ special_init(TestCase, Config) special_init(ssl2_erlang_server_openssl_client, Config) -> check_sane_openssl_sslv2(Config); +special_init(TestCase, Config) + when TestCase == erlang_client_openssl_server_npn; + TestCase == erlang_server_openssl_client_npn; + TestCase == erlang_server_openssl_client_npn_renegotiate; + TestCase == erlang_client_openssl_server_npn_renegotiate; + TestCase == erlang_server_openssl_client_npn_only_server; + TestCase == erlang_server_openssl_client_npn_only_client; + TestCase == erlang_client_openssl_server_npn_only_client; + TestCase == erlang_client_openssl_server_npn_only_server -> + check_openssl_npn_support(Config); + special_init(_, Config) -> Config. @@ -161,9 +172,9 @@ all() -> groups() -> [{basic, [], basic_tests()}, - {'tlsv1.2', [], all_versions_tests()}, - {'tlsv1.1', [], all_versions_tests()}, - {'tlsv1', [], all_versions_tests()}, + {'tlsv1.2', [], all_versions_tests() ++ npn_tests()}, + {'tlsv1.1', [], all_versions_tests() ++ npn_tests()}, + {'tlsv1', [], all_versions_tests()++ npn_tests()}, {'sslv3', [], all_versions_tests()}]. basic_tests() -> @@ -179,16 +190,26 @@ all_versions_tests() -> erlang_server_openssl_client_dsa_cert, erlang_server_openssl_client_reuse_session, erlang_client_openssl_server_renegotiate, - erlang_client_openssl_server_no_wrap_sequence_number, - erlang_server_openssl_client_no_wrap_sequence_number, + erlang_client_openssl_server_nowrap_seqnum, + erlang_server_openssl_client_nowrap_seqnum, erlang_client_openssl_server_no_server_ca_cert, erlang_client_openssl_server_client_cert, erlang_server_openssl_client_client_cert, ciphers_rsa_signed_certs, ciphers_dsa_signed_certs, erlang_client_bad_openssl_server, - ssl2_erlang_server_openssl_client - ]. + expired_session, + ssl2_erlang_server_openssl_client]. + +npn_tests() -> + [erlang_client_openssl_server_npn, + erlang_server_openssl_client_npn, + erlang_server_openssl_client_npn_renegotiate, + erlang_client_openssl_server_npn_renegotiate, + erlang_server_openssl_client_npn_only_client, + erlang_server_openssl_client_npn_only_server, + erlang_client_openssl_server_npn_only_client, + erlang_client_openssl_server_npn_only_server]. init_per_group(GroupName, Config) -> case ssl_test_lib:is_tls_version(GroupName) of @@ -544,14 +565,14 @@ erlang_client_openssl_server_renegotiate(Config) when is_list(Config) -> %%-------------------------------------------------------------------- -erlang_client_openssl_server_no_wrap_sequence_number(doc) -> +erlang_client_openssl_server_nowrap_seqnum(doc) -> ["Test that erlang client will renegotiate session when", "max sequence number celing is about to be reached. Although" "in the testcase we use the test option renegotiate_at" " to lower treashold substantially."]; -erlang_client_openssl_server_no_wrap_sequence_number(suite) -> +erlang_client_openssl_server_nowrap_seqnum(suite) -> []; -erlang_client_openssl_server_no_wrap_sequence_number(Config) when is_list(Config) -> +erlang_client_openssl_server_nowrap_seqnum(Config) when is_list(Config) -> process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), ClientOpts = ?config(client_opts, Config), @@ -590,15 +611,15 @@ erlang_client_openssl_server_no_wrap_sequence_number(Config) when is_list(Config process_flag(trap_exit, false), ok. %%-------------------------------------------------------------------- -erlang_server_openssl_client_no_wrap_sequence_number(doc) -> +erlang_server_openssl_client_nowrap_seqnum(doc) -> ["Test that erlang client will renegotiate session when", "max sequence number celing is about to be reached. Although" "in the testcase we use the test option renegotiate_at" " to lower treashold substantially."]; -erlang_server_openssl_client_no_wrap_sequence_number(suite) -> +erlang_server_openssl_client_nowrap_seqnum(suite) -> []; -erlang_server_openssl_client_no_wrap_sequence_number(Config) when is_list(Config) -> +erlang_server_openssl_client_nowrap_seqnum(Config) when is_list(Config) -> process_flag(trap_exit, true), ServerOpts = ?config(server_opts, Config), @@ -1069,6 +1090,248 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ok. %%-------------------------------------------------------------------- +erlang_client_openssl_server_npn(doc) -> + ["Test erlang client with openssl server doing npn negotiation"]; +erlang_client_openssl_server_npn(suite) -> + []; +erlang_client_openssl_server_npn(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, fun(Client, OpensslPort) -> + port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok) + end), + + ok. + + +%%-------------------------------------------------------------------- +erlang_client_openssl_server_npn_renegotiate(doc) -> + ["Test erlang client with openssl server doing npn negotiation and renegotiate"]; +erlang_client_openssl_server_npn_renegotiate(suite) -> + []; +erlang_client_openssl_server_npn_renegotiate(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, fun(Client, OpensslPort) -> + port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + test_server:sleep(?SLEEP), + port_command(OpensslPort, Data), + ssl_test_lib:check_result(Client, ok) + end), + ok. + + +%%-------------------------------------------------------------------------- + + +erlang_server_openssl_client_npn(doc) -> + ["Test erlang server with openssl client and npn negotiation"]; +erlang_server_openssl_client_npn(suite) -> + []; +erlang_server_openssl_client_npn(Config) when is_list(Config) -> + + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, fun(Server, OpensslPort) -> + port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_server_openssl_client_npn_renegotiate(doc) -> + ["Test erlang server with openssl client and npn negotiation with renegotiation"]; +erlang_server_openssl_client_npn_renegotiate(suite) -> + []; +erlang_server_openssl_client_npn_renegotiate(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, fun(Server, OpensslPort) -> + port_command(OpensslPort, ?OPENSSL_RENEGOTIATE), + test_server:sleep(?SLEEP), + port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. +%%-------------------------------------------------------------------------- + +erlang_client_openssl_server_npn_only_server(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_with_opts(Config, [], "-nextprotoneg spdy/2", Data, fun(Server, OpensslPort) -> + port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +erlang_client_openssl_server_npn_only_client(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_client_and_openssl_server_with_opts(Config, [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}}], "", Data, fun(Server, OpensslPort) -> + port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- +erlang_server_openssl_client_npn_only_server(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_with_opts(Config, [{next_protocols_advertised, [<<"spdy/2">>]}], "", Data, fun(Server, OpensslPort) -> + port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +erlang_server_openssl_client_npn_only_client(Config) when is_list(Config) -> + Data = "From openssl to erlang", + start_erlang_server_and_openssl_client_with_opts(Config, [], "-nextprotoneg spdy/2", Data, fun(Server, OpensslPort) -> + port_command(OpensslPort, Data), + ssl_test_lib:check_result(Server, ok) + end), + ok. + +%%-------------------------------------------------------------------------- + +start_erlang_client_and_openssl_server_with_opts(Config, ErlangClientOpts, OpensslServerOpts, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = ErlangClientOpts ++ ClientOpts0, + + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + + Cmd = "openssl s_server " ++ OpensslServerOpts ++ " -accept " ++ + integer_to_list(Port) ++ version_flag(Version) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile, + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + wait_for_openssl_server(), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + erlang_ssl_receive, [Data]}}, + {options, ClientOpts}]), + + Callback(Client, OpensslPort), + + %% Clean close down! Server needs to be closed first !! + close_port(OpensslPort), + + ssl_test_lib:close(Client), + process_flag(trap_exit, false). + +start_erlang_client_and_openssl_server_for_npn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + ClientOpts0 = ?config(client_opts, Config), + ClientOpts = [{client_preferred_next_protocols, {client, [<<"spdy/2">>], <<"http/1.1">>}} | ClientOpts0], + + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + + Cmd = "openssl s_server -msg -nextprotoneg http/1.1,spdy/2 -accept " ++ integer_to_list(Port) ++ version_flag(Version) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile, + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + wait_for_openssl_server(), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}}, + {options, ClientOpts}]), + + Callback(Client, OpensslPort), + + %% Clean close down! Server needs to be closed first !! + close_port(OpensslPort), + + ssl_test_lib:close(Client), + process_flag(trap_exit, false). + +start_erlang_server_and_openssl_client_for_npn_negotiation(Config, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = [{next_protocols_advertised, [<<"spdy/2">>]}, ServerOpts0], + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive_and_assert_npn, [<<"spdy/2">>, Data]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + Cmd = "openssl s_client -nextprotoneg http/1.0,spdy/2 -msg -port " ++ integer_to_list(Port) ++ version_flag(Version) ++ + " -host localhost", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + Callback(Server, OpenSslPort), + + ssl_test_lib:close(Server), + + close_port(OpenSslPort), + process_flag(trap_exit, false). + +start_erlang_server_and_openssl_client_with_opts(Config, ErlangServerOpts, OpenSSLClientOpts, Data, Callback) -> + process_flag(trap_exit, true), + ServerOpts0 = ?config(server_opts, Config), + ServerOpts = ErlangServerOpts ++ ServerOpts0, + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Cmd = "openssl s_client " ++ OpenSSLClientOpts ++ " -msg -port " ++ integer_to_list(Port) ++ + " -host localhost", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + Callback(Server, OpenSslPort), + + ssl_test_lib:close(Server), + + close_port(OpenSslPort), + process_flag(trap_exit, false). + + +erlang_ssl_receive_and_assert_npn(Socket, Protocol, Data) -> + {ok, Protocol} = ssl:negotiated_next_protocol(Socket), + erlang_ssl_receive(Socket, Data), + {ok, Protocol} = ssl:negotiated_next_protocol(Socket), + ok. erlang_ssl_receive(Socket, Data) -> test_server:format("Connection info: ~p~n", @@ -1168,6 +1431,15 @@ version_flag('tlsv1.2') -> version_flag(sslv3) -> " -ssl3 ". +check_openssl_npn_support(Config) -> + HelpText = os:cmd("openssl s_client --help"), + case string:str(HelpText, "nextprotoneg") of + 0 -> + {skip, "Openssl not compiled with nextprotoneg support"}; + _ -> + Config + end. + check_sane_openssl_renegotaite(Config) -> case os:cmd("openssl version") of "OpenSSL 0.9.8" ++ _ -> @@ -1179,11 +1451,27 @@ check_sane_openssl_renegotaite(Config) -> end. check_sane_openssl_sslv2(Config) -> - case os:cmd("openssl version") of - "OpenSSL 1." ++ _ -> - {skip, "sslv2 by default turned of in 1.*"}; - _ -> - Config + Port = open_port({spawn, "openssl s_client -ssl2 "}, [stderr_to_stdout]), + case supports_sslv2(Port) of + true -> + Config; + false -> + {skip, "sslv2 not supported by openssl"} + end. + +supports_sslv2(Port) -> + receive + {Port, {data, "unknown option -ssl2" ++ _}} -> + false; + {Port, {data, Data}} -> + case lists:member("error", string:tokens(Data, ":")) of + true -> + false; + false -> + supports_sslv2(Port) + end + after 500 -> + true end. check_sane_openssl_version(Version) -> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 7880bf8fbb..abaf64fb91 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -146,6 +146,10 @@ <desc><p>A match specification, see above.</p></desc> </datatype> <datatype> + <name name="comp_match_spec"/> + <desc><p>A compiled match specification.</p></desc> + </datatype> + <datatype> <name name="match_pattern"/> </datatype> <datatype> @@ -766,8 +770,6 @@ ets:is_compiled_ms(Broken).</code> </func> <func> <name name="match_spec_compile" arity="1"/> - <type name="comp_match_spec"/> - <type_desc name="comp_match_spec">A compiled match specification.</type_desc> <fsummary>Compiles a match specification into its internal representation</fsummary> <desc> <p>This function transforms a @@ -791,8 +793,6 @@ ets:is_compiled_ms(Broken).</code> </func> <func> <name name="match_spec_run" arity="2"/> - <type name="comp_match_spec"/> - <type_desc name="comp_match_spec">A compiled match specification.</type_desc> <fsummary>Performs matching, using a compiled match_spec, on a list of tuples</fsummary> <desc> <p>This function executes the matching specified in a diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml index f3079c7337..cec20aee8e 100644 --- a/lib/stdlib/doc/src/filelib.xml +++ b/lib/stdlib/doc/src/filelib.xml @@ -150,6 +150,11 @@ <p>Matches any number of characters up to the end of the filename, the next dot, or the next slash.</p> </item> + <tag>**</tag> + <item> + <p>Two adjacent <c>*</c>'s used as a single pattern will + match all files and zero or more directories and subdirectories.</p> + </item> <tag>[Character1,Character2,...]</tag> <item> <p>Matches any of the characters listed. Two characters @@ -192,6 +197,10 @@ <c>src</c> or <c>include</c> directories, use:</p> <code type="none"> filelib:wildcard("lib/*/{src,include}/*.{erl,hrl}") </code> + <p>To find all <c>.erl</c> or <c>.hrl</c> files in any + subdirectory, use:</p> + <code type="none"> + filelib:wildcard("lib/**/*.{erl,hrl}") </code> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/re.xml b/lib/stdlib/doc/src/re.xml index c6f45fb1e1..2211bfb925 100644 --- a/lib/stdlib/doc/src/re.xml +++ b/lib/stdlib/doc/src/re.xml @@ -490,8 +490,8 @@ This option makes it possible to include comments inside complicated patterns. N <p>The replacement string can contain the special character <c>&</c>, which inserts the whole matching expression in the - result, and the special sequence <c>\</c>N (where N is an - integer > 0), resulting in the subexpression number N will be + result, and the special sequence <c>\</c>N (where N is an integer > 0), + <c>\g</c>N or <c>\g{</c>N<c>}</c> resulting in the subexpression number N will be inserted in the result. If no subexpression with that number is generated by the regular expression, nothing is inserted.</p> <p>To insert an <c>&</c> or <c>\</c> in the result, precede it diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index f9a5e245b4..9021d02ade 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -294,10 +294,10 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} is a term with information about the error, and the supervisor terminates with reason <c>Term</c>.</p> <p>If any child process start function fails or returns an error - tuple or an erroneous value, the function returns - <c>{error,shutdown}</c> and the supervisor terminates all - started child processes and then itself with reason - <c>shutdown</c>.</p> + tuple or an erroneous value, the supervisor will first terminate + all already started child processes with reason <c>shutdown</c> + and then terminate itself and return + <c>{error, {shutdown, Reason}}</c>.</p> </desc> </func> <func> diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl index 0e95372a76..41b6ab1d5f 100644 --- a/lib/stdlib/src/binary.erl +++ b/lib/stdlib/src/binary.erl @@ -21,7 +21,9 @@ %% Implemented in this module: -export([split/2,split/3,replace/3,replace/4]). --opaque cp() :: tuple(). +-export_type([cp/0]). + +-opaque cp() :: {'am' | 'bm', binary()}. -type part() :: {Start :: non_neg_integer(), Length :: integer()}. %%% BIFs. diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 6a937f8fa2..845fae4bf4 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -88,7 +88,8 @@ %% Not documented, or not ready for publication. -export([lookup_keys/2]). --export_type([tab_name/0]). +-export_type([bindings_cont/0, cont/0, object_cont/0, select_cont/0, + tab_name/0]). -compile({inline, [{einval,2},{badarg,2},{undefined,1}, {badarg_exit,2},{lookup_reply,2}]}). diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 97dacac0a4..1e5f962375 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -365,6 +365,12 @@ format_error(callback_wrong_arity) -> format_error({imported_predefined_type, Name}) -> io_lib:format("referring to built-in type ~w as a remote type; " "please take out the module name", [Name]); +format_error({not_exported_opaque, {TypeName, Arity}}) -> + io_lib:format("opaque type ~w~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", + [TypeName, gen_type_paren(Arity)]); %% --- obsolete? unused? --- format_error({format_error, {Fmt, Args}}) -> io_lib:format(Fmt, Args); @@ -851,7 +857,8 @@ post_traversal_check(Forms, St0) -> StC = check_untyped_records(Forms, StB), StD = check_on_load(StC), StE = check_unused_records(Forms, StD), - check_callback_information(StE). + StF = check_local_opaque_types(StE), + check_callback_information(StF). %% check_behaviour(State0) -> State %% Check that the behaviour attribute is valid. @@ -2554,15 +2561,24 @@ find_field(_F, []) -> error. %% Attr :: 'type' | 'opaque' %% Checks that a type definition is valid. +-record(typeinfo, {attr, line}). + type_def(_Attr, _Line, {record, _RecName}, Fields, [], St0) -> %% The record field names and such are checked in the record format. %% We only need to check the types. Types = [T || {typed_record_field, _, T} <- Fields], check_type({type, -1, product, Types}, St0); -type_def(_Attr, Line, TypeName, ProtoType, Args, St0) -> +type_def(Attr, Line, TypeName, ProtoType, Args, St0) -> TypeDefs = St0#lint.types, Arity = length(Args), TypePair = {TypeName, Arity}, + Info = #typeinfo{attr = Attr, line = Line}, + StoreType = + fun(St) -> + NewDefs = dict:store(TypePair, Info, TypeDefs), + CheckType = {type, -1, product, [ProtoType|Args]}, + check_type(CheckType, St#lint{types=NewDefs}) + end, case (dict:is_key(TypePair, TypeDefs) orelse is_var_arity_type(TypeName)) of true -> case dict:is_key(TypePair, default_types()) of @@ -2572,20 +2588,29 @@ type_def(_Attr, Line, TypeName, ProtoType, Args, St0) -> true -> Warn = {new_builtin_type, TypePair}, St1 = add_warning(Line, Warn, St0), - NewDefs = dict:store(TypePair, Line, TypeDefs), - CheckType = {type, -1, product, [ProtoType|Args]}, - check_type(CheckType, St1#lint{types=NewDefs}); + StoreType(St1); false -> add_error(Line, {builtin_type, TypePair}, St0) end; false -> add_error(Line, {redefine_type, TypePair}, St0) end; false -> - NewDefs = dict:store(TypePair, Line, TypeDefs), - CheckType = {type, -1, product, [ProtoType|Args]}, - check_type(CheckType, St0#lint{types=NewDefs}) + St1 = case + Attr =:= opaque andalso + is_underspecified(ProtoType, Arity) + of + true -> + Warn = {underspecified_opaque, TypePair}, + add_warning(Line, Warn, St0); + false -> St0 + end, + StoreType(St1) end. +is_underspecified({type,_,term,[]}, 0) -> true; +is_underspecified({type,_,any,[]}, 0) -> true; +is_underspecified(_ProtType, _Arity) -> false. + check_type(Types, St) -> {SeenVars, St1} = check_type(Types, dict:new(), St), dict:fold(fun(Var, {seen_once, Line}, AccSt) -> @@ -2895,7 +2920,7 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> fun(_Type, -1, AccSt) -> %% Default type AccSt; - (Type, FileLine, AccSt) -> + (Type, #typeinfo{line = FileLine}, AccSt) -> case loc(FileLine) of {FirstFile, _} -> case gb_sets:is_member(Type, UsedTypes) of @@ -2914,6 +2939,24 @@ check_unused_types(Forms, #lint{usage=Usage, types=Ts, exp_types=ExpTs}=St) -> St end. +check_local_opaque_types(St) -> + #lint{types=Ts, exp_types=ExpTs} = St, + FoldFun = + fun(_Type, -1, AccSt) -> + %% Default type + AccSt; + (_Type, #typeinfo{attr = type}, AccSt) -> + AccSt; + (Type, #typeinfo{attr = opaque, line = FileLine}, AccSt) -> + case gb_sets:is_element(Type, ExpTs) of + true -> AccSt; + false -> + Warn = {not_exported_opaque,Type}, + add_warning(FileLine, Warn, AccSt) + end + end, + dict:fold(FoldFun, St, Ts). + %% icrt_clauses(Clauses, In, ImportVarTable, State) -> %% {NewVts,State}. diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 8e59e01f48..0c8735bb6d 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -55,7 +55,7 @@ token_info/1,token_info/2, attributes_info/1,attributes_info/2,set_attribute/3]). --export_type([error_info/0, line/0, tokens_result/0]). +-export_type([error_info/0, line/0, return_cont/0, tokens_result/0]). %%% %%% Defines and type definitions diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 817b397cc4..61bb038737 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -42,7 +42,7 @@ -export([i/0, i/1, i/2, i/3]). --export_type([tab/0, tid/0, match_spec/0]). +-export_type([tab/0, tid/0, match_spec/0, comp_match_spec/0, match_pattern/0]). %%----------------------------------------------------------------------------- @@ -445,7 +445,7 @@ update_element(_, _, _) -> %%% End of BIFs --opaque comp_match_spec() :: any(). %% this one is REALLY opaque +-opaque comp_match_spec() :: binary(). %% this one is REALLY opaque -spec match_spec_run(List, CompiledMatchSpec) -> list() when List :: [tuple()], diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl index fa4f92617c..318f3b87b8 100644 --- a/lib/stdlib/src/filelib.erl +++ b/lib/stdlib/src/filelib.erl @@ -132,6 +132,8 @@ do_wildcard_comp({compiled_wildcard,{exists,File}}, Mod) -> {ok,_} -> [File]; _ -> [] end; +do_wildcard_comp({compiled_wildcard,[cwd,Base|Rest]}, Mod) -> + do_wildcard_1([Base], Rest, Mod); do_wildcard_comp({compiled_wildcard,[Base|Rest]}, Mod) -> do_wildcard_1([Base], Rest, Mod). @@ -143,7 +145,11 @@ do_wildcard_comp({compiled_wildcard,{exists,File}}, Cwd, Mod) -> {ok,_} -> [File]; _ -> [] end; -do_wildcard_comp({compiled_wildcard,[current|Rest]}, Cwd0, Mod) -> +do_wildcard_comp({compiled_wildcard,[cwd|Rest0]}, Cwd0, Mod) -> + case Rest0 of + [current|Rest] -> ok; + Rest -> ok + end, {Cwd,PrefixLen} = case filename:join([Cwd0]) of Bin when is_binary(Bin) -> {Bin,byte_size(Bin)+1}; Other -> {Other,length(Other)+1} @@ -295,6 +301,8 @@ do_wildcard_2([File|Rest], Pattern, Result, Mod) -> do_wildcard_2([], _, Result, _Mod) -> Result. +do_wildcard_3(Base, [[double_star]|Rest], Result, Mod) -> + lists:sort(do_double_star(current, [Base], Rest, Result, Mod, true)); do_wildcard_3(Base, [Pattern|Rest], Result, Mod) -> case do_list_dir(Base, Mod) of {ok, Files0} -> @@ -328,6 +336,8 @@ wildcard_5([question|Rest1], [_|Rest2]) -> wildcard_5(Rest1, Rest2); wildcard_5([accept], _) -> true; +wildcard_5([double_star], _) -> + true; wildcard_5([star|Rest], File) -> do_star(Rest, File); wildcard_5([{one_of, Ordset}|Rest], [C|File]) -> @@ -348,6 +358,21 @@ wildcard_5([], [_|_]) -> wildcard_5([_|_], []) -> false. +do_double_star(Base, [H|T], Rest, Result, Mod, Root) -> + Full = join(Base, H), + Result1 = case do_list_dir(Full, Mod) of + {ok, Files} -> + do_double_star(Full, Files, Rest, Result, Mod, false); + _ -> Result + end, + Result2 = case Root andalso Rest == [] of + true -> Result1; + false -> do_wildcard_3(Full, Rest, Result1, Mod) + end, + do_double_star(Base, T, Rest, Result2, Mod, Root); +do_double_star(_Base, [], _Rest, Result, _Mod, _Root) -> + Result. + do_star(Pattern, [X|Rest]) -> case wildcard_5(Pattern, [X|Rest]) of true -> true; @@ -383,7 +408,10 @@ compile_wildcard_1(Pattern) -> [Root|Rest] = filename:split(Pattern), case filename:pathtype(Root) of relative -> - compile_wildcard_2([Root|Rest], current); + case compile_wildcard_2([Root|Rest], current) of + {exists,_}=Wc -> Wc; + [_|_]=Wc -> [cwd|Wc] + end; _ -> compile_wildcard_2(Rest, [Root]) end. @@ -416,6 +444,10 @@ compile_part([$}|Rest], true, Result) -> {ok, $}, lists:reverse(Result), Rest}; compile_part([$?|Rest], Upto, Result) -> compile_part(Rest, Upto, [question|Result]); +compile_part([$*,$*], Upto, Result) -> + compile_part([], Upto, [double_star|Result]); +compile_part([$*,$*|Rest], Upto, Result) -> + compile_part(Rest, Upto, [star|Result]); compile_part([$*], Upto, Result) -> compile_part([], Upto, [accept|Result]); compile_part([$*|Rest], Upto, Result) -> diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl index a6b42cc68c..59d6de5d10 100644 --- a/lib/stdlib/src/filename.erl +++ b/lib/stdlib/src/filename.erl @@ -69,7 +69,7 @@ absname(Name) -> -spec absname(Filename, Dir) -> file:filename() when Filename :: file:name(), - Dir :: file:filename(). + Dir :: file:name(). absname(Name, AbsBase) when is_binary(Name), is_list(AbsBase) -> absname(Name,filename_string_to_binary(AbsBase)); absname(Name, AbsBase) when is_list(Name), is_binary(AbsBase) -> @@ -123,7 +123,7 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> %% AbsBase must be absolute and Name must be relative. -spec absname_join(Dir, Filename) -> file:filename() when - Dir :: file:filename(), + Dir :: file:name(), Filename :: file:name(). absname_join(AbsBase, Name) -> join(AbsBase, flatten(Name)). @@ -388,7 +388,7 @@ extension([], Result, _OsType) -> %% Joins a list of filenames with directory separators. -spec join(Components) -> file:filename() when - Components :: [file:filename()]. + Components :: [file:name()]. join([Name1, Name2|Rest]) -> join([join(Name1, Name2)|Rest]); join([Name]) when is_list(Name) -> @@ -401,8 +401,8 @@ join([Name]) when is_atom(Name) -> %% Joins two filenames with directory separators. -spec join(Name1, Name2) -> file:filename() when - Name1 :: file:filename(), - Name2 :: file:filename(). + Name1 :: file:name(), + Name2 :: file:name(). join(Name1, Name2) when is_list(Name1), is_list(Name2) -> OsType = major_os_type(), case pathtype(Name2) of @@ -624,7 +624,7 @@ rootname2([Char|Rest], Ext, Result) when is_integer(Char) -> -spec split(Filename) -> Components when Filename :: file:name(), - Components :: [file:filename()]. + Components :: [file:name()]. split(Name) when is_binary(Name) -> case os:type() of {win32, _} -> win32_splitb(Name); @@ -718,7 +718,7 @@ split([], Comp, Components, OsType) -> %% name will be normalized as done by join/1. -spec nativename(Path) -> file:filename() when - Path :: file:filename(). + Path :: file:name(). nativename(Name0) -> Name = join([Name0]), %Normalize. case os:type() of @@ -915,10 +915,8 @@ make_abs_path(BasePath, Path) -> join(BasePath, Path). major_os_type() -> - case os:type() of - {OsT, _} -> OsT; - OsT -> OsT - end. + {OsT, _} = os:type(), + OsT. %% flatten(List) %% Flatten a list, also accepting atoms. diff --git a/lib/stdlib/src/gb_sets.erl b/lib/stdlib/src/gb_sets.erl index 91d21d869c..391f1cff64 100644 --- a/lib/stdlib/src/gb_sets.erl +++ b/lib/stdlib/src/gb_sets.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -196,6 +196,8 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Some types. +-export_type([iter/0]). + -type gb_set_node() :: 'nil' | {term(), _, _}. -opaque iter() :: [gb_set_node()]. diff --git a/lib/stdlib/src/gb_trees.erl b/lib/stdlib/src/gb_trees.erl index 6ad861ff5b..258713c90f 100644 --- a/lib/stdlib/src/gb_trees.erl +++ b/lib/stdlib/src/gb_trees.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -152,6 +152,8 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Some types. +-export_type([iter/0]). + -type gb_tree_node() :: 'nil' | {_, _, _, _}. -opaque iter() :: [gb_tree_node()]. diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 0252cdf742..513d904c39 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -82,7 +82,10 @@ -type chars() :: [char() | chars()]. -type depth() :: -1 | non_neg_integer(). --opaque continuation() :: {_, _, _, _}. % XXX: refine +-opaque continuation() :: {Format :: string(), + Stack :: chars(), + Nchars :: non_neg_integer(), + Results :: [term()]}. %%---------------------------------------------------------------------- @@ -250,10 +253,10 @@ write_ref(Ref) -> write_binary(B, D) when is_integer(D) -> [$<,$<,write_binary_body(B, D),$>,$>]. -write_binary_body(_B, 1) -> - "..."; write_binary_body(<<>>, _D) -> ""; +write_binary_body(_B, 1) -> + "..."; write_binary_body(<<X:8>>, _D) -> [integer_to_list(X)]; write_binary_body(<<X:8,Rest/bitstring>>, D) -> diff --git a/lib/stdlib/src/log_mf_h.erl b/lib/stdlib/src/log_mf_h.erl index f7f128dac7..19b555a48c 100644 --- a/lib/stdlib/src/log_mf_h.erl +++ b/lib/stdlib/src/log_mf_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,6 +25,8 @@ -export([init/1, handle_event/2, handle_info/2, terminate/2]). -export([handle_call/2, code_change/3]). +-export_type([args/0]). + %%----------------------------------------------------------------- -type b() :: non_neg_integer(). diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl index 02bcbb5a60..4bca4c1e6d 100644 --- a/lib/stdlib/src/proc_lib.erl +++ b/lib/stdlib/src/proc_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -184,6 +184,17 @@ check_for_monitor(SpawnOpts) -> false end. +spawn_mon(M,F,A) -> + Parent = get_my_name(), + Ancestors = get_ancestors(), + erlang:spawn_monitor(?MODULE, init_p, [Parent,Ancestors,M,F,A]). + +spawn_opt_mon(M, F, A, Opts) when is_atom(M), is_atom(F), is_list(A) -> + Parent = get_my_name(), + Ancestors = get_ancestors(), + check_for_monitor(Opts), + erlang:spawn_opt(?MODULE, init_p, [Parent,Ancestors,M,F,A], [monitor|Opts]). + -spec hibernate(Module, Function, Args) -> no_return() when Module :: module(), Function :: atom(), @@ -270,8 +281,8 @@ start(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> Ret :: term() | {error, Reason :: term()}. start(M, F, A, Timeout) when is_atom(M), is_atom(F), is_list(A) -> - Pid = ?MODULE:spawn(M, F, A), - sync_wait(Pid, Timeout). + PidRef = spawn_mon(M, F, A), + sync_wait_mon(PidRef, Timeout). -spec start(Module, Function, Args, Time, SpawnOpts) -> Ret when Module :: module(), @@ -282,8 +293,8 @@ start(M, F, A, Timeout) when is_atom(M), is_atom(F), is_list(A) -> Ret :: term() | {error, Reason :: term()}. start(M, F, A, Timeout, SpawnOpts) when is_atom(M), is_atom(F), is_list(A) -> - Pid = ?MODULE:spawn_opt(M, F, A, SpawnOpts), - sync_wait(Pid, Timeout). + PidRef = spawn_opt_mon(M, F, A, SpawnOpts), + sync_wait_mon(PidRef, Timeout). -spec start_link(Module, Function, Args) -> Ret when Module :: module(), @@ -330,6 +341,23 @@ sync_wait(Pid, Timeout) -> {error, timeout} end. +sync_wait_mon({Pid, Ref}, Timeout) -> + receive + {ack, Pid, Return} -> + erlang:demonitor(Ref, [flush]), + Return; + {'DOWN', Ref, _Type, Pid, Reason} -> + {error, Reason}; + {'EXIT', Pid, Reason} -> %% link as spawn_opt? + erlang:demonitor(Ref, [flush]), + {error, Reason} + after Timeout -> + erlang:demonitor(Ref, [flush]), + exit(Pid, kill), + flush(Pid), + {error, timeout} + end. + -spec flush(pid()) -> 'true'. flush(Pid) -> diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 2b691e6abf..9b71d0edb8 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -125,7 +125,7 @@ -define(THROWN_ERROR, {?MODULE, throw_error, _, _}). --export_type([query_handle/0]). +-export_type([query_cursor/0, query_handle/0]). %%% A query handle is a tuple {qlc_handle, Handle} where Handle is one %%% of #qlc_append, #qlc_table, #qlc_sort, and #qlc_lc. diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index 359afc8c14..c5109ec455 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -409,6 +409,12 @@ apply_mlist(Subject,Replacement,Mlist) -> precomp_repl(<<>>) -> []; +precomp_repl(<<$\\,$g,${,Rest/binary>>) when byte_size(Rest) > 0 -> + {NS, <<$},NRest/binary>>} = pick_int(Rest), + [list_to_integer(NS) | precomp_repl(NRest)]; +precomp_repl(<<$\\,$g,Rest/binary>>) when byte_size(Rest) > 0 -> + {NS,NRest} = pick_int(Rest), + [list_to_integer(NS) | precomp_repl(NRest)]; precomp_repl(<<$\\,X,Rest/binary>>) when X < $1 ; X > $9 -> %% Escaped character case precomp_repl(Rest) of diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 7d3c5a0e21..9f93747c3e 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -104,7 +104,9 @@ %%% SupName = {local, atom()} | {global, atom()}. %%% --------------------------------------------------- --type startlink_err() :: {'already_started', pid()} | 'shutdown' | term(). +-type startlink_err() :: {'already_started', pid()} + | {'shutdown', term()} + | term(). -type startlink_ret() :: {'ok', pid()} | 'ignore' | {'error', startlink_err()}. -spec start_link(Module, Args) -> startlink_ret() when @@ -221,8 +223,10 @@ cast(Supervisor, Req) -> -type init_sup_name() :: sup_name() | 'self'. --type stop_rsn() :: 'shutdown' | {'bad_return', {module(),'init', term()}} - | {'bad_start_spec', term()} | {'start_spec', term()} +-type stop_rsn() :: {'shutdown', term()} + | {'bad_return', {module(),'init', term()}} + | {'bad_start_spec', term()} + | {'start_spec', term()} | {'supervisor_data', term()}. -spec init({init_sup_name(), module(), [term()]}) -> @@ -253,9 +257,9 @@ init_children(State, StartSpec) -> case start_children(Children, SupName) of {ok, NChildren} -> {ok, State#state{children = NChildren}}; - {error, NChildren} -> + {error, NChildren, Reason} -> terminate_children(NChildren, SupName), - {stop, shutdown} + {stop, {shutdown, Reason}} end; Error -> {stop, {start_spec, Error}} @@ -275,9 +279,9 @@ init_dynamic(_State, StartSpec) -> %% Func: start_children/2 %% Args: Children = [child_rec()] in start order %% SupName = {local, atom()} | {global, atom()} | {pid(), Mod} -%% Purpose: Start all children. The new list contains #child's +%% Purpose: Start all children. The new list contains #child's %% with pids. -%% Returns: {ok, NChildren} | {error, NChildren} +%% Returns: {ok, NChildren} | {error, NChildren, Reason} %% NChildren = [child_rec()] in termination order (reversed %% start order) %%----------------------------------------------------------------- @@ -293,7 +297,8 @@ start_children([Child|Chs], NChildren, SupName) -> start_children(Chs, [Child#child{pid = Pid}|NChildren], SupName); {error, Reason} -> report_error(start_error, Reason, Child, SupName), - {error, lists:reverse(Chs) ++ [Child | NChildren]} + {error, lists:reverse(Chs) ++ [Child | NChildren], + {failed_to_start_child,Child#child.name,Reason}} end; start_children([], NChildren, _SupName) -> {ok, NChildren}. @@ -793,7 +798,7 @@ restart(rest_for_one, Child, State) -> case start_children(ChAfter2, State#state.name) of {ok, ChAfter3} -> {ok, State#state{children = ChAfter3 ++ ChBefore}}; - {error, ChAfter3} -> + {error, ChAfter3, _Reason} -> NChild = Child#child{pid=restarting(Child#child.pid)}, NState = State#state{children = ChAfter3 ++ ChBefore}, {try_again, replace_child(NChild,NState)} @@ -804,7 +809,7 @@ restart(one_for_all, Child, State) -> case start_children(Children2, State#state.name) of {ok, NChs} -> {ok, State#state{children = NChs}}; - {error, NChs} -> + {error, NChs, _Reason} -> NChild = Child#child{pid=restarting(Child#child.pid)}, NState = State#state{children = NChs}, {try_again, replace_child(NChild,NState)} diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index f34201604c..4dd70ad425 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -32,6 +32,8 @@ %% Types %%----------------------------------------------------------------- +-export_type([dbg_opt/0]). + -type name() :: pid() | atom() | {'global', atom()}. -type system_event() :: {'in', Msg :: _} | {'in', Msg :: _, From :: _} diff --git a/lib/stdlib/src/win32reg.erl b/lib/stdlib/src/win32reg.erl index 598e77ffdc..48a7e262be 100644 --- a/lib/stdlib/src/win32reg.erl +++ b/lib/stdlib/src/win32reg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,6 +25,8 @@ expand/1, format_error/1]). +-export_type([reg_handle/0]). + %% Key handles (always open). -define(hkey_classes_root, 16#80000000). -define(hkey_current_user, 16#80000001). diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl index c64a961ffa..7b8650f224 100644 --- a/lib/stdlib/test/base64_SUITE.erl +++ b/lib/stdlib/test/base64_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -20,7 +20,6 @@ -module(base64_SUITE). -include_lib("common_test/include/ct.hrl"). --include("test_server_line.hrl"). %% Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, @@ -33,7 +32,7 @@ mime_decode_to_string/1, roundtrip/1]). init_per_testcase(_, Config) -> - Dog = test_server:timetrap(?t:minutes(2)), + Dog = test_server:timetrap(?t:minutes(4)), NewConfig = lists:keydelete(watchdog, 1, Config), [{watchdog, Dog} | NewConfig]. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 944d8ebd6a..90a37f6441 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -50,7 +50,8 @@ unsafe_vars_try/1, guard/1, otp_4886/1, otp_4988/1, otp_5091/1, otp_5276/1, otp_5338/1, otp_5362/1, otp_5371/1, otp_7227/1, otp_5494/1, otp_5644/1, otp_5878/1, - otp_5917/1, otp_6585/1, otp_6885/1, export_all/1, + otp_5917/1, otp_6585/1, otp_6885/1, otp_10436/1, + export_all/1, bif_clash/1, behaviour_basic/1, behaviour_multiple/1, otp_7550/1, @@ -80,7 +81,7 @@ all() -> unsafe_vars, unsafe_vars2, unsafe_vars_try, guard, otp_4886, otp_4988, otp_5091, otp_5276, otp_5338, otp_5362, otp_5371, otp_7227, otp_5494, otp_5644, - otp_5878, otp_5917, otp_6585, otp_6885, export_all, + otp_5878, otp_5917, otp_6585, otp_6885, otp_10436, export_all, bif_clash, behaviour_basic, behaviour_multiple, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments]. @@ -2386,6 +2387,28 @@ otp_6885(Config) when is_list(Config) -> []} = run_test2(Config, Ts, []), ok. +otp_10436(doc) -> + "OTP-6885. Warnings for opaque types."; +otp_10436(suite) -> []; +otp_10436(Config) when is_list(Config) -> + Ts = <<"-module(otp_10436). + -export_type([t1/0]). + -opaque t1() :: {i, integer()}. + -opaque t2() :: {a, atom()}. + ">>, + {warnings,[{4,erl_lint,{not_exported_opaque,{t2,0}}}, + {4,erl_lint,{unused_type,{t2,0}}}]} = + run_test2(Config, Ts, []), + Ts2 = <<"-module(otp_10436_2). + -export_type([t1/0, t2/0]). + -opaque t1() :: term(). + -opaque t2() :: any(). + ">>, + {warnings,[{3,erl_lint,{underspecified_opaque,{t1,0}}}, + {4,erl_lint,{underspecified_opaque,{t2,0}}}]} = + run_test2(Config, Ts2, []), + ok. + export_all(doc) -> "OTP-7392. Warning for export_all."; export_all(Config) when is_list(Config) -> @@ -2834,10 +2857,10 @@ otp_8051(doc) -> otp_8051(Config) when is_list(Config) -> Ts = [{otp_8051, <<"-opaque foo() :: bar(). + -export_type([foo/0]). ">>, [], - {error,[{1,erl_lint,{undefined_type,{bar,0}}}], - [{1,erl_lint,{unused_type,{foo,0}}}]}}], + {errors,[{1,erl_lint,{undefined_type,{bar,0}}}],[]}}], ?line [] = run(Config, Ts), ok. diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl index 38c085616d..5b592c65cc 100644 --- a/lib/stdlib/test/escript_SUITE.erl +++ b/lib/stdlib/test/escript_SUITE.erl @@ -64,7 +64,7 @@ end_per_group(_GroupName, Config) -> Config. init_per_testcase(_Case, Config) -> - ?line Dog = ?t:timetrap(?t:minutes(2)), + ?line Dog = ?t:timetrap(?t:minutes(5)), [{watchdog,Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -618,7 +618,7 @@ compile_files([File | Files], SrcDir, OutDir) -> case filename:extension(File) of ".erl" -> AbsFile = filename:join([SrcDir, File]), - case compile:file(AbsFile, [{outdir, OutDir}]) of + case compile:file(AbsFile, [{outdir, OutDir},report_errors]) of {ok, _Mod} -> compile_files(Files, SrcDir, OutDir); Error -> diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 1de639a166..1fd7518519 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -176,9 +176,64 @@ do_wildcard_5(Dir, Wcf) -> %% Cleanup ?line del(Files), - ?line foreach(fun(D) -> ok = file:del_dir(filename:join(Dir, D)) end, Dirs). + ?line foreach(fun(D) -> ok = file:del_dir(filename:join(Dir, D)) end, Dirs), + do_wildcard_6(Dir, Wcf). + +do_wildcard_6(Dir, Wcf) -> + ok = file:make_dir(filename:join(Dir, "xbin")), + All = ["xbin/a.x","xbin/b.x","xbin/c.x"], + Files = mkfiles(All, Dir), + All = Wcf("xbin/*.x"), + All = Wcf("xbin/*"), + ["xbin"] = Wcf("*"), + All = Wcf("*/*"), + del(Files), + ok = file:del_dir(filename:join(Dir, "xbin")), + do_wildcard_7(Dir, Wcf). + +do_wildcard_7(Dir, Wcf) -> + Dirs = ["blurf","xa","yyy"], + SubDirs = ["blurf/nisse"], + foreach(fun(D) -> + ok = file:make_dir(filename:join(Dir, D)) + end, Dirs ++ SubDirs), + All = ["blurf/nisse/baz","xa/arne","xa/kalle","yyy/arne"], + Files = mkfiles(lists:reverse(All), Dir), + %% Test. + Listing = Wcf("**"), + ["blurf","blurf/nisse","blurf/nisse/baz", + "xa","xa/arne","xa/kalle","yyy","yyy/arne"] = Listing, + Listing = Wcf("**/*"), + ["xa/arne","yyy/arne"] = Wcf("**/arne"), + ["blurf/nisse"] = Wcf("**/nisse"), + [] = Wcf("mountain/**"), + + %% Cleanup + del(Files), + foreach(fun(D) -> + ok = file:del_dir(filename:join(Dir, D)) + end, SubDirs ++ Dirs), + do_wildcard_8(Dir, Wcf). + +do_wildcard_8(Dir, Wcf) -> + Dirs0 = ["blurf"], + Dirs1 = ["blurf/nisse"], + Dirs2 = ["blurf/nisse/a", "blurf/nisse/b"], + foreach(fun(D) -> + ok = file:make_dir(filename:join(Dir, D)) + end, Dirs0 ++ Dirs1 ++ Dirs2), + All = ["blurf/nisse/a/1.txt", "blurf/nisse/b/2.txt", "blurf/nisse/b/3.txt"], + Files = mkfiles(lists:reverse(All), Dir), + %% Test. + All = Wcf("**/blurf/**/*.txt"), + + %% Cleanup + del(Files), + foreach(fun(D) -> + ok = file:del_dir(filename:join(Dir, D)) + end, Dirs2 ++ Dirs1 ++ Dirs0). fold_files(Config) when is_list(Config) -> ?line Dir = filename:join(?config(priv_dir, Config), "fold_files"), diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 2abb01ba24..dffeadb423 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1046,8 +1046,9 @@ call_with_huge_message_queue(Config) when is_list(Config) -> io:format("Time for empty message queue: ~p", [Time]), io:format("Time for huge message queue: ~p", [NewTime]), + IsCover = test_server:is_cover(), case (NewTime+1) / (Time+1) of - Q when Q < 10 -> + Q when Q < 10; IsCover -> ok; Q -> io:format("Q = ~p", [Q]), diff --git a/lib/stdlib/test/id_transform_SUITE.erl b/lib/stdlib/test/id_transform_SUITE.erl index 233b0d0a78..ee97ffe7b3 100644 --- a/lib/stdlib/test/id_transform_SUITE.erl +++ b/lib/stdlib/test/id_transform_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -61,7 +61,7 @@ id_transform(Config) when is_list(Config) -> ?line {module,erl_id_trans}=code:load_binary(erl_id_trans,File,Bin), ?line case test_server:purify_is_running() of false -> - Dog = ?t:timetrap(?t:hours(1)), + Dog = ct:timetrap(?t:hours(1)), ?line Res = run_in_test_suite(), ?t:timetrap_cancel(Dog), Res; diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index bb02a879c2..74fcdcc7d2 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -27,7 +27,8 @@ otp_6282/1, otp_6354/1, otp_6495/1, otp_6517/1, otp_6502/1, manpage/1, otp_6708/1, otp_7084/1, otp_7421/1, io_lib_collect_line_3_wb/1, cr_whitespace_in_string/1, - io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1]). + io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1, + io_lib_print_binary_depth_one/1]). %-define(debug, true). @@ -62,7 +63,8 @@ all() -> otp_6282, otp_6354, otp_6495, otp_6517, otp_6502, manpage, otp_6708, otp_7084, otp_7421, io_lib_collect_line_3_wb, cr_whitespace_in_string, - io_fread_newlines, otp_8989, io_lib_fread_literal]. + io_fread_newlines, otp_8989, io_lib_fread_literal, + io_lib_print_binary_depth_one]. groups() -> []. @@ -2021,3 +2023,14 @@ io_lib_fread_literal(Suite) when is_list(Suite) -> ?line {done,{error,{fread,input}},_} = io_lib:fread(C2, eof, " d"), ?line {done,{ok,[]},[]} = io_lib:fread(C2, "d\n", " d"), ok. + +io_lib_print_binary_depth_one(doc) -> + "Test binaries printed with a depth of one behave correctly"; +io_lib_print_binary_depth_one(Suite) when is_list(Suite) -> + ?line "<<>>" = fmt("~W", [<<>>, 1]), + ?line "<<>>" = fmt("~P", [<<>>, 1]), + ?line "<<...>>" = fmt("~W", [<<1>>, 1]), + ?line "<<...>>" = fmt("~P", [<<1>>, 1]), + ?line "<<...>>" = fmt("~W", [<<1:7>>, 1]), + ?line "<<...>>" = fmt("~P", [<<1:7>>, 1]), + ok. diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index c95089117c..8dca69bac4 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-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,7 +28,7 @@ crash/1, sync_start_nolink/1, sync_start_link/1, spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1, hibernate/1]). --export([ otp_6345/1]). +-export([ otp_6345/1, init_dont_hang/1]). -export([hib_loop/1, awaken/1]). @@ -36,7 +36,7 @@ handle_event/2, handle_call/2, handle_info/2, terminate/2]). --export([otp_6345_init/1]). +-export([otp_6345_init/1, init_dont_hang_init/1]). -ifdef(STANDALONE). @@ -52,7 +52,7 @@ all() -> {group, tickets}]. groups() -> - [{tickets, [], [otp_6345]}, + [{tickets, [], [otp_6345, init_dont_hang]}, {sync_start, [], [sync_start_nolink, sync_start_link]}]. init_per_suite(Config) -> @@ -343,6 +343,29 @@ otp_6345_loop() -> otp_6345_loop() end. +%% OTP-9803 +init_dont_hang(suite) -> + []; +init_dont_hang(doc) -> + ["Check that proc_lib:start don't hang if spawned process crashes before proc_lib:init_ack/2"]; +init_dont_hang(Config) when is_list(Config) -> + %% Start should behave as start_link + process_flag(trap_exit, true), + StartLinkRes = proc_lib:start_link(?MODULE, init_dont_hang_init, [self()]), + try + StartLinkRes = proc_lib:start(?MODULE, init_dont_hang_init, [self()], 1000), + StartLinkRes = proc_lib:start(?MODULE, init_dont_hang_init, [self()], 1000, []), + ok + catch _:Error -> + io:format("Error ~p /= ~p ~n",[erlang:get_stacktrace(), StartLinkRes]), + exit(Error) + end. + +init_dont_hang_init(Parent) -> + 1 = 2. + + + %%----------------------------------------------------------------- %% The error_logger handler used. %%----------------------------------------------------------------- diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index a542745e67..8ee0a13f4c 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -328,6 +328,12 @@ replace_return(Config) when is_list(Config) -> ?line <<"iXk">> = re:replace("abcdefghijk","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\9X",[{return,binary}]), ?line <<"jXk">> = re:replace("abcdefghijk","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\10X",[{return,binary}]), ?line <<"Xk">> = re:replace("abcdefghijk","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\11X",[{return,binary}]), + ?line <<"9X1">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g9X",[{return,binary}]), + ?line <<"0X1">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g10X",[{return,binary}]), + ?line <<"X1">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g11X",[{return,binary}]), + ?line <<"971">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g{9}7",[{return,binary}]), + ?line <<"071">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g{10}7",[{return,binary}]), + ?line <<"71">> = re:replace("12345678901","(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)","\\g{11}7",[{return,binary}]), ?line "a\x{400}bcX" = re:replace("a\x{400}bcd","d","X",[global,{return,list},unicode]), ?line <<"a",208,128,"bcX">> = re:replace("a\x{400}bcd","d","X",[global,{return,binary},unicode]), ?line "a\x{400}bcd" = re:replace("a\x{400}bcd","Z","X",[global,{return,list},unicode]), diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 767ae3d62c..569c66959e 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2012. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,6 +46,7 @@ temporary_normal/1, permanent_shutdown/1, transient_shutdown/1, temporary_shutdown/1, + faulty_application_shutdown/1, permanent_abnormal/1, transient_abnormal/1, temporary_abnormal/1, temporary_bystander/1]). @@ -98,7 +99,8 @@ groups() -> {normal_termination, [], [permanent_normal, transient_normal, temporary_normal]}, {shutdown_termination, [], - [permanent_shutdown, transient_shutdown, temporary_shutdown]}, + [permanent_shutdown, transient_shutdown, temporary_shutdown, + faulty_application_shutdown]}, {abnormal_termination, [], [permanent_abnormal, transient_abnormal, temporary_abnormal]}, @@ -659,6 +661,39 @@ temporary_shutdown(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +%% Faulty application should shutdown and pass on errors +faulty_application_shutdown(Config) when is_list(Config) -> + + %% Set some paths + AppDir = filename:join(?config(data_dir, Config), "app_faulty"), + EbinDir = filename:join(AppDir, "ebin"), + + %% Start faulty app + code:add_patha(EbinDir), + + %% {error, + %% {{shutdown, + %% {failed_to_start_child, + %% app_faulty, + %% {undef, + %% [{an_undefined_module_with,an_undefined_function,[argument1,argument2], + %% []}, + %% {app_faulty_server,init,1, + %% [{file,"app_faulty/src/app_faulty_server.erl"},{line,16}]}, + %% {gen_server,init_it,6, + %% [{file,"gen_server.erl"},{line,304}]}, + %% {proc_lib,init_p_do_apply,3, + %% [{file,"proc_lib.erl"},{line,227}]}]}}}, + %% {app_faulty,start,[normal,[]]}}} + + {error, Error} = application:start(app_faulty), + {{shutdown, {failed_to_start_child,app_faulty,{undef, CallStack}}}, + {app_faulty,start,_}} = Error, + [{an_undefined_module_with,an_undefined_function,_,_}|_] = CallStack, + ok = application:unload(app_faulty), + ok. + +%%------------------------------------------------------------------------- %% A permanent child should always be restarted. permanent_abnormal(Config) when is_list(Config) -> {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), diff --git a/lib/stdlib/test/supervisor_SUITE_data/Makefile.src b/lib/stdlib/test/supervisor_SUITE_data/Makefile.src new file mode 100644 index 0000000000..dbc5729f47 --- /dev/null +++ b/lib/stdlib/test/supervisor_SUITE_data/Makefile.src @@ -0,0 +1,15 @@ +EFLAGS=+debug_info + +APP_FAULTY= \ + app_faulty/ebin/app_faulty_sup.@EMULATOR@ \ + app_faulty/ebin/app_faulty_server.@EMULATOR@ \ + app_faulty/ebin/app_faulty.@EMULATOR@ \ + +all: $(APP_FAULTY) + +app_faulty/ebin/app_faulty_server.@EMULATOR@: app_faulty/src/app_faulty_server.erl + erlc $(EFLAGS) -oapp_faulty/ebin app_faulty/src/app_faulty_server.erl +app_faulty/ebin/app_faulty_sup.@EMULATOR@: app_faulty/src/app_faulty_sup.erl + erlc $(EFLAGS) -oapp_faulty/ebin app_faulty/src/app_faulty_sup.erl +app_faulty/ebin/app_faulty.@EMULATOR@: app_faulty/src/app_faulty.erl + erlc $(EFLAGS) -oapp_faulty/ebin app_faulty/src/app_faulty.erl diff --git a/lib/stdlib/test/supervisor_SUITE_data/app_faulty/ebin/app_faulty.app b/lib/stdlib/test/supervisor_SUITE_data/app_faulty/ebin/app_faulty.app new file mode 100644 index 0000000000..d4ab07e485 --- /dev/null +++ b/lib/stdlib/test/supervisor_SUITE_data/app_faulty/ebin/app_faulty.app @@ -0,0 +1,10 @@ +{application, app_faulty, + [{description, "very simple example faulty application"}, + {id, "app_faulty"}, + {vsn, "1.0"}, + {modules, [app_faulty, app_faulty_sup, app_faulty_server]}, + {registered, [app_faulty]}, + {applications, [kernel, stdlib]}, + {env, [{var,val1}]}, + {mod, {app_faulty, []}} + ]}. diff --git a/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty.erl b/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty.erl new file mode 100644 index 0000000000..c65b411cd6 --- /dev/null +++ b/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty.erl @@ -0,0 +1,17 @@ +-module(app_faulty). + +-behaviour(application). + +%% Application callbacks +-export([start/2, stop/1]). + +start(_Type, _StartArgs) -> + case app_faulty_sup:start_link() of + {ok, Pid} -> + {ok, Pid}; + Error -> + Error + end. + +stop(_State) -> + ok. diff --git a/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty_server.erl b/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty_server.erl new file mode 100644 index 0000000000..6628f92210 --- /dev/null +++ b/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty_server.erl @@ -0,0 +1,32 @@ +-module(app_faulty_server). + +-behaviour(gen_server). + +%% API +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +init([]) -> + an_undefined_module_with:an_undefined_function(argument1, argument2), + {ok, []}. + +handle_call(_Request, _From, State) -> + {reply, ok, State}. + +handle_cast(_Msg, State) -> + {noreply, State}. + +handle_info(_Info, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. diff --git a/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty_sup.erl b/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty_sup.erl new file mode 100644 index 0000000000..8115a88809 --- /dev/null +++ b/lib/stdlib/test/supervisor_SUITE_data/app_faulty/src/app_faulty_sup.erl @@ -0,0 +1,17 @@ +-module(app_faulty_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callbacks +-export([init/1]). + +start_link() -> + supervisor:start_link(?MODULE, []). + +init([]) -> + AChild = {app_faulty,{app_faulty_server,start_link,[]}, + permanent,2000,worker,[app_faulty_server]}, + {ok,{{one_for_all,0,1}, [AChild]}}. diff --git a/lib/test_server/doc/src/ts.xml b/lib/test_server/doc/src/ts.xml index 7a356755ba..4a2c536e96 100644 --- a/lib/test_server/doc/src/ts.xml +++ b/lib/test_server/doc/src/ts.xml @@ -498,29 +498,6 @@ This option is mandatory for remote targets </desc> </func> <func> - <name>index() -> ok | {error, Reason}</name> - <fsummary>Updates local index page</fsummary> - <type> - <v>Reason = term()</v> - </type> - <desc> - <p>This function updates the local index page. This can be - useful if a previous test run was not completed and the index - is incomplete.</p> - </desc> - </func> - <func> - <name>clean() -> ok</name> - <name>clean(all) -> ok</name> - <fsummary>Cleans up the log directories created when running tests. </fsummary> - <desc> - <p>This function cleans up log directories created when - running test cases. <c>clean/0</c> cleans up all but the last - run of each application. <c>clean/1</c> cleans up all test - runs found.</p> - </desc> - </func> - <func> <name>estone() -> ok | {error, Reason}</name> <name>estone(Opts) -> ok</name> <fsummary>Runs the EStone test</fsummary> diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index ada9bac05a..20e7a5942c 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -40,6 +40,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/test_server-$(VSN) # ---------------------------------------------------- MODULES= test_server_ctrl \ + test_server_gl \ + test_server_io \ test_server_node \ test_server \ test_server_sup \ @@ -49,7 +51,6 @@ MODULES= test_server_ctrl \ TS_MODULES= \ ts \ ts_run \ - ts_reports \ ts_lib \ ts_make \ ts_erl_config \ diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src index faf7db835e..26330f9695 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/test_server/src/test_server.app.src @@ -24,6 +24,7 @@ test_server_ctrl, test_server, test_server_h, + test_server_io, test_server_node, test_server_sup ]}, diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 8beed9bd3e..bcffe896c4 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -524,7 +524,7 @@ stick_all_sticky(Node,Sticky) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData,RejectIoReqs) -> +%% run_test_case_apply(Mod,Func,Args,Name,RunInit,TimetrapData) -> %% {Time,Value,Loc,Opts,Comment} | {died,Reason,unknown,Comment} %% %% Time = float() (seconds) @@ -538,7 +538,6 @@ stick_all_sticky(Node,Sticky) -> %% it possible to capture all it's output from io:format/2, etc. %% %% The job process then sits down and waits for news from the case process. -%% This might be io requests (which are redirected to the log files). %% %% Returns a tuple with the time spent (in seconds) in the test case, %% the return value from the test case or an {'EXIT',Reason} if the case @@ -559,12 +558,9 @@ stick_all_sticky(Node,Sticky) -> %% ScaleTimetrap indicates if test_server should attemp to automatically %% compensate timetraps for runtime delays introduced by e.g. tools like %% cover. -%% -%% RejectIoReqs (bool) is information about whether printouts to stdout -%% should be visible in the minor log file or not. run_test_case_apply({CaseNum,Mod,Func,Args,Name, - RunInit,TimetrapData,RejectIoReqs}) -> + RunInit,TimetrapData}) -> purify_format("Test case #~w ~w:~w/1", [CaseNum, Mod, Func]), case os:getenv("TS_RUN_VALGRIND") of false -> @@ -576,18 +572,18 @@ run_test_case_apply({CaseNum,Mod,Func,Args,Name, test_server_h:testcase({Mod,Func,1}), ProcBef = erlang:system_info(process_count), Result = run_test_case_apply(Mod, Func, Args, Name, RunInit, - TimetrapData, RejectIoReqs), + TimetrapData), ProcAft = erlang:system_info(process_count), purify_new_leaks(), DetFail = get(test_server_detected_fail), {Result,DetFail,ProcBef,ProcAft}. -run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs) -> +run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> case get(test_server_job_dir) of undefined -> %% i'm a local target do_run_test_case_apply(Mod, Func, Args, Name, RunInit, - TimetrapData, RejectIoReqs); + TimetrapData); JobDir -> %% i'm a remote target case Args of @@ -602,14 +598,14 @@ run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData, RejectIoReqs) Config2 = lists:keyreplace(priv_dir, 1, Config1, {priv_dir,TargetPrivDir}), do_run_test_case_apply(Mod, Func, [Config2], Name, RunInit, - TimetrapData, RejectIoReqs); + TimetrapData); _other -> do_run_test_case_apply(Mod, Func, Args, Name, RunInit, - TimetrapData, RejectIoReqs) + TimetrapData) end end. -do_run_test_case_apply(Mod, Func, Args, Name, RunInit, - TimetrapData, RejectIoReqs) -> + +do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TimetrapData) -> {ok,Cwd} = file:get_cwd(), Args2Print = case Args of [Args1] when is_list(Args1) -> @@ -624,9 +620,6 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, TCCallback = get(test_server_testcase_callback), LogOpts = get(test_server_logopts), Ref = make_ref(), - OldGLeader = group_leader(), - %% Set ourself to group leader for the spawned process - group_leader(self(),self()), Pid = spawn_link( fun() -> @@ -634,9 +627,8 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, RunInit, TimetrapData, LogOpts, TCCallback) end), - group_leader(OldGLeader, self()), put(test_server_detected_fail, []), - run_test_case_msgloop(Ref, Pid, false, RejectIoReqs, false, "", + run_test_case_msgloop(Ref, Pid, false, "", undefined, starting). %% Ugly bug (pre R5A): @@ -648,8 +640,7 @@ do_run_test_case_apply(Mod, Func, Args, Name, RunInit, %% A test case is known to have failed if it returns {'EXIT', _} tuple, %% or sends a message {failed, File, Line} to it's group_leader %% -run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, - Comment, CurrConf, Status) -> +run_test_case_msgloop(Ref, Pid, Terminate, Comment, CurrConf, Status) -> %% NOTE: Keep job_proxy_msgloop/0 up to date when changes %% are made in this function! {Timeout,ReturnValue} = @@ -664,7 +655,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, end, receive {test_case_initialized,Pid} -> - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, Comment,CurrConf,running); Abort = {abort_current_testcase,_,_} when Status == starting -> %% we're in init phase, must must postpone this operation @@ -672,7 +663,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, %% gets killed) self() ! Abort, erlang:yield(), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, Comment,CurrConf,Status); {abort_current_testcase,Reason,From} -> Line = case is_process_alive(Pid) of @@ -703,92 +694,15 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, Error1 end end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, NewComment,CurrConf,Status); - {permit_io,FromPid} -> - put({permit_io,FromPid},true), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} - when is_list(Format) -> - Msg = (catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,io_lib,Func,[Format,Args]}} - when is_atom(Format) -> - Msg = (catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,Bytes}} -> - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} - when is_list(Format) -> - Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} - when is_list(Format) -> - Msg = (catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,unicode,io_lib,Func,[Format,Args]}} - when is_atom(Format) -> - Msg = unicode_to_latin1(catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,latin1,io_lib,Func,[Format,Args]}} - when is_atom(Format) -> - Msg = (catch io_lib:Func(Format,Args)), - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Msg,From,Func), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,unicode,Bytes}} -> - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - unicode_to_latin1(Bytes),From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {io_request,From,ReplyAs,{put_chars,latin1,Bytes}} -> - run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Bytes,From,put_chars), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - IoReq when element(1, IoReq) == io_request -> - %% something else, just pass it on - group_leader() ! IoReq, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {structured_io,ClientPid,Msg} -> - output(Msg, ClientPid), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {capture,NewCapture} -> - run_test_case_msgloop(Ref,Pid,NewCapture,RejectIoReqs,Terminate, - Comment,CurrConf,Status); {sync_apply,From,MFA} -> sync_local_or_remote_apply(false,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, Comment,CurrConf,Status); {sync_apply_proxy,Proxy,From,MFA} -> sync_local_or_remote_apply(Proxy,From,MFA), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, - Comment,CurrConf,Status); - {printout,Detail,Format,Args} -> - print(Detail,Format,Args), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, Comment,CurrConf,Status); {comment,NewComment} -> NewComment1 = test_server_ctrl:to_string(NewComment), @@ -802,19 +716,19 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, Other -> Other end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate1, + run_test_case_msgloop(Ref,Pid,Terminate1, NewComment2,CurrConf,Status); {read_comment,From} -> From ! {self(),read_comment,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, Comment,CurrConf,Status); {set_curr_conf,From,NewCurrConf} -> From ! {self(),set_curr_conf,ok}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, Comment,NewCurrConf,Status); {make_priv_dir,From} when CurrConf == undefined -> From ! {self(),make_priv_dir,{error,no_priv_dir_in_config}}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, Comment,CurrConf,Status); {make_priv_dir,From} -> Result = @@ -832,11 +746,11 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, end end, From ! {self(),make_priv_dir,Result}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs,Terminate, + run_test_case_msgloop(Ref,Pid,Terminate, Comment,CurrConf,Status); {'EXIT',Pid,{Ref,Time,Value,Loc,Opts}} -> RetVal = {Time/1000000,Value,mod_loc(Loc),Opts,Comment}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, {true,RetVal},Comment,undefined,Status); {'EXIT',Pid,Reason} -> case Reason of @@ -849,7 +763,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, {framework_error,{timetrap,TVal}}, unknown,self()), run_test_case_msgloop(Ref,Pid, - CaptureStdout,RejectIoReqs, Terminate,Comment, undefined,Status); Loc1 -> @@ -883,7 +796,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, undefined end, run_test_case_msgloop(Ref,Pid, - CaptureStdout,RejectIoReqs, Terminate,Comment, NewCurrConf,Status) end; @@ -900,7 +812,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, {timetrap_timeout,TVal}, Loc1,self()) end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); {testcase_aborted,ErrorMsg={user_timetrap_error,_},AbortLoc} -> %% user timetrap function caused exit @@ -909,7 +821,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, spawn_fw_call(Mod,Func,CurrConf,Pid, ErrorMsg,unknown,self()), run_test_case_msgloop(Ref,Pid, - CaptureStdout,RejectIoReqs, Terminate,Comment, undefined,Status); {testcase_aborted,AbortReason,AbortLoc} -> @@ -921,7 +832,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, {framework_error,ErrorMsg}, unknown,self()), run_test_case_msgloop(Ref,Pid, - CaptureStdout,RejectIoReqs, Terminate,Comment, undefined,Status); Loc1 -> @@ -954,7 +864,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, undefined end, run_test_case_msgloop(Ref,Pid, - CaptureStdout,RejectIoReqs, Terminate,Comment, NewCurrConf,Status) end; @@ -969,13 +878,13 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, spawn_fw_call(Mod,Func,CurrConf,Pid, testcase_aborted_or_killed, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); {fw_error,{FwMod,FwFunc,FwError}} -> spawn_fw_call(FwMod,FwFunc,CurrConf,Pid, {framework_error,FwError}, unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); _Other -> %% the testcase has terminated because of Reason (e.g. an exit @@ -986,7 +895,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, end, spawn_fw_call(Mod,Func,CurrConf,Pid, Reason,unknown,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status) end; {EndConfPid,{call_end_conf,Data,_Result}} -> @@ -995,10 +904,10 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, {_Mod,_Func,TCPid,TCExitReason,Loc} = Data, spawn_fw_call(Mod,Func,CurrConf,TCPid, TCExitReason,Loc,self()), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,undefined,Status); _ -> - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status) end; {_FwCallPid,fw_notify_done,{T,Value,Loc,Opts,AddToComment}} -> @@ -1019,7 +928,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, end, {T,Value,Loc,Opts,Comment1} end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, {true,RetVal},Comment,undefined,Status); {'EXIT',_FwCallPid,{fw_notify_done,Func,Error}} -> %% a framework function failed @@ -1031,12 +940,12 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, {list_to_atom(CB),Func} end, RetVal = {died,{framework_error,Loc,Error},Loc,"Framework error"}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, {true,RetVal},Comment,undefined,Status); {failed,File,Line} -> put(test_server_detected_fail, [{File, Line}| get(test_server_detected_fail)]), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); {user_timetrap,Pid,_TrapTime,StartTime,E={user_timetrap_error,_},_} -> @@ -1046,7 +955,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, ignore -> ok end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); {user_timetrap,Pid,TrapTime,StartTime,ElapsedTime,Scale} -> %% a user timetrap is triggered, ignore it if new @@ -1062,68 +971,41 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, RejectIoReqs, Terminate, ignore -> ok end, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); {timetrap_cancel_one,Handle,_From} -> timetrap_cancel_one(Handle, false), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); {timetrap_cancel_all,TCPid,_From} -> timetrap_cancel_all(TCPid, false), - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); - {get_timetrap_info,TCPid,From} -> + {get_timetrap_info,From,TCPid} -> Info = get_timetrap_info(TCPid, false), From ! {self(),get_timetrap_info,Info}, - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); _Other when not is_tuple(_Other) -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status); _Other when element(1, _Other) /= 'EXIT', element(1, _Other) /= started, element(1, _Other) /= finished, element(1, _Other) /= print -> %% ignore anything not generated by test server - run_test_case_msgloop(Ref,Pid,CaptureStdout,RejectIoReqs, + run_test_case_msgloop(Ref,Pid, Terminate,Comment,CurrConf,Status) after Timeout -> ReturnValue end. -run_test_case_msgloop_io(From,ReplyAs,CaptureStdout,RejectIoReqs, - Msg,From,Func) -> - case Msg of - {'EXIT',_} -> - From ! {io_reply,ReplyAs,{error,Func}}; - _ -> - From ! {io_reply,ReplyAs,ok} - end, - Proceed = if RejectIoReqs -> get({permit_io,From}); - true -> true - end, - if Proceed -> - if CaptureStdout /= false -> - CaptureStdout ! {captured,Msg}; - true -> - ok - end, - output({minor,Msg},From); - true -> - ok - end. - -output(Msg,Sender) -> - local_or_remote_apply({test_server_ctrl,output,[Msg,Sender]}). - call_end_conf(Mod,Func,TCPid,TCExitReason,Loc,Conf,TVal) -> - %% Starter is also the group leader process Starter = self(), Data = {Mod,Func,TCPid,TCExitReason,Loc}, EndConfProc = fun() -> - group_leader(Starter, self()), Supervisor = self(), EndConfApply = fun() -> @@ -1161,9 +1043,6 @@ spawn_fw_call(Mod,{init_per_testcase,Func},_,Pid,{timetrap_timeout,TVal}=Why, Loc,SendTo) -> FwCall = fun() -> - %% set group leader so that printouts/comments - %% from the framework get printed in the logs - group_leader(SendTo, self()), Skip = {skip,{failed,{Mod,init_per_testcase,Why}}}, %% if init_per_testcase fails, the test case %% should be skipped @@ -1192,9 +1071,6 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, end, FwCall = fun() -> - %% set group leader so that printouts/comments - %% from the framework get printed in the logs - group_leader(SendTo, self()), {RetVal,Report} = case proplists:get_value(tc_status, EndConf1) of undefined -> @@ -1230,9 +1106,6 @@ spawn_fw_call(Mod,{end_per_testcase,Func},EndConf,Pid, spawn_fw_call(FwMod,FwFunc,_,_Pid,{framework_error,FwError},_,SendTo) -> FwCall = fun() -> - %% set group leader so that printouts/comments - %% from the framework get printed in the logs - group_leader(SendTo, self()), test_server_sup:framework_call(report, [framework_error, {{FwMod,FwFunc}, FwError}]), @@ -1256,9 +1129,6 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) -> end, FwCall = fun() -> - %% set group leader so that printouts/comments - %% from the framework get printed in the logs - group_leader(SendTo, self()), case catch fw_error_notify(Mod1,Func1,[], Error,Loc) of {'EXIT',FwErrorNotifyErr} -> @@ -1366,8 +1236,7 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% save current state in controller loop - sync_send(group_leader(),set_curr_conf,{{Mod,Func},hd(Args)}, - 5000, fun() -> exit(no_answer_from_group_leader) end), + tc_supervisor_req(set_curr_conf, {{Mod,Func},hd(Args)}), case RunInit of run_init -> put(test_server_init_or_end_conf,{init_per_testcase,Func}), @@ -1397,8 +1266,7 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% call user callback function if defined NewConf1 = user_callback(TCCallback, Mod, Func, init, NewConf), %% save current state in controller loop - sync_send(group_leader(),set_curr_conf,{{Mod,Func},NewConf1}, - 5000, fun() -> exit(no_answer_from_group_leader) end), + tc_supervisor_req(set_curr_conf, {{Mod,Func},NewConf1}), put(test_server_loc, {Mod,Func}), %% execute the test case {{T,Return},Loc} = {ts_tc(Mod, Func, [NewConf1]),get_loc()}, @@ -1426,8 +1294,7 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> %% call user callback function if defined EndConf1 = user_callback(TCCallback, Mod, Func, 'end', EndConf), %% update current state in controller loop - sync_send(group_leader(),set_curr_conf,EndConf1, 5000, - fun() -> exit(no_answer_from_group_leader) end), + tc_supervisor_req(set_curr_conf, EndConf1), {FWReturn1,TSReturn1,EndConf2} = case end_per_testcase(Mod, Func, EndConf1) of SaveCfg1={save_config,_} -> @@ -1447,8 +1314,7 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {FWReturn,TSReturn,EndConf1} end, %% clear current state in controller loop - sync_send(group_leader(),set_curr_conf,undefined, - 5000, fun() -> exit(no_answer_from_group_leader) end), + tc_supervisor_req(set_curr_conf, undefined), put(test_server_init_or_end_conf,undefined), case do_end_tc_call(Mod,Func, Loc, {FWReturn1,[EndConf2]}, TSReturn1) of @@ -1908,16 +1774,6 @@ rewrite_loc_item({M,F,_,Loc}) -> %% Note: Some of these functions have been moved to test_server_sup %% %% in an attempt to keep this modules small (yeah, right!) %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -unicode_to_latin1(Chars) when is_list(Chars); is_binary(Chars) -> - lists:flatten( - [ case X of - High when High > 255 -> - io_lib:format("\\{~.8B}",[X]); - Low -> - Low - end || X <- unicode:characters_to_list(Chars,unicode) ]); -unicode_to_latin1(Garbage) -> - Garbage. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% format(Format) -> IoLibReturn @@ -2170,24 +2026,19 @@ continue(Pid) when is_pid(Pid) -> %% %% Returns the amount to scale timetraps with. +%% {X, fun() -> check() end} <- multiply scale with X if Fun() is true timetrap_scale_factor() -> - F0 = case test_server:purify_is_running() of - true -> 5; - false -> 1 - end, - F1 = case {is_debug(), has_lock_checking()} of - {true,_} -> 6 * F0; - {false,true} -> 2 * F0; - {false,false} -> F0 - end, - F = case has_superfluous_schedulers() of - true -> 3*F1; - false -> F1 - end, - case test_server:is_cover() of - true -> 10 * F; - false -> F - end. + timetrap_scale_factor([ + { 2, fun() -> has_lock_checking() end}, + { 3, fun() -> has_superfluous_schedulers() end}, + { 5, fun() -> purify_is_running() end}, + { 6, fun() -> is_debug() end}, + {10, fun() -> is_cover() end} + ]). + +timetrap_scale_factor(Scales) -> + %% The fun in {S, Fun} a filter input to the list comprehension + lists:foldl(fun(S,O) -> O*S end, 1, [ S || {S,F} <- Scales, F()]). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2515,11 +2366,7 @@ get_timetrap_info(TCPid, SendToServer) -> [I|_] -> I; [] when SendToServer == true -> - MsgLooper = group_leader(), - MsgLooper ! {get_timetrap_info,TCPid,self()}, - receive - {MsgLooper,get_timetrap_info,I} -> I - end; + tc_supervisor_req({get_timetrap_info,TCPid}); [] -> undefined end @@ -2538,17 +2385,29 @@ hours(N) -> trunc(N * 1000 * 60 * 60). minutes(N) -> trunc(N * 1000 * 60). seconds(N) -> trunc(N * 1000). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% sync_send(Pid,Tag,Msg,Timeout,DoAfter) -> Result +%% tc_supervisor_req(Tag) -> Result +%% tc_supervisor_req(Tag, Msg) -> Result %% -sync_send(Pid,Tag,Msg,Timeout,DoAfter) -> + +tc_supervisor_req(Tag) -> + Pid = test_server_gl:get_tc_supervisor(group_leader()), + Pid ! {Tag,self()}, + receive + {Pid,Tag,Result} -> + Result + after 5000 -> + error(no_answer_from_tc_supervisor) + end. + +tc_supervisor_req(Tag, Msg) -> + Pid = test_server_gl:get_tc_supervisor(group_leader()), Pid ! {Tag,self(),Msg}, receive {Pid,Tag,Result} -> Result - after Timeout -> - DoAfter() + after 5000 -> + error(no_answer_from_tc_supervisor) end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -2943,13 +2802,7 @@ comment(String) -> %% Read the current comment string stored in %% state during test case execution. read_comment() -> - MsgLooper = group_leader(), - MsgLooper ! {read_comment,self()}, - receive - {MsgLooper,read_comment,Comment} -> Comment - after - 5000 -> "" - end. + tc_supervisor_req(read_comment). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% make_priv_dir() -> ok @@ -2957,13 +2810,7 @@ read_comment() -> %% Order test server to create the private directory %% for the current test case. make_priv_dir() -> - MsgLooper = group_leader(), - group_leader() ! {make_priv_dir,self()}, - receive - {MsgLooper,make_priv_dir,Result} -> Result - after - 5000 -> error - end. + tc_supervisor_req(make_priv_dir). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% os_type() -> OsType diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index a38e2be98e..7f04e2eb23 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -172,7 +172,7 @@ -export([kill_slavenodes/0]). %%% TEST_SERVER INTERFACE %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --export([output/2, print/2, print/3, print/4, print_timestamp/2]). +-export([print/2, print/3, print/4, print_timestamp/2]). -export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]). -export([format/1, format/2, format/3, to_string/1]). -export([get_target_info/0]). @@ -203,6 +203,7 @@ -define(coverlog_name, "cover.html"). -define(cross_coverlog_name, "cross_cover.html"). -define(cover_total, "total_cover.log"). +-define(unexpected_io_log, "unexpected_io.log"). -define(last_file, "last_name"). -define(last_link, "last_link"). -define(last_test, "last_test"). @@ -1370,24 +1371,22 @@ kill_all_jobs([]) -> spawn_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) -> - spawn_link( - fun() -> init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, + spawn_link(fun() -> + init_tester(Mod, Func, Args, Dir, Name, Levels, RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) end). -init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs, - CreatePrivDir, TCCallback, ExtraTools) -> +init_tester(Mod, Func, Args, Dir, Name, {_,_,MinLev}=Levels, + RejectIoReqs, CreatePrivDir, TCCallback, ExtraTools) -> process_flag(trap_exit, true), + test_server_io:start_link(), put(test_server_name, Name), put(test_server_dir, Dir), put(test_server_total_time, 0), put(test_server_ok, 0), put(test_server_failed, 0), put(test_server_skipped, {0,0}), - put(test_server_summary_level, SumLev), - put(test_server_major_level, MajLev), put(test_server_minor_level, MinLev), - put(test_server_reject_io_reqs, RejectIoReqs), put(test_server_create_priv_dir, CreatePrivDir), put(test_server_random_seed, proplists:get_value(random_seed, ExtraTools)), put(test_server_testcase_callback, TCCallback), @@ -1403,23 +1402,29 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs, put(test_server_framework_name, list_to_atom(FWName)) end end, + %% before first print, read and set logging options LogOpts = test_server_sup:framework_call(get_logopts, [], []), put(test_server_logopts, LogOpts), - put(test_server_log_nl, not lists:member(no_nl, LogOpts)), + StartedExtraTools = start_extra_tools(ExtraTools), + + test_server_io:set_job_name(Name), + test_server_io:set_gl_props([{levels,Levels}, + {auto_nl,not lists:member(no_nl, LogOpts)}, + {reject_io_reqs,RejectIoReqs}]), + group_leader(test_server_io:get_gl(true), self()), {TimeMy,Result} = ts_tc(Mod, Func, Args), - put(test_server_common_io_handler, undefined), - stop_extra_tools(StartedExtraTools), + set_io_buffering(undefined), + catch stop_extra_tools(StartedExtraTools), case Result of {'EXIT',test_suites_done} -> - print(25, "DONE, normal exit", []); + ok; {'EXIT',_Pid,Reason} -> print(1, "EXIT, reason ~p", [Reason]); {'EXIT',Reason} -> - print(1, "EXIT, reason ~p", [Reason]); - _Other -> - print(25, "DONE", []) + report_severe_error(Reason), + print(1, "EXIT, reason ~p", [Reason]) end, Time = TimeMy/1000000, SuccessStr = @@ -1438,7 +1443,11 @@ init_tester(Mod, Func, Args, Dir, Name, {SumLev,MajLev,MinLev}, RejectIoReqs, "<tr><td></td><td><b>TOTAL</b></td><td></td><td></td><td></td>" "<td>~.3fs</td><td><b>~s</b></td><td>~p Ok, ~p Failed~s of ~p</td></tr>\n" "</tfoot>\n", - [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]). + [Time,SuccessStr,OkN,FailedN,SkipStr,OkN+FailedN+SkippedN]), + test_server_io:stop(). + +report_severe_error(Reason) -> + test_server_sup:framework_call(report, [severe_error,Reason]). %% timer:tc/3 ts_tc(M, F, A) -> @@ -1812,8 +1821,9 @@ do_test_cases(TopCases, SkipCases, print(html, "<p><ul>\n" "<li><a href=\"~s\">Full textual log</a></li>\n" - "<li><a href=\"~s\">Coverage log</a></li>\n</ul></p>\n", - [?suitelog_name,?coverlog_name]), + "<li><a href=\"~s\">Coverage log</a></li>\n" + "<li><a href=\"~s\">Unexpected I/O log</a></li>\n</ul></p>\n", + [?suitelog_name,?coverlog_name,?unexpected_io_log]), print(html, "<p>~s</p>\n" ++ xhtml("<table bgcolor=\"white\" border=\"3\" cellpadding=\"5\">", @@ -1873,7 +1883,7 @@ start_log_file() -> {error, eexist} -> ok; MkDirError -> - exit({cant_create_log_dir,{MkDirError,Dir}}) + log_file_error(MkDirError, Dir) end, TestDir = timestamp_filename_get(filename:join(Dir, "run.")), TestDir1 = @@ -1888,20 +1898,26 @@ start_log_file() -> ok -> TestDirX; MkDirError2 -> - exit({cant_create_log_dir,{MkDirError2,TestDirX}}) + log_file_error(MkDirError2, TestDirX) end; MkDirError2 -> - exit({cant_create_log_dir,{MkDirError2,TestDir}}) + log_file_error(MkDirError2, TestDir) end, ok = file:write_file(filename:join(Dir, ?last_file), TestDir1 ++ "\n"), ok = file:write_file(?last_file, TestDir1 ++ "\n"), put(test_server_log_dir_base,TestDir1), MajorName = filename:join(TestDir1, ?suitelog_name), HtmlName = MajorName ++ ?html_ext, + UnexpectedName = filename:join(TestDir1, ?unexpected_io_log), {ok,Major} = file:open(MajorName, [write]), {ok,Html} = file:open(HtmlName, [write]), + {ok,Unexpected} = file:open(UnexpectedName, [write]), + test_server_io:set_fd(major, Major), + test_server_io:set_fd(html, Html), + test_server_io:set_fd(unexpected_io, Unexpected), put(test_server_major_fd,Major), put(test_server_html_fd,Html), + put(test_server_unexpected_io, Unexpected), make_html_link(filename:absname(?last_test ++ ?html_ext), HtmlName, filename:basename(Dir)), @@ -1912,12 +1928,15 @@ start_log_file() -> PrivDir = filename:join(TestDir1, ?priv_dir), ok = file:make_dir(PrivDir), put(test_server_priv_dir,PrivDir++"/"), - print_timestamp(13,"Suite started at "), + print_timestamp(major, "Suite started at "), LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir1)}], test_server_sup:framework_call(report, [loginfo,LogInfo]), {ok,TestDir1}. +log_file_error(Error, Dir) -> + exit({cannot_create_log_dir,{Error,lists:flatten(Dir)}}). + make_html_link(LinkName, Target, Explanation) -> %% if possible use a relative reference to Target. TargetL = filename:split(Target), @@ -1951,13 +1970,14 @@ make_html_link(LinkName, Target, Explanation) -> %% Some header info will also be inserted into the log file. start_minor_log_file(Mod, Func) -> + MFA = {Mod,Func,1}, LogDir = get(test_server_log_dir_base), Name0 = lists:flatten(io_lib:format("~s.~s~s", [Mod,Func,?html_ext])), Name = downcase(Name0), AbsName = filename:join(LogDir, Name), case file:read_file_info(AbsName) of {error,_} -> %% normal case, unique name - start_minor_log_file1(Mod, Func, LogDir, AbsName); + start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA); {ok,_} -> %% special case, duplicate names {_,S,Us} = now(), Name1_0 = @@ -1966,14 +1986,15 @@ start_minor_log_file(Mod, Func) -> ?html_ext])), Name1 = downcase(Name1_0), AbsName1 = filename:join(LogDir, Name1), - start_minor_log_file1(Mod, Func, LogDir, AbsName1) + start_minor_log_file1(Mod, Func, LogDir, AbsName1, MFA) end. -start_minor_log_file1(Mod, Func, LogDir, AbsName) -> +start_minor_log_file1(Mod, Func, LogDir, AbsName, MFA) -> {ok,Fd} = file:open(AbsName, [write]), Lev = get(test_server_minor_level)+1000, %% far down in the minor levels put(test_server_minor_fd, Fd), - + test_server_gl:set_minor_fd(group_leader(), Fd, MFA), + TestDescr = io_lib:format("Test ~p:~p result", [Mod,Func]), {Header,Footer} = case test_server_sup:framework_call(get_html_wrapper, @@ -2021,6 +2042,7 @@ start_minor_log_file1(Mod, Func, LogDir, AbsName) -> AbsName. stop_minor_log_file() -> + test_server_gl:unset_minor_fd(group_leader()), Fd = get(test_server_minor_fd), Footer = get(test_server_minor_footer), io:fwrite(Fd, "</pre>\n" ++ Footer, []), @@ -2441,27 +2463,38 @@ maybe_get_privdir() -> %% reason, the Mode argument specifies if a parallel group is currently %% being executed. %% -%% A parallel test case process will always set the dictionary value -%% 'test_server_common_io_handler' to the pid of the main (starting) -%% process. With this value set, the print/3 function will send print -%% messages to the main process instead of writing the data to file -%% (only true for printouts to common log files). +%% The low-level mechanism for buffering IO for the common log files +%% is handled by the test_server_io module. Buffering is turned on by +%% test_server_io:start_transaction/0 and off by calling +%% test_server_io:end_transaction/0. The buffered data for the transaction +%% can printed by calling test_server_io:print_buffered/1. +%% +%% This module is responsible for turning on IO buffering and to later +%% test_server_io:print_buffered/1 to print the data. To help with this, +%% two variables in the process dictionary are used: +%% 'test_server_common_io_handler' and 'test_server_queued_io'. The values +%% are set to as follwing: +%% +%% Value Meaning +%% ----- ------- +%% undefined No parallel test cases running +%% {tc,Pid} Running test cases in a top-level parallel group +%% {Ref,Pid} Running sequential test case inside a parallel group +%% +%% FIXME: The Pid is no longer used. %% %% If a conf group nested under a parallel group in the test %% specification should be started, the 'test_server_common_io_handler' -%% value gets set also on the main process. This causes all printouts -%% to common files - both from parallel test cases and from cases -%% executed by the main process - to all end up as messages in the -%% inbox of the main process. +%% value gets set also on the main process. %% %% During execution of a parallel group (or of a group nested under a %% parallel group), *any* new test case being started gets registered %% in a list saved in the dictionary with 'test_server_queued_io' as key. %% When the top level parallel group is finished (only then can we be %% sure all parallel test cases have finished and "reported in"), the -%% list of test cases is traversed in order and printout messages from -%% each process - including the main process - are handled in turn. See -%% handle_test_case_io_and_status/0 for details. +%% list of test cases is traversed in order and test_server_io:print_buffered/1 +%% can be called for each test case. See handle_test_case_io_and_status/0 +%% for details. %% %% To be able to handle nested conf groups with different properties, %% the Mode argument specifies a list of {Ref,Properties} tuples. @@ -2604,16 +2637,15 @@ run_test_cases_loop([{auto_skip_case,{Type,Ref,Case,Comment},SkipMode}|Cases], run_test_cases_loop([{auto_skip_case,{Case,Comment},SkipMode}|Cases], Config, TimetrapData, Mode, Status) -> - {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1, Case, Comment, - (undefined /= get(test_server_common_io_handler)), SkipMode), + {Mod,Func} = skip_case(auto, undefined, get(test_server_case_num)+1, + Case, Comment, is_io_buffered(), SkipMode), test_server_sup:framework_call(report, [tc_auto_skip,{?pl2a(Mod),Func,Comment}]), run_test_cases_loop(Cases, Config, TimetrapData, Mode, update_status(skipped, Mod, Func, Status)); run_test_cases_loop([{skip_case,{conf,Ref,Case,Comment}}|Cases0], Config, TimetrapData, Mode, Status) -> - {Mod,Func} = skip_case(user, Ref, 0, Case, Comment, - (undefined /= get(test_server_common_io_handler))), + {Mod,Func} = skip_case(user, Ref, 0, Case, Comment, is_io_buffered()), {Cases,Config1} = case curr_ref(Mode) of Ref -> @@ -2629,8 +2661,8 @@ run_test_cases_loop([{skip_case,{conf,Ref,Case,Comment}}|Cases0], run_test_cases_loop([{skip_case,{Case,Comment}}|Cases], Config, TimetrapData, Mode, Status) -> - {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1, Case, Comment, - (undefined /= get(test_server_common_io_handler))), + {Mod,Func} = skip_case(user, undefined, get(test_server_case_num)+1, + Case, Comment, is_io_buffered()), test_server_sup:framework_call(report, [tc_user_skip,{?pl2a(Mod),Func,Comment}]), run_test_cases_loop(Cases, Config, TimetrapData, Mode, update_status(skipped, Mod, Func, Status)); @@ -3029,21 +3061,19 @@ run_test_cases_loop([{Mod,Case}|Cases], Config, TimetrapData, Mode, Status) -> run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) -> Num = put(test_server_case_num, get(test_server_case_num)+1), + %% check the current execution mode and save info about the case if %% detected that printouts to common log files is handled later - case check_prop(parallel, Mode) of + + case check_prop(parallel, Mode) =:= false andalso is_io_buffered() of + true -> + %% sequential test case nested in a parallel group; + %% io is buffered, so we must queue this test case + queue_test_case_io(undefined, self(), Num+1, Mod, Func); false -> - case get(test_server_common_io_handler) of - undefined -> - %% io printouts are written to straight to file - ok; - _ -> - %% io messages are buffered, put test case in queue - queue_test_case_io(undefined, self(), Num+1, Mod, Func) - end; - _ -> ok end, + case run_test_case(undefined, Num+1, Mod, Func, Args, run_init, target, TimetrapData, Mode) of %% callback to framework module failed, exit immediately @@ -3092,8 +3122,8 @@ run_test_cases_loop([{Mod,Func,Args}|Cases], Config, TimetrapData, Mode, Status) %% the test case is being executed in parallel with the main process (and %% other test cases) and Pid is the dedicated process executing the case Pid -> - %% io from Pid will be buffered in the main process inbox and handled - %% later, so we have to save info about the case + %% io from Pid will be buffered by the test_server_io process and + %% handled later, so we have to save info about the case queue_test_case_io(undefined, Pid, Num+1, Mod, Func), run_test_cases_loop(Cases, Config, TimetrapData, Mode, Status) end; @@ -3200,11 +3230,17 @@ get_data_dir(Mod, Suite) -> non_existing -> print(12, "The module ~p is not loaded", [Mod]), []; + cover_compiled -> + MainCoverNode = cover:get_main_node(), + {file,File} = rpc:call(MainCoverNode,cover,is_compiled,[UseMod]), + do_get_data_dir(UseMod,File); FullPath -> - filename:dirname(FullPath) ++ "/" ++ cast_to_list(UseMod) ++ - ?data_dir_suffix + do_get_data_dir(UseMod,FullPath) end. +do_get_data_dir(Mod,File) -> + filename:dirname(File) ++ "/" ++ cast_to_list(Mod) ++ ?data_dir_suffix. + print_conf_time(0) -> ok; print_conf_time(ConfTime) -> @@ -3348,7 +3384,9 @@ skip_case(Type, Ref, CaseNum, Case, Comment, SendSync, Mode) -> if SendSync -> queue_test_case_io(Ref, self(), CaseNum, Mod, Func), self() ! {started,Ref,self(),CaseNum,Mod,Func}, + test_server_io:start_transaction(), skip_case1(Type, CaseNum, Mod, Func, Comment, Mode), + test_server_io:end_transaction(), self() ! {finished,Ref,self(),CaseNum,Mod,Func,skipped,{0,skipped,[]}}; not SendSync -> skip_case1(Type, CaseNum, Mod, Func, Comment, Mode) @@ -3489,13 +3527,20 @@ modify_cases_upto1(Ref, CopyOp, [C|T], Orig, Alt) -> %% %% Save info about current process (always the main process) buffering %% io printout messages from parallel test case processes (*and* possibly -%% also the main process). If the value is the default 'undefined', -%% io is not buffered but printed directly to file (see print/3). +%% also the main process). set_io_buffering(IOHandler) -> put(test_server_common_io_handler, IOHandler). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_io_buffered() -> true|false +%% +%% Test whether is being buffered. + +is_io_buffered() -> + get(test_server_common_io_handler) =/= undefined. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% queue_test_case_io(Pid, Num, Mod, Func) -> ok %% %% Save info about test case that gets its io buffered. This can @@ -3542,7 +3587,7 @@ wait_and_resend(Ref, [{_,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> receive {finished,_Ref,CurrPid,CaseNum,Mod,Func,Result,_RetVal} = Msg -> %% resend message to main process so that it can be used - %% to handle buffered io messages later + %% to test_server_io:print_buffered/1 later self() ! Msg, MF = {Mod,Func}, {Ok1,Skip1,Fail1} = @@ -3573,16 +3618,18 @@ rm_cases_upto(Ref, [_|Ps]) -> %% %% Each parallel test case process prints to its own minor log file during %% execution. The common log files (major, html etc) must however be -%% written to sequentially. The test case processes send print requests -%% to the main (starting) process (the same process executing -%% run_test_cases_loop/4), which handles these requests in the same -%% order that the test case processes were started. -%% -%% An io session is always started with a {started,Ref,Pid,Num,Mod,Func} -%% message and terminated with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal}. -%% The result shipped with the finished message from a parallel process -%% is used to update status data of the current test run. An 'EXIT' -%% message from each parallel test case process (after finishing and +%% written to sequentially. This is handled by calling +%% test_server_io:start_transaction/0 to tell the test_server_io process +%% to buffer all print requests. +%% +%% An io session is always started with a +%% {started,Ref,Pid,Num,Mod,Func} message (and +%% test_server_io:start_transaction/0 will be called) and terminated +%% with {finished,Ref,Pid,Num,Mod,Func,Result,RetVal} (and +%% test_server_io:end_transaction/0 will be called). The result +%% shipped with the finished message from a parallel process is used +%% to update status data of the current test run. An 'EXIT' message +%% from each parallel test case process (after finishing and %% terminating) is also received and handled here. %% %% During execution of a parallel group, any cases (conf or normal) @@ -3591,13 +3638,13 @@ rm_cases_upto(Ref, [_|Ps]) -> %% correct sequence. This function handles also the print messages %% generated by nested group cases that have been executed sequentially %% by the main process (note that these cases do not generate 'EXIT' -%% messages, only 'start', 'print' and 'finished' messages). +%% messages, only 'start' and 'finished' messages). %% %% See the header comment for run_test_cases_loop/4 for more %% info about IO handling. %% %% Note: It is important that the type of messages handled here -%% do not get consumated by test_server:run_test_case_msgloop/5 +%% do not get consumed by test_server:run_test_case_msgloop/5 %% during the test case execution (e.g. in the catch clause of %% the receive)! @@ -3624,7 +3671,7 @@ handle_test_case_io_and_status() -> %% Handle cases (without Ref) that belong to the top parallel group (i.e. when Refs = []) handle_io_and_exit_loop([], [{undefined,CurrPid,CaseNum,Mod,Func}|Ps] = Cases, Ok,Skip,Fail) -> - %% retreive the start message for the current io session (= testcase) + %% retrieve the start message for the current io session (= testcase) receive {started,_,CurrPid,CaseNum,Mod,Func} -> {Ok1,Skip1,Fail1} = @@ -3666,9 +3713,11 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> receive %% end of io session from test case executed by main process {finished,_,Main,CaseNum,Mod,Func,Result,_RetVal} -> + test_server_io:print_buffered(CurrPid), {Result,{Mod,Func}}; %% end of io session from test case executed by parallel process {finished,_,CurrPid,CaseNum,Mod,Func,Result,RetVal} -> + test_server_io:print_buffered(CurrPid), case Result of ok -> put(test_server_ok, get(test_server_ok)+1); @@ -3681,13 +3730,9 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> end, {Result,{Mod,Func}}; - %% print to common log file - {print,CurrPid,Detail,Msg} -> - output({Detail,Msg}, internal), - handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases); - %% unexpected termination of test case process {'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 #~p (~p:~p) died! Reason: ~p", [Num, M, F, Reason]), @@ -3722,48 +3767,46 @@ handle_io_and_exits(Main, CurrPid, CaseNum, Mod, Func, Cases) -> run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData) -> file:set_cwd(filename:dirname(get(test_server_dir))), run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, - TimetrapData, [], [], self()). + TimetrapData, [], self()). run_test_case(Ref, Num, Mod, Func, Args, skip_init, Where, TimetrapData, Mode) -> %% a conf case is always executed by the main process run_test_case1(Ref, Num, Mod, Func, Args, skip_init, Where, - TimetrapData, [], Mode, self()); + TimetrapData, Mode, self()); run_test_case(Ref, Num, Mod, Func, Args, RunInit, Where, TimetrapData, Mode) -> file:set_cwd(filename:dirname(get(test_server_dir))), + Main = self(), case check_prop(parallel, Mode) of false -> %% this is a sequential test case run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, - TimetrapData, [], Mode, self()); + TimetrapData, Mode, Main); _Ref -> %% this a parallel test case, spawn the new process - Main = self(), - {dictionary,State} = process_info(self(), dictionary), - spawn_link(fun() -> - run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, - TimetrapData, State, Mode, Main) - end) + Dictionary = get(), + {dictionary,Dictionary} = process_info(self(), dictionary), + spawn_link( + fun() -> + process_flag(trap_exit, true), + [put(Key, Val) || {Key,Val} <- Dictionary], + set_io_buffering({tc,Main}), + run_test_case1(Ref, Num, Mod, Func, Args, RunInit, + Where, TimetrapData, Mode, Main) + end) end. run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, - TimetrapData, State, Mode, Main) -> - %% if this runs on a parallel test case process, - %% copy the dictionary from the main process - do_if_parallel(Main, fun() -> process_flag(trap_exit, true) end, ok), - CopyDict = fun() -> lists:foreach(fun({Key,Val}) -> - put(Key, Val) - end, State) - end, - do_if_parallel(Main, CopyDict, ok), - do_if_parallel(Main, fun() -> - put(test_server_common_io_handler, {tc,Main}) - end, ok), + TimetrapData, Mode, Main) -> + group_leader(test_server_io:get_gl(Main == self()), self()), + %% if io is being buffered, send start io session message %% (no matter if case runs on parallel or main process) - case get(test_server_common_io_handler) of - undefined -> ok; - _ -> Main ! {started,Ref,self(),Num,Mod,Func} + case is_io_buffered() of + false -> ok; + true -> + test_server_io:start_transaction(), + Main ! {started,Ref,self(),Num,Mod,Func} end, TSDir = get(test_server_dir), case Where of @@ -3772,6 +3815,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, host -> ok end, + print(major, "=case ~p:~p", [Mod, Func]), MinorName = start_minor_log_file(Mod, Func), print(minor, "<a name=\"top\"></a>", [], internal_raw), @@ -3823,13 +3867,12 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, [num2str(Num),fw_name(Mod),GroupName,MinorBase,Func, MinorBase,MinorBase]), - do_if_parallel(Main, ok, fun erlang:yield/0), + do_unless_parallel(Main, fun erlang:yield/0), - RejectIoReqs = get(test_server_reject_io_reqs), %% run the test case {Result,DetectedFail,ProcsBefore,ProcsAfter} = run_test_case_apply(Num, Mod, Func, [UpdatedArgs], get_name(Mode), - RunInit, Where, TimetrapData, RejectIoReqs), + RunInit, Where, TimetrapData), {Time,RetVal,Loc,Opts,Comment} = case Result of Normal={_Time,_RetVal,_Loc,_Opts,_Comment} -> Normal; @@ -3841,7 +3884,7 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, print_timestamp(minor, "Ended at "), print(major, "=ended ~s", [lists:flatten(timestamp_get(""))]), - do_if_parallel(Main, ok, fun() -> file:set_cwd(filename:dirname(TSDir)) end), + do_unless_parallel(Main, fun() -> file:set_cwd(filename:dirname(TSDir)) end), %% call the appropriate progress function clause to print the results to log Status = @@ -3950,10 +3993,13 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, %% if io is being buffered, send finished message %% (no matter if case runs on parallel or main process) - case get(test_server_common_io_handler) of - undefined -> ok; - _ -> Main ! {finished,Ref,self(),Num,Mod,Func, - ?mod_result(Status),{Time,RetVal,Opts}} + case is_io_buffered() of + false -> + ok; + true -> + test_server_io:end_transaction(), + Main ! {finished,Ref,self(),Num,Mod,Func, + ?mod_result(Status),{Time,RetVal,Opts}} end, {Time,RetVal,Opts}. @@ -3961,18 +4007,11 @@ run_test_case1(Ref, Num, Mod, Func, Args, RunInit, Where, %%-------------------------------------------------------------------- %% various help functions -%% Call If() if we're on parallel process, or -%% call Else() if we're on main process -do_if_parallel(Pid, If, Else) -> +%% Call Action if we are running on the main process (not parallel). +do_unless_parallel(Main, Action) when is_function(Action, 0) -> case self() of - Pid -> - if is_function(Else) -> Else(); - true -> Else - end; - _ -> - if is_function(If) -> If(); - true -> If - end + Main -> Action(); + _ -> ok end. num2str(0) -> ""; @@ -4448,7 +4487,7 @@ do_format_exception(Reason={Error,Stack}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, -%% Where, TimetrapData, RejectIoReqs) -> +%% Where, TimetrapData) -> %% {{Time,RetVal,Loc,Opts,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} | %% {{died,Reason,unknown,Comment},DetectedFail,ProcessesBefore,ProcessesAfter} %% Name = atom() @@ -4468,20 +4507,20 @@ do_format_exception(Reason={Error,Stack}) -> %% result back over the socket. Else test_server runs the case directly on host. run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, host, - TimetrapData, RejectIoReqs) -> + TimetrapData) -> test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData,RejectIoReqs}); + TimetrapData}); run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, - TimetrapData, RejectIoReqs) -> + TimetrapData) -> case get(test_server_ctrl_job_sock) of undefined -> %% local target test_server:run_test_case_apply({CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData,RejectIoReqs}); + TimetrapData}); JobSock -> %% remote target request(JobSock, {test_case,{CaseNum,Mod,Func,Args,Name,RunInit, - TimetrapData,RejectIoReqs}}), + TimetrapData}}), read_job_sock_loop(JobSock) end. @@ -4493,16 +4532,6 @@ run_test_case_apply(CaseNum, Mod, Func, Args, Name, RunInit, target, %% %% Just like io:format, except that depending on the Detail value, the output %% is directed to console, major and/or minor log files. -%% -%% To handle printouts to common (not minor) log files from parallel test -%% case processes, the test_server_common_io_handler value is checked. If -%% set, the data is sent to the main controlling process. Note that test -%% cases that belong to a conf group nested under a parallel group will also -%% get its io data sent to main rather than immediately printed out, even -%% if the test cases are executed by the same, main, process (ie the main -%% process sends messages to itself then). -%% -%% Buffered io is handled by the handle_test_case_io_and_status/0 function. print(Detail, Format) -> print(Detail, Format, []). @@ -4515,19 +4544,7 @@ print(Detail, Format, Args, Printer) -> print_or_buffer(Detail, Msg, Printer). print_or_buffer(Detail, Msg, Printer) -> - case get(test_server_minor_level) of - _ when Detail == minor -> - output({Detail,Msg}, Printer); - MinLevel when is_number(Detail), Detail >= MinLevel -> - output({Detail,Msg}, Printer); - _ -> % Detail < Minor | major | html - case get(test_server_common_io_handler) of - undefined -> - output({Detail,Msg}, Printer); - {_,MainPid} -> - MainPid ! {print,self(),Detail,Msg} - end - end. + test_server_gl:print(group_leader(), Detail, Msg, Printer). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% print_timestamp(Detail, Leader) -> ok @@ -4591,112 +4608,6 @@ format(Detail, Format, Args) -> print_or_buffer(Detail, Str, self()). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% output({Level,Message}, Sender) -> ok -%% Level = integer() | minor | major | html -%% Message = string() | [integer()] -%% Sender = string() | internal -%% -%% Outputs the message on the channels indicated by Level. If Level is an -%% atom, only the corresponding channel receives the output. When Level is -%% an integer console, major and/or minor log file will receive output -%% depending on the user set thresholds (see get_levels/0, set_levels/3) -%% -%% When printing on the console, the message is prefixed with the test -%% suite's name. In case a name is not set (yet), Sender is used. -%% -%% When not outputting to the console, and the Sender is 'internal', -%% the message is prefixed with "=== ", so that it will be apparent that -%% the message comes from the test server and not the test suite itself. - -output({Level,Msg}, Sender) when is_integer(Level) -> - SumLev = get(test_server_summary_level), - if Level =< SumLev -> - output_to_fd(stdout, Msg, Sender); - true -> - ok - end, - MajLev = get(test_server_major_level), - if Level =< MajLev -> - output_to_fd(get(test_server_major_fd), Msg, Sender); - true -> - ok - end, - MinLev = get(test_server_minor_level), - if Level >= MinLev -> - output_to_fd(get(test_server_minor_fd), Msg, Sender); - true -> - ok - end; -output({minor,Bytes}, Sender) when is_list(Bytes) -> - output_to_fd(get(test_server_minor_fd), Bytes, Sender); -output({major,Bytes}, Sender) when is_list(Bytes) -> - output_to_fd(get(test_server_major_fd), Bytes, Sender); -output({minor,Bytes}, Sender) when is_binary(Bytes) -> - output_to_fd(get(test_server_minor_fd),binary_to_list(Bytes), Sender); -output({major,Bytes}, Sender) when is_binary(Bytes) -> - output_to_fd(get(test_server_major_fd),binary_to_list(Bytes), Sender); -output({html,Msg}, _Sender) -> - case get(test_server_html_fd) of - undefined -> - ok; - Fd -> - io:put_chars(Fd,Msg), - case file:position(Fd, {cur, 0}) of - {ok, Pos} -> - %% We are writing to a seekable file. Finalise so - %% we get complete valid (and viewable) HTML code. - %% Then rewind to overwrite the finalising code. - io:put_chars(Fd, "\n</table>\n"), - case get(test_server_html_footer) of - undefined -> - io:put_chars(Fd, "</body>\n</html>\n"); - Footer -> - io:put_chars(Fd, Footer) - end, - file:position(Fd, Pos); - {error, epipe} -> - %% The file is not seekable. We cannot erase what - %% we've already written --- so the reader will - %% have to wait until we're done. - ok - end - end; -output({minor,Data}, Sender) -> - output_to_fd(get(test_server_minor_fd), - lists:flatten(io_lib:format( - "Unexpected output: ~p~n", [Data])),Sender); -output({major,Data}, Sender) -> - output_to_fd(get(test_server_major_fd), - lists:flatten(io_lib:format( - "Unexpected output: ~p~n", [Data])),Sender). - -output_to_fd(stdout, Msg, Sender) -> - Name = - case get(test_server_name) of - undefined -> Sender; - Other -> Other - end, - io:format("Testing ~s: ~s\n", [Name, lists:flatten(Msg)]); -output_to_fd(undefined, _Msg, _Sender) -> - ok; -output_to_fd(Fd, [$=|Msg], internal) -> - io:put_chars(Fd, [$=]), - io:put_chars(Fd, Msg), - io:put_chars(Fd, "\n"); - -output_to_fd(Fd, Msg, internal) -> - io:put_chars(Fd, [$=,$=,$=,$ ]), - io:put_chars(Fd, Msg), - io:put_chars(Fd, "\n"); - -output_to_fd(Fd, Msg, _Sender) -> - io:put_chars(Fd, Msg), - case get(test_server_log_nl) of - false -> ok; - _ -> io:put_chars(Fd, "\n") - end. - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% xhtml(BasicHtml, XHtml) -> BasicHtml | XHtml %% xhtml(HTML, XHTML) -> @@ -5827,11 +5738,11 @@ write_default_cross_coverlog(TestDir) -> {ok,CrossCoverLog} = file:open(filename:join(TestDir,?cross_coverlog_name), [write]), write_coverlog_header(CrossCoverLog), - io:fwrite(CrossCoverLog, - ["No cross cover modules exist for this application,", - xhtml("<br>","<br />"), - "or cross cover analysis is not completed.\n" - "</body></html>\n"], []), + io:put_chars(CrossCoverLog, + ["No cross cover modules exist for this application,", + xhtml("<br>","<br />"), + "or cross cover analysis is not completed.\n" + "</body></html>\n"]), file:close(CrossCoverLog). write_cover_result_table(CoverLog,Coverage) -> diff --git a/lib/test_server/src/test_server_gl.erl b/lib/test_server/src/test_server_gl.erl new file mode 100644 index 0000000000..d32c7c07dc --- /dev/null +++ b/lib/test_server/src/test_server_gl.erl @@ -0,0 +1,293 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% This module implements group leader processes for test cases. +%% Each group leader process handles output to the minor log file for +%% a test case, and calls test_server_io to handle output to the common +%% log files. The group leader processes are created and destroyed +%% through the test_server_io module/process. + +-module(test_server_gl). +-export([start_link/0,stop/1,set_minor_fd/3,unset_minor_fd/1, + get_tc_supervisor/1,print/4,set_props/2]). + +-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]). + +-record(st, {tc_supervisor :: 'none'|pid(), %Test case supervisor + tc :: mfa(), %Current test case MFA + minor :: 'none'|pid(), %Minor fd + minor_monitor, %Monitor ref for minor fd + capture :: 'none'|pid(), %Capture output + reject_io :: boolean(), %Reject I/O requests... + permit_io, %... and exceptions + auto_nl=true :: boolean(), %Automatically add NL + levels %{Stdout,Major,Minor} + }). + +%% start_link() +%% Start a new group leader process. Only to be called by +%% the test_server_io process. + +start_link() -> + case gen_server:start_link(?MODULE, [], []) of + {ok,Pid} -> + {ok,Pid}; + Other -> + Other + end. + + +%% stop(Pid) +%% Stop a group leader process. Only to be called by +%% the test_server_io process. + +stop(GL) -> + gen_server:cast(GL, stop). + + +%% set_minor_fd(GL, Fd, MFA) +%% GL = Pid for the group leader process +%% Fd = file descriptor for the minor log file +%% MFA = {M,F,A} for the test case owning the minor log file +%% +%% Register the file descriptor for the minor log file. Subsequent +%% IO directed to the minor log file will be written to this file. +%% Also register the currently executing process at the testcase +%% supervisor corresponding to this group leader process. + +set_minor_fd(GL, Fd, MFA) -> + req(GL, {set_minor_fd,Fd,MFA,self()}). + + +%% unset_minor_fd(GL, Fd, MFA) +%% GL = Pid for the group leader process +%% +%% Unregister the file descriptor for minor log file (typically +%% because the test case has ended the minor log file is about +%% to be closed). Subsequent IO (for example, by a process spawned +%% by the testcase process) will go to the unexpected_io log file. + +unset_minor_fd(GL) -> + req(GL, unset_minor_fd). + + +%% get_tc_supervisor(GL) +%% GL = Pid for the group leader process +%% +%% Return the Pid for the process that supervises the test case +%% that has this group leader. + +get_tc_supervisor(GL) -> + req(GL, get_tc_supervisor). + + +%% print(GL, Detail, Format, Args) -> ok +%% GL = Pid for the group leader process +%% Detail = integer() | minor | major | html | stdout +%% Msg = iodata() +%% Printer = internal | pid() +%% +%% Print a message to one of the log files. If Detail is an integer, +%% it will be compared to the levels (set by set_props/2) to +%% determine which log file(s) that are to receive the output. If +%% Detail is an atom, the value of the atom will directly determine +%% which log file to use. IO to the minor log file will be handled +%% directly by this group leader process (printing to the file set by +%% set_minor_fd/3), and all other IO will be handled by calling +%% test_server_io:print/3. + +print(GL, Detail, Msg, Printer) -> + req(GL, {print,Detail,Msg,Printer}). + + +%% set_props(GL, [PropertyTuple]) +%% GL = Pid for the group leader process +%% PropertyTuple = {levels,{Show,Major,Minor}} | +%% {auto_nl,boolean()} | +%% {reject_io_reqs,boolean()} +%% +%% Set properties for this group leader process. + +set_props(GL, PropList) -> + req(GL, {set_props,PropList}). + +%%% Internal functions. + +init([]) -> + {ok,#st{tc_supervisor=none, + minor=none, + minor_monitor=none, + capture=none, + reject_io=false, + permit_io=gb_sets:empty(), + auto_nl=true, + levels={1,19,10} + }}. + +req(GL, Req) -> + gen_server:call(GL, Req, infinity). + +handle_call(get_tc_supervisor, _From, #st{tc_supervisor=Pid}=St) -> + {reply,Pid,St}; +handle_call({set_minor_fd,Fd,MFA,Supervisor}, _From, St) -> + Ref = erlang:monitor(process, Fd), + {reply,ok,St#st{tc=MFA,minor=Fd,minor_monitor=Ref, + tc_supervisor=Supervisor}}; +handle_call(unset_minor_fd, _From, St) -> + {reply,ok,St#st{minor=none,tc_supervisor=none}}; +handle_call({set_props,PropList}, _From, St) -> + {reply,ok,do_set_props(PropList, St)}; +handle_call({print,Detail,Msg,Printer}, {From,_}, St) -> + output(Detail, Msg, Printer, From, St), + {reply,ok,St}. + +handle_cast(stop, St) -> + {stop,normal,St}. + +handle_info({'DOWN',Ref,process,_,_}, #st{minor_monitor=Ref}=St) -> + {noreply,St#st{minor=none,minor_monitor=none}}; +handle_info({permit_io,Pid}, #st{permit_io=P}=St) -> + {noreply,St#st{permit_io=gb_sets:add(Pid, P)}}; +handle_info({capture,Cap0}, St) -> + Cap = case Cap0 of + false -> none; + Pid when is_pid(Cap0) -> Pid + end, + {noreply,St#st{capture=Cap}}; +handle_info({io_request,From,ReplyAs,Req}=IoReq, St) -> + try io_req(Req, From, St) of + passthrough -> + group_leader() ! IoReq; + Data -> + case is_io_permitted(From, St) of + false -> + ok; + true -> + case St of + #st{capture=none} -> + ok; + #st{capture=CapturePid} -> + CapturePid ! {captured,Data} + end, + output(minor, Data, From, From, St) + end, + From ! {io_reply,ReplyAs,ok} + catch + _:_ -> + {io_reply,ReplyAs,{error,arguments}} + end, + {noreply,St}; +handle_info({structured_io,ClientPid,{Detail,Str}}, St) -> + output(Detail, Str, ClientPid, ClientPid, St), + {noreply,St}; +handle_info({printout,Detail,Format,Args}, St) -> + Str = io_lib:format(Format, Args), + output(Detail, Str, internal, none, St), + {noreply,St}; +handle_info(Msg, #st{tc_supervisor=Pid}=St) when is_pid(Pid) -> + %% The process overseeing the testcase process also used to be + %% the group leader; thus, it is widely expected that it can be + %% reached by sending a message to the group leader. Therefore + %% we'll need to forward any non-recognized messaged to the test + %% case supervisor. + Pid ! Msg, + {noreply,St}; +handle_info(_Msg, #st{}=St) -> + %% There is no known supervisor process. Ignore this message. + {noreply,St}. + +terminate(_, _) -> + ok. + +do_set_props([{levels,Levels}|Ps], St) -> + do_set_props(Ps, St#st{levels=Levels}); +do_set_props([{auto_nl,AutoNL}|Ps], St) -> + do_set_props(Ps, St#st{auto_nl=AutoNL}); +do_set_props([{reject_io_reqs,Bool}|Ps], St) -> + do_set_props(Ps, St#st{reject_io=Bool}); +do_set_props([], St) -> St. + +io_req({put_chars,Enc,Bytes}, _, _) when Enc =:= latin1; Enc =:= unicode -> + to_latin1(Enc, Bytes); +io_req({put_chars,Encoding,Mod,Func,[Format,Args]}, _, _) -> + Str = Mod:Func(Format, Args), + to_latin1(Encoding, Str); +io_req(_, _, _) -> passthrough. + +to_latin1(unicode, Str) -> + [if C > 255 -> + io_lib:format("\\{~.8B}", [C]); + true -> + C + end || C <- unicode:characters_to_list(Str, unicode)]; +to_latin1(latin1, Str) -> Str. + +output(Level, Str, Sender, From, St) when is_integer(Level) -> + case selected_by_level(Level, stdout, St) of + true -> output(stdout, Str, Sender, From, St); + false -> ok + end, + case selected_by_level(Level, major, St) of + true -> output(major, Str, Sender, From, St); + false -> ok + end, + case selected_by_level(Level, minor, St) of + true -> output(minor, Str, Sender, From, St); + false -> ok + end; +output(stdout, Str, _Sender, From, St) -> + output_to_file(stdout, Str, From, St); +output(html, Str, _Sender, From, St) -> + output_to_file(html, Str, From, St); +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("=== ~p:~p/~p\n", [M,F,A]),Data0], + test_server_io:print(From, unexpected_io, Data), + ok; +output_to_file(minor, Data, From, #st{minor=Fd}) -> + try + io:put_chars(Fd, Data) + catch + _:_ -> + test_server_io:print(From, unexpected_io, Data) + end; +output_to_file(Detail, Data, From, _) -> + test_server_io:print(From, Detail, Data). + +is_io_permitted(From, #st{reject_io=true,permit_io=P}) -> + gb_sets:is_member(From, P); +is_io_permitted(_, #st{reject_io=false}) -> true. + +selected_by_level(Level, stdout, #st{levels={Stdout,_,_}}) -> + Level =< Stdout; +selected_by_level(Level, major, #st{levels={_,Major,_}}) -> + Level =< Major; +selected_by_level(Level, minor, #st{levels={_,_,Minor}}) -> + Level >= Minor. + +dress_output([$=|_]=Str, internal, _) -> + [Str,$\n]; +dress_output(Str, internal, _) -> + ["=== ",Str,$\n]; +dress_output(Str, _, #st{auto_nl=AutoNL}) -> + case AutoNL of + true -> [Str,$\n]; + false -> Str + end. diff --git a/lib/test_server/src/test_server_io.erl b/lib/test_server/src/test_server_io.erl new file mode 100644 index 0000000000..abdfb71241 --- /dev/null +++ b/lib/test_server/src/test_server_io.erl @@ -0,0 +1,315 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% This module implements a process with the registered name 'test_server_io', +%% which has two main responsibilities: +%% +%% * Manage group leader processes (see the test_server_gl module) +%% for test cases. A group_leader process is obtained by calling +%% get_gl/1. Group leader processes will be kept alive as along as +%% the 'test_server_io' process is alive. +%% +%% * Handle output to the common log files (stdout, major, html, +%% unexpected_io). +%% + +-module(test_server_io). +-export([start_link/0,stop/0,get_gl/1,set_fd/2, + start_transaction/0,end_transaction/0,print_buffered/1,print/3, + set_footer/1,set_job_name/1,set_gl_props/1]). + +-export([init/1,handle_call/3,handle_info/2,terminate/2]). + +-record(st, {fds, %Singleton fds (gb_tree) + shared_gl :: pid(), %Shared group leader + gls, %Group leaders (gb_set) + io_buffering=false, %I/O buffering + buffered, %Buffered I/O requests + html_footer, %HTML footer + job_name, %Name of current job. + gl_props, %Properties for GL. + stopping + }). + +start_link() -> + case gen_server:start_link({local,?MODULE}, ?MODULE, [], []) of + {ok,Pid} -> + {ok,Pid}; + Other -> + Other + end. + +stop() -> + OldGL = group_leader(), + group_leader(self(), self()), + req(stop), + group_leader(OldGL, self()), + ok. + +%% get_gl(Shared) -> Pid +%% Shared = boolean() +%% Pid = pid() +%% +%% Return a group leader (a process using the test_server_gl module). +%% If Shared is true, the shared group leader is returned (suitable for +%% running sequential test cases), otherwise a new group leader process +%% is spawned. Group leader processes will live until they are garbaged +%% collected by a call to gc/0. + +get_gl(Shared) when is_boolean(Shared) -> + req({get_gl,Shared}). + +%% set_fd(Tag, Fd) -> ok. +%% Tag = major | html | unexpected_io +%% Fd = a file descriptor (as returned by file:open/2) +%% +%% Associate a file descriptor with the given Tag. This +%% Tag can later be used in when calling to print/3. + +set_fd(Tag, Fd) -> + req({set_fd,Tag,Fd}). + +%% start_transaction() +%% +%% Subsequent calls to print/3 from the process executing start_transaction/0 +%% will cause the messages to be buffered instead of printed directly. + +start_transaction() -> + req({start_transaction,self()}). + +%% end_transaction() +%% +%% End the transaction started by start_transaction/0. Subsequent calls to +%% print/3 will cause the message to be printed directory. + +end_transaction() -> + req({end_transaction,self()}). + +%% print(From, Tag, Msg) +%% From = pid() +%% Tag = stdout, or any tag that has been registered using set_fd/2 +%% Msg = string or iolist +%% +%% Either print Msg to the file identified by Tag, or buffer the message +%% start_transaction/0 has been called from the process From. +%% +%% NOTE: The tags have various special meanings. For example, 'html' +%% is assumed to be a HTML file. + +print(From, Tag, Msg) -> + req({print,From,Tag,Msg}). + +%% print_buffered(Pid) +%% Pid = pid() +%% +%% Print all messages buffered in the *first* transaction buffered for Pid. +%% (If start_transaction/0 and end_transaction/0 has been called N times, +%% print_buffered/1 must be called N times to print all transactions.) + +print_buffered(Pid) -> + req({print_buffered,Pid}). + +%% set_footer(IoData) +%% +%% Set a footer for the file associated with the 'html' tag. +%% It will be used by print/3 to print a footer for the HTML file. + +set_footer(Footer) -> + req({set_footer,Footer}). + +%% set_job_name(Name) +%% Set a name for the currently running job. The name will be used +%% when printing to 'stdout'. +%% +set_job_name(Name) -> + req({set_job_name,Name}). + +%% set_gl_props(PropList) +%% Set properties for group leader processes. When a group_leader process +%% is created, test_server_gl:set_props(PropList) will be called. + +set_gl_props(PropList) -> + req({set_gl_props,PropList}). + + +%%% Internal functions. + +init([]) -> + process_flag(trap_exit, true), + Empty = gb_trees:empty(), + {ok,Shared} = test_server_gl:start_link(), + {ok,#st{fds=Empty,shared_gl=Shared,gls=gb_sets:empty(), + io_buffering=gb_sets:empty(), + buffered=Empty, + html_footer="</body>\n</html>\n", + job_name="<name not set>", + gl_props=[]}}. + +req(Req) -> + gen_server:call(?MODULE, Req, infinity). + +handle_call({get_gl,false}, _From, #st{gls=Gls,gl_props=Props}=St) -> + {ok,Pid} = test_server_gl:start_link(), + test_server_gl:set_props(Pid, Props), + {reply,Pid,St#st{gls=gb_sets:insert(Pid, Gls)}}; +handle_call({get_gl,true}, _From, #st{shared_gl=Shared}=St) -> + {reply,Shared,St}; +handle_call({set_fd,Tag,Fd}, _From, #st{fds=Fds0}=St) -> + Fds = gb_trees:enter(Tag, Fd, Fds0), + {reply,ok,St#st{fds=Fds}}; +handle_call({start_transaction,Pid}, _From, #st{io_buffering=Buffer0, + buffered=Buf0}=St) -> + Buf = case gb_trees:is_defined(Pid, Buf0) of + false -> gb_trees:insert(Pid, queue:new(), Buf0); + true -> Buf0 + end, + Buffer = gb_sets:add(Pid, Buffer0), + {reply,ok,St#st{io_buffering=Buffer,buffered=Buf}}; +handle_call({print,From,Tag,Str}, _From, St0) -> + St = output(From, Tag, Str, St0), + {reply,ok,St}; +handle_call({end_transaction,Pid}, _From, #st{io_buffering=Buffer0, + buffered=Buffered0}=St0) -> + Q0 = gb_trees:get(Pid, Buffered0), + Q = queue:in(eot, Q0), + Buffered = gb_trees:update(Pid, Q, Buffered0), + Buffer = gb_sets:delete_any(Pid, Buffer0), + St = St0#st{io_buffering=Buffer,buffered=Buffered}, + {reply,ok,St}; +handle_call({print_buffered,Pid}, _From, #st{buffered=Buffered0}=St0) -> + Q0 = gb_trees:get(Pid, Buffered0), + Q = do_print_buffered(Q0, St0), + Buffered = gb_trees:update(Pid, Q, Buffered0), + St = St0#st{buffered=Buffered}, + {reply,ok,St}; +handle_call({set_footer,Footer}, _From, St) -> + {reply,ok,St#st{html_footer=Footer}}; +handle_call({set_job_name,Name}, _From, St) -> + {reply,ok,St#st{job_name=Name}}; +handle_call({set_gl_props,Props}, _From, #st{shared_gl=Shared}=St) -> + test_server_gl:set_props(Shared, Props), + {reply,ok,St#st{gl_props=Props}}; +handle_call(stop, From, #st{shared_gl=SGL,gls=Gls0}=St0) -> + St = St0#st{gls=gb_sets:insert(SGL, Gls0),stopping=From}, + gc(St), + %% Give the users of the surviving group leaders some + %% time to finish. + erlang:send_after(2000, self(), stop_group_leaders), + {noreply,St}. + +handle_info({'EXIT',Pid,normal}, #st{gls=Gls0,stopping=From}=St) -> + Gls = gb_sets:delete_any(Pid, Gls0), + case gb_sets:is_empty(Gls) andalso stopping =/= undefined of + true -> + %% No more group leaders left. + gen_server:reply(From, ok), + {stop,normal,St#st{gls=Gls,stopping=undefined}}; + false -> + %% Wait for more group leaders to finish. + {noreply,St#st{gls=Gls}} + end; +handle_info({'EXIT',_Pid,Reason}, _St) -> + exit(Reason); +handle_info(stop_group_leaders, #st{gls=Gls}=St) -> + %% Stop the remaining group leaders. + [test_server_gl:stop(GL) || GL <- gb_sets:to_list(Gls)], + erlang:send_after(2000, self(), kill_group_leaders), + {noreply,St}; +handle_info(kill_group_leaders, #st{gls=Gls,stopping=From}=St) -> + [exit(GL, kill) || GL <- gb_sets:to_list(Gls)], + gen_server:reply(From, ok), + {stop,normal,St}; +handle_info(Other, St) -> + io:format("Ignoring: ~p\n", [Other]), + {noreply,St}. + +terminate(_, _) -> + ok. + +output(From, Tag, Str, #st{io_buffering=Buffered,buffered=Buf0}=St) -> + case gb_sets:is_member(From, Buffered) of + false -> + do_output(Tag, Str, St), + St; + true -> + Q0 = gb_trees:get(From, Buf0), + Q = queue:in({Tag,Str}, Q0), + Buf = gb_trees:update(From, Q, Buf0), + St#st{buffered=Buf} + end. + +do_output(stdout, Str0, #st{job_name=Name}) -> + Str = io_lib:format("Testing ~s: ~s\n", [Name,Str0]), + io:put_chars(Str); +do_output(Tag, Str, #st{fds=Fds}=St) -> + case gb_trees:lookup(Tag, Fds) of + none -> + S = io_lib:format("\n*** ERROR: ~p, line ~p: No known '~p' log file\n", + [?MODULE,?LINE,Tag]), + do_output(stdout, [S,Str], St); + {value,Fd} -> + try + io:put_chars(Fd, Str), + case Tag of + html -> finalise_table(Fd, St); + _ -> ok + end + catch _:Error -> + S = io_lib:format("\n*** ERROR: ~p, line ~p: Error writing to " + "log file '~p': ~p\n", + [?MODULE,?LINE,Tag,Error]), + do_output(stdout, [S,Str], St) + end + end. + +finalise_table(Fd, #st{html_footer=Footer}) -> + case file:position(Fd, {cur,0}) of + {ok,Pos} -> + %% We are writing to a seekable file. Finalise so + %% we get complete valid (and viewable) HTML code. + %% Then rewind to overwrite the finalising code. + io:put_chars(Fd, ["\n</table>\n",Footer]), + file:position(Fd, Pos); + {error,epipe} -> + %% The file is not seekable. We cannot erase what + %% we've already written --- so the reader will + %% have to wait until we're done. + ok + end. + +do_print_buffered(Q0, St) -> + Item = queue:get(Q0), + Q = queue:drop(Q0), + case Item of + eot -> + Q; + {Tag,Str} -> + do_output(Tag, Str, St), + do_print_buffered(Q, St) + end. + +gc(#st{gls=Gls0}) -> + InUse0 = [begin + {group_leader,GL} = process_info(P, group_leader), + GL + end || P <- processes()], + InUse = ordsets:from_list(InUse0), + Gls = gb_sets:to_list(Gls0), + NotUsed = ordsets:subtract(Gls, InUse), + [test_server_gl:stop(Pid) || Pid <- NotUsed], + ok. diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 17c02dfbe5..872f15f2be 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -424,10 +424,12 @@ start_node_peer(SlaveName, OptList, From, TI) -> %% Bad environment can cause open port to fail. If this happens, %% we ignore it and let the testcase handle the situation... catch open_port({spawn, Cmd}, [stream|Opts]), + + Tmo = 60000 * test_server:timetrap_scale_factor(), case start_node_get_option_value(wait, OptList, true) of true -> - Ret = wait_for_node_started(LSock,60000,undefined,Cleanup,TI,self()), + Ret = wait_for_node_started(LSock,Tmo,undefined,Cleanup,TI,self()), case {Ret,FailOnError} of {{{ok, Node}, Warning},_} -> gen_server:reply(From,{{ok,Node},HostStr,Cmd,[],Warning}); @@ -443,7 +445,7 @@ start_node_peer(SlaveName, OptList, From, TI) -> Self = self(), spawn_link( fun() -> - wait_for_node_started(LSock,60000,undefined, + wait_for_node_started(LSock,Tmo,undefined, Cleanup,TI,Self), receive after infinity -> ok end end), diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 9d111ff769..4a27c1ebae 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -473,10 +473,8 @@ getenv_any([]) -> "". %% %% Returns the OS family get_os_family() -> - case os:type() of - {OsFamily,_OsName} -> OsFamily; - OsFamily -> OsFamily - end. + {OsFamily,_OsName} = os:type(), + OsFamily. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/test_server/src/ts.erl b/lib/test_server/src/ts.erl index a30f6c65fe..db16b6ecd2 100644 --- a/lib/test_server/src/ts.erl +++ b/lib/test_server/src/ts.erl @@ -25,9 +25,8 @@ -module(ts). -export([run/0, run/1, run/2, run/3, run/4, - clean/0, clean/1, tests/0, tests/1, - install/0, install/1, index/0, + install/0, install/1, bench/0, bench/1, bench/2, benchmarks/0, estone/0, estone/1, cross_cover_analyse/1, @@ -42,17 +41,11 @@ %%% %%% +-- ts_install --+------ ts_autoconf_win32 %%% | -%%% | -%%% | %%% ts ---+ +------ ts_erl_config %%% | | ts_lib -%%% | +------ ts_make -%%% | | -%%% +-- ts_run -----+ +%%% +-- ts_run -----+------ ts_make %%% | | ts_filelib %%% | +------ ts_make_erl -%%% | | -%%% | +------ ts_reports (indirectly) %%% | %%% +-- ts_benchmark %%% @@ -77,8 +70,6 @@ %%% and other platforms. %%% ts_make_erl A corrected version of the standar Erlang module %%% make (used for rebuilding test suites). -%%% ts_reports Generates index pages in HTML, providing a summary -%%% of the tests run. %%% ts_lib Miscellanous utility functions, each used by several %%% other modules. %%% ts_benchmark Supervises otp benchmarks and collects results. @@ -163,9 +154,6 @@ help(installed) -> " ts:tests() - Shows all available families of tests.\n", " ts:tests(Spec) - Shows all available test modules in Spec,\n", " i.e. ../Spec_test/*_SUITE.erl\n", - " ts:index() - Updates local index page.\n", - " ts:clean() - Cleans up all but the last tests run.\n", - " ts:clean(all) - Cleans up all test runs found.\n", " ts:estone() - Run estone_SUITE in kernel application with\n" " no run options\n", " ts:estone(Opts) - Run estone_SUITE in kernel application with\n" @@ -201,33 +189,6 @@ install() -> install(Options) when is_list(Options) -> ts_install:install(install_local,Options). -%% Updates the local index page. - -index() -> - check_and_run(fun(_Vars) -> ts_reports:make_index(), ok end). - -%% -%% clean(all) -%% Deletes all logfiles. -%% -clean(all) -> - delete_files(filelib:wildcard("*" ++ ?logdir_ext)). - -%% clean/0 -%% -%% Cleans up run logfiles, all but the last run. -clean() -> - clean1(filelib:wildcard("*" ++ ?logdir_ext)). - -clean1([Dir|Dirs]) -> - List0 = filelib:wildcard(filename:join(Dir, "run.*")), - case lists:reverse(lists:sort(List0)) of - [] -> ok; - [_Last|Rest] -> delete_files(Rest) - end, - clean1(Dirs); -clean1([]) -> ok. - %% run/0 %% Runs all specs found by ts:tests(), if any, or returns %% {error, no_tests_available}. (batch) @@ -579,32 +540,6 @@ run_test(File, Args, Options) -> run_test(File, Args, Options, Vars) -> ts_run:run(File, Args, Options, Vars). - -delete_files([]) -> ok; -delete_files([Item|Rest]) -> - case file:delete(Item) of - ok -> - delete_files(Rest); - {error,eperm} -> - file:change_mode(Item, 8#777), - delete_files(filelib:wildcard(filename:join(Item, "*"))), - file:del_dir(Item), - ok; - {error,eacces} -> - %% We'll see about that! - file:change_mode(Item, 8#777), - case file:delete(Item) of - ok -> ok; - {error,_} -> - erlang:yield(), - file:change_mode(Item, 8#777), - file:delete(Item), - ok - end; - {error,_} -> ok - end, - delete_files(Rest). - %% This module provides some convenient shortcuts to running %% the test server from within a started Erlang shell. diff --git a/lib/test_server/src/ts_lib.erl b/lib/test_server/src/ts_lib.erl index 3dce19ed65..d9a699ca9f 100644 --- a/lib/test_server/src/ts_lib.erl +++ b/lib/test_server/src/ts_lib.erl @@ -25,9 +25,8 @@ -compile({no_auto_import,[error/1]}). -export([error/1, var/2, erlang_type/0, erlang_type/1, - initial_capital/1, interesting_logs/1, - specs/1, suites/2, last_test/1, - force_write_file/2, force_delete/1, + initial_capital/1, + specs/1, suites/2, subst_file/3, subst/2, print_data/1, make_non_erlang/2, maybe_atom_to_list/1, progress/4 @@ -91,21 +90,6 @@ initial_capital([C|Rest]) when $a =< C, C =< $z -> initial_capital(String) -> String. -%% Returns a list of the "interesting logs" in a directory, -%% i.e. those that correspond to spec files. - -interesting_logs(Dir) -> - Logs = filelib:wildcard(filename:join(Dir, [$*|?logdir_ext])), - Interesting = - case specs(Dir) of - [] -> - Logs; - Specs0 -> - Specs = ordsets:from_list(Specs0), - [L || L <- Logs, ordsets:is_element(filename_to_atom(L), Specs)] - end, - sort_tests(Interesting). - specs(Dir) -> Specs = filelib:wildcard(filename:join([filename:dirname(Dir), "*_test", "*.{dyn,}spec"])), @@ -165,42 +149,6 @@ suite_order(mnesia) -> 44; suite_order(system) -> 999; %% IMPORTANT: system SHOULD always be last! suite_order(_) -> 200. -last_test(Dir) -> - last_test(filelib:wildcard(filename:join(Dir, "run.[1-2]*")), false). - -last_test([Run|Rest], false) -> - last_test(Rest, Run); -last_test([Run|Rest], Latest) when Run > Latest -> - last_test(Rest, Run); -last_test([_|Rest], Latest) -> - last_test(Rest, Latest); -last_test([], Latest) -> - Latest. - -%% Do the utmost to ensure that the file is written, by deleting or -%% renaming an old file with the same name. - -force_write_file(Name, Contents) -> - force_delete(Name), - file:write_file(Name, Contents). - -force_delete(Name) -> - case file:delete(Name) of - {error, eacces} -> - force_rename(Name, Name ++ ".old.", 0); - Other -> - Other - end. - -force_rename(From, To, Number) -> - Dest = [To|integer_to_list(Number)], - case file:read_file_info(Dest) of - {ok, _} -> - force_rename(From, To, Number+1); - {error, _} -> - file:rename(From, Dest) - end. - %% Substitute all occurrences of @var@ in the In file, using %% the list of variables in Vars, producing the output file Out. %% Returns: ok | {error, Reason} diff --git a/lib/test_server/src/ts_reports.erl b/lib/test_server/src/ts_reports.erl deleted file mode 100644 index f981a77ae4..0000000000 --- a/lib/test_server/src/ts_reports.erl +++ /dev/null @@ -1,545 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%%% Purpose : Produces reports in HTML from the outcome of test suite runs. - --module(ts_reports). - --export([make_index/0, make_master_index/2, make_progress_index/2]). --export([count_cases/1, year/0, current_time/0]). - --include_lib("kernel/include/file.hrl"). --include("ts.hrl"). - --compile({no_auto_import,[error/1]}). - --import(filename, [basename/1, rootname/1]). --import(ts_lib, [error/1]). - - -%% Make master index page which points out index pages for all platforms. - -make_master_index(Dir, Vars) -> - IndexName = filename:join(Dir, "index.html"), - {ok, Index0} = make_master_index1(directories(Dir), master_header(Vars)), - Index = [Index0|master_footer()], - io:put_chars("Updating " ++ IndexName ++ "... "), - ok = ts_lib:force_write_file(IndexName, Index), - io:put_chars("done\n"). - -make_master_index1([Dir|Rest], Result) -> - NewResult = - case catch read_variables(Dir) of - {'EXIT',{{bad_installation,Reason},_}} -> - io:put_chars("Failed to read " ++ filename:join(Dir,?variables)++ - ": " ++ Reason ++ " - Ignoring this directory\n"), - Result; - Vars -> - Platform = ts_lib:var(platform_label, Vars), - case make_index(Dir, Vars, false) of - {ok, Summary} -> - make_master_index(Platform, Dir, Summary, Result); - {error, _} -> - Result - end - end, - make_master_index1(Rest, NewResult); -make_master_index1([], Result) -> - {ok, Result}. - -make_progress_index(Dir, Vars) -> - IndexName = filename:join(Dir, "index.html"), - io:put_chars("Updating " ++ IndexName ++ "... "), - Index0=progress_header(Vars), - ts_lib:force_delete(IndexName), - Dirs=find_progress_runs(Dir), - Index1=[Index0|make_progress_links(Dirs, [])], - IndexF=[Index1|progress_footer()], - ok = ts_lib:force_write_file(IndexName, IndexF), - io:put_chars("done\n"). - -find_progress_runs(Dir) -> - case file:list_dir(Dir) of - {ok, Dirs0} -> - Dirs1= [filename:join(Dir,X) || X <- Dirs0, - filelib:is_dir(filename:join(Dir,X))], - lists:sort(Dirs1); - _ -> - [] - end. - -name_from_vars(Dir, Platform) -> - VarFile=filename:join([Dir, Platform, "variables"]), - case file:consult(VarFile) of - {ok, Vars} -> - ts_lib:var(platform_id, Vars); - _Other -> - Platform - end. - -make_progress_links([], Acc) -> - Acc; -make_progress_links([RDir|Rest], Acc) -> - Dir=filename:basename(RDir), - Platforms=[filename:basename(X) || - X <- find_progress_runs(RDir)], - PlatformLinks=["<A HREF=\""++filename:join([Dir,X,"index.html"]) - ++"\">"++name_from_vars(RDir, X)++"</A><BR>" || - X <- Platforms], - LinkName=Dir++"/index.html", - Link = - [ - "<TR valign=top>\n", - "<TD><A HREF=\"", LinkName, "\">", Dir, "</A></TD>", "\n", - "<TD>", PlatformLinks, "</TD>", "\n" - ], - make_progress_links(Rest, [Link|Acc]). - -read_variables(Dir) -> - case file:consult(filename:join(Dir, ?variables)) of - {ok, Vars} -> Vars; - {error, Reason} -> - erlang:error({bad_installation,file:format_error(Reason)}, [Dir]) - end. - -make_master_index(Platform, Dirname, {Succ, Fail, UserSkip,AutoSkip}, Result) -> - Link = filename:join(filename:basename(Dirname), "index.html"), - FailStr = - if Fail > 0 -> - ["<FONT color=\"red\">", - integer_to_list(Fail),"</FONT>"]; - true -> - integer_to_list(Fail) - end, - AutoSkipStr = - if AutoSkip > 0 -> - ["<FONT color=\"brown\">", - integer_to_list(AutoSkip),"</FONT>"]; - true -> integer_to_list(AutoSkip) - end, - [Result, - "<TR valign=top>\n", - "<TD><A HREF=\"", Link, "\">", Platform, "</A></TD>", "\n", - make_row(integer_to_list(Succ), false), - make_row(FailStr, false), - make_row(integer_to_list(UserSkip), false), - make_row(AutoSkipStr, false), - "</TR>\n"]. - -%% Make index page which points out individual test suites for a single platform. - -make_index() -> - {ok, Pwd} = file:get_cwd(), - Vars = read_variables(Pwd), - make_index(Pwd, Vars, true). - -make_index(Dir, Vars, IncludeLast) -> - IndexName = filename:absname("index.html", Dir), - io:put_chars("Updating " ++ IndexName ++ "... "), - case catch make_index1(Dir, IndexName, Vars, IncludeLast) of - {'EXIT', Reason} -> - io:put_chars("CRASHED!\n"), - io:format("~p~n", [Reason]), - {error, Reason}; - {error, Reason} -> - io:put_chars("FAILED\n"), - io:format("~p~n", [Reason]), - {error, Reason}; - {ok, Summary} -> - io:put_chars("done\n"), - {ok, Summary}; - Err -> - io:format("Unknown internal error. Please report.\n(Err: ~p, ID: 1)", - [Err]), - {error, Err} - end. - -make_index1(Dir, IndexName, Vars, IncludeLast) -> - Logs0 = ts_lib:interesting_logs(Dir), - Logs = - case IncludeLast of - true -> add_last_name(Logs0); - false -> Logs0 - end, - {ok, {Index0, Summary}} = make_index(Logs, header(Vars), 0, 0, 0, 0, 0), - Index = [Index0|footer()], - case ts_lib:force_write_file(IndexName, Index) of - ok -> - {ok, Summary}; - {error, Reason} -> - error({index_write_error, Reason}) - end. - -make_index([Name|Rest], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt) -> - case ts_lib:last_test(Name) of - false -> - %% Silently skip. - make_index(Rest, Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt); - Last -> - case count_cases(Last) of - {Succ, Fail, USkip, ASkip} -> - Cov = - case file:read_file(filename:join(Last,?cover_total)) of - {ok,Bin} -> - TotCoverage = binary_to_term(Bin), - io_lib:format("~w %",[TotCoverage]); - _error -> - "" - end, - Link = filename:join(basename(Name), basename(Last)), - JustTheName = rootname(basename(Name)), - NotBuilt = not_built(JustTheName), - NewResult = [Result, make_index1(JustTheName, - Link, Succ, Fail, USkip, ASkip, - NotBuilt, Cov, false)], - make_index(Rest, NewResult, TotSucc+Succ, TotFail+Fail, - UserSkip+USkip, AutoSkip+ASkip, TotNotBuilt+NotBuilt); - error -> - make_index(Rest, Result, TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt) - end - end; -make_index([], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt) -> - {ok, {[Result|make_index1("Total", no_link, - TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt, "", true)], - {TotSucc, TotFail, UserSkip, AutoSkip}}}. - -make_index1(SuiteName, Link, Success, Fail, UserSkip, AutoSkip, NotBuilt, Coverage, Bold) -> - Name = test_suite_name(SuiteName), - FailStr = - if Fail > 0 -> - ["<FONT color=\"red\">", - integer_to_list(Fail),"</FONT>"]; - true -> - integer_to_list(Fail) - end, - AutoSkipStr = - if AutoSkip > 0 -> - ["<FONT color=\"brown\">", - integer_to_list(AutoSkip),"</FONT>"]; - true -> integer_to_list(AutoSkip) - end, - ["<TR valign=top>\n", - "<TD>", - case Link of - no_link -> - ["<B>", Name|"</B>"]; - _Other -> - CrashDumpName = SuiteName ++ "_erl_crash.dump", - CrashDumpLink = - case filelib:is_file(CrashDumpName) of - true -> - [" <A HREF=\"", CrashDumpName, - "\">(CrashDump)</A>"]; - false -> - "" - end, - LogFile = filename:join(Link, ?suitelog_name ++ ".html"), - ["<A HREF=\"", LogFile, "\">", Name, "</A>\n", CrashDumpLink, - "</TD>\n"] - end, - make_row(integer_to_list(Success), Bold), - make_row(FailStr, Bold), - make_row(integer_to_list(UserSkip), Bold), - make_row(AutoSkipStr, Bold), - make_row(integer_to_list(NotBuilt), Bold), - make_row(Coverage, Bold), - "</TR>\n"]. - -make_row(Row, true) -> - ["<TD ALIGN=right><B>", Row|"</B></TD>"]; -make_row(Row, false) -> - ["<TD ALIGN=right>", Row|"</TD>"]. - -not_built(BaseName) -> - Dir = filename:join("..", BaseName++"_test"), - Erl = length(filelib:wildcard(filename:join(Dir,"*_SUITE.erl"))), - Beam = length(filelib:wildcard(filename:join(Dir,"*_SUITE.beam"))), - Erl-Beam. - - -%% Add the log file directory for the very last test run (according to -%% last_name). - -add_last_name(Logs) -> - case file:read_file("last_name") of - {ok, Bin} -> - Name = filename:dirname(lib:nonl(binary_to_list(Bin))), - case lists:member(Name, Logs) of - true -> Logs; - false -> [Name|Logs] - end; - _ -> - Logs - end. - -term_to_text(Term) -> - lists:flatten(io_lib:format("~p.\n", [Term])). - -test_suite_name(Name) -> - ts_lib:initial_capital(Name) ++ " suite". - -directories(Dir) -> - {ok, Files} = file:list_dir(Dir), - [filename:join(Dir, X) || X <- Files, - filelib:is_dir(filename:join(Dir, X))]. - - -%%% Headers and footers. - -header(Vars) -> - Platform = ts_lib:var(platform_id, Vars), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>Test Results for ", Platform, "</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>Test Results for ", Platform, "</H1>\n", - "</CENTER>\n", - - "<!-- ---- CONTENT ---- -->\n", - "<CENTER>\n", - - "<TABLE border=3 cellpadding=5>\n", - "<th><B>Family</B></th>\n", - "<th>Successful</th>\n", - "<th>Failed</th>\n", - "<th>User Skipped</th>\n" - "<th>Auto Skipped</th>\n" - "<th>Missing Suites</th>\n" - "<th>Coverage</th>\n" - "\n"]. - -footer() -> - ["</TABLE>\n" - "</CENTER>\n" - "<P><CENTER>\n" - "<HR>\n" - "<P><FONT SIZE=-1>\n" - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n" - "Updated: <!date>", current_time(), "<!/date><BR>\n" - "</FONT>\n" - "</CENTER>\n" - "</body>\n" - "</HTML>\n"]. - -progress_header(Vars) -> - Release = ts_lib:var(erl_release, Vars), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>", Release, " Progress Test Results</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>", Release, " Progress Test Results</H1>\n", - "<TABLE border=3 cellpadding=5>\n", - "<th><b>Test Run</b></th><th>Platforms</th>\n"]. - -progress_footer() -> - ["</TABLE>\n", - "</CENTER>\n", - "<P><CENTER>\n", - "<HR>\n", - "<P><FONT SIZE=-1>\n", - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n", - "Updated: <!date>", current_time(), "<!/date><BR>\n", - "</FONT>\n", - "</CENTER>\n", - "</body>\n", - "</HTML>\n"]. - -master_header(Vars) -> - Release = ts_lib:var(erl_release, Vars), - Vsn = erlang:system_info(version), - ["<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">\n" - "<!-- autogenerated by '"++atom_to_list(?MODULE)++"'. -->\n" - "<HTML>\n", - "<HEAD>\n", - "<TITLE>", Release, " Test Results (", Vsn, ")</TITLE>\n", - "</HEAD>\n", - - body_tag(), - - "<!-- ---- DOCUMENT TITLE ---- -->\n", - - "<CENTER>\n", - "<H1>", Release, " Test Results (", Vsn, ")</H1>\n", - "</CENTER>\n", - - "<!-- ---- CONTENT ---- -->\n", - - "<CENTER>\n", - - "<TABLE border=3 cellpadding=5>\n", - "<th><b>Platform</b></th>\n", - "<th>Successful</th>\n", - "<th>Failed</th>\n", - "<th>User Skipped</th>\n" - "<th>Auto Skipped</th>\n" - "\n"]. - -master_footer() -> - ["</TABLE>\n", - "</CENTER>\n", - "<P><CENTER>\n", - "<HR>\n", - "<P><FONT SIZE=-1>\n", - "Copyright © ", year(), - " <A HREF=\"http://erlang.ericsson.se\">Open Telecom Platform</A><BR>\n", - "Updated: <!date>", current_time(), "<!/date><BR>\n", - "</FONT>\n", - "</CENTER>\n", - "</body>\n", - "</HTML>\n"]. - -body_tag() -> - "<body bgcolor=\"#FFFFFF\" text=\"#000000\" link=\"#0000FF\"" - "vlink=\"#800080\" alink=\"#FF0000\">". - -year() -> - {Y, _, _} = date(), - integer_to_list(Y). - -current_time() -> - {{Y, Mon, D}, {H, Min, S}} = calendar:local_time(), - Weekday = weekday(calendar:day_of_the_week(Y, Mon, D)), - lists:flatten(io_lib:format("~s ~s ~p ~2.2.0w:~2.2.0w:~2.2.0w ~w", - [Weekday, month(Mon), D, H, Min, S, Y])). - -weekday(1) -> "Mon"; -weekday(2) -> "Tue"; -weekday(3) -> "Wed"; -weekday(4) -> "Thu"; -weekday(5) -> "Fri"; -weekday(6) -> "Sat"; -weekday(7) -> "Sun". - -month(1) -> "Jan"; -month(2) -> "Feb"; -month(3) -> "Mar"; -month(4) -> "Apr"; -month(5) -> "May"; -month(6) -> "Jun"; -month(7) -> "Jul"; -month(8) -> "Aug"; -month(9) -> "Sep"; -month(10) -> "Oct"; -month(11) -> "Nov"; -month(12) -> "Dec". - -%% Count test cases in the given directory (a directory of the type -%% run.1997-08-04_09.58.52). - -count_cases(Dir) -> - SumFile = filename:join(Dir, ?run_summary), - case read_summary(SumFile, [summary]) of - {ok, [{Succ,Fail,Skip}]} -> - {Succ,Fail,Skip,0}; - {ok, [Summary]} -> - Summary; - {error, _} -> - LogFile = filename:join(Dir, ?suitelog_name), - case file:read_file(LogFile) of - {ok, Bin} -> - Summary = count_cases1(binary_to_list(Bin), {0, 0, 0, 0}), - write_summary(SumFile, Summary), - Summary; - {error, _Reason} -> - io:format("\nFailed to read ~p (skipped)\n", [LogFile]), - error - end - end. - -write_summary(Name, Summary) -> - File = [term_to_text({summary, Summary})], - ts_lib:force_write_file(Name, File). - -% XXX: This function doesn't do what the writer expect. It can't handle -% the case if there are several different keys and I had to add a special -% case for the empty file. The caller also expect just one tuple as -% a result so this function is written way to general for no reason. -% But it works sort of. /kgb - -read_summary(Name, Keys) -> - case file:consult(Name) of - {ok, []} -> - {error, "Empty summary file"}; - {ok, Terms} -> - {ok, lists:map(fun(Key) -> {value, {_, Value}} = - lists:keysearch(Key, 1, Terms), - Value end, - Keys)}; - {error, Reason} -> - {error, Reason} - end. - -count_cases1("=failed" ++ Rest, {Success, _Fail, UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Count, UserSkip,AutoSkip}); -count_cases1("=successful" ++ Rest, {_Success, Fail, UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Count, Fail, UserSkip,AutoSkip}); -count_cases1("=skipped" ++ Rest, {Success, Fail, _UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, Count,AutoSkip}); -count_cases1("=user_skipped" ++ Rest, {Success, Fail, _UserSkip,AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, Count,AutoSkip}); -count_cases1("=auto_skipped" ++ Rest, {Success, Fail, UserSkip,_AutoSkip}) -> - {NextLine, Count} = get_number(Rest), - count_cases1(NextLine, {Success, Fail, UserSkip,Count}); -count_cases1([], Counters) -> - Counters; -count_cases1(Other, Counters) -> - count_cases1(skip_to_nl(Other), Counters). - -get_number([$\s|Rest]) -> - get_number(Rest); -get_number([Digit|Rest]) when $0 =< Digit, Digit =< $9 -> - get_number(Rest, Digit-$0). - -get_number([Digit|Rest], Acc) when $0 =< Digit, Digit =< $9 -> - get_number(Rest, Acc*10+Digit-$0); -get_number([$\n|Rest], Acc) -> - {Rest, Acc}; -get_number([_|Rest], Acc) -> - get_number(Rest, Acc). - -skip_to_nl([$\n|Rest]) -> - Rest; -skip_to_nl([_|Rest]) -> - skip_to_nl(Rest); -skip_to_nl([]) -> - []. diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index e108a22839..57d1b8806e 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -21,7 +21,7 @@ -module(ts_run). --export([run/4]). +-export([run/4,ct_run_test/2]). -define(DEFAULT_MAKE_TIMETRAP_MINUTES, 60). -define(DEFAULT_UNMAKE_TIMETRAP_MINUTES, 15). @@ -87,6 +87,24 @@ execute([Hook|Rest], Vars0, Spec0, St0) -> execute([], Vars, Spec, St) -> {ok, Vars, Spec, St}. +%% Wrapper to run tests using ct:run_test/1 and handle any errors. + +ct_run_test(Dir, CommonTestArgs) -> + try + ok = file:set_cwd(Dir), + case ct:run_test(CommonTestArgs) of + {_,_,_} -> + ok; + {error,Error} -> + io:format("ERROR: ~P\n", [Error,20]); + Other -> + io:format("~P\n", [Other,20]) + end + catch + _:Crash -> + io:format("CRASH: ~P\n", [Crash,20]) + end. + %% %% Deletes File from Files when File is on the form .../<SUITE>_data/<file> %% when all of <SUITE> has been skipped in Spec, i.e. there @@ -230,8 +248,7 @@ make_command(Vars, Spec, State) -> " -boot start_sasl -sasl errlog_type error", " -pz \"",Cwd,"\"", " -ct_test_vars ",TestVars, - " -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" " - " -eval \"ct:run_test(", + " -eval \"ts_run:ct_run_test(\\\"",TestDir,"\\\", ", backslashify(lists:flatten(State#state.test_server_args)),")\"" " ", ExtraArgs], @@ -363,13 +380,7 @@ make_common_test_args(Args0, Options0, _Vars) -> [{logdir,"../test_server"}] end, - TimeTrap = case test_server:timetrap_scale_factor() of - 1 -> - []; - Scale -> - [{multiply_timetraps, Scale}, - {scale_timetraps, true}] - end, + TimeTrap = [{scale_timetraps, true}], {ConfigPath, Options} = case {os:getenv("TEST_CONFIG_PATH"), diff --git a/lib/test_server/src/ts_selftest.erl b/lib/test_server/src/ts_selftest.erl deleted file mode 100644 index 655aa4bab3..0000000000 --- a/lib/test_server/src/ts_selftest.erl +++ /dev/null @@ -1,120 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(ts_selftest). --export([selftest/0]). - -selftest() -> - case node() of - nonode@nohost -> - io:format("Sorry, you have to start this node distributed.~n"), - exit({error, node_not_distributed}); - _ -> - ok - end, - case catch ts:tests(test_server) of - {'EXIT', _} -> - io:format("Test Server self test not availiable."); - Other -> - selftest1() - end. - -selftest1() -> - % Batch starts - io:format("Selftest #1: Whole spec, batch mode:~n"), - io:format("------------------------------------~n"), - ts:run(test_server, [batch]), - ok=check_result(1, "test_server.logs", 2), - - io:format("Selftest #2: One module, batch mode:~n"), - io:format("------------------------------------~n"), - ts:run(test_server, test_server_SUITE, [batch]), - ok=check_result(2, "test_server_SUITE.logs", 2), - - io:format("Selftest #3: One testcase, batch mode:~n"), - io:format("--------------------------------------~n"), - ts:run(test_server, test_server_SUITE, msgs, [batch]), - ok=check_result(3, "test_server_SUITE.logs", 0), - - % Interactive starts - io:format("Selftest #4: Whole spec, interactive mode:~n"), - io:format("------------------------------------------~n"), - ts:run(test_server), - kill_test_server(), - ok=check_result(4, "test_server.logs", 2), - - io:format("Selftest #5: One module, interactive mode:~n"), - io:format("------------------------------------------~n"), - ts:run(test_server, test_server_SUITE), - kill_test_server(), - ok=check_result(5, "test_server_SUITE.logs", 2), - - io:format("Selftest #6: One testcase, interactive mode:~n"), - io:format("--------------------------------------------~n"), - ts:run(test_server, test_server_SUITE, msgs), - kill_test_server(), - ok=check_result(6, "test_server_SUITE.logs", 0), - - ok. - -check_result(Test, TDir, ExpSkip) -> - Dir=ts_lib:last_test(TDir), - {Total, Failed, Skipped}=ts_reports:count_cases(Dir), - io:format("Selftest #~p:",[Test]), - case {Total, Failed, Skipped} of - {_, 0, ExpSkip} -> % 2 test cases should be skipped. - io:format("All ok.~n~n"), - ok; - {_, _, _} -> - io:format("Not completely successful.~n~n"), - error - end. - - -%% Wait for test server to get started. -kill_test_server() -> - Node=list_to_atom("test_server@"++atom_to_list(hostname())), - net_adm:ping(Node), - case whereis(test_server_ctrl) of - undefined -> - kill_test_server(); - Pid -> - kill_test_server(0, Pid) - end. - -%% Wait for test server to finish. -kill_test_server(30, Pid) -> - exit(self(), test_server_is_dead); -kill_test_server(Num, Pid) -> - case whereis(test_server_ctrl) of - undefined -> - slave:stop(node(Pid)); - Pid -> - receive - after - 1000 -> - kill_test_server(Num+1, Pid) - end - end. - - -hostname() -> - list_to_atom(from($@, atom_to_list(node()))). -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(H, []) -> []. diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile index afe5aff196..a3f9820d7f 100644 --- a/lib/test_server/test/Makefile +++ b/lib/test_server/test/Makefile @@ -26,7 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ test_server_SUITE \ - test_server_line_SUITE \ test_server_test_lib ERL_FILES= $(MODULES:%=%.erl) @@ -65,7 +64,6 @@ make_emakefile: >> $(EMAKEFILE) tests debug opt: make_emakefile - cd ../src && $(MAKE) ../ebin/test_server_line.beam erl $(ERL_MAKE_FLAGS) -make clean: diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE.erl index a8532b08ab..d20528d43b 100644 --- a/lib/test_server/test/test_server_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE.erl @@ -92,8 +92,8 @@ test_server_SUITE(Config) -> % rpc:call(Node,dbg, tracer,[]), % rpc:call(Node,dbg, p,[all,c]), % rpc:call(Node,dbg, tpl,[test_server_ctrl,x]), - run_test_server_tests("test_server_SUITE", 39, 1, 31, - 20, 9, 1, 11, 2, 26, Config). + run_test_server_tests("test_server_SUITE", 38, 1, 30, + 19, 9, 1, 11, 2, 25, Config). test_server_parallel01_SUITE(Config) -> run_test_server_tests("test_server_parallel01_SUITE", 37, 0, 19, @@ -120,9 +120,9 @@ run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, NUsrSkip, NAutoSkip, NActualSkip, NActualFail, NActualSucc, Config) -> - ct:log("See test case log files under:~n~p~n", - [filename:join([proplists:get_value(priv_dir, Config), - SuiteName++".logs"])]), + WorkDir = proplists:get_value(work_dir, Config), + ct:log("<a href=\"file://~s\">Test case log files</a>\n", + [filename:join(WorkDir, SuiteName++".logs")]), Node = proplists:get_value(node, Config), {ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []), @@ -138,17 +138,16 @@ run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, rpc:call(Node,test_server_ctrl, stop, []), - {ok,#suite{ n_cases = NCases, - n_cases_failed = NFail, - n_cases_expected = NExpected, - n_cases_succ = NSucc, - n_cases_user_skip = NUsrSkip, - n_cases_auto_skip = NAutoSkip, - cases = Cases }} = Data = - test_server_test_lib:parse_suite( - hd(filelib:wildcard( - filename:join([proplists:get_value(priv_dir, Config), - SuiteName++".logs","run*","suite.log"])))), + {ok,Data} = test_server_test_lib:parse_suite( + hd(filelib:wildcard( + filename:join([WorkDir,SuiteName++".logs", + "run*","suite.log"])))), + check([{"Number of cases",NCases,Data#suite.n_cases}, + {"Number failed",NFail,Data#suite.n_cases_failed}, + {"Number expected",NExpected,Data#suite.n_cases_expected}, + {"Number successful",NSucc,Data#suite.n_cases_succ}, + {"Number user skipped",NUsrSkip,Data#suite.n_cases_user_skip}, + {"Number auto skipped",NAutoSkip,Data#suite.n_cases_auto_skip}], ok), {NActualSkip,NActualFail,NActualSucc} = lists:foldl(fun(#tc{ result = skip },{S,F,Su}) -> {S+1,F,Su}; @@ -156,9 +155,18 @@ run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, {S,F,Su+1}; (#tc{ result = failed },{S,F,Su}) -> {S,F+1,Su} - end,{0,0,0},Cases), + end,{0,0,0},Data#suite.cases), Data. +check([{Str,Same,Same}|T], Status) -> + io:format("~s: ~p\n", [Str,Same]), + check(T, Status); +check([{Str,Expected,Actual}|T], _) -> + io:format("~s: expected ~p, actual ~p\n", [Str,Expected,Actual]), + check(T, error); +check([], ok) -> ok; +check([], error) -> ?t:fail(). + until(Fun) -> case Fun() of true -> diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl index dfcdff0c3e..ab25e4ad2f 100644 --- a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl @@ -34,7 +34,7 @@ do_times/1, do_times_mfa/1, do_times_fun/1, skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, - skip_case8/1, skip_case9/1, undefined_functions/1, + skip_case8/1, skip_case9/1, conf_init/1, check_new_conf/1, conf_cleanup/1, check_old_conf/1, conf_init_fail/1, start_stop_node/1, cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, @@ -47,7 +47,7 @@ all(suite) -> [config, comment, timetrap, timetrap_cancel, multiply_timetrap, init_per_s, init_per_tc, end_per_tc, timeconv, msgs, capture, timecall, do_times, skip_cases, - undefined_functions, commercial, + commercial, {conf, conf_init, [check_new_conf], conf_cleanup}, check_old_conf, {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, @@ -386,50 +386,6 @@ skip_case9(Config) when is_list(Config) -> %% returning {skip, Reason} from init_per_testcase/2 for this case. ?t:fail("This case should have been Skipped by init_per_testcase/2"). -undefined_functions(suite) -> []; -undefined_functions(doc) -> ["Check for calls to undefined functions in" - " test_server." - "Skip if cover is running"]; -undefined_functions(Config) when is_list(Config) -> - case whereis(cover_server) of - Pid when is_pid(Pid) -> - {skip,"Cover is running"}; - undefined -> - undefined_functions() - end. - -undefined_functions() -> - TestServerDir = filename:dirname(code:which(test_server)), - Res = xref:d(TestServerDir), - - {value,{unused,Unused}} = lists:keysearch(unused, 1, Res), - case Unused of - [] -> ok; - _ -> - lists:foreach(fun (MFA) -> - io:format("~s unused", [format_mfa(MFA)]) - end, Unused) - end, - - {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res), - Undef = [U || U <- Undef0, not unresolved(U)], - case Undef of - [] -> ok; - _ -> - lists:foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls undefined ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, Undef), - ?t:fail({length(Undef),undefined_functions_in_otp}) - end, - ok. - -unresolved({_,{_,'$F_EXPR',_}}) -> true; -unresolved(_) -> false. - -format_mfa({M,F,A}) -> - lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). - conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; conf_init(Config) when is_list(Config) -> [{conf_init_var,1389}|Config]. diff --git a/lib/test_server/test/test_server_line_SUITE.erl b/lib/test_server/test/test_server_line_SUITE.erl deleted file mode 100644 index 0aba54f6b5..0000000000 --- a/lib/test_server/test/test_server_line_SUITE.erl +++ /dev/null @@ -1,131 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ --module(test_server_line_SUITE). --include_lib("test_server/include/test_server.hrl"). - --export([all/0,suite/0]). --export([init_per_suite/1,end_per_suite/1, - init_per_testcase/2, end_per_testcase/2]). --export([parse_transform/1, lines/1]). - -suite() -> - [{ct_hooks,[ts_install_cth]}, - {doc,["Test of parse transform for collection line numbers"]}]. - -all() -> [parse_transform,lines]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_testcase(_Case, Config) -> - ?line test_server_line:clear(), - Dog = ?t:timetrap(?t:minutes(2)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - ?line test_server_line:clear(), - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -parse_transform(suite) -> []; -parse_transform(doc) -> []; -parse_transform(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir,Config), - code:add_pathz(DataDir), - - ?line ok = parse_transform_test:excluded(), - ?line [] = test_server_line:get_lines(), - - ?line test_server_line:clear(), - ?line ok = parse_transform_test:func(), - - ?line [{parse_transform_test,func4,58}, - {parse_transform_test,func,49}, - {parse_transform_test,func3,56}, - {parse_transform_test,func,39}, - {parse_transform_test,func2,54}, - {parse_transform_test,func,36}, - {parse_transform_test,func1,52}, - {parse_transform_test,func,35}] = test_server_line:get_lines(), - - code:del_path(DataDir), - ok. - -lines(suite) -> []; -lines(doc) -> ["Test parse transform for collection line numbers"]; -lines(Config) when is_list(Config) -> - ?line L0 = [{mod,func,1},{mod,func,2},{mod,func,3}, - {m,f,4},{m,f,5},{m,f,6}, - {mo,fu,7},{mo,fu,8},{mo,fu,9}], - ?line LL = string:copies(L0, 1000), - ?line T1 = erlang:now(), - ?line lists:foreach(fun ({M,F,L}) -> - test_server_line:'$test_server_line'(M, F, L) - end, LL), - ?line T2 = erlang:now(), - ?line Long = test_server_line:get_lines(), - ?line test_server_line:clear(), - - ?line T3 = erlang:now(), - ?line lists:foreach(fun ({M,F,L}) -> - test_server_line:'$test_server_lineQ'(M, F, L) - end, LL), - ?line T4 = erlang:now(), - ?line LongQ = test_server_line:get_lines(), - - ?line io:format("'$test_server_line': ~f~n'$test_server_lineQ': ~f~n", - [timer:now_diff(T2, T1)/1000, timer:now_diff(T4, T3)/1000]), - ?line io:format("'$test_server_line' result long:~p~n", [Long]), - ?line io:format("'$test_server_lineQ' result long:~p~n", [LongQ]), - - if Long =:= LongQ -> - ?line ok; - true -> - ?line ?t:fail("The two methods did not produce same result for" - " long lists of lines") - end, - - ?line test_server_line:clear(), - ?line lists:foreach(fun ({M,F,L}) -> - test_server_line:'$test_server_line'(M, F, L) - end, L0), - ?line Short = test_server_line:get_lines(), - ?line test_server_line:clear(), - ?line lists:foreach(fun ({M,F,L}) -> - test_server_line:'$test_server_lineQ'(M, F, L) - end, L0), - ?line ShortQ = test_server_line:get_lines(), - - ?line io:format("'$test_server_line' result short:~p~n", [Short]), - ?line io:format("'$test_server_lineQ' result short:~p~n", [ShortQ]), - - if Short =:= ShortQ -> - ?line ok; - true -> - ?line ?t:fail("The two methods did not produce same result for" - " shot lists of lines\n") - end. diff --git a/lib/test_server/test/test_server_line_SUITE_data/Makefile.src b/lib/test_server/test/test_server_line_SUITE_data/Makefile.src deleted file mode 100644 index a077648934..0000000000 --- a/lib/test_server/test/test_server_line_SUITE_data/Makefile.src +++ /dev/null @@ -1,6 +0,0 @@ -EFLAGS=+debug_info -pa ../../test_server -I../../test_server - -all: parse_transform_test.@EMULATOR@ - -parse_transform_test.@EMULATOR@: parse_transform_test.erl - erlc $(EFLAGS) parse_transform_test.erl diff --git a/lib/test_server/test/test_server_line_SUITE_data/parse_transform_test.erl b/lib/test_server/test/test_server_line_SUITE_data/parse_transform_test.erl deleted file mode 100644 index 8f3477d3ac..0000000000 --- a/lib/test_server/test/test_server_line_SUITE_data/parse_transform_test.erl +++ /dev/null @@ -1,59 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(parse_transform_test). - --include("test_server_line.hrl"). --no_lines([{excluded,0}]). - --export([excluded/0, func/0]). - - -excluded() -> - line1, - line2, - ok. - - -func() -> - hello, - func1(), - case func2() of - ok -> - helloagain, - case func3() of - ok -> - ok; - error -> - error - end; - error -> - error - end, - excluded(), - func4(). - -func1() -> - ok. -func2() -> - ok. -func3() -> - error. -func4() -> - ok. - diff --git a/lib/test_server/test/test_server_test_lib.erl b/lib/test_server/test/test_server_test_lib.erl index 5ca24f3df7..8a808c5360 100644 --- a/lib/test_server/test/test_server_test_lib.erl +++ b/lib/test_server/test/test_server_test_lib.erl @@ -54,9 +54,13 @@ start_slave(Config,_Level) -> ok end, DataDir = proplists:get_value(data_dir, Config), - PrivDir = proplists:get_value(priv_dir, Config), + %% We would normally use priv_dir for temporary data, + %% but the pathnames gets too long on Windows. + %% Until the run-time system can support long pathnames, + %% use the data dir. + WorkDir = DataDir, - %% PrivDir as well as directory of Test Server suites + %% WorkDir as well as directory of Test Server suites %% have to be in code path on Test Server node. [_ | Parts] = lists:reverse(filename:split(DataDir)), TSDir = filename:join(lists:reverse(Parts)), @@ -64,7 +68,7 @@ start_slave(Config,_Level) -> undefined -> []; Ds -> Ds end, - PathDirs = [PrivDir,TSDir | AddPathDirs], + PathDirs = [WorkDir,TSDir | AddPathDirs], [true = rpc:call(Node, code, add_patha, [D]) || D <- PathDirs], io:format("Dirs added to code path (on ~w):~n", [Node]), @@ -73,8 +77,8 @@ start_slave(Config,_Level) -> true = rpc:call(Node, os, putenv, ["TEST_SERVER_FRAMEWORK", "undefined"]), - ok = rpc:call(Node, file, set_cwd, [PrivDir]), - [{node,Node} | Config] + ok = rpc:call(Node, file, set_cwd, [WorkDir]), + [{node,Node}, {work_dir,WorkDir} | Config] end. post_end_per_testcase(_TC, Config, Return, State) -> diff --git a/lib/tools/emacs/erlang-pkg.el b/lib/tools/emacs/erlang-pkg.el new file mode 100644 index 0000000000..decc696e21 --- /dev/null +++ b/lib/tools/emacs/erlang-pkg.el @@ -0,0 +1,3 @@ +(define-package "erlang" "2.7.0" + "Erlang major mode" + '((flymake-mode "0.4.6"))) diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index aae118f3db..e2bcd37def 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1,4 +1,10 @@ -;; erlang.el --- Major modes for editing and running Erlang +;;; erlang.el --- Major modes for editing and running Erlang + +;; Copyright (C) 2004 Free Software Foundation, Inc. +;; Author: Anders Lindgren +;; Keywords: erlang, languages, processes +;; Date: 2011-12-11 + ;; %CopyrightBegin% ;; ;; Copyright Ericsson AB 1996-2012. All Rights Reserved. @@ -15,10 +21,7 @@ ;; under the License. ;; ;; %CopyrightEnd% -;; -;; Copyright (C) 2004 Free Software Foundation, Inc. -;; Author: Anders Lindgren -;; Keywords: erlang, languages, processes +;; ;; Lars Thors�n's modifications of 2000-06-07 included. ;; The original version of this package was written by Robert Virding. diff --git a/lib/tools/emacs/vsn.mk b/lib/tools/emacs/vsn.mk index f33ea8b519..a495da3453 100644 --- a/lib/tools/emacs/vsn.mk +++ b/lib/tools/emacs/vsn.mk @@ -1,3 +1,2 @@ -EMACS_VSN = 2.4.13 - +EMACS_VSN = 2.7.0 diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index cd9b622f15..94998fb763 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -24,6 +24,7 @@ eprof, fprof, instrument, + lcnt, make, xref, xref_base, diff --git a/system/doc/embedded/part.xml b/system/doc/embedded/part.xml index abedce46d6..d96a94a1a0 100644 --- a/system/doc/embedded/part.xml +++ b/system/doc/embedded/part.xml @@ -45,6 +45,5 @@ </description> <xi:include href="embedded_solaris.xml"/> <xi:include href="embedded_nt.xml"/> - <xi:include href="vxworks.xml"/> </part> |