aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore6
-rw-r--r--HOWTO/INSTALL-RASPBERRYPI3.md323
-rw-r--r--Makefile.in10
-rw-r--r--OTP_VERSION2
-rw-r--r--README.md2
-rw-r--r--bootstrap/bin/no_dot_erlang.bootbin6483 -> 6544 bytes
-rw-r--r--bootstrap/bin/start.bootbin6483 -> 6544 bytes
-rw-r--r--bootstrap/bin/start_clean.bootbin6483 -> 6544 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_a.beambin3192 -> 3200 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_asm.beambin11208 -> 10988 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_block.beambin3508 -> 3444 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_bs.beambin3400 -> 0 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_clean.beambin3568 -> 3516 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_dict.beambin4900 -> 4644 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_disasm.beambin21224 -> 20860 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_except.beambin3780 -> 4204 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_flatten.beambin1940 -> 1928 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_jump.beambin10048 -> 10012 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beambin32408 -> 28692 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_peep.beambin3752 -> 3588 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa.beambin12300 -> 12168 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_bsm.beambin18708 -> 17888 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_codegen.beambin39156 -> 37604 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_dead.beambin12444 -> 12072 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_funs.beambin2556 -> 2556 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_lint.beambin7672 -> 7536 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_opt.beambin32308 -> 39916 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_pp.beambin5500 -> 5500 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beambin43612 -> 45300 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_recv.beambin4040 -> 3884 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_share.beambin5608 -> 5348 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_ssa_type.beambin18660 -> 28324 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_trim.beambin9008 -> 8676 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_utils.beambin3548 -> 3548 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_validator.beambin35476 -> 46224 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/beam_z.beambin3240 -> 3604 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl.beambin28604 -> 28236 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_clauses.beambin2852 -> 2808 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_inline.beambin36696 -> 34712 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_sets.beambin2840 -> 2728 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/cerl_trees.beambin21740 -> 20408 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/compile.beambin42628 -> 41208 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/compiler.app4
-rw-r--r--bootstrap/lib/compiler/ebin/compiler.appup2
-rw-r--r--bootstrap/lib/compiler/ebin/core_lib.beambin4088 -> 3720 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_lint.beambin12548 -> 12472 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_parse.beambin63288 -> 63064 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_pp.beambin11832 -> 11472 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/core_scan.beambin6452 -> 6248 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/erl_bifs.beambin2076 -> 2080 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/rec_env.beambin4536 -> 4468 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_alias.beambin5800 -> 5548 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_bsm.beambin1676 -> 1672 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_dsetel.beambin6376 -> 0 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_fold.beambin48364 -> 45480 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_fold_lists.beambin3900 -> 4020 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_core_inline.beambin3872 -> 3908 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/sys_pre_attributes.beambin2600 -> 2468 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_core.beambin55284 -> 50672 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_kernel.beambin53044 -> 50576 bytes
-rw-r--r--bootstrap/lib/compiler/ebin/v3_kernel_pp.beambin12472 -> 12052 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application.beambin3736 -> 3684 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_controller.beambin30324 -> 29612 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_master.beambin6172 -> 6108 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/application_starter.beambin1188 -> 1180 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/auth.beambin6196 -> 6148 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/code.beambin12872 -> 12688 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/code_server.beambin23508 -> 22552 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log.beambin30992 -> 29556 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log_1.beambin23204 -> 22392 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/disk_log_server.beambin6196 -> 6136 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/dist_ac.beambin23964 -> 23356 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/dist_util.beambin12512 -> 12312 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_boot_server.beambin5632 -> 5580 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_ddll.beambin2800 -> 2744 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erl_epmd.beambin7096 -> 7036 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/error_handler.beambin1572 -> 1576 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/error_logger.beambin6264 -> 6112 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/erts_debug.beambin9332 -> 9176 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file.beambin13540 -> 13356 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file_io_server.beambin15768 -> 15292 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/file_server.beambin4948 -> 4912 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/gen_sctp.beambin3212 -> 3212 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/global.beambin30232 -> 29188 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/global_group.beambin16048 -> 15708 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/group.beambin14388 -> 14200 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/group_history.beambin5656 -> 5496 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/heart.beambin5204 -> 5140 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/hipe_unified_loader.beambin12440 -> 12348 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet.beambin23584 -> 23232 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet6_tcp.beambin3016 -> 3016 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_config.beambin7368 -> 7236 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_db.beambin25552 -> 25300 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_dns.beambin19172 -> 18564 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_gethost_native.beambin9876 -> 9708 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_hosts.beambin1924 -> 1904 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_parse.beambin13544 -> 13396 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_res.beambin13380 -> 13192 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_sctp.beambin2148 -> 2148 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_tcp.beambin2784 -> 2784 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_tcp_dist.beambin7616 -> 7476 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/inet_udp.beambin1912 -> 1908 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.app7
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.appup49
-rw-r--r--bootstrap/lib/kernel/ebin/kernel.beambin3588 -> 3532 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel_config.beambin2680 -> 2604 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/kernel_refc.beambin2368 -> 2288 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/local_tcp.beambin2192 -> 2180 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/local_udp.beambin1380 -> 1372 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger.beambin11796 -> 15012 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_backend.beambin2560 -> 2544 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_config.beambin2988 -> 3176 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_disk_log_h.beambin9492 -> 3348 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_filters.beambin1780 -> 1748 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_formatter.beambin8796 -> 8552 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_h_common.beambin5592 -> 7644 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_handler_watcher.beambin1352 -> 1344 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_olp.beambin0 -> 8308 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_proxy.beambin0 -> 2884 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_server.beambin11248 -> 11352 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_simple_h.beambin4256 -> 4236 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_std_h.beambin10860 -> 5168 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/logger_sup.beambin576 -> 636 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/net.beambin608 -> 0 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/net_adm.beambin2900 -> 2824 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/net_kernel.beambin24536 -> 24164 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/os.beambin5172 -> 5112 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/pg2.beambin7612 -> 7568 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/ram_file.beambin6072 -> 6008 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io.beambin1712 -> 1660 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_compressed.beambin2336 -> 2308 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_deflate.beambin2608 -> 2592 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_delayed.beambin5276 -> 5200 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_inflate.beambin4200 -> 4140 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/raw_file_io_list.beambin2480 -> 2460 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/rpc.beambin7700 -> 7704 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/seq_trace.beambin1584 -> 1600 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/standard_error.beambin3744 -> 3724 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/user.beambin11112 -> 10980 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/user_drv.beambin10940 -> 10844 bytes
-rw-r--r--bootstrap/lib/kernel/ebin/wrap_log_reader.beambin3028 -> 2940 bytes
-rw-r--r--bootstrap/lib/kernel/include/dist.hrl3
-rw-r--r--bootstrap/lib/stdlib/ebin/array.beambin11708 -> 11640 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/beam_lib.beambin19108 -> 18660 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/binary.beambin2900 -> 2844 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/c.beambin17192 -> 16968 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/calendar.beambin7604 -> 7632 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets.beambin46376 -> 45128 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_server.beambin6556 -> 6444 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_utils.beambin26280 -> 25712 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dets_v9.beambin46536 -> 45228 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/dict.beambin9292 -> 8836 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/digraph.beambin7684 -> 7500 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/digraph_utils.beambin6772 -> 6732 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/edlin.beambin10720 -> 10472 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/edlin_expand.beambin3868 -> 3748 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/epp.beambin28976 -> 28268 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_abstract_code.beambin1012 -> 968 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_anno.beambin3568 -> 3484 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_bits.beambin2396 -> 2348 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_compile.beambin7032 -> 6676 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_error.beambin8388 -> 8256 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_eval.beambin35668 -> 35048 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_expand_records.beambin20864 -> 19356 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_internal.beambin6812 -> 6732 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_lint.beambin88436 -> 84964 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_parse.beambin97240 -> 96136 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_pp.beambin25780 -> 25552 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_scan.beambin26012 -> 25696 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/erl_tar.beambin32248 -> 30896 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/error_logger_file_h.beambin3956 -> 3944 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/error_logger_tty_h.beambin4800 -> 4776 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/escript.beambin16344 -> 15636 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/ets.beambin21976 -> 21460 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/eval_bits.beambin7760 -> 7660 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/file_sorter.beambin28412 -> 27276 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/filelib.beambin10400 -> 10188 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/filename.beambin14920 -> 14788 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gb_sets.beambin8160 -> 7712 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gb_trees.beambin5368 -> 5084 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen.beambin4916 -> 4896 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_event.beambin13560 -> 13012 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_fsm.beambin11304 -> 12424 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_server.beambin14812 -> 15328 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/gen_statem.beambin20016 -> 20408 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io.beambin5868 -> 5792 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib.beambin13612 -> 13532 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_format.beambin14360 -> 13892 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_fread.beambin7052 -> 6520 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/io_lib_pretty.beambin21520 -> 20996 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/lists.beambin29436 -> 29272 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/log_mf_h.beambin2380 -> 2352 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/maps.beambin3200 -> 3188 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/ms_transform.beambin18912 -> 18452 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/otp_internal.beambin10112 -> 10396 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/pool.beambin3688 -> 3664 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/proc_lib.beambin12852 -> 12624 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/proplists.beambin4612 -> 4596 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/qlc.beambin66332 -> 65060 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/qlc_pt.beambin72744 -> 70536 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/queue.beambin5976 -> 5904 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/rand.beambin29488 -> 29052 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/random.beambin1736 -> 1768 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/re.beambin12648 -> 12312 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sets.beambin6392 -> 6152 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/shell.beambin28860 -> 28396 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/slave.beambin4756 -> 4740 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sofs.beambin35860 -> 35276 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/stdlib.app2
-rw-r--r--bootstrap/lib/stdlib/ebin/stdlib.appup47
-rw-r--r--bootstrap/lib/stdlib/ebin/string.beambin36300 -> 35032 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/supervisor.beambin22372 -> 21588 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/supervisor_bridge.beambin2348 -> 2332 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/sys.beambin8436 -> 9084 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/timer.beambin5280 -> 5272 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/unicode.beambin14192 -> 14076 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/unicode_util.beambin198916 -> 198636 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/uri_string.beambin26600 -> 24988 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/win32reg.beambin5180 -> 5120 bytes
-rw-r--r--bootstrap/lib/stdlib/ebin/zip.beambin25376 -> 24188 bytes
-rw-r--r--configure.src2
-rwxr-xr-xerts/autoconf/configure.vxworks2
-rw-r--r--erts/autoconf/vxworks/sed.general1
-rw-r--r--erts/configure.in30
-rw-r--r--erts/doc/src/Makefile7
-rw-r--r--erts/doc/src/alt_dist.xml2
-rw-r--r--erts/doc/src/erl.xml2
-rw-r--r--erts/doc/src/erl_dist_protocol.xml116
-rw-r--r--erts/doc/src/erl_ext_dist.xml18
-rw-r--r--erts/doc/src/erl_nif.xml135
-rw-r--r--erts/doc/src/erlang.xml30
-rw-r--r--erts/doc/src/net.xml129
-rw-r--r--erts/doc/src/notes.xml254
-rw-r--r--erts/doc/src/part.xml1
-rw-r--r--erts/doc/src/persistent_term.xml16
-rw-r--r--erts/doc/src/ref_man.xml4
-rw-r--r--erts/doc/src/socket.xml650
-rw-r--r--erts/doc/src/socket_usage.xml773
-rw-r--r--erts/doc/src/specs.xml2
-rw-r--r--erts/emulator/Makefile.in56
-rw-r--r--erts/emulator/beam/arith_instrs.tab11
-rw-r--r--erts/emulator/beam/beam_emu.c19
-rw-r--r--erts/emulator/beam/beam_load.c155
-rw-r--r--erts/emulator/beam/bif.c324
-rw-r--r--erts/emulator/beam/bif.tab1
-rw-r--r--erts/emulator/beam/bif_instrs.tab118
-rw-r--r--erts/emulator/beam/big.h6
-rw-r--r--erts/emulator/beam/break.c6
-rw-r--r--erts/emulator/beam/bs_instrs.tab363
-rw-r--r--erts/emulator/beam/copy.c6
-rw-r--r--erts/emulator/beam/dist.c1582
-rw-r--r--erts/emulator/beam/dist.h270
-rw-r--r--erts/emulator/beam/erl_alloc.types23
-rw-r--r--erts/emulator/beam/erl_alloc_util.c16
-rw-r--r--erts/emulator/beam/erl_ao_firstfit_alloc.c87
-rw-r--r--erts/emulator/beam/erl_bestfit_alloc.c45
-rw-r--r--erts/emulator/beam/erl_bif_binary.c18
-rw-r--r--erts/emulator/beam/erl_bif_info.c53
-rw-r--r--erts/emulator/beam/erl_bif_persistent.c17
-rw-r--r--erts/emulator/beam/erl_db.c94
-rw-r--r--erts/emulator/beam/erl_db.h2
-rw-r--r--erts/emulator/beam/erl_db_catree.c52
-rw-r--r--erts/emulator/beam/erl_db_hash.c444
-rw-r--r--erts/emulator/beam/erl_db_tree.c65
-rw-r--r--erts/emulator/beam/erl_db_util.c2
-rw-r--r--erts/emulator/beam/erl_db_util.h35
-rw-r--r--erts/emulator/beam/erl_dirty_bif.tab1
-rw-r--r--erts/emulator/beam/erl_gc.c24
-rw-r--r--erts/emulator/beam/erl_hl_timer.c432
-rw-r--r--erts/emulator/beam/erl_hl_timer.h2
-rw-r--r--erts/emulator/beam/erl_init.c7
-rw-r--r--erts/emulator/beam/erl_lock_check.c3
-rw-r--r--erts/emulator/beam/erl_map.c2
-rw-r--r--erts/emulator/beam/erl_message.c204
-rw-r--r--erts/emulator/beam/erl_message.h35
-rw-r--r--erts/emulator/beam/erl_monitor_link.c131
-rw-r--r--erts/emulator/beam/erl_monitor_link.h230
-rw-r--r--erts/emulator/beam/erl_nif.c118
-rw-r--r--erts/emulator/beam/erl_nif.h23
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h9
-rw-r--r--erts/emulator/beam/erl_node_tables.c240
-rw-r--r--erts/emulator/beam/erl_node_tables.h86
-rw-r--r--erts/emulator/beam/erl_port.h2
-rw-r--r--erts/emulator/beam/erl_port_task.c2
-rw-r--r--erts/emulator/beam/erl_printf_term.c4
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.c373
-rw-r--r--erts/emulator/beam/erl_proc_sig_queue.h88
-rw-r--r--erts/emulator/beam/erl_process.c1018
-rw-r--r--erts/emulator/beam/erl_process.h14
-rw-r--r--erts/emulator/beam/erl_process_dump.c33
-rw-r--r--erts/emulator/beam/erl_ptab.h5
-rw-r--r--erts/emulator/beam/erl_rbtree.h280
-rw-r--r--erts/emulator/beam/erl_time_sup.c6
-rw-r--r--erts/emulator/beam/external.c361
-rw-r--r--erts/emulator/beam/external.h76
-rw-r--r--erts/emulator/beam/global.h5
-rw-r--r--erts/emulator/beam/instrs.tab75
-rw-r--r--erts/emulator/beam/io.c19
-rw-r--r--erts/emulator/beam/msg_instrs.tab4
-rw-r--r--erts/emulator/beam/ops.tab290
-rw-r--r--erts/emulator/beam/sys.h26
-rw-r--r--erts/emulator/beam/utils.c7
-rw-r--r--erts/emulator/drivers/common/inet_drv.c115
-rw-r--r--erts/emulator/drivers/unix/ttsl_drv.c4
-rw-r--r--erts/emulator/drivers/win32/ttsl_drv.c4
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c2
-rw-r--r--erts/emulator/internal_doc/CountingInstructions.md53
-rw-r--r--erts/emulator/nifs/common/net_nif.c1656
-rw-r--r--erts/emulator/nifs/common/socket_dbg.c138
-rw-r--r--erts/emulator/nifs/common/socket_dbg.h55
-rw-r--r--erts/emulator/nifs/common/socket_int.h392
-rw-r--r--erts/emulator/nifs/common/socket_nif.c18278
-rw-r--r--erts/emulator/nifs/common/socket_tarray.c143
-rw-r--r--erts/emulator/nifs/common/socket_tarray.h47
-rw-r--r--erts/emulator/nifs/common/socket_util.c1658
-rw-r--r--erts/emulator/nifs/common/socket_util.h205
-rw-r--r--erts/emulator/sys/common/erl_check_io.c5
-rw-r--r--erts/emulator/sys/common/erl_mmap.h2
-rw-r--r--erts/emulator/sys/common/erl_osenv.c12
-rw-r--r--erts/emulator/sys/common/erl_poll.c4
-rw-r--r--erts/emulator/sys/unix/sys_drivers.c16
-rw-r--r--erts/emulator/test/Makefile32
-rw-r--r--erts/emulator/test/binary_SUITE.erl178
-rw-r--r--erts/emulator/test/distribution_SUITE.erl336
-rw-r--r--erts/emulator/test/emulator_bench.spec1
-rw-r--r--erts/emulator/test/erts_test_utils.erl31
-rw-r--r--erts/emulator/test/esock_misc/socket_client.erl538
-rw-r--r--erts/emulator/test/esock_misc/socket_lib.erl133
-rw-r--r--erts/emulator/test/esock_misc/socket_server.erl954
-rw-r--r--erts/emulator/test/esock_ttest/.gitignore0
-rwxr-xr-xerts/emulator/test/esock_ttest/esock-ttest352
-rwxr-xr-xerts/emulator/test/esock_ttest/esock-ttest-client72
-rwxr-xr-xerts/emulator/test/esock_ttest/esock-ttest-server-gen32
-rwxr-xr-xerts/emulator/test/esock_ttest/esock-ttest-server-sock32
-rw-r--r--erts/emulator/test/net_SUITE.erl481
-rw-r--r--erts/emulator/test/nif_SUITE.erl99
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c121
-rw-r--r--erts/emulator/test/node_container_SUITE.erl23
-rw-r--r--erts/emulator/test/persistent_term_SUITE.erl5
-rw-r--r--erts/emulator/test/socket_SUITE.erl17992
-rw-r--r--erts/emulator/test/socket_test_evaluator.erl563
-rw-r--r--erts/emulator/test/socket_test_evaluator.hrl68
-rw-r--r--erts/emulator/test/socket_test_lib.erl98
-rw-r--r--erts/emulator/test/socket_test_logger.erl118
-rw-r--r--erts/emulator/test/socket_test_ttest.hrl (renamed from lib/kernel/src/net.erl)26
-rw-r--r--erts/emulator/test/socket_test_ttest_client.hrl141
-rw-r--r--erts/emulator/test/socket_test_ttest_lib.erl127
-rw-r--r--erts/emulator/test/socket_test_ttest_tcp_client.erl678
-rw-r--r--erts/emulator/test/socket_test_ttest_tcp_client_gen.erl49
-rw-r--r--erts/emulator/test/socket_test_ttest_tcp_client_socket.erl51
-rw-r--r--erts/emulator/test/socket_test_ttest_tcp_gen.erl138
-rw-r--r--erts/emulator/test/socket_test_ttest_tcp_server.erl642
-rw-r--r--erts/emulator/test/socket_test_ttest_tcp_server_gen.erl41
-rw-r--r--erts/emulator/test/socket_test_ttest_tcp_server_socket.erl43
-rw-r--r--erts/emulator/test/socket_test_ttest_tcp_socket.erl414
-rw-r--r--erts/emulator/test/trace_local_SUITE.erl4
-rwxr-xr-xerts/emulator/utils/beam_makeops2
-rw-r--r--erts/etc/common/heart.c38
-rw-r--r--erts/etc/unix/Makefile3
-rw-r--r--erts/etc/unix/cerl.src29
-rw-r--r--erts/etc/unix/etp-commands.in122
-rw-r--r--erts/etc/unix/etp-rr-run-until-beam.py45
-rw-r--r--erts/etc/unix/to_erl.c1
-rw-r--r--erts/etc/win32/msys_tools/vc/ld.sh5
-rw-r--r--erts/lib_src/Makefile.in7
-rw-r--r--erts/lib_src/common/erl_printf.c5
-rw-r--r--erts/preloaded/ebin/erl_init.beambin1716 -> 1820 bytes
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin53300 -> 52636 bytes
-rw-r--r--erts/preloaded/ebin/init.beambin50696 -> 50304 bytes
-rw-r--r--erts/preloaded/ebin/net.beambin0 -> 5940 bytes
-rw-r--r--erts/preloaded/ebin/persistent_term.beambin1692 -> 1836 bytes
-rw-r--r--erts/preloaded/ebin/prim_file.beambin28072 -> 28084 bytes
-rw-r--r--erts/preloaded/ebin/prim_inet.beambin81144 -> 81012 bytes
-rw-r--r--erts/preloaded/ebin/socket.beambin0 -> 70312 bytes
-rw-r--r--erts/preloaded/src/Makefile31
-rw-r--r--erts/preloaded/src/erl_init.erl2
-rw-r--r--erts/preloaded/src/erl_prim_loader.erl7
-rw-r--r--erts/preloaded/src/erts.app.src6
-rw-r--r--erts/preloaded/src/init.erl7
-rw-r--r--erts/preloaded/src/net.erl336
-rw-r--r--erts/preloaded/src/persistent_term.erl9
-rw-r--r--erts/preloaded/src/prim_eval.S4
-rw-r--r--erts/preloaded/src/prim_file.erl7
-rw-r--r--erts/preloaded/src/prim_inet.erl19
-rw-r--r--erts/preloaded/src/socket.erl3680
-rw-r--r--erts/vsn.mk2
-rw-r--r--lib/Makefile4
-rw-r--r--lib/common_test/doc/src/basics_chapter.xml2
-rw-r--r--lib/common_test/doc/src/ct_telnet.xml29
-rw-r--r--lib/common_test/doc/src/notes.xml103
-rw-r--r--lib/common_test/src/ct_cover.erl5
-rw-r--r--lib/common_test/src/ct_netconfc.erl10
-rw-r--r--lib/common_test/src/ct_run.erl8
-rw-r--r--lib/common_test/src/ct_telnet.erl144
-rw-r--r--lib/common_test/src/ct_telnet_client.erl6
-rw-r--r--lib/common_test/src/ct_util.hrl1
-rw-r--r--lib/common_test/src/test_server.erl47
-rw-r--r--lib/common_test/test/ct_hooks_SUITE.erl106
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_cth_update_result_post_end_tc_SUITE.erl101
-rw-r--r--lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_result_post_end_tc_cth.erl98
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl6
-rw-r--r--lib/common_test/test/ct_telnet_SUITE.erl39
-rw-r--r--lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_faulty_regexp_SUITE.erl79
-rw-r--r--lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl11
-rw-r--r--lib/common_test/test_server/configure.in6
-rw-r--r--lib/common_test/test_server/ts_install.erl2
-rw-r--r--lib/common_test/vsn.mk2
-rw-r--r--lib/compiler/doc/src/notes.xml32
-rw-r--r--lib/compiler/scripts/.gitignore1
-rwxr-xr-xlib/compiler/scripts/smoke123
-rw-r--r--lib/compiler/scripts/smoke-mix.exs95
-rw-r--r--lib/compiler/src/Makefile2
-rw-r--r--lib/compiler/src/beam_a.erl4
-rw-r--r--lib/compiler/src/beam_except.erl88
-rw-r--r--lib/compiler/src/beam_jump.erl51
-rw-r--r--lib/compiler/src/beam_kernel_to_ssa.erl15
-rw-r--r--lib/compiler/src/beam_ssa.erl130
-rw-r--r--lib/compiler/src/beam_ssa_bsm.erl10
-rw-r--r--lib/compiler/src/beam_ssa_dead.erl410
-rw-r--r--lib/compiler/src/beam_ssa_funs.erl8
-rw-r--r--lib/compiler/src/beam_ssa_opt.erl443
-rw-r--r--lib/compiler/src/beam_ssa_pre_codegen.erl298
-rw-r--r--lib/compiler/src/beam_ssa_recv.erl8
-rw-r--r--lib/compiler/src/beam_ssa_type.erl752
-rw-r--r--lib/compiler/src/beam_validator.erl3085
-rw-r--r--lib/compiler/src/cerl_sets.erl2
-rw-r--r--lib/compiler/src/compile.erl32
-rw-r--r--lib/compiler/src/compiler.app.src1
-rw-r--r--lib/compiler/src/erl_bifs.erl16
-rw-r--r--lib/compiler/src/sys_core_dsetel.erl360
-rw-r--r--lib/compiler/src/sys_core_fold.erl153
-rw-r--r--lib/compiler/src/sys_core_fold_lists.erl101
-rw-r--r--lib/compiler/src/v3_core.erl27
-rw-r--r--lib/compiler/src/v3_kernel.erl86
-rw-r--r--lib/compiler/test/Makefile15
-rw-r--r--lib/compiler/test/beam_except_SUITE.erl41
-rw-r--r--lib/compiler/test/beam_jump_SUITE.erl47
-rw-r--r--lib/compiler/test/beam_type_SUITE.erl16
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl82
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S4
-rw-r--r--lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S4
-rw-r--r--lib/compiler/test/bif_SUITE.erl7
-rw-r--r--lib/compiler/test/compile_SUITE.erl287
-rw-r--r--lib/compiler/test/compiler.cover5
-rw-r--r--lib/compiler/test/float_SUITE.erl23
-rw-r--r--lib/compiler/test/inline_SUITE.erl30
-rw-r--r--lib/compiler/test/inline_SUITE_data/barnes2.erl2
-rw-r--r--lib/compiler/test/match_SUITE.erl15
-rw-r--r--lib/compiler/test/misc_SUITE.erl12
-rw-r--r--lib/compiler/test/receive_SUITE.erl30
-rw-r--r--lib/compiler/test/test_lib.erl66
-rw-r--r--lib/compiler/test/warnings_SUITE.erl33
-rw-r--r--lib/compiler/vsn.mk2
-rw-r--r--lib/crypto/c_src/Makefile.in1
-rw-r--r--lib/crypto/c_src/aead.c302
-rw-r--r--lib/crypto/c_src/aes.c395
-rw-r--r--lib/crypto/c_src/aes.h5
-rw-r--r--lib/crypto/c_src/algorithms.c95
-rw-r--r--lib/crypto/c_src/api_ng.c223
-rw-r--r--lib/crypto/c_src/api_ng.h29
-rw-r--r--lib/crypto/c_src/atoms.c95
-rw-r--r--lib/crypto/c_src/atoms.h45
-rw-r--r--lib/crypto/c_src/block.c144
-rw-r--r--lib/crypto/c_src/bn.c153
-rw-r--r--lib/crypto/c_src/chacha20.c97
-rw-r--r--lib/crypto/c_src/check_erlang.cocci196
-rw-r--r--lib/crypto/c_src/check_openssl.cocci281
-rw-r--r--lib/crypto/c_src/cipher.c301
-rw-r--r--lib/crypto/c_src/cipher.h35
-rw-r--r--lib/crypto/c_src/cmac.c66
-rw-r--r--lib/crypto/c_src/common.h2
-rw-r--r--lib/crypto/c_src/crypto.c194
-rw-r--r--lib/crypto/c_src/crypto_callback.c46
-rw-r--r--lib/crypto/c_src/dh.c392
-rw-r--r--lib/crypto/c_src/digest.c16
-rw-r--r--lib/crypto/c_src/dss.c137
-rw-r--r--lib/crypto/c_src/ec.c466
-rw-r--r--lib/crypto/c_src/ecdh.c66
-rw-r--r--lib/crypto/c_src/eddsa.c38
-rw-r--r--lib/crypto/c_src/engine.c568
-rw-r--r--lib/crypto/c_src/evp.c164
-rw-r--r--lib/crypto/c_src/evp_compat.h26
-rw-r--r--lib/crypto/c_src/hash.c326
-rw-r--r--lib/crypto/c_src/hash.h1
-rw-r--r--lib/crypto/c_src/hmac.c215
-rw-r--r--lib/crypto/c_src/info.c56
-rw-r--r--lib/crypto/c_src/info.h2
-rw-r--r--lib/crypto/c_src/math.c24
-rw-r--r--lib/crypto/c_src/openssl_config.h58
-rw-r--r--lib/crypto/c_src/otp_test_engine.c186
-rw-r--r--lib/crypto/c_src/pkey.c1564
-rw-r--r--lib/crypto/c_src/poly1305.c68
-rw-r--r--lib/crypto/c_src/rand.c136
-rw-r--r--lib/crypto/c_src/rc4.c56
-rw-r--r--lib/crypto/c_src/rsa.c257
-rw-r--r--lib/crypto/c_src/srp.c368
-rw-r--r--lib/crypto/doc/src/crypto.xml23
-rw-r--r--lib/crypto/doc/src/engine_keys.xml2
-rw-r--r--lib/crypto/doc/src/notes.xml32
-rw-r--r--lib/crypto/src/crypto.erl391
-rw-r--r--lib/crypto/test/Makefile1
-rw-r--r--lib/crypto/test/blowfish_SUITE.erl300
-rw-r--r--lib/crypto/test/crypto_SUITE.erl132
-rw-r--r--lib/crypto/test/engine_SUITE.erl2
-rw-r--r--lib/crypto/vsn.mk2
-rw-r--r--lib/debugger/doc/src/Makefile3
-rw-r--r--lib/debugger/test/int_eval_SUITE.erl5
-rw-r--r--lib/dialyzer/doc/src/notes.xml30
-rw-r--r--lib/dialyzer/src/dialyzer_codeserver.erl8
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl130
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl37
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/results/para1
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/para/para4.erl11
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/src/para/para4_adt.erl12
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/spec_other_module2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/lists_key_bug.erl75
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/spec_other_module.erl7
-rw-r--r--lib/dialyzer/vsn.mk2
-rw-r--r--lib/diameter/doc/src/diameter.xml24
-rw-r--r--lib/diameter/doc/src/diameter_transport.xml31
-rw-r--r--lib/diameter/doc/src/notes.xml53
-rw-r--r--lib/diameter/src/base/diameter.erl4
-rw-r--r--lib/diameter/src/base/diameter_callback.erl4
-rw-r--r--lib/diameter/src/base/diameter_dist.erl525
-rw-r--r--lib/diameter/src/base/diameter_gen.erl2
-rw-r--r--lib/diameter/src/base/diameter_misc_sup.erl3
-rw-r--r--lib/diameter/src/base/diameter_traffic.erl99
-rw-r--r--lib/diameter/src/diameter.appup.src10
-rw-r--r--lib/diameter/src/modules.mk3
-rw-r--r--lib/diameter/src/transport/diameter_tcp.erl8
-rw-r--r--lib/diameter/test/diameter_dist_SUITE.erl332
-rw-r--r--lib/diameter/test/diameter_distribution_SUITE.erl7
-rw-r--r--lib/diameter/test/diameter_pool_SUITE.erl3
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl5
-rw-r--r--lib/diameter/test/modules.mk3
-rw-r--r--lib/diameter/vsn.mk2
-rw-r--r--lib/edoc/doc/src/notes.xml16
-rw-r--r--lib/edoc/src/edoc.erl17
-rw-r--r--lib/edoc/vsn.mk2
-rw-r--r--lib/erl_docgen/doc/src/notes.xml26
-rw-r--r--lib/erl_docgen/priv/css/otp_doc.css10
-rw-r--r--lib/erl_docgen/priv/xsl/db_html.xsl76
-rw-r--r--lib/erl_docgen/vsn.mk2
-rw-r--r--lib/erl_interface/configure.in1
-rw-r--r--lib/erl_interface/doc/src/ei.xml18
-rw-r--r--lib/erl_interface/doc/src/ei_connect.xml13
-rw-r--r--lib/erl_interface/doc/src/ei_users_guide.xml30
-rw-r--r--lib/erl_interface/doc/src/erl_connect.xml9
-rw-r--r--lib/erl_interface/doc/src/erl_eterm.xml9
-rw-r--r--lib/erl_interface/doc/src/erl_global.xml9
-rw-r--r--lib/erl_interface/doc/src/erl_interface.xml12
-rw-r--r--lib/erl_interface/doc/src/erl_malloc.xml8
-rw-r--r--lib/erl_interface/doc/src/erl_marshal.xml8
-rw-r--r--lib/erl_interface/doc/src/notes.xml17
-rw-r--r--lib/erl_interface/doc/src/ref_man.xml8
-rw-r--r--lib/erl_interface/doc/src/ref_man_ei.xml10
-rw-r--r--lib/erl_interface/doc/src/ref_man_erl_interface.xml8
-rw-r--r--lib/erl_interface/include/ei.h23
-rw-r--r--lib/erl_interface/include/erl_interface.h213
-rw-r--r--lib/erl_interface/src/Makefile2
-rw-r--r--lib/erl_interface/src/Makefile.in8
-rw-r--r--lib/erl_interface/src/connect/ei_connect.c90
-rw-r--r--lib/erl_interface/src/connect/ei_resolve.c22
-rw-r--r--lib/erl_interface/src/connect/ei_resolve.h2
-rw-r--r--lib/erl_interface/src/legacy/erl_eterm.c2
-rw-r--r--lib/erl_interface/src/misc/ei_init.c32
-rw-r--r--lib/erl_interface/src/misc/ei_internal.h2
-rw-r--r--lib/erl_interface/src/misc/ei_portio.c13
-rw-r--r--lib/erl_interface/src/prog/erl_start.c2
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c2
-rw-r--r--lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c2
-rw-r--r--lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c2
-rw-r--r--lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c15
-rw-r--r--lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c2
-rw-r--r--lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c14
-rw-r--r--lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c8
-rw-r--r--lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c8
-rw-r--r--lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c8
-rw-r--r--lib/erl_interface/vsn.mk2
-rw-r--r--lib/ftp/doc/src/ftp.xml2
-rw-r--r--lib/ftp/doc/src/notes.xml18
-rw-r--r--lib/ftp/src/ftp.erl287
-rw-r--r--lib/ftp/test/ftp_SUITE.erl73
-rw-r--r--lib/ftp/vsn.mk2
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl5
-rw-r--r--lib/hipe/cerl/erl_types.erl94
-rw-r--r--lib/hipe/doc/src/notes.xml15
-rw-r--r--lib/hipe/vsn.mk2
-rw-r--r--lib/inets/doc/src/notes.xml60
-rw-r--r--lib/inets/examples/httpd_load_test/hdlt_slave.erl11
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl12
-rw-r--r--lib/inets/src/http_server/mod_esi.erl6
-rw-r--r--lib/inets/test/httpd_SUITE.erl15
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/jinterface/doc/src/Makefile10
-rw-r--r--lib/kernel/doc/src/application.xml35
-rw-r--r--lib/kernel/doc/src/kernel_app.xml18
-rw-r--r--lib/kernel/doc/src/logger.xml37
-rw-r--r--lib/kernel/doc/src/logger_chapter.xml14
-rw-r--r--lib/kernel/doc/src/logger_std_h.xml122
-rw-r--r--lib/kernel/doc/src/notes.xml198
-rw-r--r--lib/kernel/include/dist.hrl3
-rw-r--r--lib/kernel/src/Makefile1
-rw-r--r--lib/kernel/src/application.erl22
-rw-r--r--lib/kernel/src/application_controller.erl104
-rw-r--r--lib/kernel/src/code_server.erl10
-rw-r--r--lib/kernel/src/dist_util.erl4
-rw-r--r--lib/kernel/src/erl_epmd.erl8
-rw-r--r--lib/kernel/src/gen_tcp.erl6
-rw-r--r--lib/kernel/src/gen_udp.erl6
-rw-r--r--lib/kernel/src/inet_db.erl7
-rw-r--r--lib/kernel/src/inet_tcp_dist.erl1
-rw-r--r--lib/kernel/src/kernel.app.src5
-rw-r--r--lib/kernel/src/kernel.appup.src10
-rw-r--r--lib/kernel/src/kernel.erl72
-rw-r--r--lib/kernel/src/logger.erl147
-rw-r--r--lib/kernel/src/logger_formatter.erl71
-rw-r--r--lib/kernel/src/logger_h_common.erl37
-rw-r--r--lib/kernel/src/logger_olp.erl5
-rw-r--r--lib/kernel/src/logger_olp.hrl7
-rw-r--r--lib/kernel/src/logger_simple_h.erl4
-rw-r--r--lib/kernel/src/logger_std_h.erl506
-rw-r--r--lib/kernel/src/net_kernel.erl16
-rw-r--r--lib/kernel/src/standard_error.erl3
-rw-r--r--lib/kernel/src/user.erl3
-rw-r--r--lib/kernel/src/user_drv.erl7
-rw-r--r--lib/kernel/test/Makefile6
-rw-r--r--lib/kernel/test/application_SUITE.erl97
-rw-r--r--lib/kernel/test/inet_SUITE.erl31
-rw-r--r--lib/kernel/test/kernel.spec1
-rw-r--r--lib/kernel/test/kernel_config_SUITE.erl21
-rw-r--r--lib/kernel/test/logger_SUITE.erl76
-rw-r--r--lib/kernel/test/logger_disk_log_h_SUITE.erl2
-rw-r--r--lib/kernel/test/logger_formatter_SUITE.erl2
-rw-r--r--lib/kernel/test/logger_std_h_SUITE.erl444
-rw-r--r--lib/kernel/test/logger_stress_SUITE.erl94
-rw-r--r--lib/kernel/vsn.mk2
-rw-r--r--lib/mnesia/doc/src/notes.xml17
-rw-r--r--lib/mnesia/examples/bench/README2
-rw-r--r--lib/mnesia/src/mnesia_dumper.erl37
-rw-r--r--lib/mnesia/vsn.mk2
-rw-r--r--lib/observer/doc/src/notes.xml39
-rw-r--r--lib/observer/src/cdv_detail_wx.erl3
-rw-r--r--lib/observer/src/cdv_table_wx.erl3
-rw-r--r--lib/observer/src/cdv_virtual_list_wx.erl3
-rw-r--r--lib/observer/src/cdv_wx.erl3
-rw-r--r--lib/observer/src/observer_alloc_wx.erl3
-rw-r--r--lib/observer/src/observer_app_wx.erl11
-rw-r--r--lib/observer/src/observer_perf_wx.erl15
-rw-r--r--lib/observer/src/observer_port_wx.erl14
-rw-r--r--lib/observer/src/observer_pro_wx.erl15
-rw-r--r--lib/observer/src/observer_procinfo.erl8
-rw-r--r--lib/observer/src/observer_trace_wx.erl17
-rw-r--r--lib/observer/src/observer_traceoptions_wx.erl9
-rw-r--r--lib/observer/src/observer_tv_table.erl3
-rw-r--r--lib/observer/src/observer_tv_wx.erl13
-rw-r--r--lib/observer/src/observer_wx.erl20
-rw-r--r--lib/observer/test/crashdump_helper.erl2
-rw-r--r--lib/observer/vsn.mk2
-rw-r--r--lib/odbc/c_src/Makefile.in2
-rw-r--r--lib/odbc/doc/src/notes.xml17
-rw-r--r--lib/odbc/vsn.mk2
-rw-r--r--lib/public_key/doc/src/notes.xml15
-rw-r--r--lib/public_key/doc/src/public_key.xml4
-rw-r--r--lib/public_key/src/public_key.erl2
-rw-r--r--lib/public_key/vsn.mk2
-rw-r--r--lib/reltool/doc/src/reltool.xml2
-rw-r--r--lib/reltool/doc/src/reltool_examples.xml9
-rw-r--r--lib/reltool/src/reltool.hrl3
-rw-r--r--lib/reltool/src/reltool_server.erl12
-rw-r--r--lib/reltool/src/reltool_target.erl27
-rw-r--r--lib/reltool/test/reltool_server_SUITE.erl179
-rw-r--r--lib/reltool/test/reltool_test_lib.erl3
-rw-r--r--lib/reltool/test/reltool_wx_SUITE.erl7
-rw-r--r--lib/runtime_tools/doc/src/notes.xml15
-rw-r--r--lib/runtime_tools/vsn.mk2
-rw-r--r--lib/sasl/src/systools_make.erl6
-rw-r--r--lib/sasl/test/test_lib.hrl4
-rw-r--r--lib/ssh/doc/src/notes.xml17
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE.erl6
-rw-r--r--lib/ssh/test/ssh_trpt_test_lib.erl99
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/doc/specs/.gitignore1
-rw-r--r--lib/ssl/doc/src/Makefile8
-rw-r--r--lib/ssl/doc/src/notes.xml87
-rw-r--r--lib/ssl/doc/src/specs.xml9
-rw-r--r--lib/ssl/doc/src/ssl.xml1802
-rw-r--r--lib/ssl/doc/src/ssl_crl_cache.xml25
-rw-r--r--lib/ssl/doc/src/ssl_crl_cache_api.xml61
-rw-r--r--lib/ssl/doc/src/ssl_session_cache_api.xml95
-rw-r--r--lib/ssl/src/dtls_connection.erl271
-rw-r--r--lib/ssl/src/dtls_handshake.erl33
-rw-r--r--lib/ssl/src/dtls_handshake.hrl13
-rw-r--r--lib/ssl/src/dtls_packet_demux.erl7
-rw-r--r--lib/ssl/src/dtls_record.erl89
-rw-r--r--lib/ssl/src/dtls_socket.erl49
-rw-r--r--lib/ssl/src/inet_tls_dist.erl25
-rw-r--r--lib/ssl/src/ssl.erl461
-rw-r--r--lib/ssl/src/ssl_alert.erl85
-rw-r--r--lib/ssl/src/ssl_api.hrl49
-rw-r--r--lib/ssl/src/ssl_app.erl6
-rw-r--r--lib/ssl/src/ssl_cipher.erl123
-rw-r--r--lib/ssl/src/ssl_cipher.hrl1
-rw-r--r--lib/ssl/src/ssl_cipher_format.erl42
-rw-r--r--lib/ssl/src/ssl_connection.erl1245
-rw-r--r--lib/ssl/src/ssl_connection.hrl93
-rw-r--r--lib/ssl/src/ssl_crl_cache.erl4
-rw-r--r--lib/ssl/src/ssl_crl_cache_api.erl15
-rw-r--r--lib/ssl/src/ssl_handshake.erl25
-rw-r--r--lib/ssl/src/ssl_handshake.hrl4
-rw-r--r--lib/ssl/src/ssl_internal.hrl14
-rw-r--r--lib/ssl/src/ssl_logger.erl77
-rw-r--r--lib/ssl/src/ssl_manager.erl8
-rw-r--r--lib/ssl/src/ssl_record.erl83
-rw-r--r--lib/ssl/src/ssl_record.hrl4
-rw-r--r--lib/ssl/src/ssl_session.erl5
-rw-r--r--lib/ssl/src/ssl_session_cache_api.erl24
-rw-r--r--lib/ssl/src/tls_connection.erl355
-rw-r--r--lib/ssl/src/tls_connection.hrl1
-rw-r--r--lib/ssl/src/tls_connection_1_3.erl136
-rw-r--r--lib/ssl/src/tls_handshake.erl14
-rw-r--r--lib/ssl/src/tls_handshake.hrl1
-rw-r--r--lib/ssl/src/tls_handshake_1_3.erl924
-rw-r--r--lib/ssl/src/tls_record.erl437
-rw-r--r--lib/ssl/src/tls_record_1_3.erl30
-rw-r--r--lib/ssl/src/tls_sender.erl309
-rw-r--r--lib/ssl/src/tls_socket.erl56
-rw-r--r--lib/ssl/src/tls_v1.erl52
-rw-r--r--lib/ssl/test/Makefile2
-rw-r--r--lib/ssl/test/property_test/ssl_eqc_handshake.erl50
-rw-r--r--lib/ssl/test/ssl_ECC_SUITE.erl61
-rw-r--r--lib/ssl/test/ssl_alpn_handshake_SUITE.erl35
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl1389
-rw-r--r--lib/ssl/test/ssl_bench_SUITE.erl37
-rw-r--r--lib/ssl/test/ssl_certificate_verify_SUITE.erl109
-rw-r--r--lib/ssl/test/ssl_crl_SUITE.erl23
-rw-r--r--lib/ssl/test/ssl_dist_bench_SUITE.erl63
-rw-r--r--lib/ssl/test/ssl_sni_SUITE.erl8
-rw-r--r--lib/ssl/test/ssl_test_lib.erl137
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl7
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/ets.xml61
-rw-r--r--lib/stdlib/doc/src/filename.xml2
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml98
-rw-r--r--lib/stdlib/doc/src/notes.xml66
-rw-r--r--lib/stdlib/doc/src/proplists.xml5
-rw-r--r--lib/stdlib/doc/src/slave.xml19
-rw-r--r--lib/stdlib/doc/src/sys.xml5
-rw-r--r--lib/stdlib/src/calendar.erl94
-rw-r--r--lib/stdlib/src/erl_pp.erl4
-rw-r--r--lib/stdlib/src/gen_statem.erl40
-rw-r--r--lib/stdlib/src/io_lib.erl18
-rw-r--r--lib/stdlib/src/io_lib_format.erl27
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl64
-rw-r--r--lib/stdlib/src/otp_internal.erl15
-rw-r--r--lib/stdlib/src/slave.erl17
-rw-r--r--lib/stdlib/src/stdlib.appup.src10
-rw-r--r--lib/stdlib/src/sys.erl28
-rw-r--r--lib/stdlib/test/binary_module_SUITE.erl20
-rw-r--r--lib/stdlib/test/calendar_SUITE.erl16
-rw-r--r--lib/stdlib/test/erl_eval_SUITE.erl12
-rw-r--r--lib/stdlib/test/erl_pp_SUITE.erl11
-rw-r--r--lib/stdlib/test/ets_SUITE.erl117
-rw-r--r--lib/stdlib/test/io_SUITE.erl39
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl10
-rw-r--r--lib/stdlib/vsn.mk2
-rw-r--r--lib/syntax_tools/doc/src/notes.xml14
-rw-r--r--lib/syntax_tools/vsn.mk2
-rw-r--r--lib/tools/c_src/Makefile.in7
-rw-r--r--lib/tools/doc/src/cover.xml16
-rw-r--r--lib/tools/doc/src/notes.xml39
-rw-r--r--lib/tools/src/cover.erl490
-rw-r--r--lib/tools/test/cover_SUITE.erl40
-rw-r--r--lib/tools/vsn.mk2
-rw-r--r--lib/wx/api_gen/wx_extra/added_func.h6
-rw-r--r--lib/wx/api_gen/wx_gen.erl9
-rw-r--r--lib/wx/api_gen/wx_gen_cpp.erl8
-rw-r--r--lib/wx/api_gen/wxapi.conf36
-rw-r--r--lib/wx/c_src/gen/wxe_derived_dest.h10
-rw-r--r--lib/wx/c_src/gen/wxe_events.cpp4
-rw-r--r--lib/wx/c_src/gen/wxe_funcs.cpp115
-rw-r--r--lib/wx/c_src/gen/wxe_init.cpp66
-rw-r--r--lib/wx/c_src/gen/wxe_macros.h20
-rw-r--r--lib/wx/c_src/wxe_impl.cpp16
-rw-r--r--lib/wx/doc/src/notes.xml19
-rw-r--r--lib/wx/include/wx.hrl16
-rw-r--r--lib/wx/src/gen/wxDisplay.erl131
-rw-r--r--lib/wx/src/gen/wxGCDC.erl287
-rw-r--r--lib/wx/src/gen/wxe_debug.hrl18
-rw-r--r--lib/wx/src/gen/wxe_funcs.hrl18
-rw-r--r--lib/wx/vsn.mk2
-rw-r--r--make/install_dir_data.sh.in70
-rw-r--r--make/otp.mk.in2
-rw-r--r--make/otp_version_tickets_in_merge79
-rwxr-xr-xotp_build4
-rwxr-xr-xotp_patch_apply6
-rw-r--r--otp_versions.table7
-rw-r--r--system/doc/Makefile1
-rw-r--r--system/doc/design_principles/Makefile5
-rw-r--r--system/doc/design_principles/statem.xml13
-rw-r--r--system/doc/efficiency_guide/Makefile5
-rw-r--r--system/doc/embedded/Makefile5
-rw-r--r--system/doc/general_info/Makefile99
-rw-r--r--system/doc/general_info/book.xml44
-rw-r--r--system/doc/general_info/deprecations.xml98
-rw-r--r--system/doc/general_info/part.xml34
-rw-r--r--system/doc/general_info/scheduled_for_removal.xml61
-rw-r--r--system/doc/general_info/xmlfiles.mk22
-rw-r--r--system/doc/getting_started/Makefile5
-rw-r--r--system/doc/html/design_principles/.gitignore0
-rw-r--r--system/doc/html/efficiency_guide/.gitignore0
-rw-r--r--system/doc/html/embedded/.gitignore0
-rw-r--r--system/doc/html/general_info/.gitignore0
-rw-r--r--system/doc/html/getting_started/.gitignore0
-rw-r--r--system/doc/html/installation_guide/.gitignore0
-rw-r--r--system/doc/html/installation_guide/source/.gitignore0
-rw-r--r--system/doc/html/js/.gitignore0
-rw-r--r--system/doc/html/oam/.gitignore0
-rw-r--r--system/doc/html/programming_examples/.gitignore0
-rw-r--r--system/doc/html/reference_manual/.gitignore0
-rw-r--r--system/doc/html/system_architecture_intro/.gitignore0
-rw-r--r--system/doc/html/system_principles/.gitignore0
-rw-r--r--system/doc/html/tutorial/.gitignore0
-rw-r--r--system/doc/installation_guide/Makefile5
-rw-r--r--system/doc/oam/Makefile7
-rw-r--r--system/doc/programming_examples/Makefile5
-rw-r--r--system/doc/reference_manual/Makefile5
-rw-r--r--system/doc/system_architecture_intro/Makefile5
-rw-r--r--system/doc/system_principles/Makefile5
-rw-r--r--system/doc/system_principles/misc.xml8
-rw-r--r--system/doc/top/Makefile98
-rw-r--r--system/doc/top/book.xml1
-rw-r--r--system/doc/top/src/erl_html_tools.erl4
-rw-r--r--system/doc/top/src/erlresolvelinks.erl90
-rw-r--r--system/doc/top/templates/index.html.src2
-rw-r--r--system/doc/tutorial/Makefile7
-rw-r--r--system/doc/xml/design_principles/.gitignore0
-rw-r--r--system/doc/xml/efficiency_guide/.gitignore0
-rw-r--r--system/doc/xml/embedded/.gitignore0
-rw-r--r--system/doc/xml/general_info/.gitignore0
-rw-r--r--system/doc/xml/getting_started/.gitignore0
-rw-r--r--system/doc/xml/installation_guide/.gitignore0
-rw-r--r--system/doc/xml/oam/.gitignore0
-rw-r--r--system/doc/xml/programming_examples/.gitignore0
-rw-r--r--system/doc/xml/reference_manual/.gitignore0
-rw-r--r--system/doc/xml/system_architecture_intro/.gitignore0
-rw-r--r--system/doc/xml/system_principles/.gitignore0
-rw-r--r--system/doc/xml/tutorial/.gitignore0
848 files changed, 82905 insertions, 14198 deletions
diff --git a/.gitignore b/.gitignore
index e426c042a2..9497169cde 100644
--- a/.gitignore
+++ b/.gitignore
@@ -38,6 +38,8 @@ x86_64-unknown-freebsd[0-9]*.[0-9]*
sparc-sun-solaris[0-9]*.[0-9]*
i386-pc-solaris[0-9]*.[0-9]*
i386-unknown-freebsd[0-9]*.[0-9]*
+x86_64-unknown-freebsd[0-9]*.[0-9]*
+x86_64-unknown-openbsd[0-9]*.[0-9]*
tile-tilera-linux-gnu
powerpc-unknown-linux-gnu
aarch64-unknown-linux-gnu
@@ -140,6 +142,7 @@ JAVADOC-GENERATED
/make/output.mk
/make/emd2exml
/make/make_emakefile
+/make/install_dir_data.sh
# Created by "out_build update_primary"
/bootstrap/primary_compiler/
@@ -244,6 +247,7 @@ JAVADOC-GENERATED
/lib/compiler/src/core_parse.erl
/lib/compiler/test/*_no_opt_SUITE.erl
+/lib/compiler/test/*_no_ssa_opt_SUITE.erl
/lib/compiler/test/*_post_opt_SUITE.erl
/lib/compiler/test/*_inline_SUITE.erl
/lib/compiler/test/*_r21_SUITE.erl
@@ -314,6 +318,7 @@ JAVADOC-GENERATED
/lib/jinterface/doc/html/java
/lib/jinterface/pom.xml
/lib/jinterface/target
+/lib/jinterface/doc/src/jdoc
# kernel
@@ -368,7 +373,6 @@ JAVADOC-GENERATED
/system/doc/html
/system/doc/xml
/system/doc/top/PR.template
-/system/doc/top/erlresolvelinks.js
# test_server
diff --git a/HOWTO/INSTALL-RASPBERRYPI3.md b/HOWTO/INSTALL-RASPBERRYPI3.md
index 536d095cb4..b9cffbe0c5 100644
--- a/HOWTO/INSTALL-RASPBERRYPI3.md
+++ b/HOWTO/INSTALL-RASPBERRYPI3.md
@@ -4,7 +4,7 @@
## Introduction
This document describes how to build a toolchain and cross compile Erlang/OTP
-to Raspberry Pi 3 on macOS High Sierra. It is recommended to consult
+to Raspberry Pi 3 on macOS Mojave. It is recommended to consult
[Building and Installing Erlang/OTP](https://github.com/erlang/otp/blob/master/HOWTO/INSTALL.md) and [Cross Compiling Erlang/OTP](https://github.com/erlang/otp/blob/master/HOWTO/INSTALL-CROSS.md) before attempting to follow the instructions in this guide.
The whole process takes several hours and depending on the package versions different problems may arise that require additional
@@ -18,9 +18,15 @@ toolchain and sysroot.
#### Tested Configuration
-macOS High Sierra 10.13.2<br>
+macOS Mojave 10.14.3<br>
Raspberry Pi Model B Rev 1.2<br>
-Crosstools-NG 1.23.0_1
+Crosstools-NG 1.23.0_3
+
+```
+build = x86_64-apple-darwin18.2.0
+host = x86_64-apple-darwin18.2.0
+target = armv8-rpi3-linux-gnueabihf
+```
> Note: /proc/device/tree/model contains model information of your
> Raspberry Pi.
@@ -34,10 +40,13 @@ Crosstools-NG 1.23.0_1
$ brew install grep --default-names # needed by crosstools-ng scripts
$ brew install md5sha1sum # needed by crosstools-ng populate script
+ (2)
+
+ $ chmod 744 /usr/local/Cellar/crosstool-ng/1.23.0_3/lib/crosstool-ng-1.23.0/scripts/crosstool-NG.sh
#### Create case-sensitive disk images
- (2)
+ (3)
Create two case-sensitive disk images using Disk Utility:
@@ -47,47 +56,106 @@ Format: `Mac OS Extended (Case-sensitive, Journaled)`
```
/Volumes/xtools-build-env 15 GB
-/Volumes/xtools           500 MB
+/Volumes/xtools 500 MB
```
-The first image holds all source and object files while building the toolchain. The second image houses the compiled
+> The first image holds all source and object files while building the toolchain. The second image houses the compiled
toolchain.
-## Building the Toolchain
+## Building the Toolchain
-#### Configure crosstool-ng
+### Environment settings
(4)
+ $ ulimit -n 1024
+
+### Inspect target system
+
+ (5)
+
+ $ uname -a
+ Linux raspberrypi 4.9.35-v7+ #1014 SMP Fri Jun 30 14:47:43 BST 2017 armv7l GNU/Linux
+ $ ld -v
+ GNU ld (GNU Binutils for Raspbian) 2.25
+ $ ldd --version
+ ldd (Debian GLIBC 2.19-18+deb8u10) 2.19
+ Copyright (C) 2014 Free Software Foundation, Inc.
+ This is free software; see the source for copying conditions. There is NO
+ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+ Written by Roland McGrath and Ulrich Drepper.
+
+> Use the versions available on your target system!
+
+> See https://wiki.osdev.org/Cross-Compiler_Successful_Builds
+
+### Configure crosstool-ng
+
+ (6)
+
+ $ cd /Volumes/xtools-build-env
$ ct-ng armv8-rpi3-linux-gnueabihf
$ ct-ng menuconfig
-#### Modify *path* section
+#### Path and misc options
+
+##### crosstool-NG behavior
+
+ (7)
+
+```
+[*] Use obsolete features
+
+[*] Debug crosstool-NG
+[ ] Pause between every steps
+[*] Save intermediate steps
+[*] gzip saved states
+[*] Interactive shell on failed commands
+```
+
+> Should the build break at a particular build step, you can fix the problem and continue the build from where it broke.
+
+##### Paths
+
+ (8)
* Local tarballs directory: `/Volumes/xtools-build-env/src`
* Working directory: `/Volumes/xtools-build-env/.build`
* Prefix directory: `/Volumes/xtools/${CT_TARGET}`
-#### Modify *Extracting* section
+##### Extracting
+
+ (9)
+
+`[*] Stop after extracting tarballs`
-* Check option: _Stop after extracting tarballs_.
+> Stop the build process right after the tarballs have been extracted. This can be handy to fix known source code problems before the actual build process is started.
-> Note: The build shall stop after the tarballs have been extracted to give us time to fix source code problems.
+#### Operating System
-#### Enable STOP / RESTART
+ (10)
-Edit /Volumes/xtools-build-env/.config
-  `CT_DEBUG_CT_SAVE_STEPS=y`
+`Linux kernel version (4.9.20)`
-Should the build break at a particular build step, you can fix the problem and continue the build from where it broke.
+#### Binary utilities
-Short summary of the most common `ct-ng` commands:
+ (11)
-* Listing all build steps
+`bintutils version (2.28)`
+
+#### C-library
+
+ (12)
+
+`glibc version (2.19 (OBSOLETE))`
+
+#### Sample `ct-ng` commands:
+
+* List all build steps
```
-    $ ct-ng list-steps
+ $ ct-ng list-steps
Available build steps, in order:
- companion_tools_for_build
@@ -108,216 +176,153 @@ Short summary of the most common `ct-ng` commands:
- binutils_for_target
- debug
- test_suite
-    - finish
+ - finish
```
-* Re-run step
-```
-    $ ct-ng step
-```
+* Re-run step `companion_libs_for_host`
-* Restart from step
```
-    $ ct-ng step+
+ $ ct-ng companion_libs_for_host
```
-* Run until step
+* Restart from `companion_libs_for_host`
+
```
-    $ ct-ng +step
+ $ ct-ng companion_libs_for_host+
```
-#### Fix file permissions on crosstool-NG.sh
-
- (5)
-
- $ chmod 744 /usr/local/Cellar/crosstool-ng/1.23.0_1/lib/crosstool-ng-1.23.0/scripts/crosstool-NG.sh
+* Run until step `companion_libs_for_host`
-#### Run build command
+```
+ $ ct-ng +companion_libs_for_host
+```
-Build process stops just after the tarballs have been extracted.
+### Build
- (6)
+ (13)
$ ct-ng build
- Retrieving needed toolchain components' tarballs
- [EXTRA] Retrieving 'make-4.2.1'
- [EXTRA] Retrieving 'm4-1.4.18'
- [EXTRA] Retrieving 'linux-4.10.8'
- [EXTRA] Retrieving 'gmp-6.1.2'
- [EXTRA] Retrieving 'mpfr-3.1.5'
- [EXTRA] Retrieving 'isl-0.16.1'
- [EXTRA] Retrieving 'mpc-1.0.3'
- [EXTRA] Retrieving 'expat-2.2.0'
- [EXTRA] Retrieving 'ncurses-6.0'
- [EXTRA] Retrieving 'libiconv-1.15'
- [EXTRA] Retrieving 'gettext-0.19.8.1'
- [EXTRA] Retrieving 'binutils-2.28'
- [EXTRA] Retrieving 'gcc-6.3.0'
- [EXTRA] Retrieving 'glibc-2.25'
- [EXTRA] Retrieving 'gdb-7.12.1'
+> Build process stops just after the tarballs have been extracted.
#### Fix source files
- (7)
-
-Add macro to /Volumes/xtools-build-env/.build/src/gdb-7.12.1/gdb/doublest.c:
-```C
-#define min(a,b) \
- ({ typeof (a) _a = (a); \
- typeof (b) _b = (b); \
-    _a < _b ? _a : _b; })
-```
-
-  (8) Update ulimit
+ (14)
- $ ulimit -n 1024
+ $ pushd .build/src/gettext-0.19.8.1/
+ $ autoreconf
+ $ popd
-#### Modify *extract* section
+#### Update configuration
- (8)
+ (15)
$ ct-ng menuconfig
- Uncheck option: _Stop after extracting tarballs_
+Uncheck option:
-#### Re-run build command
+`[ ] Stop after extracting tarballs`
-Restarts build process from where it previously stopped.
+#### Continue build
- (9)
+ (16)
$ ct-ng build
-#### Fix gettext
+> Restart build process from where it previously stopped.
-Build will fail at step `companion_tools_for_build` but it can be fixed by running autoreconf:
+ (17)
- (10)
+ $ export PATH=/Volumes/xtools/armv8-rpi3-linux-gnueabihf/bin:$PATH
- $ cd .build/src/gettext-0.19.8.1/
- $ ./autoreconf
- $ ct-ng companion_tools_for_build+
+### Test
-#### Test the toolchain
-
- (11)
+ (18)
$ cat > test.c
$ int main() { printf("Hello, world!\n"); return 0; }
- $ /Volumes/xtools/arm-unknown-linux-gnueabi-gcc -o test test.c
-
- (12) OPTIONAL
-
- “Render the toolchain read-only” from crosstool-NG’s “Paths and misc options” configuration page.
+ <CTRL+D>
+ $ armv8-rpi3-linux-gnueabihf-gcc -o test test.c
## Cross compiling dependencies
- (13)
+ (19)
- $ export PATH=/Volumes/xtools/armv8-rpi3-linux-gnueabihf/bin:$PATH
+ $ mkdir local # prefix directory
+ $ mkdir 3pps # OTP dependencies
+ $ cd 3pps
-#### Cross compiling zlib
+#### zlib
- (14)
+ (20)
$ wget http://zlib.net/zlib-1.2.11.tar.gz
$ tar xf zlib-1.2.11.tar.gz
- $ cd zlib-1.2.11
- $ CHOST=armv8-rpi3-linux-gnueabihf ./configure --prefix=/Users/<username>/git/raspberrypi/arm
+ $ pushd zlib-1.2.11
+ $ CHOST=armv8-rpi3-linux-gnueabihf ./configure --prefix=/Volumes/xtools-build-env/local
$ make
$ make install
+ $ popd
-#### Cross compiling openssl
+#### openssl
- (15)
+ (21)
- $ wget http://openssl.org/source/openssl-1.1.0g.tar.gz
- $ tar xf openssl-1.1.0g.tar.gz
- $ cd openssl-1.1.0g
- $ ./Configure linux-generic32 --prefix=/Users/<username>/git/raspberrypi/arm --openssldir=/Users/<username>/git/raspberrypi/arm/openssl --cross-compile-prefix=armv8-rpi3-linux-gnueabihf
+ $ wget http://openssl.org/source/openssl-1.1.1b.tar.gz
+ $ tar xf openssl-1.1.1b.tar.gz
+ $ pushd openssl-1.1.1b
+ $ ./Configure linux-generic32 --prefix=/Volumes/xtools-build-env/local \
+ --openssldir=/Volumes/xtools-build-env/local/openssl \
+ --cross-compile-prefix=armv8-rpi3-linux-gnueabihf-
$ make
$ make install
+ $ popd
-#### Cross compiling ncurses
-
- (16)
-
- $ wget http://ftp.gnu.org/pub/gnu/ncurses/ncurses-5.9.tar.gz
+> A compatible openssl library shall be available on the target system!
+#### ncurses
- (17)
-
-Apply patch:
-
-```patch
---- a/ncurses/base/MKlib_gen.sh
-+++ b/ncurses/base/MKlib_gen.sh
-@@ -474,11 +474,22 @@ sed -n -f $ED1 \
- -e 's/gen_$//' \
- -e 's/ / /g' >>$TMP
-
-+cat >$ED1 <<EOF
-+s/ / /g
-+s/^ //
-+s/ $//
-+s/P_NCURSES_BOOL/NCURSES_BOOL/g
-+EOF
-+
-+# A patch discussed here:
-+# https://gcc.gnu.org/ml/gcc-patches/2014-06/msg02185.html
-+# introduces spurious #line markers. Work around that by ignoring the system's
-+# attempt to define "bool" and using our own symbol here.
-+sed -e 's/bool/P_NCURSES_BOOL/g' $TMP > $ED2
-+cat $ED2 >$TMP
-+
- $preprocessor $TMP 2>/dev/null \
--| sed \
-- -e 's/ / /g' \
-- -e 's/^ //' \
-- -e 's/_Bool/NCURSES_BOOL/g' \
-+| sed -f $ED1 \
- | $AWK -f $AW2 \
- | sed -f $ED3 \
- | sed \
-```
+ (22)
-  (18)
-
- $ ./configure --build=x86_64-apple-darwin17.3.0 --host=armv8-rpi3-linux-gnueabihf --without-ada --without-cxx --without-cxx-binding --without-manpages --without-progs --without-tests --prefix=/usr --libdir=/lib --with-build-cc="gcc -D_GNU_SOURCE" --with-shared
+ $ wget http://ftp.gnu.org/pub/gnu/ncurses/ncurses-5.9.tar.gz
+ $ tar xf ncurses-5.9.tar.gz
+ $ pushd ncurses-5.9
+ $ wget https://gist.githubusercontent.com/peterdmv/1068b2f9e1fec6e1330ad62ed87461ad/\
+ raw/065597b63654ed6a9f28d02fdfbca844413847ad/ncurses-5.9.patch
+ $ patch -p0 < ncurses-5.9.patch
+ $ ./configure --build=x86_64-apple-darwin18.2.0 --host=armv8-rpi3-linux-gnueabihf \
+ --without-ada --without-cxx --without-cxx-binding --without-manpages \
+ --without-progs --without-tests --prefix=/usr --libdir=/lib \
+ --with-build-cc="gcc -D_GNU_SOURCE" --with-shared
$ make
- $ make DESTDIR=/Users/<username>/git/raspberrypi/arm install
-
- (19)
-
-Compile ncurses test program:
-
- $ cd test
- $ armv8-rpi3-linux-gnueabihf-gcc -o nctest ncurses.c -I${RPI_SYSROOT}/usr/include -L${RPI_SYSROOT}/lib -lncursesw
+ $ make DESTDIR=/Volumes/xtools-build-env/local install
+ $ popd
## Populating sysroot
- (19)
-
- Edit /Volumes/xtools/armv8-rpi3-linux-gnueabihf/bin/armv8-rpi3-linux-gnueabihf-populate:
+ (23)
- sed="gsed"
+ $ chmod 755 /Volumes/xtools/armv8-rpi3-linux-gnueabihf/bin
+ $ chmod 755 /Volumes/xtools/armv8-rpi3-linux-gnueabihf/bin/armv8-rpi3-linux-gnueabihf-populate
+ $ gsed -i 's/"sed"/"gsed"/g' \
+ /Volumes/xtools/armv8-rpi3-linux-gnueabihf/bin/armv8-rpi3-linux-gnueabihf-populate
+ $ chmod 555 /Volumes/xtools/armv8-rpi3-linux-gnueabihf/bin
+ $ chmod 555 /Volumes/xtools/armv8-rpi3-linux-gnueabihf/bin/armv8-rpi3-linux-gnueabihf-populate
- (20)
+ (24)
- $ armv8-rpi3-linux-gnueabihf-populate -s /Users/<username>/git/raspberrypi/arm -d /Users/<username>/git/raspberrypi/sysroot
- $ export RPI_SYSROOT=/Users/<username>/git/raspberrypi/sysroot
+ $ armv8-rpi3-linux-gnueabihf-populate -s /Volumes/xtools-build-env/local \
+ -d /Volumes/xtools-build-env/sysroot
+ $ export RPI_SYSROOT=/Volumes/xtools-build-env/sysroot
## Cross compiling Erlang/OTP
- (21)
+ (25)
$ LC_CTYPE=C && LANG=C && ./otp_build autoconf
- $ ./otp_build configure --disable-dynamic-ssl-lib --xcomp-conf=./xcomp/erl-xcomp-armv8-rpi3-linux-gnueabihf.conf
+ $ ./otp_build configure --xcomp-conf=./xcomp/erl-xcomp-armv8-rpi3-linux-gnueabihf.conf
$ ./otp_build boot -a
- $ ./otp_build release -a /Users/<username>/git/raspberrypi/erlang
- $ tar czf erlang.tgz ./erlang
-
+ $ ./otp_build release -a /Volumes/xtools-build-env/otp_22.0
diff --git a/Makefile.in b/Makefile.in
index 240450cdd4..49a0d9f8af 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -434,7 +434,7 @@ endif
PATH=$(BOOT_PREFIX)"$${PATH}" \
ERL_TOP=$(ERL_TOP) $(MAKE) TESTROOT="$(RELEASE_ROOT)" DOCGEN=$(BOOTSTRAP_ROOT)/bootstrap/lib/erl_docgen $@
ifneq ($(OTP_SMALL_BUILD),true)
- echo "OTP doc built" > $(ERL_TOP)/make/otp_doc_built
+ test -f $(ERL_TOP)/make/otp_doc_built || echo "OTP doc built" > $(ERL_TOP)/make/otp_doc_built
endif
xmllint: docs
@@ -450,7 +450,9 @@ else
$(MAKE) -C system/doc $@
endif
-mod2app:
+mod2app: $(ERL_TOP)/make/$(TARGET)/mod2app.xml
+
+$(ERL_TOP)/make/$(TARGET)/mod2app.xml: erts/doc/src/Makefile lib/*/doc/src/Makefile
PATH=$(BOOT_PREFIX)"$${PATH}" escript $(BOOTSTRAP_ROOT)/bootstrap/lib/erl_docgen/priv/bin/xref_mod_app.escript -topdir $(ERL_TOP) -outfile $(ERL_TOP)/make/$(TARGET)/mod2app.xml
# ----------------------------------------------------------------------
@@ -488,7 +490,7 @@ else
$(make_verbose)cd lib && \
ERL_TOP=$(ERL_TOP) PATH=$(BOOT_PREFIX)"$${PATH}" \
$(MAKE) opt BUILD_ALL=true
- $(V_at)echo "OTP built" > $(ERL_TOP)/make/otp_built
+ $(V_at)test -f $(ERL_TOP)/make/otp_built || echo "OTP built" > $(ERL_TOP)/make/otp_built
endif
kernel:
$(make_verbose)cd lib/kernel && \
@@ -767,7 +769,7 @@ tertiary_bootstrap_copy:
true; \
done
# copy erl_interface includes
- $(V_at)for x in lib/erl_interface/include/*; do \
+ $(V_at)for x in lib/erl_interface/include/*.h; do \
BN=`basename $$x`; \
TF=$(BOOTSTRAP_ROOT)/bootstrap/lib/erl_interface/include/$$BN; \
test -f $$TF && \
diff --git a/OTP_VERSION b/OTP_VERSION
index a12e109d04..da0a41680b 100644
--- a/OTP_VERSION
+++ b/OTP_VERSION
@@ -1 +1 @@
-22.0-rc0
+22.0-rc1
diff --git a/README.md b/README.md
index 5e051388d1..4cf018901c 100644
--- a/README.md
+++ b/README.md
@@ -4,6 +4,8 @@
**OTP** is a set of Erlang libraries, which consists of the Erlang runtime system, a number of ready-to-use components mainly written in Erlang, and a set of design principles for Erlang programs. [Learn more about Erlang and OTP](http://erlang.org/doc/system_architecture_intro/sys_arch_intro.html).
+[Release notes](http://erlang.org/download/otp_versions_tree.html) for all OTP versions.
+
[Learn how to program in Erlang](http://learnyousomeerlang.com/content).
## Examples
diff --git a/bootstrap/bin/no_dot_erlang.boot b/bootstrap/bin/no_dot_erlang.boot
index 0d5ef3920d..b48d22fe41 100644
--- a/bootstrap/bin/no_dot_erlang.boot
+++ b/bootstrap/bin/no_dot_erlang.boot
Binary files differ
diff --git a/bootstrap/bin/start.boot b/bootstrap/bin/start.boot
index 0d5ef3920d..b48d22fe41 100644
--- a/bootstrap/bin/start.boot
+++ b/bootstrap/bin/start.boot
Binary files differ
diff --git a/bootstrap/bin/start_clean.boot b/bootstrap/bin/start_clean.boot
index 0d5ef3920d..b48d22fe41 100644
--- a/bootstrap/bin/start_clean.boot
+++ b/bootstrap/bin/start_clean.boot
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_a.beam b/bootstrap/lib/compiler/ebin/beam_a.beam
index addcf3a6de..ceb83ba48b 100644
--- a/bootstrap/lib/compiler/ebin/beam_a.beam
+++ b/bootstrap/lib/compiler/ebin/beam_a.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_asm.beam b/bootstrap/lib/compiler/ebin/beam_asm.beam
index cac4ba468c..5c91f09b30 100644
--- a/bootstrap/lib/compiler/ebin/beam_asm.beam
+++ b/bootstrap/lib/compiler/ebin/beam_asm.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_block.beam b/bootstrap/lib/compiler/ebin/beam_block.beam
index 3f7efe278b..1db56cb5f1 100644
--- a/bootstrap/lib/compiler/ebin/beam_block.beam
+++ b/bootstrap/lib/compiler/ebin/beam_block.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_bs.beam b/bootstrap/lib/compiler/ebin/beam_bs.beam
deleted file mode 100644
index e59be34306..0000000000
--- a/bootstrap/lib/compiler/ebin/beam_bs.beam
+++ /dev/null
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam
index 7ee870f80f..4d567eca88 100644
--- a/bootstrap/lib/compiler/ebin/beam_clean.beam
+++ b/bootstrap/lib/compiler/ebin/beam_clean.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_dict.beam b/bootstrap/lib/compiler/ebin/beam_dict.beam
index c1aadafb76..b9317a55ee 100644
--- a/bootstrap/lib/compiler/ebin/beam_dict.beam
+++ b/bootstrap/lib/compiler/ebin/beam_dict.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_disasm.beam b/bootstrap/lib/compiler/ebin/beam_disasm.beam
index a75223de58..6b6b6d0f3f 100644
--- a/bootstrap/lib/compiler/ebin/beam_disasm.beam
+++ b/bootstrap/lib/compiler/ebin/beam_disasm.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_except.beam b/bootstrap/lib/compiler/ebin/beam_except.beam
index 2a892da335..0fb15b1422 100644
--- a/bootstrap/lib/compiler/ebin/beam_except.beam
+++ b/bootstrap/lib/compiler/ebin/beam_except.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_flatten.beam b/bootstrap/lib/compiler/ebin/beam_flatten.beam
index cc245af68a..d7780861c2 100644
--- a/bootstrap/lib/compiler/ebin/beam_flatten.beam
+++ b/bootstrap/lib/compiler/ebin/beam_flatten.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_jump.beam b/bootstrap/lib/compiler/ebin/beam_jump.beam
index 160958f700..289c08630a 100644
--- a/bootstrap/lib/compiler/ebin/beam_jump.beam
+++ b/bootstrap/lib/compiler/ebin/beam_jump.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam b/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam
index 40b20fbdd1..a6b54314f6 100644
--- a/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam
+++ b/bootstrap/lib/compiler/ebin/beam_kernel_to_ssa.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_peep.beam b/bootstrap/lib/compiler/ebin/beam_peep.beam
index dfcfdfb25a..9246bd1c27 100644
--- a/bootstrap/lib/compiler/ebin/beam_peep.beam
+++ b/bootstrap/lib/compiler/ebin/beam_peep.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa.beam b/bootstrap/lib/compiler/ebin/beam_ssa.beam
index f2732c5c26..9ba124a92d 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam b/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam
index 1ed4084574..50412bc8de 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_bsm.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam
index 96a6141b72..50737c66b1 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_codegen.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam b/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam
index 3491c86049..f3dbfc42ff 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_dead.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_funs.beam b/bootstrap/lib/compiler/ebin/beam_ssa_funs.beam
index bcfaa3da2d..6370e1eb78 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_funs.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_funs.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam
index 5102ff8dc0..322653dfc7 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_lint.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam
index 4c6af72b91..7b34cc5906 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_opt.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam b/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam
index 8d60dcecf0..f76f15aa70 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_pp.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam
index d2fabb3b18..8481429a30 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_pre_codegen.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam b/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam
index 97504d7aed..578e8db0eb 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_recv.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_share.beam b/bootstrap/lib/compiler/ebin/beam_ssa_share.beam
index d1062609c3..ea8e83d919 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_share.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_share.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam
index 504a94cb0a..52bdbf6937 100644
--- a/bootstrap/lib/compiler/ebin/beam_ssa_type.beam
+++ b/bootstrap/lib/compiler/ebin/beam_ssa_type.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_trim.beam b/bootstrap/lib/compiler/ebin/beam_trim.beam
index 2574f1ec31..00f3224106 100644
--- a/bootstrap/lib/compiler/ebin/beam_trim.beam
+++ b/bootstrap/lib/compiler/ebin/beam_trim.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam
index cef4e2ec8d..996525efc9 100644
--- a/bootstrap/lib/compiler/ebin/beam_utils.beam
+++ b/bootstrap/lib/compiler/ebin/beam_utils.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam
index 72e00f055c..a5db96bdaf 100644
--- a/bootstrap/lib/compiler/ebin/beam_validator.beam
+++ b/bootstrap/lib/compiler/ebin/beam_validator.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/beam_z.beam b/bootstrap/lib/compiler/ebin/beam_z.beam
index eebfcf4a5c..21ca7bcf46 100644
--- a/bootstrap/lib/compiler/ebin/beam_z.beam
+++ b/bootstrap/lib/compiler/ebin/beam_z.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl.beam b/bootstrap/lib/compiler/ebin/cerl.beam
index 6df0b15731..948c4759b0 100644
--- a/bootstrap/lib/compiler/ebin/cerl.beam
+++ b/bootstrap/lib/compiler/ebin/cerl.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_clauses.beam b/bootstrap/lib/compiler/ebin/cerl_clauses.beam
index 299b535077..a20a4ca43b 100644
--- a/bootstrap/lib/compiler/ebin/cerl_clauses.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_clauses.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_inline.beam b/bootstrap/lib/compiler/ebin/cerl_inline.beam
index c6e0e6e8e0..7bf92a0dd7 100644
--- a/bootstrap/lib/compiler/ebin/cerl_inline.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_inline.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_sets.beam b/bootstrap/lib/compiler/ebin/cerl_sets.beam
index 4ab7584977..bda70130a6 100644
--- a/bootstrap/lib/compiler/ebin/cerl_sets.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_sets.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/cerl_trees.beam b/bootstrap/lib/compiler/ebin/cerl_trees.beam
index c4fd19ef3b..831eddc405 100644
--- a/bootstrap/lib/compiler/ebin/cerl_trees.beam
+++ b/bootstrap/lib/compiler/ebin/cerl_trees.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam
index c1788f31c3..5829ab4867 100644
--- a/bootstrap/lib/compiler/ebin/compile.beam
+++ b/bootstrap/lib/compiler/ebin/compile.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/compiler.app b/bootstrap/lib/compiler/ebin/compiler.app
index 70748f16ff..0a5e6de039 100644
--- a/bootstrap/lib/compiler/ebin/compiler.app
+++ b/bootstrap/lib/compiler/ebin/compiler.app
@@ -19,12 +19,11 @@
{application, compiler,
[{description, "ERTS CXC 138 10"},
- {vsn, "7.2.7"},
+ {vsn, "7.3.1"},
{modules, [
beam_a,
beam_asm,
beam_block,
- beam_bs,
beam_clean,
beam_dict,
beam_disasm,
@@ -66,7 +65,6 @@
rec_env,
sys_core_alias,
sys_core_bsm,
- sys_core_dsetel,
sys_core_fold,
sys_core_fold_lists,
sys_core_inline,
diff --git a/bootstrap/lib/compiler/ebin/compiler.appup b/bootstrap/lib/compiler/ebin/compiler.appup
index 399b1af1bb..8370664167 100644
--- a/bootstrap/lib/compiler/ebin/compiler.appup
+++ b/bootstrap/lib/compiler/ebin/compiler.appup
@@ -16,7 +16,7 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"7.2.4",
+{"7.3.1",
[{<<".*">>,[{restart_application, compiler}]}],
[{<<".*">>,[{restart_application, compiler}]}]
}.
diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam
index eb7dca711d..19b0c3dfcb 100644
--- a/bootstrap/lib/compiler/ebin/core_lib.beam
+++ b/bootstrap/lib/compiler/ebin/core_lib.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_lint.beam b/bootstrap/lib/compiler/ebin/core_lint.beam
index 75ec19a458..ecad4f33e0 100644
--- a/bootstrap/lib/compiler/ebin/core_lint.beam
+++ b/bootstrap/lib/compiler/ebin/core_lint.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam
index 84a20817f4..f14357cf02 100644
--- a/bootstrap/lib/compiler/ebin/core_parse.beam
+++ b/bootstrap/lib/compiler/ebin/core_parse.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_pp.beam b/bootstrap/lib/compiler/ebin/core_pp.beam
index ceff6dbdfa..2423c9b2ea 100644
--- a/bootstrap/lib/compiler/ebin/core_pp.beam
+++ b/bootstrap/lib/compiler/ebin/core_pp.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/core_scan.beam b/bootstrap/lib/compiler/ebin/core_scan.beam
index b6dcb0a559..8e44464cd7 100644
--- a/bootstrap/lib/compiler/ebin/core_scan.beam
+++ b/bootstrap/lib/compiler/ebin/core_scan.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam
index dc3ede0fce..e626e91f4f 100644
--- a/bootstrap/lib/compiler/ebin/erl_bifs.beam
+++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/rec_env.beam b/bootstrap/lib/compiler/ebin/rec_env.beam
index ddbf799292..6d0c5baa04 100644
--- a/bootstrap/lib/compiler/ebin/rec_env.beam
+++ b/bootstrap/lib/compiler/ebin/rec_env.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_alias.beam b/bootstrap/lib/compiler/ebin/sys_core_alias.beam
index d6899a780b..622221a8b0 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_alias.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_alias.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam
index fe04ff54ba..6f4204e0a1 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_bsm.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_bsm.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam b/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam
deleted file mode 100644
index 344e864891..0000000000
--- a/bootstrap/lib/compiler/ebin/sys_core_dsetel.beam
+++ /dev/null
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam
index bac42707e9..dd2874bbe0 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam
index db9b195aec..f4aac9ac13 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_fold_lists.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_core_inline.beam b/bootstrap/lib/compiler/ebin/sys_core_inline.beam
index 55869526a4..5647c8fcb5 100644
--- a/bootstrap/lib/compiler/ebin/sys_core_inline.beam
+++ b/bootstrap/lib/compiler/ebin/sys_core_inline.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam
index 348c060875..002b4f2914 100644
--- a/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam
+++ b/bootstrap/lib/compiler/ebin/sys_pre_attributes.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam
index b1e0e21729..06a5b9973a 100644
--- a/bootstrap/lib/compiler/ebin/v3_core.beam
+++ b/bootstrap/lib/compiler/ebin/v3_core.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_kernel.beam b/bootstrap/lib/compiler/ebin/v3_kernel.beam
index 251483be06..54b2f1f0ad 100644
--- a/bootstrap/lib/compiler/ebin/v3_kernel.beam
+++ b/bootstrap/lib/compiler/ebin/v3_kernel.beam
Binary files differ
diff --git a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam
index 4e157cc305..5177b65198 100644
--- a/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam
+++ b/bootstrap/lib/compiler/ebin/v3_kernel_pp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam
index 83070b9a8a..9db02f55fd 100644
--- a/bootstrap/lib/kernel/ebin/application.beam
+++ b/bootstrap/lib/kernel/ebin/application.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam
index 24ceb48536..32612f1bf6 100644
--- a/bootstrap/lib/kernel/ebin/application_controller.beam
+++ b/bootstrap/lib/kernel/ebin/application_controller.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application_master.beam b/bootstrap/lib/kernel/ebin/application_master.beam
index f04a61d46f..77bb9544e2 100644
--- a/bootstrap/lib/kernel/ebin/application_master.beam
+++ b/bootstrap/lib/kernel/ebin/application_master.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/application_starter.beam b/bootstrap/lib/kernel/ebin/application_starter.beam
index d17ed145cb..0daab463ab 100644
--- a/bootstrap/lib/kernel/ebin/application_starter.beam
+++ b/bootstrap/lib/kernel/ebin/application_starter.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/auth.beam b/bootstrap/lib/kernel/ebin/auth.beam
index d1a5f2c31e..c77178bf7c 100644
--- a/bootstrap/lib/kernel/ebin/auth.beam
+++ b/bootstrap/lib/kernel/ebin/auth.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/code.beam b/bootstrap/lib/kernel/ebin/code.beam
index 99a05979a0..41e4bd4ab2 100644
--- a/bootstrap/lib/kernel/ebin/code.beam
+++ b/bootstrap/lib/kernel/ebin/code.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/code_server.beam b/bootstrap/lib/kernel/ebin/code_server.beam
index 500906fe3c..6add687cf2 100644
--- a/bootstrap/lib/kernel/ebin/code_server.beam
+++ b/bootstrap/lib/kernel/ebin/code_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/disk_log.beam b/bootstrap/lib/kernel/ebin/disk_log.beam
index db24834614..25142ee575 100644
--- a/bootstrap/lib/kernel/ebin/disk_log.beam
+++ b/bootstrap/lib/kernel/ebin/disk_log.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/disk_log_1.beam b/bootstrap/lib/kernel/ebin/disk_log_1.beam
index 1859239f78..350b66d1fb 100644
--- a/bootstrap/lib/kernel/ebin/disk_log_1.beam
+++ b/bootstrap/lib/kernel/ebin/disk_log_1.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/disk_log_server.beam b/bootstrap/lib/kernel/ebin/disk_log_server.beam
index e5838e0171..3b961dcefa 100644
--- a/bootstrap/lib/kernel/ebin/disk_log_server.beam
+++ b/bootstrap/lib/kernel/ebin/disk_log_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/dist_ac.beam b/bootstrap/lib/kernel/ebin/dist_ac.beam
index e1145bd00f..e82fc7dc75 100644
--- a/bootstrap/lib/kernel/ebin/dist_ac.beam
+++ b/bootstrap/lib/kernel/ebin/dist_ac.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/dist_util.beam b/bootstrap/lib/kernel/ebin/dist_util.beam
index bbf2b22d0a..fd21dd47f5 100644
--- a/bootstrap/lib/kernel/ebin/dist_util.beam
+++ b/bootstrap/lib/kernel/ebin/dist_util.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erl_boot_server.beam b/bootstrap/lib/kernel/ebin/erl_boot_server.beam
index 2b4885199e..81f6779c20 100644
--- a/bootstrap/lib/kernel/ebin/erl_boot_server.beam
+++ b/bootstrap/lib/kernel/ebin/erl_boot_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erl_ddll.beam b/bootstrap/lib/kernel/ebin/erl_ddll.beam
index b08f0ed2ab..c04bc43872 100644
--- a/bootstrap/lib/kernel/ebin/erl_ddll.beam
+++ b/bootstrap/lib/kernel/ebin/erl_ddll.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erl_epmd.beam b/bootstrap/lib/kernel/ebin/erl_epmd.beam
index 1c54ab32a4..6ed9862a0e 100644
--- a/bootstrap/lib/kernel/ebin/erl_epmd.beam
+++ b/bootstrap/lib/kernel/ebin/erl_epmd.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/error_handler.beam b/bootstrap/lib/kernel/ebin/error_handler.beam
index 40fb8ef4ec..19739b0043 100644
--- a/bootstrap/lib/kernel/ebin/error_handler.beam
+++ b/bootstrap/lib/kernel/ebin/error_handler.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/error_logger.beam b/bootstrap/lib/kernel/ebin/error_logger.beam
index 02ab05023a..10b13c35b6 100644
--- a/bootstrap/lib/kernel/ebin/error_logger.beam
+++ b/bootstrap/lib/kernel/ebin/error_logger.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/erts_debug.beam b/bootstrap/lib/kernel/ebin/erts_debug.beam
index 52aae18464..5336f4ae6c 100644
--- a/bootstrap/lib/kernel/ebin/erts_debug.beam
+++ b/bootstrap/lib/kernel/ebin/erts_debug.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/file.beam b/bootstrap/lib/kernel/ebin/file.beam
index 51407568c7..9c2759adc9 100644
--- a/bootstrap/lib/kernel/ebin/file.beam
+++ b/bootstrap/lib/kernel/ebin/file.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/file_io_server.beam b/bootstrap/lib/kernel/ebin/file_io_server.beam
index 17473bb2e3..b8f1272be4 100644
--- a/bootstrap/lib/kernel/ebin/file_io_server.beam
+++ b/bootstrap/lib/kernel/ebin/file_io_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/file_server.beam b/bootstrap/lib/kernel/ebin/file_server.beam
index 18134e367b..cc2face79c 100644
--- a/bootstrap/lib/kernel/ebin/file_server.beam
+++ b/bootstrap/lib/kernel/ebin/file_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/gen_sctp.beam b/bootstrap/lib/kernel/ebin/gen_sctp.beam
index 6776a74958..9fc5800f0c 100644
--- a/bootstrap/lib/kernel/ebin/gen_sctp.beam
+++ b/bootstrap/lib/kernel/ebin/gen_sctp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/global.beam b/bootstrap/lib/kernel/ebin/global.beam
index f5a8195f7c..f57cf03afd 100644
--- a/bootstrap/lib/kernel/ebin/global.beam
+++ b/bootstrap/lib/kernel/ebin/global.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/global_group.beam b/bootstrap/lib/kernel/ebin/global_group.beam
index c1e229b2da..83885cdeb5 100644
--- a/bootstrap/lib/kernel/ebin/global_group.beam
+++ b/bootstrap/lib/kernel/ebin/global_group.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/group.beam b/bootstrap/lib/kernel/ebin/group.beam
index 620a9d2974..396f1166f1 100644
--- a/bootstrap/lib/kernel/ebin/group.beam
+++ b/bootstrap/lib/kernel/ebin/group.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/group_history.beam b/bootstrap/lib/kernel/ebin/group_history.beam
index e0287893c0..b9df7cfc14 100644
--- a/bootstrap/lib/kernel/ebin/group_history.beam
+++ b/bootstrap/lib/kernel/ebin/group_history.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/heart.beam b/bootstrap/lib/kernel/ebin/heart.beam
index 945b10cd31..1b63142893 100644
--- a/bootstrap/lib/kernel/ebin/heart.beam
+++ b/bootstrap/lib/kernel/ebin/heart.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
index 57e58235d4..fc80f2d1bd 100644
--- a/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
+++ b/bootstrap/lib/kernel/ebin/hipe_unified_loader.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet.beam b/bootstrap/lib/kernel/ebin/inet.beam
index 2cace976ea..b0c67afe90 100644
--- a/bootstrap/lib/kernel/ebin/inet.beam
+++ b/bootstrap/lib/kernel/ebin/inet.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet6_tcp.beam b/bootstrap/lib/kernel/ebin/inet6_tcp.beam
index 6c1c562ded..7cacde3399 100644
--- a/bootstrap/lib/kernel/ebin/inet6_tcp.beam
+++ b/bootstrap/lib/kernel/ebin/inet6_tcp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_config.beam b/bootstrap/lib/kernel/ebin/inet_config.beam
index 1cf364e231..c44b389b75 100644
--- a/bootstrap/lib/kernel/ebin/inet_config.beam
+++ b/bootstrap/lib/kernel/ebin/inet_config.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_db.beam b/bootstrap/lib/kernel/ebin/inet_db.beam
index f1f5766692..76d7ac2adb 100644
--- a/bootstrap/lib/kernel/ebin/inet_db.beam
+++ b/bootstrap/lib/kernel/ebin/inet_db.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_dns.beam b/bootstrap/lib/kernel/ebin/inet_dns.beam
index 3f6e85965f..d88fa2185d 100644
--- a/bootstrap/lib/kernel/ebin/inet_dns.beam
+++ b/bootstrap/lib/kernel/ebin/inet_dns.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam
index 4034ae6171..afc4999c42 100644
--- a/bootstrap/lib/kernel/ebin/inet_gethost_native.beam
+++ b/bootstrap/lib/kernel/ebin/inet_gethost_native.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_hosts.beam b/bootstrap/lib/kernel/ebin/inet_hosts.beam
index ba989b642d..8fb47e84eb 100644
--- a/bootstrap/lib/kernel/ebin/inet_hosts.beam
+++ b/bootstrap/lib/kernel/ebin/inet_hosts.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_parse.beam b/bootstrap/lib/kernel/ebin/inet_parse.beam
index b85540ead1..84c0169d4b 100644
--- a/bootstrap/lib/kernel/ebin/inet_parse.beam
+++ b/bootstrap/lib/kernel/ebin/inet_parse.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_res.beam b/bootstrap/lib/kernel/ebin/inet_res.beam
index c3230acc89..c964152d79 100644
--- a/bootstrap/lib/kernel/ebin/inet_res.beam
+++ b/bootstrap/lib/kernel/ebin/inet_res.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_sctp.beam b/bootstrap/lib/kernel/ebin/inet_sctp.beam
index 65cbd8f5ad..0e659bd738 100644
--- a/bootstrap/lib/kernel/ebin/inet_sctp.beam
+++ b/bootstrap/lib/kernel/ebin/inet_sctp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_tcp.beam b/bootstrap/lib/kernel/ebin/inet_tcp.beam
index 49fdc129f4..c273d47012 100644
--- a/bootstrap/lib/kernel/ebin/inet_tcp.beam
+++ b/bootstrap/lib/kernel/ebin/inet_tcp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam
index 100ccc01fe..d09aa250c8 100644
--- a/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam
+++ b/bootstrap/lib/kernel/ebin/inet_tcp_dist.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/inet_udp.beam b/bootstrap/lib/kernel/ebin/inet_udp.beam
index 35edff2393..62156a3284 100644
--- a/bootstrap/lib/kernel/ebin/inet_udp.beam
+++ b/bootstrap/lib/kernel/ebin/inet_udp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/kernel.app b/bootstrap/lib/kernel/ebin/kernel.app
index 898ed0a048..ab106113c2 100644
--- a/bootstrap/lib/kernel/ebin/kernel.app
+++ b/bootstrap/lib/kernel/ebin/kernel.app
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -22,7 +22,7 @@
{application, kernel,
[
{description, "ERTS CXC 138 10"},
- {vsn, "6.1"},
+ {vsn, "6.2"},
{modules, [application,
application_controller,
application_master,
@@ -68,11 +68,12 @@
logger_formatter,
logger_h_common,
logger_handler_watcher,
+ logger_olp,
+ logger_proxy,
logger_server,
logger_simple_h,
logger_std_h,
logger_sup,
- net,
net_adm,
net_kernel,
os,
diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup
index ac114f0354..59e716b2d0 100644
--- a/bootstrap/lib/kernel/ebin/kernel.appup
+++ b/bootstrap/lib/kernel/ebin/kernel.appup
@@ -16,13 +16,42 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"5.4.3",
- %% Up from - max one major revision back
- [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0
- {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.1+
- {<<"6\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-21
- %% Down to - max one major revision back
- [{<<"5\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.0
- {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.1+
- {<<"6\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-21
-}.
+%%
+%% We allow upgrade from, and downgrade to all previous
+%% versions from the following OTP releases:
+%% - OTP 20
+%% - OTP 21
+%%
+%% We also allow upgrade from, and downgrade to all
+%% versions that have branched off from the above
+%% stated previous versions.
+%%
+{"6.2",
+ [{<<"^5\\.3$">>,[restart_new_emulator]},
+ {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^5\\.4$">>,[restart_new_emulator]},
+ {<<"^5\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^5\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^5\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^5\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^6\\.0$">>,[restart_new_emulator]},
+ {<<"^6\\.0\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^6\\.1$">>,[restart_new_emulator]},
+ {<<"^6\\.1\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}],
+ [{<<"^5\\.3$">>,[restart_new_emulator]},
+ {<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^5\\.4$">>,[restart_new_emulator]},
+ {<<"^5\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^5\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^5\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^5\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^6\\.0$">>,[restart_new_emulator]},
+ {<<"^6\\.0\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^6\\.1$">>,[restart_new_emulator]},
+ {<<"^6\\.1\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}.
diff --git a/bootstrap/lib/kernel/ebin/kernel.beam b/bootstrap/lib/kernel/ebin/kernel.beam
index 10a5f0298a..8f75029c0f 100644
--- a/bootstrap/lib/kernel/ebin/kernel.beam
+++ b/bootstrap/lib/kernel/ebin/kernel.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/kernel_config.beam b/bootstrap/lib/kernel/ebin/kernel_config.beam
index 9f29de109f..e749cc6c96 100644
--- a/bootstrap/lib/kernel/ebin/kernel_config.beam
+++ b/bootstrap/lib/kernel/ebin/kernel_config.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/kernel_refc.beam b/bootstrap/lib/kernel/ebin/kernel_refc.beam
index 3ab1e0e46a..04306c6e2c 100644
--- a/bootstrap/lib/kernel/ebin/kernel_refc.beam
+++ b/bootstrap/lib/kernel/ebin/kernel_refc.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/local_tcp.beam b/bootstrap/lib/kernel/ebin/local_tcp.beam
index 17b7c20daa..2958d19524 100644
--- a/bootstrap/lib/kernel/ebin/local_tcp.beam
+++ b/bootstrap/lib/kernel/ebin/local_tcp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/local_udp.beam b/bootstrap/lib/kernel/ebin/local_udp.beam
index 725a6e2073..cc5f46f746 100644
--- a/bootstrap/lib/kernel/ebin/local_udp.beam
+++ b/bootstrap/lib/kernel/ebin/local_udp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger.beam b/bootstrap/lib/kernel/ebin/logger.beam
index ac70f610cc..bd17885e22 100644
--- a/bootstrap/lib/kernel/ebin/logger.beam
+++ b/bootstrap/lib/kernel/ebin/logger.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_backend.beam b/bootstrap/lib/kernel/ebin/logger_backend.beam
index 1b29546101..40a3c4d80a 100644
--- a/bootstrap/lib/kernel/ebin/logger_backend.beam
+++ b/bootstrap/lib/kernel/ebin/logger_backend.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_config.beam b/bootstrap/lib/kernel/ebin/logger_config.beam
index bded41c72d..51c7f78237 100644
--- a/bootstrap/lib/kernel/ebin/logger_config.beam
+++ b/bootstrap/lib/kernel/ebin/logger_config.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam b/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam
index 31b18bde25..dd0ca5f204 100644
--- a/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam
+++ b/bootstrap/lib/kernel/ebin/logger_disk_log_h.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_filters.beam b/bootstrap/lib/kernel/ebin/logger_filters.beam
index 712ebee110..2d8035278d 100644
--- a/bootstrap/lib/kernel/ebin/logger_filters.beam
+++ b/bootstrap/lib/kernel/ebin/logger_filters.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_formatter.beam b/bootstrap/lib/kernel/ebin/logger_formatter.beam
index b2d43763a9..83df11e66f 100644
--- a/bootstrap/lib/kernel/ebin/logger_formatter.beam
+++ b/bootstrap/lib/kernel/ebin/logger_formatter.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_h_common.beam b/bootstrap/lib/kernel/ebin/logger_h_common.beam
index 24bdf42273..5e14216b5d 100644
--- a/bootstrap/lib/kernel/ebin/logger_h_common.beam
+++ b/bootstrap/lib/kernel/ebin/logger_h_common.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam b/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam
index 2ebf3799ee..fb20fd1818 100644
--- a/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam
+++ b/bootstrap/lib/kernel/ebin/logger_handler_watcher.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_olp.beam b/bootstrap/lib/kernel/ebin/logger_olp.beam
new file mode 100644
index 0000000000..ed06b6ae5e
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_olp.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_proxy.beam b/bootstrap/lib/kernel/ebin/logger_proxy.beam
new file mode 100644
index 0000000000..ed0ed0f56b
--- /dev/null
+++ b/bootstrap/lib/kernel/ebin/logger_proxy.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_server.beam b/bootstrap/lib/kernel/ebin/logger_server.beam
index 91135f0080..dcff9beac7 100644
--- a/bootstrap/lib/kernel/ebin/logger_server.beam
+++ b/bootstrap/lib/kernel/ebin/logger_server.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_simple_h.beam b/bootstrap/lib/kernel/ebin/logger_simple_h.beam
index 73d8d0727c..954bbdc071 100644
--- a/bootstrap/lib/kernel/ebin/logger_simple_h.beam
+++ b/bootstrap/lib/kernel/ebin/logger_simple_h.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_std_h.beam b/bootstrap/lib/kernel/ebin/logger_std_h.beam
index 9577a05b2f..3b5d3cd9f8 100644
--- a/bootstrap/lib/kernel/ebin/logger_std_h.beam
+++ b/bootstrap/lib/kernel/ebin/logger_std_h.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/logger_sup.beam b/bootstrap/lib/kernel/ebin/logger_sup.beam
index 32eb526a09..60192ef4a1 100644
--- a/bootstrap/lib/kernel/ebin/logger_sup.beam
+++ b/bootstrap/lib/kernel/ebin/logger_sup.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/net.beam b/bootstrap/lib/kernel/ebin/net.beam
deleted file mode 100644
index 3e971eb0e1..0000000000
--- a/bootstrap/lib/kernel/ebin/net.beam
+++ /dev/null
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/net_adm.beam b/bootstrap/lib/kernel/ebin/net_adm.beam
index 3ba16fbf3f..5810577c6a 100644
--- a/bootstrap/lib/kernel/ebin/net_adm.beam
+++ b/bootstrap/lib/kernel/ebin/net_adm.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/net_kernel.beam b/bootstrap/lib/kernel/ebin/net_kernel.beam
index cd8db9b45f..4c57f5f6c8 100644
--- a/bootstrap/lib/kernel/ebin/net_kernel.beam
+++ b/bootstrap/lib/kernel/ebin/net_kernel.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/os.beam b/bootstrap/lib/kernel/ebin/os.beam
index 95da61ed4a..f05007041b 100644
--- a/bootstrap/lib/kernel/ebin/os.beam
+++ b/bootstrap/lib/kernel/ebin/os.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/pg2.beam b/bootstrap/lib/kernel/ebin/pg2.beam
index 40d216bac9..d293ea18f3 100644
--- a/bootstrap/lib/kernel/ebin/pg2.beam
+++ b/bootstrap/lib/kernel/ebin/pg2.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/ram_file.beam b/bootstrap/lib/kernel/ebin/ram_file.beam
index 8135abcab0..02c4c6454a 100644
--- a/bootstrap/lib/kernel/ebin/ram_file.beam
+++ b/bootstrap/lib/kernel/ebin/ram_file.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io.beam b/bootstrap/lib/kernel/ebin/raw_file_io.beam
index 2e73087b25..16dc314ba5 100644
--- a/bootstrap/lib/kernel/ebin/raw_file_io.beam
+++ b/bootstrap/lib/kernel/ebin/raw_file_io.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam
index ae9db38926..3c41f8528e 100644
--- a/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_compressed.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam
index 0793ba6f2d..11b8f4a6db 100644
--- a/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_deflate.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam
index 9199dac5ba..b3381cc397 100644
--- a/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_delayed.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam
index 457cbcc64c..bd0064ebf2 100644
--- a/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_inflate.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam
index 73f072fb5f..b544fd394e 100644
--- a/bootstrap/lib/kernel/ebin/raw_file_io_list.beam
+++ b/bootstrap/lib/kernel/ebin/raw_file_io_list.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/rpc.beam b/bootstrap/lib/kernel/ebin/rpc.beam
index 62b972805a..b53525e2ca 100644
--- a/bootstrap/lib/kernel/ebin/rpc.beam
+++ b/bootstrap/lib/kernel/ebin/rpc.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/seq_trace.beam b/bootstrap/lib/kernel/ebin/seq_trace.beam
index 9a325446ed..f81a39ddc0 100644
--- a/bootstrap/lib/kernel/ebin/seq_trace.beam
+++ b/bootstrap/lib/kernel/ebin/seq_trace.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/standard_error.beam b/bootstrap/lib/kernel/ebin/standard_error.beam
index 0ca95ea770..18582d22f2 100644
--- a/bootstrap/lib/kernel/ebin/standard_error.beam
+++ b/bootstrap/lib/kernel/ebin/standard_error.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/user.beam b/bootstrap/lib/kernel/ebin/user.beam
index a30f12417a..f3573d95af 100644
--- a/bootstrap/lib/kernel/ebin/user.beam
+++ b/bootstrap/lib/kernel/ebin/user.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/user_drv.beam b/bootstrap/lib/kernel/ebin/user_drv.beam
index 3558dff5be..ce4d4328de 100644
--- a/bootstrap/lib/kernel/ebin/user_drv.beam
+++ b/bootstrap/lib/kernel/ebin/user_drv.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam
index 382cc0e618..ceb8dd9a78 100644
--- a/bootstrap/lib/kernel/ebin/wrap_log_reader.beam
+++ b/bootstrap/lib/kernel/ebin/wrap_log_reader.beam
Binary files differ
diff --git a/bootstrap/lib/kernel/include/dist.hrl b/bootstrap/lib/kernel/include/dist.hrl
index 003852f1b0..f06fc328d7 100644
--- a/bootstrap/lib/kernel/include/dist.hrl
+++ b/bootstrap/lib/kernel/include/dist.hrl
@@ -42,6 +42,9 @@
-define(DFLAG_BIG_CREATION, 16#40000).
-define(DFLAG_SEND_SENDER, 16#80000).
-define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000).
+%% -define(DFLAG_NO_MAGIC, 16#200000). %% Used internally only
+-define(DFLAG_EXIT_PAYLOAD, 16#400000).
+-define(DFLAG_FRAGMENTS, 16#800000).
%% Also update dflag2str() in ../src/dist_util.erl
%% when adding flags...
diff --git a/bootstrap/lib/stdlib/ebin/array.beam b/bootstrap/lib/stdlib/ebin/array.beam
index a132cb5470..ac3193515c 100644
--- a/bootstrap/lib/stdlib/ebin/array.beam
+++ b/bootstrap/lib/stdlib/ebin/array.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/beam_lib.beam b/bootstrap/lib/stdlib/ebin/beam_lib.beam
index a778a2dad4..c13a82a074 100644
--- a/bootstrap/lib/stdlib/ebin/beam_lib.beam
+++ b/bootstrap/lib/stdlib/ebin/beam_lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/binary.beam b/bootstrap/lib/stdlib/ebin/binary.beam
index c88e1a003f..0cedd64883 100644
--- a/bootstrap/lib/stdlib/ebin/binary.beam
+++ b/bootstrap/lib/stdlib/ebin/binary.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/c.beam b/bootstrap/lib/stdlib/ebin/c.beam
index a367eb8897..c61132b2de 100644
--- a/bootstrap/lib/stdlib/ebin/c.beam
+++ b/bootstrap/lib/stdlib/ebin/c.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/calendar.beam b/bootstrap/lib/stdlib/ebin/calendar.beam
index 5aa493c638..d0abc17e48 100644
--- a/bootstrap/lib/stdlib/ebin/calendar.beam
+++ b/bootstrap/lib/stdlib/ebin/calendar.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets.beam b/bootstrap/lib/stdlib/ebin/dets.beam
index d118445f7f..a92506125d 100644
--- a/bootstrap/lib/stdlib/ebin/dets.beam
+++ b/bootstrap/lib/stdlib/ebin/dets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets_server.beam b/bootstrap/lib/stdlib/ebin/dets_server.beam
index f88f45c809..8cd247e3be 100644
--- a/bootstrap/lib/stdlib/ebin/dets_server.beam
+++ b/bootstrap/lib/stdlib/ebin/dets_server.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets_utils.beam b/bootstrap/lib/stdlib/ebin/dets_utils.beam
index 440805c963..16c6f1aba5 100644
--- a/bootstrap/lib/stdlib/ebin/dets_utils.beam
+++ b/bootstrap/lib/stdlib/ebin/dets_utils.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dets_v9.beam b/bootstrap/lib/stdlib/ebin/dets_v9.beam
index 06356b7063..2f82423bac 100644
--- a/bootstrap/lib/stdlib/ebin/dets_v9.beam
+++ b/bootstrap/lib/stdlib/ebin/dets_v9.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/dict.beam b/bootstrap/lib/stdlib/ebin/dict.beam
index 81b26934eb..dc390024a4 100644
--- a/bootstrap/lib/stdlib/ebin/dict.beam
+++ b/bootstrap/lib/stdlib/ebin/dict.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/digraph.beam b/bootstrap/lib/stdlib/ebin/digraph.beam
index 27da3f013b..60abe020fd 100644
--- a/bootstrap/lib/stdlib/ebin/digraph.beam
+++ b/bootstrap/lib/stdlib/ebin/digraph.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/digraph_utils.beam b/bootstrap/lib/stdlib/ebin/digraph_utils.beam
index 7a4d347912..772332cd08 100644
--- a/bootstrap/lib/stdlib/ebin/digraph_utils.beam
+++ b/bootstrap/lib/stdlib/ebin/digraph_utils.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/edlin.beam b/bootstrap/lib/stdlib/ebin/edlin.beam
index cf1a6c5e90..b6a7ecc9a5 100644
--- a/bootstrap/lib/stdlib/ebin/edlin.beam
+++ b/bootstrap/lib/stdlib/ebin/edlin.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/edlin_expand.beam b/bootstrap/lib/stdlib/ebin/edlin_expand.beam
index fb483ec8cd..865066c3ac 100644
--- a/bootstrap/lib/stdlib/ebin/edlin_expand.beam
+++ b/bootstrap/lib/stdlib/ebin/edlin_expand.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam
index 5b995408bf..2618efb7d2 100644
--- a/bootstrap/lib/stdlib/ebin/epp.beam
+++ b/bootstrap/lib/stdlib/ebin/epp.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam b/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam
index b52efa7445..973ad9fb80 100644
--- a/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_abstract_code.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_anno.beam b/bootstrap/lib/stdlib/ebin/erl_anno.beam
index e74e1a41c0..a40fcb3f92 100644
--- a/bootstrap/lib/stdlib/ebin/erl_anno.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_anno.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_bits.beam b/bootstrap/lib/stdlib/ebin/erl_bits.beam
index 1b0d1d2ceb..1beb0d5ebb 100644
--- a/bootstrap/lib/stdlib/ebin/erl_bits.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_bits.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_compile.beam b/bootstrap/lib/stdlib/ebin/erl_compile.beam
index f625088f9c..fa223657bf 100644
--- a/bootstrap/lib/stdlib/ebin/erl_compile.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_compile.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_error.beam b/bootstrap/lib/stdlib/ebin/erl_error.beam
index b19c0b7538..db9d45a0d2 100644
--- a/bootstrap/lib/stdlib/ebin/erl_error.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_error.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam
index 10a62b2b15..90b3858207 100644
--- a/bootstrap/lib/stdlib/ebin/erl_eval.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam
index da0822e9bb..3a631e24bc 100644
--- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_internal.beam b/bootstrap/lib/stdlib/ebin/erl_internal.beam
index 37d4e09347..9015ad8936 100644
--- a/bootstrap/lib/stdlib/ebin/erl_internal.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_internal.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam
index 8170bfb4cc..35e02b9595 100644
--- a/bootstrap/lib/stdlib/ebin/erl_lint.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam
index 79194f5283..41369ca147 100644
--- a/bootstrap/lib/stdlib/ebin/erl_parse.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam
index e741577c2f..64e558e272 100644
--- a/bootstrap/lib/stdlib/ebin/erl_pp.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_scan.beam b/bootstrap/lib/stdlib/ebin/erl_scan.beam
index 360233e8f3..3b30d3e8c7 100644
--- a/bootstrap/lib/stdlib/ebin/erl_scan.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_scan.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/erl_tar.beam b/bootstrap/lib/stdlib/ebin/erl_tar.beam
index 99ef87f432..97ddc7d703 100644
--- a/bootstrap/lib/stdlib/ebin/erl_tar.beam
+++ b/bootstrap/lib/stdlib/ebin/erl_tar.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam
index 7f3c843426..64de26f7a4 100644
--- a/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam
+++ b/bootstrap/lib/stdlib/ebin/error_logger_file_h.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam
index 4ecfd2d919..e7ee41cc2e 100644
--- a/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam
+++ b/bootstrap/lib/stdlib/ebin/error_logger_tty_h.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/escript.beam b/bootstrap/lib/stdlib/ebin/escript.beam
index b5ed605760..7685b4a49a 100644
--- a/bootstrap/lib/stdlib/ebin/escript.beam
+++ b/bootstrap/lib/stdlib/ebin/escript.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam
index a40a00ab48..cb7c957719 100644
--- a/bootstrap/lib/stdlib/ebin/ets.beam
+++ b/bootstrap/lib/stdlib/ebin/ets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/eval_bits.beam b/bootstrap/lib/stdlib/ebin/eval_bits.beam
index 639cbbfb60..08f86f86ff 100644
--- a/bootstrap/lib/stdlib/ebin/eval_bits.beam
+++ b/bootstrap/lib/stdlib/ebin/eval_bits.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/file_sorter.beam b/bootstrap/lib/stdlib/ebin/file_sorter.beam
index dbc990c5b6..f24f6cfbe8 100644
--- a/bootstrap/lib/stdlib/ebin/file_sorter.beam
+++ b/bootstrap/lib/stdlib/ebin/file_sorter.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/filelib.beam b/bootstrap/lib/stdlib/ebin/filelib.beam
index b366827ae7..62b8c3588e 100644
--- a/bootstrap/lib/stdlib/ebin/filelib.beam
+++ b/bootstrap/lib/stdlib/ebin/filelib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/filename.beam b/bootstrap/lib/stdlib/ebin/filename.beam
index 068ca59ebe..9981a33a4e 100644
--- a/bootstrap/lib/stdlib/ebin/filename.beam
+++ b/bootstrap/lib/stdlib/ebin/filename.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gb_sets.beam b/bootstrap/lib/stdlib/ebin/gb_sets.beam
index c402e65233..8d1e2c11e0 100644
--- a/bootstrap/lib/stdlib/ebin/gb_sets.beam
+++ b/bootstrap/lib/stdlib/ebin/gb_sets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gb_trees.beam b/bootstrap/lib/stdlib/ebin/gb_trees.beam
index 215704f10e..0aae509cb6 100644
--- a/bootstrap/lib/stdlib/ebin/gb_trees.beam
+++ b/bootstrap/lib/stdlib/ebin/gb_trees.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen.beam b/bootstrap/lib/stdlib/ebin/gen.beam
index dfe444ee66..85a9c25618 100644
--- a/bootstrap/lib/stdlib/ebin/gen.beam
+++ b/bootstrap/lib/stdlib/ebin/gen.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_event.beam b/bootstrap/lib/stdlib/ebin/gen_event.beam
index b41dc43257..f3376d2ee2 100644
--- a/bootstrap/lib/stdlib/ebin/gen_event.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_event.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_fsm.beam b/bootstrap/lib/stdlib/ebin/gen_fsm.beam
index dfa8202179..5c4a0aa3d5 100644
--- a/bootstrap/lib/stdlib/ebin/gen_fsm.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_fsm.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_server.beam b/bootstrap/lib/stdlib/ebin/gen_server.beam
index fb69aaf296..06c3d6de19 100644
--- a/bootstrap/lib/stdlib/ebin/gen_server.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_server.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/gen_statem.beam b/bootstrap/lib/stdlib/ebin/gen_statem.beam
index b643d2f550..0aab776d07 100644
--- a/bootstrap/lib/stdlib/ebin/gen_statem.beam
+++ b/bootstrap/lib/stdlib/ebin/gen_statem.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io.beam b/bootstrap/lib/stdlib/ebin/io.beam
index 4b4b4d6196..631863b587 100644
--- a/bootstrap/lib/stdlib/ebin/io.beam
+++ b/bootstrap/lib/stdlib/ebin/io.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io_lib.beam b/bootstrap/lib/stdlib/ebin/io_lib.beam
index 1b21c65ba1..c52efe1b44 100644
--- a/bootstrap/lib/stdlib/ebin/io_lib.beam
+++ b/bootstrap/lib/stdlib/ebin/io_lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io_lib_format.beam b/bootstrap/lib/stdlib/ebin/io_lib_format.beam
index e42ebca4fe..5556dc733b 100644
--- a/bootstrap/lib/stdlib/ebin/io_lib_format.beam
+++ b/bootstrap/lib/stdlib/ebin/io_lib_format.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam
index 3bc7bfd679..b56a9e3eb7 100644
--- a/bootstrap/lib/stdlib/ebin/io_lib_fread.beam
+++ b/bootstrap/lib/stdlib/ebin/io_lib_fread.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam
index a732e98e3c..7ffe569c60 100644
--- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam
+++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/lists.beam b/bootstrap/lib/stdlib/ebin/lists.beam
index 5134be06af..5a330bece0 100644
--- a/bootstrap/lib/stdlib/ebin/lists.beam
+++ b/bootstrap/lib/stdlib/ebin/lists.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/log_mf_h.beam b/bootstrap/lib/stdlib/ebin/log_mf_h.beam
index 592de58dc5..b812621c0a 100644
--- a/bootstrap/lib/stdlib/ebin/log_mf_h.beam
+++ b/bootstrap/lib/stdlib/ebin/log_mf_h.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/maps.beam b/bootstrap/lib/stdlib/ebin/maps.beam
index 623fd0951c..193a06241d 100644
--- a/bootstrap/lib/stdlib/ebin/maps.beam
+++ b/bootstrap/lib/stdlib/ebin/maps.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam
index 65d745a858..bb98ae56b3 100644
--- a/bootstrap/lib/stdlib/ebin/ms_transform.beam
+++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/otp_internal.beam b/bootstrap/lib/stdlib/ebin/otp_internal.beam
index e1785421db..a975a43c00 100644
--- a/bootstrap/lib/stdlib/ebin/otp_internal.beam
+++ b/bootstrap/lib/stdlib/ebin/otp_internal.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/pool.beam b/bootstrap/lib/stdlib/ebin/pool.beam
index 7c310e3eda..408ee3a0c9 100644
--- a/bootstrap/lib/stdlib/ebin/pool.beam
+++ b/bootstrap/lib/stdlib/ebin/pool.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/proc_lib.beam b/bootstrap/lib/stdlib/ebin/proc_lib.beam
index 3f73773e06..b51898901d 100644
--- a/bootstrap/lib/stdlib/ebin/proc_lib.beam
+++ b/bootstrap/lib/stdlib/ebin/proc_lib.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/proplists.beam b/bootstrap/lib/stdlib/ebin/proplists.beam
index 94fd9746da..a8ddeb2d57 100644
--- a/bootstrap/lib/stdlib/ebin/proplists.beam
+++ b/bootstrap/lib/stdlib/ebin/proplists.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam
index af30cc1864..4b7a3b5278 100644
--- a/bootstrap/lib/stdlib/ebin/qlc.beam
+++ b/bootstrap/lib/stdlib/ebin/qlc.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam
index 41adc8473e..22c0e2ef95 100644
--- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam
+++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/queue.beam b/bootstrap/lib/stdlib/ebin/queue.beam
index 4a52126c62..571d4a13a5 100644
--- a/bootstrap/lib/stdlib/ebin/queue.beam
+++ b/bootstrap/lib/stdlib/ebin/queue.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/rand.beam b/bootstrap/lib/stdlib/ebin/rand.beam
index e4cbb26417..9636f4fbbf 100644
--- a/bootstrap/lib/stdlib/ebin/rand.beam
+++ b/bootstrap/lib/stdlib/ebin/rand.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/random.beam b/bootstrap/lib/stdlib/ebin/random.beam
index 197b7b8b50..a4bc2b6128 100644
--- a/bootstrap/lib/stdlib/ebin/random.beam
+++ b/bootstrap/lib/stdlib/ebin/random.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/re.beam b/bootstrap/lib/stdlib/ebin/re.beam
index af77423e98..d6920d54ce 100644
--- a/bootstrap/lib/stdlib/ebin/re.beam
+++ b/bootstrap/lib/stdlib/ebin/re.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/sets.beam b/bootstrap/lib/stdlib/ebin/sets.beam
index cea57f083a..e3609ea527 100644
--- a/bootstrap/lib/stdlib/ebin/sets.beam
+++ b/bootstrap/lib/stdlib/ebin/sets.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam
index ff11977085..319bb9aebf 100644
--- a/bootstrap/lib/stdlib/ebin/shell.beam
+++ b/bootstrap/lib/stdlib/ebin/shell.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/slave.beam b/bootstrap/lib/stdlib/ebin/slave.beam
index ad8763725e..259d300155 100644
--- a/bootstrap/lib/stdlib/ebin/slave.beam
+++ b/bootstrap/lib/stdlib/ebin/slave.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/sofs.beam b/bootstrap/lib/stdlib/ebin/sofs.beam
index 89529b7df0..f64faafa52 100644
--- a/bootstrap/lib/stdlib/ebin/sofs.beam
+++ b/bootstrap/lib/stdlib/ebin/sofs.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/stdlib.app b/bootstrap/lib/stdlib/ebin/stdlib.app
index 46163158bf..2bb0b06f12 100644
--- a/bootstrap/lib/stdlib/ebin/stdlib.app
+++ b/bootstrap/lib/stdlib/ebin/stdlib.app
@@ -20,7 +20,7 @@
%%
{application, stdlib,
[{description, "ERTS CXC 138 10"},
- {vsn, "3.6"},
+ {vsn, "3.7.1"},
{modules, [array,
base64,
beam_lib,
diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup
index 381b33c833..d22e917574 100644
--- a/bootstrap/lib/stdlib/ebin/stdlib.appup
+++ b/bootstrap/lib/stdlib/ebin/stdlib.appup
@@ -16,11 +16,42 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
-{"3.4.5",
- %% Up from - max one major revision back
- [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
- {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}],% OTP-21.*
- %% Down to - max one major revision back
- [{<<"3\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-20.*
- {<<"3\\.5(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.*
-}.
+%%
+%% We allow upgrade from, and downgrade to all previous
+%% versions from the following OTP releases:
+%% - OTP 20
+%% - OTP 21
+%%
+%% We also allow upgrade from, and downgrade to all
+%% versions that have branched off from the above
+%% stated previous versions.
+%%
+{"3.7.1",
+ [{<<"^3\\.4$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.4(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.5(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.5$">>,[restart_new_emulator]},
+ {<<"^3\\.5\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.5\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.6$">>,[restart_new_emulator]},
+ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.7$">>,[restart_new_emulator]},
+ {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}],
+ [{<<"^3\\.4$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.2(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.3(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.4(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.4\\.5(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.5$">>,[restart_new_emulator]},
+ {<<"^3\\.5\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.5\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^3\\.6$">>,[restart_new_emulator]},
+ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.7$">>,[restart_new_emulator]},
+ {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}.
diff --git a/bootstrap/lib/stdlib/ebin/string.beam b/bootstrap/lib/stdlib/ebin/string.beam
index dd005daf89..da647da3ca 100644
--- a/bootstrap/lib/stdlib/ebin/string.beam
+++ b/bootstrap/lib/stdlib/ebin/string.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam
index 425c946a05..1816fe6c41 100644
--- a/bootstrap/lib/stdlib/ebin/supervisor.beam
+++ b/bootstrap/lib/stdlib/ebin/supervisor.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
index 6b410a6bd2..761907b40c 100644
--- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
+++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/sys.beam b/bootstrap/lib/stdlib/ebin/sys.beam
index 90e7fbfdb2..2b4906508a 100644
--- a/bootstrap/lib/stdlib/ebin/sys.beam
+++ b/bootstrap/lib/stdlib/ebin/sys.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/timer.beam b/bootstrap/lib/stdlib/ebin/timer.beam
index d54c6de720..2953299e8b 100644
--- a/bootstrap/lib/stdlib/ebin/timer.beam
+++ b/bootstrap/lib/stdlib/ebin/timer.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/unicode.beam b/bootstrap/lib/stdlib/ebin/unicode.beam
index 71ee4524a7..d61ed589aa 100644
--- a/bootstrap/lib/stdlib/ebin/unicode.beam
+++ b/bootstrap/lib/stdlib/ebin/unicode.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/unicode_util.beam b/bootstrap/lib/stdlib/ebin/unicode_util.beam
index 93d8257a71..8ddf73ca26 100644
--- a/bootstrap/lib/stdlib/ebin/unicode_util.beam
+++ b/bootstrap/lib/stdlib/ebin/unicode_util.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/uri_string.beam b/bootstrap/lib/stdlib/ebin/uri_string.beam
index 0a0dfaff7a..001118f0b9 100644
--- a/bootstrap/lib/stdlib/ebin/uri_string.beam
+++ b/bootstrap/lib/stdlib/ebin/uri_string.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/win32reg.beam b/bootstrap/lib/stdlib/ebin/win32reg.beam
index aed66c3559..136b65f9fb 100644
--- a/bootstrap/lib/stdlib/ebin/win32reg.beam
+++ b/bootstrap/lib/stdlib/ebin/win32reg.beam
Binary files differ
diff --git a/bootstrap/lib/stdlib/ebin/zip.beam b/bootstrap/lib/stdlib/ebin/zip.beam
index a03dd40c1f..cd6274efe5 100644
--- a/bootstrap/lib/stdlib/ebin/zip.beam
+++ b/bootstrap/lib/stdlib/ebin/zip.beam
Binary files differ
diff --git a/configure.src b/configure.src
index 889902eb96..4b748f2545 100644
--- a/configure.src
+++ b/configure.src
@@ -70,8 +70,10 @@ while test $# != 0; do
ERL_TOP="$user_srcdir"
;;
--enable-bootstrap-only)
+ config_arguments="$config_arguments --enable-bootstrap-only"
bootstrap_only=yes;;
--disable-bootstrap-only)
+ config_arguments="$config_arguments --disable-bootstrap-only"
bootstrap_only=no;;
--enable-option-checking)
echo "ERROR: Cannot enable option checking" 1>&2
diff --git a/erts/autoconf/configure.vxworks b/erts/autoconf/configure.vxworks
index a253848403..1893f3f7e0 100755
--- a/erts/autoconf/configure.vxworks
+++ b/erts/autoconf/configure.vxworks
@@ -93,6 +93,7 @@ erts_lib_src=${ERL_TOP}/erts/lib_src
erts_incl=${ERL_TOP}/erts/include
erts_incl_intrnl=${ERL_TOP}/erts/include/internal
etcdir=${ERL_TOP}/erts/etc/common
+erlint_incl_dir=${ERL_TOP}/lib/erl_interface/include
erlint_dir=${ERL_TOP}/lib/erl_interface/src
epmd_dir=${ERL_TOP}/erts/epmd/src
os_mon_dir=${ERL_TOP}/lib/os_mon/c_src
@@ -109,6 +110,7 @@ CONFIG_FILES="${ERL_TOP}/erts/emulator/$host/Makefile
$erts_incl_intrnl/$host/ethread.mk
$erts_incl_intrnl/$host/ethread_header_config.h
$etcdir/$host/Makefile
+ $erlint_incl_dir/$host/ei_config.h
$erlint_dir/$host/Makefile
$erlint_dir/$host/eidefs.mk
$epmd_dir/$host/Makefile
diff --git a/erts/autoconf/vxworks/sed.general b/erts/autoconf/vxworks/sed.general
index 0e99b4dba4..d32fbdc5c0 100644
--- a/erts/autoconf/vxworks/sed.general
+++ b/erts/autoconf/vxworks/sed.general
@@ -103,7 +103,6 @@ s|@INSTALL_PROGRAM@|${INSTALL}|
s|@INSTALL_SCRIPT@|${INSTALL}|
s|@INSTALL_DATA@|${INSTALL} -m 644|
s|@INSTALL_DIR@|$(INSTALL) -d|
-s|@RM@|/bin/rm|
s|@MKDIR@|/bin/mkdir|
s|@ERLANG_OSTYPE@|vxworks|
s|@vxworks_reclaim@|reclaim.h|
diff --git a/erts/configure.in b/erts/configure.in
index 14c8b50680..b070ad0649 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -772,11 +772,6 @@ AC_SUBST(LIBCARBON)
_search_path=/bin:/usr/bin:/usr/local/bin:$PATH
-AC_PATH_PROG(RM, rm, false, $_search_path)
-if test "$ac_cv_path_RM" = false; then
- AC_MSG_ERROR([No 'rm' command found])
-fi
-
AC_PATH_PROG(MKDIR, mkdir, false, $_search_path)
if test "$ac_cv_path_MKDIR" = false; then
AC_MSG_ERROR([No 'mkdir' command found])
@@ -791,9 +786,9 @@ _search_path=
# Remove old configuration information.
-# Next line should be placed after AC_PATH_PROG(RM, ...), but before
-# first output to CONN_INFO. So this is just the right place.
-$RM -f "$ERL_TOP/erts/CONF_INFO"
+# Next line should be before first output to CONN_INFO. So this is
+# just the right place.
+rm -f "$ERL_TOP/erts/CONF_INFO"
dnl Check if we should/can build a sharing-preserving emulator
AC_MSG_CHECKING(if we are building a sharing-preserving emulator)
@@ -831,7 +826,7 @@ fi
## Delete previous failed configure results
if test -f doc/CONF_INFO; then
- $RM doc/CONF_INFO
+ rm -f doc/CONF_INFO
fi
AC_CHECK_PROGS(XSLTPROC, xsltproc)
@@ -1655,7 +1650,9 @@ if test x"$ac_cv_header_netinet_sctp_h" = x"yes"; then
struct sctp_paddrparams.spp_sackdelay,
struct sctp_paddrparams.spp_flags,
struct sctp_remote_error.sre_data,
- struct sctp_send_failed.ssf_data], [], [],
+ struct sctp_send_failed.ssf_data,
+ struct sctp_event_subscribe.sctp_authentication_event,
+ struct sctp_event_subscribe.sctp_sender_dry_event], [], [],
[#if HAVE_SYS_SOCKET_H
#include <sys/socket.h>
#endif
@@ -3083,14 +3080,14 @@ if test "$enable_dtrace_test" = "yes" ; then
AC_MSG_CHECKING([for 2-stage DTrace precompilation])
AC_TRY_COMPILE([ #include "foo-dtrace.h" ],
[ERLANG_DIST_PORT_BUSY_ENABLED();],
- [$RM -f $DTRACE_2STEP_TEST
+ [rm -f $DTRACE_2STEP_TEST
dtrace -G $DTRACE_CPP $DTRACE_BITS_FLAG -Iemulator/beam -o $DTRACE_2STEP_TEST -s emulator/beam/erlang_dtrace.d conftest.$OBJEXT 2>&AS_MESSAGE_LOG_FD
if test -f $DTRACE_2STEP_TEST; then
- $RM $DTRACE_2STEP_TEST
+ rm -f $DTRACE_2STEP_TEST
DTRACE_ENABLED_2STEP=yes
fi],
[])
- $RM -f foo-dtrace.h
+ rm -f foo-dtrace.h
AS_IF([test "x$DTRACE_ENABLED_2STEP" = "xyes"],
[AC_MSG_RESULT([yes])],
[AC_MSG_RESULT([no])])
@@ -3188,7 +3185,7 @@ need_java="jinterface ic/java_src"
# Remove all SKIP files from previous runs
for a in $need_java ; do
- $RM -f $ERL_TOP/lib/$a/SKIP
+ rm -f $ERL_TOP/lib/$a/SKIP
done
if test "X$with_javac" = "Xno"; then
@@ -3239,7 +3236,7 @@ dnl this deliberately does not believe that 'gcc' is a C++ compiler
AC_CHECK_TOOLS(CXX, [$CCC c++ g++ CC cxx cc++ cl], false)
# Remove SKIP file from previous run
-$RM -f $ERL_TOP/lib/orber/SKIP
+rm -f $ERL_TOP/lib/orber/SKIP
if test "$CXX" = false; then
echo "No C++ compiler found" > $ERL_TOP/lib/orber/SKIP
@@ -3395,11 +3392,12 @@ AC_CONFIG_FILES([../make/make_emakefile:../make/make_emakefile.in],
dnl
dnl The ones below should be moved to their respective lib
dnl
-dnl ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in
AC_CONFIG_FILES([
../lib/os_mon/c_src/$host/Makefile:../lib/os_mon/c_src/Makefile.in
../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in
../lib/tools/c_src/$host/Makefile:../lib/tools/c_src/Makefile.in
])
+AC_CONFIG_FILES([../make/install_dir_data.sh:../make/install_dir_data.sh.in], [chmod +x ../make/install_dir_data.sh])
+
AC_OUTPUT
diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile
index 40f74b78ff..06a8691c0e 100644
--- a/erts/doc/src/Makefile
+++ b/erts/doc/src/Makefile
@@ -55,7 +55,9 @@ XML_REF3_EFILES = \
persistent_term.xml \
atomics.xml \
counters.xml \
- zlib.xml
+ zlib.xml \
+ socket.xml \
+ net.xml
XML_REF3_FILES = \
$(XML_REF3_EFILES) \
@@ -77,6 +79,7 @@ XML_CHAPTER_FILES = \
driver.xml \
absform.xml \
inet_cfg.xml \
+ socket_usage.xml \
erl_ext_dist.xml \
erl_dist_protocol.xml \
communication.xml \
@@ -146,6 +149,8 @@ $(INFO_FILE): $(INFO_FILE_SRC) $(ERL_TOP)/make/$(TARGET)/otp.mk
debug opt:
+ldocs: xmllint local_docs
+
clean:
rm -rf $(HTMLDIR)/*
rm -rf $(XMLDIR)
diff --git a/erts/doc/src/alt_dist.xml b/erts/doc/src/alt_dist.xml
index e6245130fc..7c997cae20 100644
--- a/erts/doc/src/alt_dist.xml
+++ b/erts/doc/src/alt_dist.xml
@@ -60,7 +60,7 @@
parts of the logic in Erlang code, and you perhaps do not
even need a new driver for the protocol. One example could
be Erlang distribution over UDP using <c>gen_udp</c> (your
- Erlang code will of course have to take care of retranspissions,
+ Erlang code will of course have to take care of retransmissions,
etc in this example). That is, depending on what you want
to do you perhaps do not need to implement a driver at all
and can then skip the driver related sections below.
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index 05a9895687..88ddb03e97 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -464,7 +464,7 @@
</item>
<tag><c><![CDATA[-rsh Program]]></c></tag>
<item>
- <p>Specifies an alternative to <c><![CDATA[rsh]]></c> for starting a
+ <p>Specifies an alternative to <c><![CDATA[ssh]]></c> for starting a
slave node on a remote host; see
<seealso marker="stdlib:slave"><c>slave(3)</c></seealso>.</p>
</item>
diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml
index c90c8f9521..185c75fe84 100644
--- a/erts/doc/src/erl_dist_protocol.xml
+++ b/erts/doc/src/erl_dist_protocol.xml
@@ -532,11 +532,7 @@ io:format("old/unused name ~ts at port ~p, fd = ~p ~n",
<marker id="distribution_handshake"/>
<title>Distribution Handshake</title>
<p>This section describes the distribution handshake protocol introduced
- in Erlang/OTP R6. This description was previously located in
- <c>$ERL_TOP/lib/kernel/internal_doc/distribution_handshake.txt</c> and
- has more or less been copied and "formatted" here. It has been almost
- unchanged since 1999, but the handshake has not changed much since then
- either.</p>
+ in Erlang/OTP R6. The handshake has remained almost the same since then.</p>
<section>
<title>General</title>
@@ -847,6 +843,18 @@ DiB == gen_digest(ChA, ICA)?
of the <c>SEND_TT</c> control message.
</p>
</item>
+ <tag><c>-define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000).</c></tag>
+ <item>
+ <p>The node understands any term as the seqtrace label.</p>
+ </item>
+ <tag><c>-define(DFLAG_EXIT_PAYLOAD, 16#400000).</c></tag>
+ <item>
+ <p>Use the <c>PAYLOAD_EXIT</c>, <c>PAYLOAD_EXIT_TT</c>,
+ <c>PAYLOAD_EXIT2</c>, <c>PAYLOAD_EXIT2_TT</c>
+ and <c>PAYLOAD_MONITOR_P_EXIT</c>
+ <seealso marker="#control_message">control message</seealso>s
+ instead of the non-PAYLOAD variants.</p>
+ </item>
</taglist>
<p>
There is also function <c>dist_util:strict_order_flags/0</c>
@@ -859,7 +867,7 @@ DiB == gen_digest(ChA, ICA)?
<section>
<marker id="connected_nodes"/>
<title>Protocol between Connected Nodes</title>
- <p>As from ERTS 5.7.2 the runtime system passes a distribution flag
+ <p>Since ERTS 5.7.2 (OTP R13B) the runtime system passes a distribution flag
in the handshake stage that enables the use of a
<seealso marker="erl_ext_dist#distribution_header">distribution header
</seealso> on all messages passed. Messages passed between nodes have in
@@ -878,7 +886,7 @@ DiB == gen_digest(ChA, ICA)?
<cell align="center"><c>ControlMessage</c></cell>
<cell align="center"><c>Message</c></cell>
</row>
- <tcaption>Format of Messages Passed between Nodes (as from ERTS 5.7.2)
+ <tcaption>Format of Messages Passed between Nodes (as from ERTS 5.7.2 (OTP R13B))
</tcaption>
</table>
@@ -887,15 +895,23 @@ DiB == gen_digest(ChA, ICA)?
<item>
<p>Equal to d + n + m.</p>
</item>
+ <tag><c>DistributionHeader</c></tag>
+ <item>
+ <p>
+ <seealso marker="erl_ext_dist#distribution_header">Distribution header
+ describing the atom cache and fragmented distribution messages.
+ </seealso>
+ </p>
+ </item>
<tag><c>ControlMessage</c></tag>
<item>
<p>A tuple passed using the external format of Erlang.</p>
</item>
<tag><c>Message</c></tag>
<item>
- <p>The message sent to another node using the '!' (in external format).
- Notice that <c>Message</c> is only passed in combination with a
- <c>ControlMessage</c> encoding a send ('!').</p>
+ <p>The message sent to another node using the '!'
+ or the reason for a EXIT, EXIT2 or DOWN signal using
+ the external term format.</p>
</item>
</taglist>
@@ -903,7 +919,7 @@ DiB == gen_digest(ChA, ICA)?
number is omitted from the terms that follow a distribution header
</seealso>.</p>
- <p>Nodes with an ERTS version earlier than 5.7.2 does not pass the
+ <p>Nodes with an ERTS version earlier than 5.7.2 (OTP R13B) does not pass the
distribution flag that enables the distribution header. Messages passed
between nodes have in this case the following format:</p>
@@ -920,7 +936,7 @@ DiB == gen_digest(ChA, ICA)?
<cell align="center"><c>ControlMessage</c></cell>
<cell align="center"><c>Message</c></cell>
</row>
- <tcaption>Format of Messages Passed between Nodes (before ERTS 5.7.2)
+ <tcaption>Format of Messages Passed between Nodes (before ERTS 5.7.2 (OTP R13B))
</tcaption>
</table>
@@ -963,6 +979,7 @@ DiB == gen_digest(ChA, ICA)?
<tag><c>EXIT</c></tag>
<item>
<p><c>{3, FromPid, ToPid, Reason}</c></p>
+ <p>This signal is sent when a link has been broken</p>
</item>
<tag><c>UNLINK</c></tag>
<item>
@@ -985,6 +1002,7 @@ DiB == gen_digest(ChA, ICA)?
<tag><c>EXIT2</c></tag>
<item>
<p><c>{8, FromPid, ToPid, Reason}</c></p>
+ <p>This signal is sent by a call to the erlang:exit/2 bif</p>
</item>
</taglist>
</section>
@@ -1007,7 +1025,7 @@ DiB == gen_digest(ChA, ICA)?
<p><c>{16, FromPid, Unused, ToName, TraceToken}</c></p>
<p>Followed by <c>Message</c>.</p>
<p><c>Unused</c> is kept for backward compatibility.</p>
- </item>
+ </item>
<tag><c>EXIT2_TT</c></tag>
<item>
<p><c>{18, FromPid, ToPid, TraceToken, Reason}</c></p>
@@ -1061,7 +1079,7 @@ DiB == gen_digest(ChA, ICA)?
<p><c>{22, FromPid, ToPid}</c></p>
<p>Followed by <c>Message</c>.</p>
<p>
- This control messages replace the <c>SEND</c> control
+ This control message replaces the <c>SEND</c> control
message and will be sent when the distribution flag
<seealso marker="erl_dist_protocol#dflags"><c>DFLAG_SEND_SENDER</c></seealso>
has been negotiated in the connection setup handshake.
@@ -1080,7 +1098,7 @@ DiB == gen_digest(ChA, ICA)?
<p><c>{23, FromPid, ToPid, TraceToken}</c></p>
<p>Followed by <c>Message</c>.</p>
<p>
- This control messages replace the <c>SEND_TT</c> control
+ This control message replaces the <c>SEND_TT</c> control
message and will be sent when the distribution flag
<seealso marker="erl_dist_protocol#dflags"><c>DFLAG_SEND_SENDER</c></seealso>
has been negotiated in the connection setup handshake.
@@ -1097,4 +1115,72 @@ DiB == gen_digest(ChA, ICA)?
</taglist>
</section>
+ <section>
+ <title>New Ctrlmessages for Erlang/OTP 22</title>
+ <note><p>
+ Messages encoded before the connection has
+ been set up may still use the non-PAYLOAD variant.
+ However, once a PAYLOAD control message has been sent,
+ no more non-PAYLOAD control messages will be sent in
+ the same direction on the connection.
+ </p></note>
+ <taglist>
+ <tag><c>PAYLOAD_EXIT</c></tag>
+ <item>
+ <p><c>{24, FromPid, ToPid}</c></p>
+ <p>Followed by <c>Reason</c>.</p>
+ <p>
+ This control message replaces the <c>EXIT</c> control
+ message and will be sent when the distribution flag
+ <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso>
+ has been negotiated in the connection setup handshake.
+ </p>
+ </item>
+ <tag><c>PAYLOAD_EXIT_TT</c></tag>
+ <item>
+ <p><c>{25, FromPid, ToPid}</c></p>
+ <p>Followed by <c>Reason</c>.</p>
+ <p>
+ This control message replaces the <c>EXIT_TT</c> control
+ message and will be sent when the distribution flag
+ <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso>
+ has been negotiated in the connection setup handshake.
+ </p>
+ </item>
+ <tag><c>PAYLOAD_EXIT2</c></tag>
+ <item>
+ <p><c>{26, FromPid, ToPid}</c></p>
+ <p>Followed by <c>Reason</c>.</p>
+ <p>
+ This control message replaces the <c>EXIT2</c> control
+ message and will be sent when the distribution flag
+ <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso>
+ has been negotiated in the connection setup handshake.
+ </p>
+ </item>
+ <tag><c>PAYLOAD_EXIT2_TT</c></tag>
+ <item>
+ <p><c>{27, FromPid, ToPid}</c></p>
+ <p>Followed by <c>Reason</c>.</p>
+ <p>
+ This control message replaces the <c>EXIT2_TT</c> control
+ message and will be sent when the distribution flag
+ <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso>
+ has been negotiated in the connection setup handshake.
+ </p>
+ </item>
+ <tag><c>PAYLOAD_MONITOR_P_EXIT</c></tag>
+ <item>
+ <p><c>{28, FromPid, ToPid, Ref}</c></p>
+ <p>Followed by <c>Reason</c>.</p>
+ <p>
+ This control message replaces the <c>MONITOR_P_EXIT</c> control
+ message and will be sent when the distribution flag
+ <seealso marker="erl_dist_protocol#dflags"><c>DFLAG_EXIT_PAYLOAD</c></seealso>
+ has been negotiated in the connection setup handshake.
+ </p>
+ </item>
+ </taglist>
+ </section>
+
</chapter>
diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml
index b7090d0472..4721747097 100644
--- a/erts/doc/src/erl_ext_dist.xml
+++ b/erts/doc/src/erl_ext_dist.xml
@@ -136,16 +136,10 @@
</note>
</section>
- <section>
+ <section>
+ <marker id="distribution_header"/>
<title>Distribution Header</title>
<p>
- <marker id="distribution_header"/>
- As from ERTS 5.7.2 the old atom cache protocol was
- dropped and a new one was introduced. This protocol
- introduced the distribution header. Nodes with an ERTS version
- earlier than 5.7.2 can still communicate with new nodes,
- but no distribution header and no atom cache are used.</p>
- <p>
The distribution header only contains an atom cache
reference section, but can in the future contain more
information. The distribution header precedes one or more Erlang
@@ -373,8 +367,9 @@
</row>
<tcaption>FLOAT_EXT</tcaption></table>
<p>
- A float is stored in string format. The format used in sprintf to
- format the float is "%.20e"
+ A finite float (i.e. not inf, -inf or NaN) is stored in
+ string format. The format used in sprintf to format the
+ float is "%.20e"
(there are more bytes allocated than necessary).
To unpack the float, use sscanf with format "%lf".
</p>
@@ -989,7 +984,8 @@
</row>
<tcaption>NEW_FLOAT_EXT</tcaption></table>
<p>
- A float is stored as 8 bytes in big-endian IEEE format.
+ A finite float (i.e. not inf, -inf or NaN) is stored as 8 bytes
+ in big-endian IEEE format.
</p>
<p>
This term is used in minor version 1 of the external format.
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index 34042cb4de..cf1994887a 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -783,14 +783,16 @@ typedef struct {
<p>A process identifier (pid). In contrast to pid terms (instances of
<c>ERL_NIF_TERM</c>), <c>ErlNifPid</c>s are self-contained and not
bound to any <seealso marker="#ErlNifEnv">environment</seealso>.
- <c>ErlNifPid</c> is an opaque type.</p>
+ <c>ErlNifPid</c> is an opaque type. It can be copied, moved
+ in memory, forgotten, and so on.</p>
</item>
<tag><marker id="ErlNifPort"/><c>ErlNifPort</c></tag>
<item>
<p>A port identifier. In contrast to port ID terms (instances of
<c>ERL_NIF_TERM</c>), <c>ErlNifPort</c>s are self-contained and not
bound to any <seealso marker="#ErlNifEnv">environment</seealso>.
- <c>ErlNifPort</c> is an opaque type.</p>
+ <c>ErlNifPort</c> is an opaque type. It can be copied, moved
+ in memory, forgotten, and so on.</p>
</item>
<tag><marker id="ErlNifResourceType"/><c>ErlNifResourceType</c></tag>
<item>
@@ -1088,6 +1090,20 @@ typedef struct {
</func>
<func>
+ <name since="OTP @OTP-15011@"><ret>int</ret>
+ <nametext>enif_compare_pids(const ErlNifPid *pid1, const ErlNifPid *pid2)
+ </nametext></name>
+ <fsummary>Compare two pids.</fsummary>
+ <desc>
+ <p>Compares two <seealso marker="#ErlNifPid"><c>ErlNifPid</c>
+ </seealso>s according to term order.</p>
+ <p>Returns <c>0</c> if <c>pid1</c> and <c>pid2</c> are equal,
+ &lt; <c>0</c> if <c>pid1</c> &lt; <c>pid2</c>, and
+ &gt; <c>0</c> if <c>pid1</c> &gt; <c>pid2</c>.</p>
+ </desc>
+ </func>
+
+ <func>
<name since="OTP R13B04"><ret>void</ret>
<nametext>enif_cond_broadcast(ErlNifCond *cnd)</nametext></name>
<fsummary></fsummary>
@@ -1392,6 +1408,9 @@ enif_free_iovec(iovec);]]></code>
initializes the pid variable <c>*pid</c> from it and returns
<c>true</c>. Otherwise returns <c>false</c>. No check is done to see
if the process is alive.</p>
+ <note><p><c>enif_get_local_pid</c> will return false if argument
+ <c>term</c> is the atom <seealso marker="#enif_make_pid">
+ <c>undefined</c></seealso>.</p></note>
</desc>
</func>
@@ -1871,6 +1890,17 @@ enif_inspect_iovec(env, max_elements, term, &amp;tail, &amp;iovec);
</func>
<func>
+ <name since="OTP @OTP-15011@"><ret>int</ret>
+ <nametext>enif_is_pid_undefined(const ErlNifPid* pid)</nametext></name>
+ <fsummary>Determine if pid is undefined.</fsummary>
+ <desc>
+ <p>Returns <c>true</c> if <c>pid</c> has been set as undefined by
+ <seealso marker="#enif_set_pid_undefined"><c>enif_set_pid_undefined</c>
+ </seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
<name since="OTP R13B04"><ret>int</ret>
<nametext>enif_is_port(ErlNifEnv* env, ERL_NIF_TERM term)</nametext>
</name>
@@ -2217,6 +2247,18 @@ enif_inspect_iovec(env, max_elements, term, &amp;tail, &amp;iovec);
</func>
<func>
+ <name since="OTP @OTP-15362@"><ret>ERL_NIF_TERM</ret>
+ <nametext>enif_make_monitor_term(ErlNifEnv* env, const ErlNifMonitor* mon)</nametext></name>
+ <fsummary>Make monitor term from the given monitor identifier.</fsummary>
+ <desc>
+ <p>Creates a term identifying the given monitor received from
+ <seealso marker="#enif_monitor_process"><c>enif_monitor_process</c>
+ </seealso>.</p>
+ <p>This function is primarily intended for debugging purpose.</p>
+ </desc>
+ </func>
+
+ <func>
<name since="OTP R14B"><ret>unsigned char *</ret><nametext>enif_make_new_binary(ErlNifEnv*
env, size_t size, ERL_NIF_TERM* termp)</nametext></name>
<fsummary>Allocate and create a new binary term.</fsummary>
@@ -2247,7 +2289,8 @@ enif_inspect_iovec(env, max_elements, term, &amp;tail, &amp;iovec);
</name>
<fsummary>Make a pid term.</fsummary>
<desc>
- <p>Makes a pid term from <c>*pid</c>.</p>
+ <p>Makes a pid term or the atom <seealso marker="#enif_set_pid_undefined">
+ <c>undefined</c></seealso> from <c>*pid</c>.</p>
</desc>
</func>
@@ -2613,7 +2656,9 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
<p>Argument <c>caller_env</c> is the environment of the calling process
or callback. Must only be NULL if calling from a custom thread.</p>
<p>Returns <c>0</c> on success, &lt; 0 if no <c>down</c> callback is
- provided, and &gt; 0 if the process is no longer alive.</p>
+ provided, and &gt; 0 if the process is no longer alive or if
+ <c>target_pid</c> is <seealso marker="#enif_set_pid_undefined">
+ undefined</seealso>.</p>
<p>This function is only thread-safe when the emulator with SMP support
is used. It can only be used in a non-SMP emulator from a NIF-calling
thread.</p>
@@ -3068,7 +3113,9 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
<seealso marker="#enif_select_write"><c>enif_select_write</c></seealso>
introduced in erts-11.0 (OTP-22.0).</p>
</note>
- <p>Argument <c>pid</c> may be <c>NULL</c> to indicate the calling process.</p>
+ <p>Argument <c>pid</c> may be <c>NULL</c> to indicate the calling
+ process. It must not be set as <seealso marker="#enif_set_pid_undefined">
+ undefined</seealso>.</p>
<p>Argument <c>obj</c> is a resource object obtained from
<seealso marker="#enif_alloc_resource"><c>enif_alloc_resource</c></seealso>.
The purpose of the resource objects is as a container of the event object
@@ -3079,16 +3126,18 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
or the atom <c>undefined</c>. It will be passed as <c>Ref</c> in the notifications.
If a selective <c>receive</c> statement is used to wait for the notification
then a reference created just before the <c>receive</c> will exploit a runtime
- optimization that bypasses all earlier received messages in the queue.</p>
+ optimization that bypasses all earlier received messages in the
+ queue.</p>
<p>The notifications are one-shot only. To receive further notifications of the same
type (read or write), repeated calls to <c>enif_select</c> must be made
after receiving each notification.</p>
<p><c>ERL_NIF_SELECT_CANCEL</c> can be used to cancel previously
selected events. It must be used in a bitwise OR combination with
<c>ERL_NIF_SELECT_READ</c> and/or <c>ERL_NIF_SELECT_WRITE</c> to
- indicate which type of event to cancel. The return value will
- tell if the event was actualy cancelled or if a notification may
- already have been sent.</p>
+ indicate which type of event to cancel. Arguments <c>pid</c> and
+ <c>ref</c> are ignored when <c>ERL_NIF_SELECT_CANCEL</c> is specified.
+ The return value will tell if the event was actualy cancelled or if a
+ notification may already have been sent.</p>
<p>Use <c>ERL_NIF_SELECT_STOP</c> as <c>mode</c> in order to safely
close an event object that has been passed to <c>enif_select</c>. The
<seealso marker="#ErlNifResourceStop"><c>stop</c></seealso> callback
@@ -3097,7 +3146,9 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
even if all notifications have been received (or cancelled) and no
further calls to <c>enif_select</c> have been made.
<c>ERL_NIF_SELECT_STOP</c> will first cancel any selected events
- before it calls or schedules the <c>stop</c> callback.</p>
+ before it calls or schedules the <c>stop</c> callback. Arguments
+ <c>pid</c> and <c>ref</c> are ignored when <c>ERL_NIF_SELECT_STOP</c>
+ is specified.</p>
<p>The first call to <c>enif_select</c> for a specific OS <c>event</c> will establish
a relation between the event object and the containing resource. All subsequent calls
for an <c>event</c> must pass its containing resource as argument
@@ -3180,7 +3231,11 @@ if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
<c>enif_alloc_env</c></seealso>. If argument <c>msg_env</c> is
<c>NULL</c> the term <c>msg</c> will be copied, otherwise both
<c>msg</c> and <c>msg_env</c> will be invalidated by a successful call
- to <c>enif_select_read</c> or <c>enif_select_write</c>.</p>
+ to <c>enif_select_read</c> or <c>enif_select_write</c>. The environment
+ is then to either be freed with <seealso marker="#enif_free_env">
+ <c>enif_free_env</c></seealso> or cleared for reuse with
+ <seealso marker="#enif_clear_env"><c>enif_clear_env</c></seealso>. An
+ unsuccessful call will leave <c>msg</c> and <c>msg_env</c> still valid.</p>
<p>Apart from the message format <c>enif_select_read</c> and
<c>enif_select_write</c> behaves exactly the same as <seealso
marker="#enif_select">enif_select</seealso> with argument <c>mode</c> as
@@ -3234,8 +3289,9 @@ if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
<c>msg</c>) is invalidated by a successful call to <c>enif_send</c>.
The environment is to either be freed with
<seealso marker="#enif_free_env">
- <c>enif_free_env</c></seealso> of cleared for reuse with
- <seealso marker="#enif_clear_env"><c>enif_clear_env</c></seealso>.</p>
+ <c>enif_free_env</c></seealso> or cleared for reuse with
+ <seealso marker="#enif_clear_env"><c>enif_clear_env</c></seealso>. An
+ unsuccessful call will leave <c>msg</c> and <c>msg_env</c> still valid.</p>
<p>If <c>msg_env</c> is set to <c>NULL</c>, the <c>msg</c> term is
copied and the original term and its environment is still valid after
the call.</p>
@@ -3250,6 +3306,17 @@ if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
</func>
<func>
+ <name since="OTP @OTP-15011@"><ret>void</ret>
+ <nametext>enif_set_pid_undefined(ErlNifPid* pid)</nametext></name>
+ <fsummary>Set pid as undefined.</fsummary>
+ <desc>
+ <p>Sets an <seealso marker="#ErlNifPid"><c>ErlNifPid</c></seealso>
+ variable as undefined. See <seealso marker="#enif_is_pid_undefined">
+ <c>enif_is_pid_undefined</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
<name since="OTP R13B04"><ret>unsigned</ret>
<nametext>enif_sizeof_resource(void* obj)</nametext></name>
<fsummary>Get the byte size of a resource object.</fsummary>
@@ -3302,6 +3369,48 @@ if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
</func>
<func>
+ <name since="OTP @OTP-15640@"><ret>ErlNifTermType</ret>
+ <nametext>enif_term_type(ErlNifEnv *env, ERL_NIF_TERM term)</nametext>
+ </name>
+ <fsummary>Determine the type of a term.</fsummary>
+ <desc>
+ <p>Determines the type of the given term. The term must be an ordinary
+ Erlang term and not one of the special terms returned by
+ <seealso marker="#enif_raise_exception">
+ <c>enif_raise_exception</c></seealso>,
+ <seealso marker="#enif_schedule_nif">
+ <c>enif_schedule_nif</c></seealso>, or similar.</p>
+ <p>The following types are defined at the moment:</p>
+ <taglist>
+ <tag><c>ERL_NIF_TERM_TYPE_ATOM</c></tag>
+ <item/>
+ <tag><c>ERL_NIF_TERM_TYPE_BITSTRING</c></tag>
+ <item><p>A bitstring or binary</p></item>
+ <tag><c>ERL_NIF_TERM_TYPE_FLOAT</c></tag>
+ <item/>
+ <tag><c>ERL_NIF_TERM_TYPE_FUN</c></tag>
+ <item/>
+ <tag><c>ERL_NIF_TERM_TYPE_INTEGER</c></tag>
+ <item/>
+ <tag><c>ERL_NIF_TERM_TYPE_LIST</c></tag>
+ <item><p>A list, empty or not</p></item>
+ <tag><c>ERL_NIF_TERM_TYPE_MAP</c></tag>
+ <item/>
+ <tag><c>ERL_NIF_TERM_TYPE_PID</c></tag>
+ <item/>
+ <tag><c>ERL_NIF_TERM_TYPE_PORT</c></tag>
+ <item/>
+ <tag><c>ERL_NIF_TERM_TYPE_REFERENCE</c></tag>
+ <item/>
+ <tag><c>ERL_NIF_TERM_TYPE_TUPLE</c></tag>
+ <item/>
+ </taglist>
+ <p>Note that new types may be added in the future, so the caller must
+ be prepared to handle unknown types.</p>
+ </desc>
+ </func>
+
+ <func>
<name since="OTP R13B04"><ret>int</ret>
<nametext>enif_thread_create(char *name,ErlNifTid
*tid,void * (*func)(void *),void *args,ErlNifThreadOpts
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 92e979c046..e78ded4ae1 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -4174,9 +4174,16 @@ RealSystem = system + MissedSystem</code>
</item>
<tag><c>badarg</c></tag>
<item>
- If the port driver so decides for any reason (probably
+ <p>If the port driver so decides for any reason (probably
something wrong with <c><anno>Operation</anno></c>
- or <c><anno>Data</anno></c>).
+ or <c><anno>Data</anno></c>).</p>
+ <warning>
+ <p>Do not call <c>port_call</c> with an unknown
+ <c><anno>Port</anno></c> identifier and expect <c>badarg</c>
+ exception. Any undefined behavior is possible (including node
+ crash) depending on how the port driver interprets the supplied
+ arguments.</p>
+ </warning>
</item>
</taglist>
</desc>
@@ -4266,6 +4273,11 @@ RealSystem = system + MissedSystem</code>
<p>If <c><anno>Data</anno></c> is an invalid I/O list.</p>
</item>
</taglist>
+ <warning>
+ <p>Do not send data to an unknown port. Any undefined behavior is
+ possible (including node crash) depending on how the port driver
+ interprets the data.</p>
+ </warning>
</desc>
</func>
@@ -4325,6 +4337,11 @@ RealSystem = system + MissedSystem</code>
a busy port.
</item>
</taglist>
+ <warning>
+ <p>Do not send data to an unknown port. Any undefined behavior is
+ possible (including node crash) depending on how the port driver
+ interprets the data.</p>
+ </warning>
</desc>
</func>
@@ -4429,6 +4446,13 @@ RealSystem = system + MissedSystem</code>
If the port driver so decides for any reason (probably
something wrong with <c><anno>Operation</anno></c> or
<c><anno>Data</anno></c>).
+ <warning>
+ <p>Do not call <c>port_control/3</c> with an unknown
+ <c><anno>Port</anno></c> identifier and expect <c>badarg</c>
+ exception. Any undefined behavior is possible (including node
+ crash) depending on how the port driver interprets the supplied
+ arguments.</p>
+ </warning>
</item>
</taglist>
</desc>
@@ -8363,7 +8387,7 @@ Metadata = #{ pid => pid(),
system time</seealso> that is used by the runtime system.</p>
<p>The list contains two-tuples with <c>Key</c>s
as first element, and <c>Value</c>s as second element. The
- order if these tuples is undefined. The following
+ order of these tuples is undefined. The following
tuples can be part of the list, but more tuples can be
introduced in the future:</p>
<taglist>
diff --git a/erts/doc/src/net.xml b/erts/doc/src/net.xml
new file mode 100644
index 0000000000..b9e2cffce9
--- /dev/null
+++ b/erts/doc/src/net.xml
@@ -0,0 +1,129 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2018</year><year>2018</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>net</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>net.xml</file>
+ </header>
+ <module since="OTP @OTP-14831@">net</module>
+ <modulesummary>Network interface.</modulesummary>
+ <description>
+ <p>This module provides an API for the network interface.</p>
+ <note>
+ <p>There is currently <em>no</em> support for Windows. </p>
+ </note>
+ </description>
+
+ <datatypes>
+ <datatype>
+ <name name="address_info"/>
+ </datatype>
+ <datatype>
+ <name name="name_info"/>
+ </datatype>
+ <datatype>
+ <name name="name_info_flags"/>
+ </datatype>
+ <datatype>
+ <name name="name_info_flag"/>
+ </datatype>
+ <datatype>
+ <name name="name_info_flag_ext"/>
+ </datatype>
+ <datatype>
+ <name name="network_interface_name"/>
+ </datatype>
+ <datatype>
+ <name name="network_interface_index"/>
+ </datatype>
+ </datatypes>
+
+ <funcs>
+ <func>
+ <name name="gethostname" arity="0"/>
+ <fsummary>Get hostname.</fsummary>
+ <desc>
+ <p>Returns the name of the current host.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="getnameinfo" arity="1" since="OTP @OTP-14831@"/>
+ <name name="getnameinfo" arity="2" since="OTP @OTP-14831@"/>
+ <fsummary>Address-to-name transaltion.</fsummary>
+ <desc>
+ <p>Address-to-name translation in a protocol-independant manner.</p>
+ <p>This function is the inverse of
+ <seealso marker="#getaddrinfo/1"><c>getaddrinfo</c></seealso>.
+ It converts a socket address to a corresponding host and service.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="getaddrinfo" arity="1" since="OTP @OTP-14831@"/>
+ <name name="getaddrinfo" arity="2" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="getaddrinfo" arity="2" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="getaddrinfo" arity="2" clause_i="3" since="OTP @OTP-14831@"/>
+ <fsummary>Network address and service transation.</fsummary>
+ <desc>
+ <p>Network address and service translation.</p>
+ <p>This function is the inverse of
+ <seealso marker="#getnameinfo/1"><c>getnameinfo</c></seealso>.
+ It converts host and service to a corresponding socket address.</p>
+ <p>One of the <c>Host</c> and <c>Service</c> may be <c>undefined</c>
+ but <em>not</em> both.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="if_name2index" arity="1" since="OTP @OTP-14831@"/>
+ <fsummary>Mappings between network interface names and indexes.</fsummary>
+ <desc>
+ <p>Mappings between network interface names and indexes.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="if_index2name" arity="1" since="OTP @OTP-14831@"/>
+ <fsummary>Mappings between network interface index and names.</fsummary>
+ <desc>
+ <p>Mappings between network interface index and names.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="if_names" arity="0" since="OTP @OTP-14831@"/>
+ <fsummary>Get network interface names and indexes.</fsummary>
+ <desc>
+ <p>Get network interface names and indexes.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index 2c23456ff1..bdae994d06 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -31,6 +31,240 @@
</header>
<p>This document describes the changes made to the ERTS application.</p>
+<section><title>Erts 10.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>When multiplying a number by itself, a word beyond the
+ number on the heap could be read (and ignored). This bug
+ was extremely unlikely to actually cause a real
+ problem.</p>
+ <p>
+ Own Id: OTP-15484</p>
+ </item>
+ <item>
+ <p>
+ Fix bug where doing <c>seq_trace:reset_trace()</c> while
+ another process was doing a garbage collection could
+ cause the run-time system to segfault.</p>
+ <p>
+ Own Id: OTP-15490</p>
+ </item>
+ <item>
+ <p>
+ Fix reading of ancillary data from packet oriented
+ sockets on old Linux kernel versions. Without this fix,
+ getting the data would cause the port to enter an
+ infinite loop.</p>
+ <p>
+ Own Id: OTP-15494</p>
+ </item>
+ <item>
+ <p>
+ Fix bug where crash dumping or doing
+ <c>erlang:system_info(procs)</c> while another process
+ was doing a garbage collection could cause the run-time
+ system to segfault.</p>
+ <p>
+ Own Id: OTP-15527</p>
+ </item>
+ <item>
+ <p>
+ Fix <c>erlang:system_info(kernel_poll)</c> to return
+ correct value. Before this fix, the call always returned
+ <c>false</c>.</p>
+ <p>
+ Own Id: OTP-15556</p>
+ </item>
+ <item>
+ <p>
+ Fix bug in <c>enif_make_map_from_arrays</c> that would
+ produce broken maps when number of keys were 32. Bug
+ exists since OTP 21.0.</p>
+ <p>
+ Own Id: OTP-15567</p>
+ </item>
+ <item>
+ <p>
+ Fix a bug in <c>binary:encode_unsigned</c> that may cause
+ a read of uninitialized memory.</p>
+ <p>
+ The bug existed since the function was added (OTP
+ R16B02).</p>
+ <p>
+ Own Id: OTP-15583 Aux Id: PR-2118 </p>
+ </item>
+ <item>
+ <p>
+ Fixed a bug that could cause <c>heart</c> to kill an
+ exiting node before it had time to flush all buffered
+ writes. If environment variable
+ <c>HEART_KILL_SIGNAL=SIGABRT</c> was set a superfluous
+ core dump could also be generated.</p>
+ <p>
+ Own Id: OTP-15599 Aux Id: ERIERL-298 </p>
+ </item>
+ <item>
+ <p>
+ Fix <c>enif_consume_timeslice</c> to be a no-op on dirty
+ scheduler and not crash debug compiled emulator.</p>
+ <p>
+ Own Id: OTP-15604</p>
+ </item>
+ <item>
+ <p>
+ Fixed macro redefinition warnings.</p>
+ <p>
+ Own Id: OTP-15629</p>
+ </item>
+ <item>
+ <p>
+ <c>to_erl</c> fixed to not garble terminal input beyond
+ 7-bit ASCII.</p>
+ <p>
+ Own Id: OTP-15650 Aux Id: ERL-854, PR-2161 </p>
+ </item>
+ <item>
+ <p>
+ Minor fixes for <c>make clean</c>.</p>
+ <p>
+ Own Id: OTP-15657</p>
+ </item>
+ <item>
+ <p>
+ Fixed a bug in all <c>ets:select*</c> and
+ <c>ets:match*</c> functions that could in some rare cases
+ lead to very poor performance.</p>
+ <p>
+ Own Id: OTP-15660 Aux Id: ERL-869 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Add <c>erlang:system_flag(system_logger, Pid)</c> and
+ <c>erlang:system_info(system_logger)</c>. This
+ system_flag can be used to set the process that will
+ receive the logging messages generated by ERTS.</p>
+ <p>
+ Own Id: OTP-15375</p>
+ </item>
+ <item>
+ <p><c>integer_to_list/2</c> and
+ <c>integer_to_binary/2</c> are now implemented in C,
+ improving their performance.</p>
+ <p>
+ Own Id: OTP-15503 Aux Id: PR-2052 </p>
+ </item>
+ <item>
+ <p>
+ Improved <c>term_to_binary</c> to do more fair reduction
+ count and yielding when encoding large byte lists
+ (strings).</p>
+ <p>
+ Own Id: OTP-15514 Aux Id: ERL-774 </p>
+ </item>
+ <item>
+ <p>
+ Made internal port drivers more robust against
+ <c>erlang:port_control</c> with invalid arguments and
+ added documentation warnings about such abuse.</p>
+ <p>
+ Own Id: OTP-15555 Aux Id: ERIERL-231 </p>
+ </item>
+ <item>
+ <p>
+ Fix bug on NetBSD where the <c>exit_status</c> from a
+ port program would never be sent.</p>
+ <p>
+ Own Id: OTP-15558 Aux Id: ERL-725 </p>
+ </item>
+ <item>
+ <p>There is a new function <c>persistent:term(Key,
+ Default)</c> to allow specifying a default when looking
+ up a persistent term.</p>
+ <p>
+ Own Id: OTP-15576 Aux Id: ERL-843 </p>
+ </item>
+ <item>
+ <p>A transitory emulator option '<c>+ztma true</c>' has
+ been added to allow running existing BEAM code that
+ relies on "tuple calls" (dispatch on parameterized
+ modules) which has been compiled under OTP 20 or earlier.
+ This option will be removed in OTP 22, so such modules
+ should eventually be recompiled with the
+ <c>+tuple_calls</c> option.</p>
+ <p>
+ Own Id: OTP-15580 Aux Id: PR-2113 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 10.2.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixes of install/release phase in build system.</p>
+ <list> <item>The source tree was modified when
+ installing/releasing and/or applying a patch.</item>
+ <item>Some files were installed with wrong access
+ rights.</item> <item>If applying a patch (using
+ <c>otp_patch_apply</c>) as another user (except root)
+ than the user that built the source, the documentation
+ was not properly updated.</item> </list>
+ <p>
+ Own Id: OTP-15551</p>
+ </item>
+ <item>
+ <p>
+ Setting the <c>recbuf</c> size of an inet socket the
+ <c>buffer</c> is also automatically increased. Fix a bug
+ where the auto adjustment of inet buffer size would be
+ triggered even if an explicit inet buffer size had
+ already been set.</p>
+ <p>
+ Own Id: OTP-15651 Aux Id: ERIERL-304 </p>
+ </item>
+ <item>
+ <p>
+ Reading from UDP using active <c>true</c> or active
+ <c>N</c> mode has been optimized when more packets than
+ specified by <c>read_packets</c> are available on the
+ socket.</p>
+ <p>
+ Own Id: OTP-15652 Aux Id: ERIERL-304 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 10.2.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ When using the <c>{linger,{true,T}}</c> option;
+ <c>gen_tcp:listen/2</c> used the full linger time before
+ returning for example <c>eaddrinuse</c>. This bug has now
+ been corrected.</p>
+ <p>
+ Own Id: OTP-14728 Aux Id: ERIERL-303 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erts 10.2.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -1694,6 +1928,26 @@
</section>
+<section><title>Erts 9.3.3.9</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>Added an optional <c>./configure</c> flag to compile
+ the emulator with spectre mitigation:
+ <c>--with-spectre-mitigation</c></p>
+ <p>Note that this requires a recent version of GCC with
+ support for spectre mitigation and the
+ <c>--mindirect-branch=thunk</c> flag, such as
+ <c>8.1</c>.</p>
+ <p>
+ Own Id: OTP-15430 Aux Id: ERIERL-237 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erts 9.3.3.8</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/erts/doc/src/part.xml b/erts/doc/src/part.xml
index 05e9a24af8..f0b8a00b90 100644
--- a/erts/doc/src/part.xml
+++ b/erts/doc/src/part.xml
@@ -42,6 +42,7 @@
<xi:include href="tty.xml"/>
<xi:include href="driver.xml"/>
<xi:include href="inet_cfg.xml"/>
+ <xi:include href="socket_usage.xml"/>
<xi:include href="erl_ext_dist.xml"/>
<xi:include href="erl_dist_protocol.xml"/>
</part>
diff --git a/erts/doc/src/persistent_term.xml b/erts/doc/src/persistent_term.xml
index 1eda7f8d76..9d3c9afd80 100644
--- a/erts/doc/src/persistent_term.xml
+++ b/erts/doc/src/persistent_term.xml
@@ -256,6 +256,22 @@ will be slower as the number of persistent terms increases.</pre>
</func>
<func>
+ <name name="get" arity="2" since="OTP 21.3"/>
+ <fsummary>Get the value for a persistent term.</fsummary>
+ <desc>
+ <p>Retrieve the value for the persistent term associated with
+ the key <c><anno>Key</anno></c>. The lookup will be made in
+ constant time and the value will not be copied to the heap
+ of the calling process.</p>
+ <p>This function returns <c><anno>Default</anno></c> if no
+ term has been stored with the key <c><anno>Key</anno></c>.</p>
+ <p>If the calling process holds on to the value of the
+ persistent term and the persistent term is deleted in the future,
+ the term will be copied to the process.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="info" arity="0" since="OTP 21.2"/>
<fsummary>Get information about persistent terms.</fsummary>
<desc>
diff --git a/erts/doc/src/ref_man.xml b/erts/doc/src/ref_man.xml
index 811d299f06..80cdcf9145 100644
--- a/erts/doc/src/ref_man.xml
+++ b/erts/doc/src/ref_man.xml
@@ -4,7 +4,7 @@
<application xmlns:xi="http://www.w3.org/2001/XInclude">
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2018</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -46,8 +46,10 @@
<xi:include href="erts_alloc.xml"/>
<xi:include href="escript.xml"/>
<xi:include href="init.xml"/>
+ <xi:include href="net.xml"/>
<xi:include href="persistent_term.xml"/>
<xi:include href="run_erl.xml"/>
+ <xi:include href="socket.xml"/>
<xi:include href="start.xml"/>
<xi:include href="start_erl.xml"/>
<xi:include href="werl.xml"/>
diff --git a/erts/doc/src/socket.xml b/erts/doc/src/socket.xml
new file mode 100644
index 0000000000..f6195a65b2
--- /dev/null
+++ b/erts/doc/src/socket.xml
@@ -0,0 +1,650 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2018</year><year>2019</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>socket</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>socket.xml</file>
+ </header>
+ <module since="OTP @OTP-14831@">socket</module>
+ <modulesummary>Socket interface.</modulesummary>
+ <description>
+ <p>This module provides an API for the socket interface.
+ It is used to create, delete and manipulate sockets,
+ send and receive data.</p>
+ <p>The idea is that it shall be as "close as possible" to the OS
+ level socket interface. The only significant addition is that some of
+ the functions,
+ e.g. <seealso marker="#recv/3"><c>recv/3</c></seealso>,
+ has a timeout argument. </p>
+ <note>
+ <p>There is currently <em>no</em> support for Windows. </p>
+ <p>Support for IPv6 has been implemented but <em>not</em> tested. </p>
+ <p>SCTP has only been partly implemented (and not tested). </p>
+ </note>
+ </description>
+
+ <datatypes>
+ <datatype>
+ <name name="domain"/>
+ </datatype>
+ <datatype>
+ <name name="type"/>
+ </datatype>
+ <datatype>
+ <name name="protocol"/>
+ </datatype>
+ <datatype>
+ <name>socket()</name>
+ <desc><p>As returned by
+ <seealso marker="#open/2"><c>open/2,3,4</c></seealso> and
+ <seealso marker="#accept/1"><c>accept/1,2</c></seealso>.</p>
+ </desc>
+ </datatype>
+ <datatype>
+ <name name="ip4_address"/>
+ </datatype>
+ <datatype>
+ <name name="ip6_address"/>
+ </datatype>
+ <datatype>
+ <name name="ip_address"/>
+ </datatype>
+ <datatype>
+ <name name="sockaddr"/>
+ </datatype>
+ <datatype>
+ <name name="sockaddr_in4"/>
+ </datatype>
+ <datatype>
+ <name name="sockaddr_in6"/>
+ </datatype>
+ <datatype>
+ <name name="sockaddr_un"/>
+ </datatype>
+ <datatype>
+ <name name="port_number"/>
+ </datatype>
+ <datatype>
+ <name name="in6_flow_info"/>
+ </datatype>
+ <datatype>
+ <name name="in6_scope_id"/>
+ </datatype>
+ <datatype>
+ <name name="accept_flags"/>
+ </datatype>
+ <datatype>
+ <name name="accept_flag"/>
+ </datatype>
+ <datatype>
+ <name name="send_flags"/>
+ </datatype>
+ <datatype>
+ <name name="send_flag"/>
+ </datatype>
+ <datatype>
+ <name name="recv_flags"/>
+ </datatype>
+ <datatype>
+ <name name="recv_flag"/>
+ </datatype>
+ <datatype>
+ <name name="shutdown_how"/>
+ </datatype>
+ <datatype>
+ <name name="sockopt_level"/>
+ </datatype>
+ <datatype>
+ <name name="otp_socket_option"/>
+ </datatype>
+ <datatype>
+ <name name="socket_option"/>
+ </datatype>
+ <datatype>
+ <name name="ip_socket_option"/>
+ </datatype>
+ <datatype>
+ <name name="ipv6_socket_option"/>
+ </datatype>
+ <datatype>
+ <name name="tcp_socket_option"/>
+ </datatype>
+ <datatype>
+ <name name="udp_socket_option"/>
+ </datatype>
+ <datatype>
+ <name name="sctp_socket_option"/>
+ </datatype>
+ <datatype>
+ <name name="timeval"/>
+ </datatype>
+ <datatype>
+ <name name="ip_tos"/>
+ </datatype>
+ <datatype>
+ <name name="ip_mreq"/>
+ </datatype>
+ <datatype>
+ <name name="ip_mreq_source"/>
+ </datatype>
+ <datatype>
+ <name name="ip_pmtudisc"/>
+ </datatype>
+ <datatype>
+ <name name="ip_msfilter_mode"/>
+ </datatype>
+ <datatype>
+ <name name="ip_msfilter"/>
+ </datatype>
+ <datatype>
+ <name name="ip_pktinfo"/>
+ </datatype>
+ <datatype>
+ <name name="ipv6_mreq"/>
+ </datatype>
+ <datatype>
+ <name name="ipv6_pmtudisc"/>
+ </datatype>
+ <datatype>
+ <name name="ipv6_pktinfo"/>
+ </datatype>
+ <datatype>
+ <name name="sctp_assoc_id"/>
+ </datatype>
+ <datatype>
+ <name name="sctp_sndrcvinfo"/>
+ </datatype>
+ <datatype>
+ <name name="sctp_event_subscribe"/>
+ </datatype>
+ <datatype>
+ <name name="sctp_assocparams"/>
+ </datatype>
+ <datatype>
+ <name name="sctp_initmsg"/>
+ </datatype>
+ <datatype>
+ <name name="sctp_rtoinfo"/>
+ </datatype>
+ <datatype>
+ <name name="msghdr_flag"/>
+ </datatype>
+ <datatype>
+ <name name="msghdr_flags"/>
+ </datatype>
+ <datatype>
+ <name name="msghdr"/>
+ </datatype>
+ <datatype>
+ <name name="cmsghdr_level"/>
+ </datatype>
+ <datatype>
+ <name name="cmsghdr_type"/>
+ </datatype>
+ <!--
+ <datatype>
+ <name name="cmsghdr_data"/>
+ </datatype>
+ -->
+ <datatype>
+ <name name="cmsghdr_recv"/>
+ </datatype>
+ <datatype>
+ <name name="cmsghdr_send"/>
+ </datatype>
+ <datatype>
+ <name name="uint8"/>
+ </datatype>
+ <datatype>
+ <name name="uint16"/>
+ </datatype>
+ <datatype>
+ <name name="uint20"/>
+ </datatype>
+ <datatype>
+ <name name="uint32"/>
+ </datatype>
+ <datatype>
+ <name name="int32"/>
+ </datatype>
+ <datatype>
+ <name name="supports_options_socket"/>
+ </datatype>
+ <datatype>
+ <name name="supports_options_ip"/>
+ </datatype>
+ <datatype>
+ <name name="supports_options_ipv6"/>
+ </datatype>
+ <datatype>
+ <name name="supports_options_tcp"/>
+ </datatype>
+ <datatype>
+ <name name="supports_options_udp"/>
+ </datatype>
+ <datatype>
+ <name name="supports_options_sctp"/>
+ </datatype>
+ <datatype>
+ <name name="supports_options"/>
+ </datatype>
+ </datatypes>
+
+ <funcs>
+ <func>
+ <name name="accept" arity="1" since="OTP @OTP-14831@"/>
+ <name name="accept" arity="2" since="OTP @OTP-14831@"/>
+ <fsummary>Accept a connection on a socket.</fsummary>
+ <desc>
+ <p>Accept a connection on a socket.</p>
+ <p>This call is used with connection-based socket types
+ (<c>stream</c> or <c>seqpacket</c>). It extracs the first pending
+ connection request for the listen socket and returns the (newly)
+ connected socket.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="bind" arity="2" since="OTP @OTP-14831@"/>
+ <fsummary>Bind a name to a socket.</fsummary>
+ <desc>
+ <p>Bind a name to a socket.</p>
+ <p>When a socket is created
+ (with <seealso marker="#open/2"><c>open</c></seealso>),
+ it has no address assigned to it. <c>bind</c> assigns the
+ address specified by the <c>Addr</c> argument.</p>
+ <p>The rules used for name binding vary between domains.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="close" arity="1" since="OTP @OTP-14831@"/>
+ <fsummary>Close a socket.</fsummary>
+ <desc>
+ <p>Closes the socket.</p>
+
+ <note>
+ <p>Note that for e.g. <c>protocol</c> = <c>tcp</c>, most implementations
+ doing a close does not guarantee that any data sent is delivered to
+ the recipient before the close is detected at the remote side. </p>
+ <p>One way to handle this is to use the
+ <seealso marker="#shutdown/2"><c>shutdown</c></seealso>
+ function
+ (<c>socket:shutdown(Socket, write)</c>) to signal that no more data is
+ to be sent and then wait for the read side of the socket to be closed.</p>
+ </note>
+ </desc>
+ </func>
+
+ <func>
+ <name name="connect" arity="2" since="OTP @OTP-14831@"/>
+ <name name="connect" arity="3" since="OTP @OTP-14831@"/>
+ <fsummary>Initiate a connection on a socket.</fsummary>
+ <desc>
+ <p>This function connects the socket to the address
+ specied by the <c>SockAddr</c> argument.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="getopt" arity="3" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="getopt" arity="3" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="getopt" arity="3" clause_i="3" since="OTP @OTP-14831@"/>
+ <name name="getopt" arity="3" clause_i="4" since="OTP @OTP-14831@"/>
+ <name name="getopt" arity="3" clause_i="5" since="OTP @OTP-14831@"/>
+ <name name="getopt" arity="3" clause_i="6" since="OTP @OTP-14831@"/>
+ <name name="getopt" arity="3" clause_i="7" since="OTP @OTP-14831@"/>
+ <fsummary>Get an option on a socket.</fsummary>
+ <desc>
+ <p>Get an option on a socket.</p>
+ <p>What properties are valid depend both on <c>Level</c> and
+ on what kind of socket it is (<c>domain</c>, <c>type</c> and
+ <c>protocol</c>).</p>
+
+ <p>See the
+ <seealso marker="socket_usage#socket_options">socket options</seealso>
+ chapter of the users guide for more info. </p>
+
+ <note><p>Not all options are valid on all platforms. That is,
+ even if "we" support an option, that does not mean that the
+ underlying OS does.</p></note>
+
+ </desc>
+ </func>
+
+ <func>
+ <name name="getopt" arity="3" clause_i="8" since="OTP @OTP-14831@"/>
+ <fsummary>Get an option on a socket.</fsummary>
+ <desc>
+ <p>Get an option on a socket.</p>
+ <p>What properties are valid depend both on <c>Level</c> and
+ on what kind of socket it is (<c>domain</c>, <c>type</c> and
+ <c>protocol</c>).</p>
+ <p>When specifying <c>Level</c> as an integer, and therefor
+ using "native mode", it is *currently* up to the caller to
+ know how to interpret the result.</p>
+
+ <p>See the
+ <seealso marker="socket_usage#socket_options">socket options</seealso>
+ chapter of the users guide for more info. </p>
+
+ <note><p>Not all options are valid on all platforms. That is,
+ even if "we" support an option, that does not mean that the
+ underlying OS does.</p></note>
+ </desc>
+ </func>
+
+ <func>
+ <name name="listen" arity="1" since="OTP @OTP-14831@"/>
+ <name name="listen" arity="2" since="OTP @OTP-14831@"/>
+ <fsummary>Listen for connections on a socket.</fsummary>
+ <desc>
+ <p>Listen for connections on a socket.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="open" arity="2" since="OTP @OTP-14831@"/>
+ <name name="open" arity="3" since="OTP @OTP-14831@"/>
+ <name name="open" arity="4" since="OTP @OTP-14831@"/>
+ <fsummary>Create an endpoint for communication.</fsummary>
+ <desc>
+ <p>Creates an endpoint (socket) for communication.</p>
+ <p>For some <c>types</c> there is a default protocol, which will
+ be used if no protocol is specified: </p>
+
+ <list>
+ <item><p><c>stream</c>: <c>tcp</c></p></item>
+ <item><p><c>dgram</c>: <c>udp</c></p></item>
+ <item><p><c>seqpacket</c>: <c>sctp</c></p></item>
+ </list>
+
+ <p>The <c>Extra</c> argument is intended for "obscure" options.
+ Currently the only supported option is <c>netns</c>, which
+ is only supported on the linux platform.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="peername" arity="1" since="OTP @OTP-14831@"/>
+ <fsummary>Get name of connected socket peer.</fsummary>
+ <desc>
+ <p>Returns the address of the peer connected to the socket.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="recv" arity="1" since="OTP @OTP-14831@"/>
+ <name name="recv" arity="2" since="OTP @OTP-14831@"/>
+ <name name="recv" arity="3" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="recv" arity="3" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="recv" arity="4" since="OTP @OTP-14831@"/>
+ <fsummary>Receive a message from a socket.</fsummary>
+ <desc>
+ <p>Receive a message from a socket.</p>
+ <p>There is a special case for the argument <c>Length</c>.
+ If it is set to zero (0), it means "give me everything you
+ currently have".</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="recvfrom" arity="1" since="OTP @OTP-14831@"/>
+ <name name="recvfrom" arity="2" since="OTP @OTP-14831@"/>
+ <name name="recvfrom" arity="3" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="recvfrom" arity="3" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="recvfrom" arity="3" clause_i="3" since="OTP @OTP-14831@"/>
+ <name name="recvfrom" arity="4" since="OTP @OTP-14831@"/>
+ <fsummary>Receive a message from a socket.</fsummary>
+ <desc>
+ <p>Receive a message from a socket.</p>
+ <p>This function reads "messages", which means that regardless of
+ how much we want to read, it returns when we get a message.</p>
+ <p>The <c>BufSz</c> argument basically defines the size of the
+ receive buffer. By setting the value to zero (0), the configured
+ size (setopt with <c>Level</c> = <c>otp</c> and <c>Key</c> = <c>rcvbuf</c>)
+ is used.</p>
+ <p>It may be impossible to know what (buffer) size is appropriate
+ "in advance", and in those cases it may be convenient to use the
+ (recv) 'peek' flag. When this flag is provided, the message is *not*
+ "consumed" from the underlying buffers, so another recvfrom call
+ is needed, possibly with a then adjusted buffer size.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="recvmsg" arity="1" since="OTP @OTP-14831@"/>
+ <name name="recvmsg" arity="2" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="recvmsg" arity="2" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="recvmsg" arity="3" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="recvmsg" arity="3" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="recvmsg" arity="5" since="OTP @OTP-14831@"/>
+ <fsummary>Receive a message from a socket.</fsummary>
+ <desc>
+ <p>Receive a message from a socket.</p>
+ <p>This function reads "messages", which means that regardless of
+ how much we want to read, it returns when we get a message.</p>
+ <p>The message will be delivered in the form of a <c>msghdr()</c>,
+ which may contain the source address (if socket not connected),
+ a list of <c>cmsghdr_recv()</c> (depends on what socket options have
+ been set and what the protocol and platform supports) and
+ also a set of flags, providing further info about the read. </p>
+
+ <p>The <c>BufSz</c> argument basically defines the size of the
+ receive buffer. By setting the value to zero (0), the configured
+ size (setopt with <c>Level</c> = <c>otp</c> and <c>Key</c> = <c>rcvbuf</c>)
+ is used.</p>
+
+ <p>The <c>CtrlSz</c> argument basically defines the size of the
+ receive buffer for the control messages.
+ By setting the value to zero (0), the configured size (setopt
+ with <c>Level</c> = <c>otp</c>) is used.</p>
+
+ <p>It may be impossible to know what (buffer) size is appropriate
+ "in advance", and in those cases it may be convenient to use the
+ (recv) 'peek' flag. When this flag is provided, the message is *not*
+ "consumed" from the underlying buffers, so another recvmsg call
+ is needed, possibly with a then adjusted buffer size.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="send" arity="2" since="OTP @OTP-14831@"/>
+ <name name="send" arity="3" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="send" arity="3" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="send" arity="4" since="OTP @OTP-14831@"/>
+ <fsummary>Send a message on a socket.</fsummary>
+ <desc>
+ <p>Send a message on a connected socket.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="sendmsg" arity="2" since="OTP @OTP-14831@"/>
+ <name name="sendmsg" arity="3" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="sendmsg" arity="3" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="sendmsg" arity="4" since="OTP @OTP-14831@"/>
+ <fsummary>Send a message on a socket.</fsummary>
+ <desc>
+ <p>Send a message on a socket. The destination, if needed
+ (socket <em>not</em> connected) is provided in the <c>MsgHdr</c>,
+ which also contains the message to send,
+ The <c>MsgHdr</c> may also contain an list of optional <c>cmsghdr_send()</c>
+ (depends on what the protocol and platform supports).</p>
+
+ <p>Unlike the <seealso marker="#send/2"><c>send</c></seealso> function,
+ this one sends <em>one message</em>.
+ This means that if, for whatever reason, its not possible to send the
+ message in one go, the function will instead return with the
+ <em>remaining</em> data (<c>{ok, Remaining}</c>). Thereby leaving it
+ up to the caller to decide what to do (retry with the remaining data
+ of give up). </p>
+
+ </desc>
+ </func>
+
+ <func>
+ <name name="sendto" arity="3" since="OTP @OTP-14831@"/>
+ <name name="sendto" arity="4" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="sendto" arity="4" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="sendto" arity="5" since="OTP @OTP-14831@"/>
+ <fsummary>Send a message on a socket.</fsummary>
+ <desc>
+ <p>Send a message on a socket, to the specified destination.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="setopt" arity="4" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="setopt" arity="4" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="setopt" arity="4" clause_i="3" since="OTP @OTP-14831@"/>
+ <name name="setopt" arity="4" clause_i="4" since="OTP @OTP-14831@"/>
+ <name name="setopt" arity="4" clause_i="5" since="OTP @OTP-14831@"/>
+ <name name="setopt" arity="4" clause_i="6" since="OTP @OTP-14831@"/>
+ <name name="setopt" arity="4" clause_i="7" since="OTP @OTP-14831@"/>
+ <fsummary>Set options on a socket.</fsummary>
+ <desc>
+ <p>Set options on a socket.</p>
+ <p>What properties are valid depend both on <c>Level</c> and on
+ what kind of socket it is (<c>domain</c>, <c>type</c> and
+ <c>protocol</c>).</p>
+
+ <p>See the
+ <seealso marker="socket_usage#socket_options">socket options</seealso>
+ chapter of the users guide for more info. </p>
+
+ <note><p>Not all options are valid on all platforms. That is,
+ even if "we" support an option, that does not mean that the
+ underlying OS does.</p></note>
+
+ <note><p>Sockets are set 'non-blocking' when created, so this option
+ is *not* available (as it would adversely effect the Erlang VM
+ to set a socket 'blocking').</p></note>
+ </desc>
+ </func>
+
+ <func>
+ <name name="setopt" arity="4" clause_i="8" since="OTP @OTP-14831@"/>
+ <fsummary>Set options on a socket.</fsummary>
+ <desc>
+ <p>Set options on a socket.</p>
+ <p>What properties are valid depend both on <c>Level</c> and on
+ what kind of socket it is (<c>domain</c>, <c>type</c> and
+ <c>protocol</c>).</p>
+
+ <p>See the
+ <seealso marker="socket_usage#socket_options">socket options</seealso>
+ chapter of the users guide for more info. </p>
+
+ <note><p>Not all options are valid on all platforms. That is,
+ even if "we" support an option, that does not mean that the
+ underlying OS does.</p></note>
+
+ <note><p>Sockets are set 'non-blocking' when created, so this option
+ is *not* available (as it would adversely effect the Erlang VM
+ to set a socket 'blocking').</p></note>
+ </desc>
+ </func>
+
+ <func>
+ <name name="shutdown" arity="2" since="OTP @OTP-14831@"/>
+ <fsummary>Shut down part of a full-duplex connection.</fsummary>
+ <desc>
+ <p>Shut down all or part of a full-duplex connection.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="sockname" arity="1" since="OTP @OTP-14831@"/>
+ <fsummary>Get socket name.</fsummary>
+ <desc>
+ <p>Returns the current address to which the socket is bound.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="supports" arity="0" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="1" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="1" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="1" clause_i="3" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="1" clause_i="4" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="2" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="2" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="2" clause_i="3" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="2" clause_i="4" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="2" clause_i="5" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="2" clause_i="6" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="2" clause_i="7" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="3" clause_i="1" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="3" clause_i="2" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="3" clause_i="3" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="3" clause_i="4" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="3" clause_i="5" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="3" clause_i="6" since="OTP @OTP-14831@"/>
+ <name name="supports" arity="3" clause_i="7" since="OTP @OTP-14831@"/>
+ <fsummary>Report info about what the platform supports.</fsummary>
+ <desc>
+ <p>This function intends to retreive information about what the
+ platform supports. Such as if SCTP is supported. Or which socket
+ options are supported. </p>
+ </desc>
+ </func>
+
+ </funcs>
+ <section>
+ <title>Examples</title>
+ <marker id="examples"></marker>
+ <code type="none">
+client(Addr, SAddr, SPort) ->
+ {ok, Sock} = socket:open(inet, stream, tcp),
+ {ok, _} = socket:bind(Sock, #{family => inet,
+ addr => Addr}),
+ ok = socket:connect(Sock, #{family => inet,
+ addr => SAddr,
+ port => SPort}),
+ Msg = list_to_binary("hello"),
+ ok = socket:send(Sock, Msg),
+ ok = socket:shutdown(Sock, write),
+ {ok, Msg} = socket:recv(Sock),
+ ok = socket:close(Sock).
+
+server(Addr, Port) ->
+ {ok, LSock} = socket:open(inet, stream, tcp),
+ {ok, _} = socket:bind(LSock, #{family => inet,
+ port => Port,
+ addr => Addr}),
+ ok = socket:listen(LSock),
+ {ok, Sock} = socket:accept(LSock),
+ {ok, Msg} = socket:recv(Sock),
+ ok = socket:send(Sock, Msg),
+ ok = socket:shutdown(Sock, write),
+ ok = socket:close(Sock),
+ ok = socket:close(LSock).
+ </code>
+ </section>
+</erlref>
+
diff --git a/erts/doc/src/socket_usage.xml b/erts/doc/src/socket_usage.xml
new file mode 100644
index 0000000000..e0f006e618
--- /dev/null
+++ b/erts/doc/src/socket_usage.xml
@@ -0,0 +1,773 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2018</year><year>2019</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>Socket Usage</title>
+ <prepared>Micael Karlberg</prepared>
+ <docno></docno>
+ <date>2018-07-17</date>
+ <rev>PA1</rev>
+ <file>socket_usage.xml</file>
+ </header>
+
+ <section>
+ <title>Introduction</title>
+ <p>The socket interface (module) is basically an "thin" layer on top of
+ the OS socket interface. It is assumed that, unless you have special needs,
+ gen_[tcp|udp|sctp] should be sufficent. </p>
+ <p>Note that just because we have a documented and described option,
+ it does <em>not</em> mean that the OS supports it. So its recommended
+ that the user reads the platform specific documentation for the
+ option used. </p>
+ </section>
+
+ <section>
+ <marker id="socket_options"></marker>
+ <title>Socket Options</title>
+
+ <p>Options for level <c>otp</c>: </p>
+ <table>
+ <row>
+ <cell><em>Option Name</em></cell>
+ <cell><em>Value Type</em></cell>
+ <cell><em>Set</em></cell>
+ <cell><em>Get</em></cell>
+ <cell><em>Other Requirements and comments</em></cell>
+ </row>
+ <row>
+ <cell>assoc_id</cell>
+ <cell>integer()</cell>
+ <cell>no</cell>
+ <cell>yes</cell>
+ <cell>type = seqpacket, protocol = sctp, is an association</cell>
+ </row>
+ <row>
+ <cell>debug</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>iow</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>controlling_process</cell>
+ <cell>pid()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>rcvbuf</cell>
+ <cell>default | pos_integer() | {pos_integer(), pos_ineteger()}</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>'default' only valid for set.
+ The tuple form is only valid for type 'stream' and protocol 'tcp'.</cell>
+ </row>
+ <row>
+ <cell>rcvctrlbuf</cell>
+ <cell>default | pos_integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>default only valid for set</cell>
+ </row>
+ <row>
+ <cell>sndctrlbuf</cell>
+ <cell>default | pos_integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>default only valid for set</cell>
+ </row>
+ <row>
+ <cell>fd</cell>
+ <cell>integer()</cell>
+ <cell>no</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <tcaption>option levels</tcaption>
+ </table>
+
+ <p>Options for level <c>socket</c>: </p>
+ <table>
+ <row>
+ <cell><em>Option Name</em></cell>
+ <cell><em>Value Type</em></cell>
+ <cell><em>Set</em></cell>
+ <cell><em>Get</em></cell>
+ <cell><em>Other Requirements and comments</em></cell>
+ </row>
+ <row>
+ <cell>acceptcon</cell>
+ <cell>boolean()</cell>
+ <cell>no</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>bindtodevice</cell>
+ <cell>string()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>broadcast</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram</cell>
+ </row>
+ <row>
+ <cell>debug</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>requires admin capability</cell>
+ </row>
+ <row>
+ <cell>domain</cell>
+ <cell>domain()</cell>
+ <cell>no</cell>
+ <cell>yes</cell>
+ <cell><em>Not</em> on FreeBSD (for instance)</cell>
+ </row>
+ <row>
+ <cell>dontroute</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>keepalive</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>linger</cell>
+ <cell>abort | linger()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>oobinline</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>peek_off</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>domain = local (unix)</cell>
+ </row>
+ <row>
+ <cell>priority</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>protocol</cell>
+ <cell>protocol()</cell>
+ <cell>no</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>rcvbuf</cell>
+ <cell>non_neg_integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>rcvlowat</cell>
+ <cell>non_neg_integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>rcvtimeo</cell>
+ <cell>timeval()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>reuseaddr</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>reuseport</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>domain = inet | inet6</cell>
+ </row>
+ <row>
+ <cell>sndbuf</cell>
+ <cell>non_neg_integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>sndlowat</cell>
+ <cell>non_neg_integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>not changeable on Linux</cell>
+ </row>
+ <row>
+ <cell>sndtimeo</cell>
+ <cell>timeval()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>timestamp</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>type</cell>
+ <cell>type()</cell>
+ <cell>no</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <tcaption>socket options</tcaption>
+ </table>
+
+ <p>Options for level <c>ip</c>: </p>
+ <table>
+ <row>
+ <cell><em>Option Name</em></cell>
+ <cell><em>Value Type</em></cell>
+ <cell><em>Set</em></cell>
+ <cell><em>Get</em></cell>
+ <cell><em>Other Requirements and comments</em></cell>
+ </row>
+ <row>
+ <cell>add_membership</cell>
+ <cell>ip_mreq()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>add_source_membership</cell>
+ <cell>ip_mreq_source()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>block_source</cell>
+ <cell>ip_mreq_source()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>drop_membership</cell>
+ <cell>ip_mreq()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>drop_source_membership</cell>
+ <cell>ip_mreq_source()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>freebind</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>hdrincl</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = raw</cell>
+ </row>
+ <row>
+ <cell>minttl</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = raw</cell>
+ </row>
+ <row>
+ <cell>msfilter</cell>
+ <cell>null | ip_msfilter()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>mtu</cell>
+ <cell>integer()</cell>
+ <cell>no</cell>
+ <cell>yes</cell>
+ <cell>type = raw</cell>
+ </row>
+ <row>
+ <cell>mtu_discover</cell>
+ <cell>ip_pmtudisc()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>multicast_all</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>multicast_if</cell>
+ <cell>any | ip4_address()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>multicast_loop</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>multicast_ttl</cell>
+ <cell>uint8()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>nodefrag</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = raw</cell>
+ </row>
+ <row>
+ <cell>pktinfo</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram</cell>
+ </row>
+ <row>
+ <cell>recvdstaddr</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram</cell>
+ </row>
+ <row>
+ <cell>recverr</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>recvif</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw</cell>
+ </row>
+ <row>
+ <cell>recvopts</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type =/= stream</cell>
+ </row>
+ <row>
+ <cell>recvorigdstaddr</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>recvttl</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type =/= stream</cell>
+ </row>
+ <row>
+ <cell>retopts</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type =/= stream</cell>
+ </row>
+ <row>
+ <cell>router_alert</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = raw</cell>
+ </row>
+ <row>
+ <cell>sendsrcaddr</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>tos</cell>
+ <cell>ip_tos()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>some high-priority levels may require superuser capability</cell>
+ </row>
+ <row>
+ <cell>transparent</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>requires admin capability</cell>
+ </row>
+ <row>
+ <cell>ttl</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>unblock_source</cell>
+ <cell>ip_mreq_source()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <tcaption>ip options</tcaption>
+ </table>
+
+ <p>Options for level <c>ipv6</c>: </p>
+ <table>
+ <row>
+ <cell><em>Option Name</em></cell>
+ <cell><em>Value Type</em></cell>
+ <cell><em>Set</em></cell>
+ <cell><em>Get</em></cell>
+ <cell><em>Other Requirements and comments</em></cell>
+ </row>
+ <row>
+ <cell>addrform</cell>
+ <cell>inet</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>allowed only for IPv6 sockets that are connected and bound to a
+ v4-mapped-on-v6 address</cell>
+ </row>
+ <row>
+ <cell>add_membership</cell>
+ <cell>ipv6_mreq()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>authhdr</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw, obsolete?</cell>
+ </row>
+ <row>
+ <cell>drop_membership</cell>
+ <cell>ipv6_mreq()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>dstopts</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw, requires superuser privileges to update</cell>
+ </row>
+ <row>
+ <cell>flowinfo</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw, requires superuser privileges to update</cell>
+ </row>
+ <row>
+ <cell>hoplimit</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw, requires superuser privileges to update</cell>
+ </row>
+ <row>
+ <cell>hopopts</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw, requires superuser privileges to update</cell>
+ </row>
+ <row>
+ <cell>mtu</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>Get: Only after the socket has been connected</cell>
+ </row>
+ <row>
+ <cell>mtu_discover</cell>
+ <cell>ipv6_pmtudisc()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>multicast_hops</cell>
+ <cell>default | uint8()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>multicast_if</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw</cell>
+ </row>
+ <row>
+ <cell>multicast_loop</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>recverr</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>recvpktinfo | pktinfo</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw</cell>
+ </row>
+ <row>
+ <cell>router_alert</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = raw</cell>
+ </row>
+ <row>
+ <cell>rthdr</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>type = dgram | raw, requires superuser privileges to update</cell>
+ </row>
+ <row>
+ <cell>unicast_hops</cell>
+ <cell>default | uint8()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>v6only</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <tcaption>ipv6 options</tcaption>
+ </table>
+
+ <p>Options for level <c>tcp</c>: </p>
+ <table>
+ <row>
+ <cell><em>Option Name</em></cell>
+ <cell><em>Value Type</em></cell>
+ <cell><em>Set</em></cell>
+ <cell><em>Get</em></cell>
+ <cell><em>Other Requirements and comments</em></cell>
+ </row>
+ <row>
+ <cell>congestion</cell>
+ <cell>string()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>maxseg</cell>
+ <cell>integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>nodelay</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <tcaption>tcp options</tcaption>
+ </table>
+
+ <p>Options for level <c>udp</c>: </p>
+ <table>
+ <row>
+ <cell><em>Option Name</em></cell>
+ <cell><em>Value Type</em></cell>
+ <cell><em>Set</em></cell>
+ <cell><em>Get</em></cell>
+ <cell><em>Other Requirements and comments</em></cell>
+ </row>
+ <row>
+ <cell>cork</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <tcaption>udp options</tcaption>
+ </table>
+
+ <p>Options for level <c>sctp</c>: </p>
+ <table>
+ <row>
+ <cell><em>Option Name</em></cell>
+ <cell><em>Value Type</em></cell>
+ <cell><em>Set</em></cell>
+ <cell><em>Get</em></cell>
+ <cell><em>Other Requirements and comments</em></cell>
+ </row>
+ <row>
+ <cell>associnfo</cell>
+ <cell>sctp_assocparams()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>autoclose</cell>
+ <cell>non_neg_integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>disable_fragments</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>events</cell>
+ <cell>sctp_event_subscribe()</cell>
+ <cell>yes</cell>
+ <cell>no</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>initmsg</cell>
+ <cell>sctp_initmsg()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>maxseg</cell>
+ <cell>non_neg_integer()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>nodelay</cell>
+ <cell>boolean()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <row>
+ <cell>rtoinfo</cell>
+ <cell>sctp_rtoinfo()</cell>
+ <cell>yes</cell>
+ <cell>yes</cell>
+ <cell>none</cell>
+ </row>
+ <tcaption>sctp options</tcaption>
+ </table>
+
+ </section>
+</chapter>
+
diff --git a/erts/doc/src/specs.xml b/erts/doc/src/specs.xml
index 0b943e6295..68fab5edf1 100644
--- a/erts/doc/src/specs.xml
+++ b/erts/doc/src/specs.xml
@@ -5,6 +5,8 @@
<xi:include href="../specs/specs_erl_tracer.xml"/>
<xi:include href="../specs/specs_init.xml"/>
<xi:include href="../specs/specs_persistent_term.xml"/>
+ <xi:include href="../specs/specs_socket.xml"/>
+ <xi:include href="../specs/specs_net.xml"/>
<xi:include href="../specs/specs_zlib.xml"/>
<xi:include href="../specs/specs_atomics.xml"/>
<xi:include href="../specs/specs_counters.xml"/>
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in
index b74f8371f5..21351df656 100644
--- a/erts/emulator/Makefile.in
+++ b/erts/emulator/Makefile.in
@@ -1,7 +1,8 @@
+
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2018. All Rights Reserved.
+# Copyright Ericsson AB 1996-2019. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -266,7 +267,6 @@ DEXPORT = @DEXPORT@
RANLIB = @RANLIB@
STRIP = strip
PERL = @PERL@
-RM = @RM@
MKDIR = @MKDIR@
USING_MINGW=@MIXED_CYGWIN_MINGW@
@@ -467,13 +467,13 @@ $(ERTS_LIB):
.PHONY: clean
clean:
- $(RM) -f $(GENERATE)
- $(RM) -rf $(TARGET)/*.c $(TARGET)/*.h $(TARGET)/*-GENERATED
- $(RM) -rf $(TARGET)/*/*
- $(RM) -rf obj/$(TARGET)
- $(RM) -rf pcre/obj/$(TARGET) $(PCRE_GENINC)
- $(RM) -rf zlib/obj/$(TARGET)
- $(RM) -rf bin/$(TARGET)
+ $(RM) $(GENERATE)
+ $(RM) -r $(TARGET)/*.c $(TARGET)/*.h $(TARGET)/*-GENERATED
+ $(RM) -r $(TARGET)/*/*
+ $(RM) -r obj/$(TARGET)
+ $(RM) -r pcre/obj/$(TARGET) $(PCRE_GENINC)
+ $(RM) -r zlib/obj/$(TARGET)
+ $(RM) -r bin/$(TARGET)
cd $(ERTS_LIB_DIR) && $(MAKE) clean
.PHONY: docs
@@ -641,6 +641,8 @@ PRELOAD_BEAM = $(ERL_TOP)/erts/preloaded/ebin/erts_code_purger.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \
$(ERL_TOP)/erts/preloaded/ebin/zlib.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/socket.beam \
+ $(ERL_TOP)/erts/preloaded/ebin/net.beam \
$(ERL_TOP)/erts/preloaded/ebin/prim_zip.beam \
$(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \
$(ERL_TOP)/erts/preloaded/ebin/erlang.beam \
@@ -833,6 +835,18 @@ EMU_OBJS = \
$(OBJDIR)/beam_catches.o $(OBJDIR)/code_ix.o \
$(OBJDIR)/beam_ranges.o
+ifneq ($(TARGET), win32)
+# These are *currently* only needed for non-win32,
+# since the nif-functions for socket and net are basically
+# stubbed with notsup in the win32 case.
+ESOCK_RUN_OBJS = \
+ $(OBJDIR)/socket_dbg.o \
+ $(OBJDIR)/socket_tarray.o \
+ $(OBJDIR)/socket_util.o
+else
+ESOCK_RUN_OBJS =
+endif
+
RUN_OBJS += \
$(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \
$(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \
@@ -865,7 +879,7 @@ RUN_OBJS += \
$(OBJDIR)/register.o $(OBJDIR)/break.o \
$(OBJDIR)/erl_async.o $(OBJDIR)/erl_lock_check.o \
$(OBJDIR)/erl_gc.o $(OBJDIR)/erl_lock_count.o \
- $(OBJDIR)/erl_posix_str.o \
+ $(OBJDIR)/erl_posix_str.o \
$(OBJDIR)/erl_bits.o $(OBJDIR)/erl_math.o \
$(OBJDIR)/erl_fun.o $(OBJDIR)/erl_bif_port.o \
$(OBJDIR)/erl_term.o $(OBJDIR)/erl_node_tables.o \
@@ -879,14 +893,18 @@ RUN_OBJS += \
$(OBJDIR)/erl_thr_queue.o $(OBJDIR)/erl_sched_spec_pre_alloc.o \
$(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \
$(OBJDIR)/erl_msacc.o $(OBJDIR)/erl_lock_flags.o \
- $(OBJDIR)/erl_io_queue.o $(OBJDIR)/erl_db_catree.o
+ $(OBJDIR)/erl_io_queue.o $(OBJDIR)/erl_db_catree.o \
+ $(ESOCK_RUN_OBJS)
LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o
+
NIF_OBJS = \
- $(OBJDIR)/erl_tracer_nif.o \
- $(OBJDIR)/prim_buffer_nif.o \
- $(OBJDIR)/prim_file_nif.o \
- $(OBJDIR)/zlib_nif.o
+ $(OBJDIR)/erl_tracer_nif.o \
+ $(OBJDIR)/prim_buffer_nif.o \
+ $(OBJDIR)/prim_file_nif.o \
+ $(OBJDIR)/zlib_nif.o \
+ $(OBJDIR)/socket_nif.o \
+ $(OBJDIR)/net_nif.o
ifeq ($(TARGET),win32)
DRV_OBJS = \
@@ -1147,7 +1165,15 @@ endif
BEAM_SRC=$(wildcard beam/*.c)
DRV_COMMON_SRC=$(wildcard drivers/common/*.c)
DRV_OSTYPE_SRC=$(wildcard drivers/$(ERLANG_OSTYPE)/*.c)
+ifeq ($(TARGET), win32)
+# These are *currently* only needed for non-win32,
+# since the nif-functions for socket and net are basically
+# stubbed with badarg in the win32 case.
+NIF_SOCKET_UTILS_SRC=$(filter-out nifs/common/socket_nif.c, $(wildcard nifs/common/socket_*.c))
+NIF_COMMON_SRC=$(filter-out $(NIF_SOCKET_UTILS_SRC), $(wildcard nifs/common/*.c))
+else
NIF_COMMON_SRC=$(wildcard nifs/common/*.c)
+endif
NIF_OSTYPE_SRC=$(wildcard nifs/$(ERLANG_OSTYPE)/*.c)
ALL_SYS_SRC=$(wildcard sys/$(ERLANG_OSTYPE)/*.c) $(wildcard sys/common/*.c)
# We use $(shell ls) here instead of wildcard as $(wildcard ) resolved at
diff --git a/erts/emulator/beam/arith_instrs.tab b/erts/emulator/beam/arith_instrs.tab
index 574fceec5b..5f23b2c168 100644
--- a/erts/emulator/beam/arith_instrs.tab
+++ b/erts/emulator/beam/arith_instrs.tab
@@ -116,6 +116,17 @@ increment.execute(IncrementVal, Dst) {
i_times(Fail, Op1, Op2, Dst) {
Eterm op1 = $Op1;
Eterm op2 = $Op2;
+#ifdef HAVE_OVERFLOW_CHECK_BUILTINS
+ if (ERTS_LIKELY(is_both_small(op1, op2))) {
+ Sint a = signed_val(op1);
+ Sint b = signed_val(op2);
+ Sint res;
+ if (ERTS_LIKELY(!__builtin_mul_overflow(a, b, &res) && IS_SSMALL(res))) {
+ $Dst = make_small(res);
+ $NEXT0();
+ }
+ }
+#endif
$OUTLINED_ARITH_2($Fail, mixed_times, BIF_stimes_2, op1, op2, $Dst);
}
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 4ef06464f4..04a2a83123 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -322,19 +322,19 @@ void** beam_ops;
#define Arg(N) I[(N)+1]
-#define GetR(pos, tr) \
+#define GetSource(raw, dst) \
do { \
- tr = Arg(pos); \
- switch (loader_tag(tr)) { \
+ dst = raw; \
+ switch (loader_tag(dst)) { \
case LOADER_X_REG: \
- tr = x(loader_x_reg_index(tr)); \
+ dst = x(loader_x_reg_index(dst)); \
break; \
case LOADER_Y_REG: \
- ASSERT(loader_y_reg_index(tr) >= 1); \
- tr = y(loader_y_reg_index(tr)); \
+ ASSERT(loader_y_reg_index(dst) >= 1); \
+ dst = y(loader_y_reg_index(dst)); \
break; \
} \
- CHECK_TERM(tr); \
+ CHECK_TERM(dst); \
} while (0)
#define PUT_TERM_REG(term, desc) \
@@ -885,19 +885,22 @@ void process_main(Eterm * x_reg_array, FloatDef* f_reg_array)
#include "beam_warm.h"
OpCase(normal_exit): {
- SWAPOUT;
+ HEAVY_SWAPOUT;
c_p->freason = EXC_NORMAL;
c_p->arity = 0; /* In case this process will ever be garbed again. */
ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
erts_do_exit_process(c_p, am_normal);
ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ HEAVY_SWAPIN;
goto do_schedule;
}
OpCase(continue_exit): {
+ HEAVY_SWAPOUT;
ERTS_UNREQ_PROC_MAIN_LOCK(c_p);
erts_continue_exit_process(c_p);
ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ HEAVY_SWAPIN;
goto do_schedule;
}
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 7ff55e8927..0ad5329b2f 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -1425,7 +1425,7 @@ load_atom_table(LoaderState* stp, ErtsAtomEncoding enc)
ap = atom_tab(atom_val(stp->atom[1]));
sys_memcpy(sbuf, ap->name, ap->len);
sbuf[ap->len] = '\0';
- LoadError1(stp, "module name in object code is %s", sbuf);
+ LoadError1(stp, "BEAM file exists but it defines a module named %s", sbuf);
}
return 1;
@@ -2970,6 +2970,8 @@ load_code(LoaderState* stp)
#define succ(St, X, Y) ((X).type == (Y).type && (X).val + 1 == (Y).val)
#define succ2(St, X, Y) ((X).type == (Y).type && (X).val + 2 == (Y).val)
#define succ3(St, X, Y) ((X).type == (Y).type && (X).val + 3 == (Y).val)
+#define succ4(St, X, Y) ((X).type == (Y).type && (X).val + 4 == (Y).val)
+
#ifdef NO_FPE_SIGNALS
#define no_fpe_signals(St) 1
@@ -2986,6 +2988,35 @@ compiled_with_otp_20_or_higher(LoaderState* stp)
}
/*
+ * Predicate that tests whether the following two moves are independent:
+ *
+ * move Src1 Dst1
+ * move Src2 Dst2
+ *
+ */
+static int
+independent_moves(LoaderState* stp, GenOpArg Src1, GenOpArg Dst1,
+ GenOpArg Src2, GenOpArg Dst2)
+{
+ return (Src1.type != Dst2.type || Src1.val != Dst2.val) &&
+ (Src2.type != Dst1.type || Src2.val != Dst1.val) &&
+ (Dst1.type != Dst2.type ||Dst1.val != Dst2.val);
+}
+
+/*
+ * Predicate that tests that two registers are distinct.
+ *
+ * move Src1 Dst1
+ * move Src2 Dst2
+ *
+ */
+static int
+distinct(LoaderState* stp, GenOpArg Reg1, GenOpArg Reg2)
+{
+ return Reg1.type != Reg2.type || Reg1.val != Reg2.val;
+}
+
+/*
* Predicate that tests whether a jump table can be used.
*/
@@ -3264,11 +3295,11 @@ gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
} else {
op->op = genop_i_bs_get_integer_6;
op->arity = 6;
- op->a[0] = Fail;
- op->a[1] = Live;
- op->a[2].type = TAG_u;
- op->a[2].val = (Unit.val << 3) | Flags.val;
- op->a[3] = Ms;
+ op->a[0] = Ms;
+ op->a[1] = Fail;
+ op->a[2] = Live;
+ op->a[3].type = TAG_u;
+ op->a[3].val = (Unit.val << 3) | Flags.val;
op->a[4] = Size;
op->a[5] = Dst;
op->next = NULL;
@@ -3301,8 +3332,8 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
} else {
op->op = genop_i_bs_get_binary_all2_5;
op->arity = 5;
- op->a[0] = Fail;
- op->a[1] = Ms;
+ op->a[0] = Ms;
+ op->a[1] = Fail;
op->a[2] = Live;
op->a[3] = Unit;
op->a[4] = Dst;
@@ -3310,8 +3341,8 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
} else if (Size.type == TAG_i) {
op->op = genop_i_bs_get_binary_imm2_6;
op->arity = 6;
- op->a[0] = Fail;
- op->a[1] = Ms;
+ op->a[0] = Ms;
+ op->a[1] = Fail;
op->a[2] = Live;
op->a[3].type = TAG_u;
if (!safe_mul(Size.val, Unit.val, &op->a[3].val)) {
@@ -3331,8 +3362,8 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
} else {
op->op = genop_i_bs_get_binary_imm2_6;
op->arity = 6;
- op->a[0] = Fail;
- op->a[1] = Ms;
+ op->a[0] = Ms;
+ op->a[1] = Fail;
op->a[2] = Live;
op->a[3].type = TAG_u;
if (!safe_mul(bigval, Unit.val, &op->a[3].val)) {
@@ -3344,8 +3375,8 @@ gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
} else {
op->op = genop_i_bs_get_binary2_6;
op->arity = 6;
- op->a[0] = Fail;
- op->a[1] = Ms;
+ op->a[0] = Ms;
+ op->a[1] = Fail;
op->a[2] = Live;
op->a[3] = Size;
op->a[4].type = TAG_u;
@@ -3378,8 +3409,8 @@ gen_put_binary(LoaderState* stp, GenOpArg Fail,GenOpArg Size,
if (Size.type == TAG_a && Size.val == am_all) {
op->op = genop_i_new_bs_put_binary_all_3;
op->arity = 3;
- op->a[0] = Fail;
- op->a[1] = Src;
+ op->a[0] = Src;
+ op->a[1] = Fail;
op->a[2] = Unit;
} else if (Size.type == TAG_i) {
op->op = genop_i_new_bs_put_binary_imm_3;
@@ -3389,10 +3420,33 @@ gen_put_binary(LoaderState* stp, GenOpArg Fail,GenOpArg Size,
if (safe_mul(Size.val, Unit.val, &op->a[1].val)) {
op->a[2] = Src;
} else {
+ error:
op->op = genop_badarg_1;
op->arity = 1;
op->a[0] = Fail;
}
+ } else if (Size.type == TAG_q) {
+#ifdef ARCH_64
+ /*
+ * There is no way that this binary would fit in memory.
+ */
+ goto error;
+#else
+ Eterm big = stp->literals[Size.val].term;
+ Uint bigval;
+ Uint size;
+
+ if (!term_to_Uint(big, &bigval) ||
+ !safe_mul(bigval, Unit.val, &size)) {
+ goto error;
+ }
+ op->op = genop_i_new_bs_put_binary_imm_3;
+ op->arity = 3;
+ op->a[0] = Fail;
+ op->a[1].type = TAG_u;
+ op->a[1].val = size;
+ op->a[2] = Src;
+#endif
} else {
op->op = genop_i_new_bs_put_binary_4;
op->arity = 4;
@@ -3417,11 +3471,8 @@ gen_put_integer(LoaderState* stp, GenOpArg Fail, GenOpArg Size,
NATIVE_ENDIAN(Flags);
/* Negative size must fail */
if (Size.type == TAG_i) {
- op->op = genop_i_new_bs_put_integer_imm_4;
- op->arity = 4;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
- if (!safe_mul(Size.val, Unit.val, &op->a[1].val)) {
+ Uint size;
+ if (!safe_mul(Size.val, Unit.val, &size)) {
error:
op->op = genop_badarg_1;
op->arity = 1;
@@ -3429,26 +3480,31 @@ gen_put_integer(LoaderState* stp, GenOpArg Fail, GenOpArg Size,
op->next = NULL;
return op;
}
- op->a[1].val = Size.val * Unit.val;
- op->a[2].type = Flags.type;
- op->a[2].val = (Flags.val & 7);
- op->a[3] = Src;
+ op->op = genop_i_new_bs_put_integer_imm_4;
+ op->arity = 4;
+ op->a[0] = Src;
+ op->a[1] = Fail;
+ op->a[2].type = TAG_u;
+ op->a[2].val = size;
+ op->a[3].type = Flags.type;
+ op->a[3].val = (Flags.val & 7);
} else if (Size.type == TAG_q) {
Eterm big = stp->literals[Size.val].term;
Uint bigval;
+ Uint size;
- if (!term_to_Uint(big, &bigval)) {
+ if (!term_to_Uint(big, &bigval) ||
+ !safe_mul(bigval, Unit.val, &size)) {
goto error;
- } else {
- op->op = genop_i_new_bs_put_integer_imm_4;
- op->arity = 4;
- op->a[0] = Fail;
- op->a[1].type = TAG_u;
- op->a[1].val = bigval * Unit.val;
- op->a[2].type = Flags.type;
- op->a[2].val = (Flags.val & 7);
- op->a[3] = Src;
}
+ op->op = genop_i_new_bs_put_integer_imm_4;
+ op->arity = 4;
+ op->a[0] = Src;
+ op->a[1] = Fail;
+ op->a[2].type = TAG_u;
+ op->a[2].val = size;
+ op->a[3].type = Flags.type;
+ op->a[3].val = (Flags.val & 7);
} else {
op->op = genop_i_new_bs_put_integer_4;
op->arity = 4;
@@ -3510,8 +3566,8 @@ gen_get_float2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live,
NATIVE_ENDIAN(Flags);
op->op = genop_i_bs_get_float2_6;
op->arity = 6;
- op->a[0] = Fail;
- op->a[1] = Ms;
+ op->a[0] = Ms;
+ op->a[1] = Fail;
op->a[2] = Live;
op->a[3] = Size;
op->a[4].type = TAG_u;
@@ -3534,10 +3590,22 @@ gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms,
NATIVE_ENDIAN(Flags);
NEW_GENOP(stp, op);
if (Size.type == TAG_a && Size.val == am_all) {
- op->op = genop_i_bs_skip_bits_all2_3;
+ /*
+ * This kind of skip instruction will only be found in modules
+ * compiled before OTP 19. From OTP 19, the compiler generates
+ * a test_unit instruction of a bs_skip at the end of a
+ * binary.
+ *
+ * It is safe to replace the skip instruction with a test_unit
+ * instruction, because the position will never be used again.
+ * If the match context itself is used again, it will be used by
+ * a bs_restore2 instruction which will overwrite the position
+ * by one of the stored positions.
+ */
+ op->op = genop_bs_test_unit_3;
op->arity = 3;
op->a[0] = Fail;
- op->a[1] = Ms;
+ op->a[1] = Ms;
op->a[2] = Unit;
} else if (Size.type == TAG_i) {
op->op = genop_i_bs_skip_bits_imm2_3;
@@ -3570,9 +3638,9 @@ gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms,
} else {
op->op = genop_i_bs_skip_bits2_4;
op->arity = 4;
- op->a[0] = Fail;
- op->a[1] = Ms;
- op->a[2] = Size;
+ op->a[0] = Ms;
+ op->a[1] = Size;
+ op->a[2] = Fail;
op->a[3] = Unit;
}
op->next = NULL;
@@ -6108,7 +6176,8 @@ erts_release_literal_area(ErtsLiteralArea* literal_area)
}
default:
ASSERT(is_external_header(oh->thing_word));
- erts_deref_node_entry(((ExternalThing*)oh)->node);
+ erts_deref_node_entry(((ExternalThing*)oh)->node,
+ make_boxed(&oh->thing_word));
}
oh = oh->next;
}
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index ff7db0e742..c102ddbee6 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -184,7 +184,7 @@ BIF_RETTYPE link_1(BIF_ALIST_1)
DistEntry *dep;
ErtsLink *lnk;
int code;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
dep = external_pid_dist_entry(BIF_ARG_1);
if (dep == erts_this_dist_entry)
@@ -201,9 +201,9 @@ BIF_RETTYPE link_1(BIF_ALIST_1)
ldp = erts_link_to_data(lnk);
- code = erts_dsig_prepare(&dsd, dep, BIF_P,
+ code = erts_dsig_prepare(&ctx, dep, BIF_P,
ERTS_PROC_LOCK_MAIN,
- ERTS_DSP_RLOCK, 0, 1);
+ ERTS_DSP_RLOCK, 0, 1, 1);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
@@ -222,9 +222,10 @@ BIF_RETTYPE link_1(BIF_ALIST_1)
ASSERT(inserted); (void)inserted;
erts_de_runlock(dep);
- code = erts_dsig_send_link(&dsd, BIF_P->common.id, BIF_ARG_1);
+ code = erts_dsig_send_link(&ctx, BIF_P->common.id, BIF_ARG_1);
if (code == ERTS_DSIG_SEND_YIELD)
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+ ASSERT(code == ERTS_DSIG_SEND_OK);
BIF_RET(am_true);
break;
}
@@ -306,7 +307,7 @@ demonitor(Process *c_p, Eterm ref, Eterm *multip)
DistEntry *dep;
int code = ERTS_DSIG_SEND_OK;
int deleted;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
ASSERT(is_external_pid(to) || is_node_name_atom(to));
@@ -322,8 +323,8 @@ demonitor(Process *c_p, Eterm ref, Eterm *multip)
}
}
- code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_PROC_LOCK_MAIN,
- ERTS_DSP_RLOCK, 0, 0);
+ code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_RLOCK, 0, 1, 0);
deleted = erts_monitor_dist_delete(&mdp->target);
@@ -352,8 +353,8 @@ demonitor(Process *c_p, Eterm ref, Eterm *multip)
* monitor list since in case of monitor name
* the atom is stored there. Yield if necessary.
*/
- code = erts_dsig_send_demonitor(&dsd, c_p->common.id,
- watched, mdp->ref, 0);
+ code = erts_dsig_send_demonitor(&ctx, c_p->common.id,
+ watched, mdp->ref);
break;
}
@@ -533,7 +534,7 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2)
}
if (is_external_pid(target)) {
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
int code;
dep = external_pid_dist_entry(target);
@@ -551,9 +552,9 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2)
BIF_P->common.id, id, name);
erts_monitor_tree_insert(&ERTS_P_MONITORS(BIF_P), &mdp->origin);
- code = erts_dsig_prepare(&dsd, dep,
+ code = erts_dsig_prepare(&ctx, dep,
BIF_P, ERTS_PROC_LOCK_MAIN,
- ERTS_DSP_RLOCK, 0, 1);
+ ERTS_DSP_RLOCK, 0, 1, 1);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
@@ -568,7 +569,7 @@ BIF_RETTYPE monitor_2(BIF_ALIST_2)
ASSERT(inserted); (void)inserted;
erts_de_runlock(dep);
- code = erts_dsig_send_monitor(&dsd, BIF_P->common.id, target, ref);
+ code = erts_dsig_send_monitor(&ctx, BIF_P->common.id, target, ref);
break;
}
@@ -914,7 +915,7 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1)
ErtsLinkData *ldp;
DistEntry *dep;
int code;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
dep = external_pid_dist_entry(BIF_ARG_1);
if (dep == erts_this_dist_entry)
@@ -932,15 +933,15 @@ BIF_RETTYPE unlink_1(BIF_ALIST_1)
else
erts_link_release(lnk);
- code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN,
- ERTS_DSP_NO_LOCK, 0, 0);
+ code = erts_dsig_prepare(&ctx, dep, BIF_P, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK, 0, 1, 0);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
BIF_RET(am_true);
case ERTS_DSIG_PREP_PENDING:
case ERTS_DSIG_PREP_CONNECTED:
- code = erts_dsig_send_unlink(&dsd, BIF_P->common.id, BIF_ARG_1);
+ code = erts_dsig_send_unlink(&ctx, BIF_P->common.id, BIF_ARG_1);
if (code == ERTS_DSIG_SEND_YIELD)
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
break;
@@ -1301,10 +1302,11 @@ static BIF_RETTYPE send_exit_signal_bif(Process *c_p, Eterm id, Eterm reason, in
ERTS_BIF_PREP_RET(ret_val, am_true); /* Old incarnation of this node... */
else {
int code;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
+
+ code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK, 0, 0, 1);
- code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_PROC_LOCK_MAIN,
- ERTS_DSP_NO_LOCK, 0, 1);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
@@ -1312,11 +1314,29 @@ static BIF_RETTYPE send_exit_signal_bif(Process *c_p, Eterm id, Eterm reason, in
break;
case ERTS_DSIG_PREP_PENDING:
case ERTS_DSIG_PREP_CONNECTED:
- code = erts_dsig_send_exit2(&dsd, c_p->common.id, id, reason);
- if (code == ERTS_DSIG_SEND_YIELD)
+ code = erts_dsig_send_exit2(&ctx, c_p->common.id, id, reason);
+ switch (code) {
+ case ERTS_DSIG_SEND_YIELD:
ERTS_BIF_PREP_YIELD_RETURN(ret_val, c_p, am_true);
- else
+ break;
+ case ERTS_DSIG_SEND_CONTINUE:
+ BUMP_ALL_REDS(c_p);
+ erts_set_gc_state(c_p, 0);
+ ERTS_BIF_PREP_TRAP1(ret_val, &dsend_continue_trap_export, c_p,
+ erts_dsend_export_trap_context(c_p, &ctx));
+ break;
+ case ERTS_DSIG_SEND_OK:
ERTS_BIF_PREP_RET(ret_val, am_true);
+ break;
+ case ERTS_DSIG_SEND_TOO_LRG:
+ erts_set_gc_state(c_p, 1);
+ ERTS_BIF_PREP_ERROR(ret_val, c_p, SYSTEM_LIMIT);
+ break;
+ default:
+ ASSERT(! "Invalid dsig send exit2 result");
+ ERTS_BIF_PREP_ERROR(ret_val, c_p, EXC_INTERNAL_ERROR);
+ break;
+ }
break;
default:
ASSERT(! "Invalid dsig prepare result");
@@ -1800,33 +1820,36 @@ ebif_bang_2(BIF_ALIST_2)
static Sint remote_send(Process *p, DistEntry *dep,
- Eterm to, Eterm full_to, Eterm msg,
- ErtsSendContext* ctx)
+ Eterm to, Eterm node, Eterm full_to, Eterm msg,
+ Eterm return_term, Eterm *ctxpp,
+ int connect, int suspend)
{
Sint res;
int code;
+ ErtsDSigSendContext ctx;
ASSERT(is_atom(to) || is_external_pid(to));
- ctx->dep = dep;
- code = erts_dsig_prepare(&ctx->dsd, dep, p, ERTS_PROC_LOCK_MAIN,
+ code = erts_dsig_prepare(&ctx, dep, p, ERTS_PROC_LOCK_MAIN,
ERTS_DSP_NO_LOCK,
- !ctx->suspend, ctx->connect);
+ !suspend, 0, connect);
+ ctx.return_term = return_term;
+ ctx.node = node;
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
res = SEND_NOCONNECT;
break;
case ERTS_DSIG_PREP_WOULD_SUSPEND:
- ASSERT(!ctx->suspend);
+ ASSERT(!suspend);
res = SEND_YIELD;
break;
case ERTS_DSIG_PREP_PENDING:
case ERTS_DSIG_PREP_CONNECTED: {
if (is_atom(to))
- code = erts_dsig_send_reg_msg(to, msg, ctx);
+ code = erts_dsig_send_reg_msg(&ctx, to, msg);
else
- code = erts_dsig_send_msg(to, msg, ctx);
+ code = erts_dsig_send_msg(&ctx, to, msg);
/*
* Note that reductions have been bumped on calling
* process by erts_dsig_send_reg_msg() or
@@ -1834,9 +1857,19 @@ static Sint remote_send(Process *p, DistEntry *dep,
*/
if (code == ERTS_DSIG_SEND_YIELD)
res = SEND_YIELD_RETURN;
- else if (code == ERTS_DSIG_SEND_CONTINUE)
+ else if (code == ERTS_DSIG_SEND_CONTINUE) {
+ erts_set_gc_state(p, 0);
+
+ /* Keep a reference to the dist entry if the
+ name is an not a pid. */
+ if (is_atom(to)) {
+ erts_ref_dist_entry(ctx.dep);
+ ctx.deref_dep = 1;
+ }
+
+ *ctxpp = erts_dsend_export_trap_context(p, &ctx);
res = SEND_YIELD_CONTINUE;
- else if (code == ERTS_DSIG_SEND_TOO_LRG)
+ } else if (code == ERTS_DSIG_SEND_TOO_LRG)
res = SEND_SYSTEM_LIMIT;
else
res = 0;
@@ -1858,7 +1891,8 @@ static Sint remote_send(Process *p, DistEntry *dep,
}
static Sint
-do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
+do_send(Process *p, Eterm to, Eterm msg, Eterm return_term, Eterm *refp,
+ Eterm *dist_ctx, int connect, int suspend)
{
Eterm portid;
Port *pt;
@@ -1890,7 +1924,8 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
erts_send_error_to_logger(p->group_leader, dsbufp);
return 0;
}
- return remote_send(p, dep, to, to, msg, ctx);
+ return remote_send(p, dep, to, dep->sysname, to, msg, return_term,
+ dist_ctx, connect, suspend);
} else if (is_atom(to)) {
Eterm id = erts_whereis_name_to_id(p, to);
@@ -1945,7 +1980,7 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
ret_val = 0;
if (pt) {
- int ps_flags = ctx->suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND;
+ int ps_flags = suspend ? 0 : ERTS_PORT_SIG_FLG_NOSUSPEND;
*refp = NIL;
if (IS_TRACED_FL(p, F_TRACE_SEND)) /* trace once only !! */
@@ -1960,12 +1995,12 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
switch (erts_port_command(p, ps_flags, pt, msg, refp)) {
case ERTS_PORT_OP_BUSY:
/* Nothing has been sent */
- if (ctx->suspend)
+ if (suspend)
erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt);
return SEND_YIELD;
case ERTS_PORT_OP_BUSY_SCHEDULED:
/* Message was sent */
- if (ctx->suspend) {
+ if (suspend) {
erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt);
ret_val = SEND_YIELD_RETURN;
break;
@@ -2036,13 +2071,10 @@ do_send(Process *p, Eterm to, Eterm msg, Eterm *refp, ErtsSendContext *ctx)
ASSERT(dep != erts_this_dist_entry);
deref_dep = 1;
}
- ctx->dsd.node = tp[2];
- ret = remote_send(p, dep, tp[1], to, msg, ctx);
- if (ret == SEND_YIELD_CONTINUE) {
- erts_ref_dist_entry(ctx->dep);
- ctx->deref_dep = 1;
- }
+ ret = remote_send(p, dep, tp[1], tp[2], to, msg, return_term,
+ dist_ctx, connect, suspend);
+
if (deref_dep)
erts_deref_dist_entry(dep);
return ret;
@@ -2081,25 +2113,16 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
Eterm l = opts;
Sint result;
-
- DeclareTypedTmpHeap(ErtsSendContext, ctx, BIF_P);
+ int connect = 1, suspend = 1;
+ Eterm ctx;
ERTS_MSACC_PUSH_STATE_M_X();
- UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P);
-
- ctx->suspend = !0;
- ctx->connect = !0;
- ctx->deref_dep = 0;
- ctx->return_term = am_ok;
- ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR);
- ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT;
-
while (is_list(l)) {
if (CAR(list_val(l)) == am_noconnect) {
- ctx->connect = 0;
+ connect = 0;
} else if (CAR(list_val(l)) == am_nosuspend) {
- ctx->suspend = 0;
+ suspend = 0;
} else {
ERTS_BIF_PREP_ERROR(retval, p, BADARG);
goto done;
@@ -2116,7 +2139,7 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
#endif
ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_SEND);
- result = do_send(p, to, msg, &ref, ctx);
+ result = do_send(p, to, msg, am_ok, &ref, &ctx, connect, suspend);
ERTS_MSACC_POP_STATE_M_X();
if (result >= 0) {
@@ -2129,22 +2152,21 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
switch (result) {
case SEND_NOCONNECT:
- if (ctx->connect) {
+ if (connect) {
ERTS_BIF_PREP_RET(retval, am_ok);
} else {
ERTS_BIF_PREP_RET(retval, am_noconnect);
}
break;
case SEND_YIELD:
- if (ctx->suspend) {
- ERTS_BIF_PREP_YIELD3(retval,
- bif_export[BIF_send_3], p, to, msg, opts);
+ if (suspend) {
+ ERTS_BIF_PREP_YIELD3(retval, bif_export[BIF_send_3], p, to, msg, opts);
} else {
ERTS_BIF_PREP_RET(retval, am_nosuspend);
}
break;
case SEND_YIELD_RETURN:
- if (!ctx->suspend) {
+ if (!suspend) {
ERTS_BIF_PREP_RET(retval, am_nosuspend);
break;
}
@@ -2169,9 +2191,7 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
break;
case SEND_YIELD_CONTINUE:
BUMP_ALL_REDS(p);
- erts_set_gc_state(p, 0);
- ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p,
- erts_dsend_export_trap_context(p, ctx));
+ ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, ctx);
break;
default:
erts_exit(ERTS_ABORT_EXIT, "send_3 invalid result %d\n", (int)result);
@@ -2179,7 +2199,6 @@ BIF_RETTYPE send_3(BIF_ALIST_3)
}
done:
- UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), BIF_P);
return retval;
}
@@ -2193,14 +2212,14 @@ BIF_RETTYPE send_2(BIF_ALIST_2)
static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1)
{
Binary* bin = erts_magic_ref2bin(BIF_ARG_1);
- ErtsSendContext* ctx = (ErtsSendContext*) ERTS_MAGIC_BIN_DATA(bin);
+ ErtsDSigSendContext *ctx = (ErtsDSigSendContext*) ERTS_MAGIC_BIN_DATA(bin);
Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(BIF_P) * TERM_TO_BINARY_LOOP_FACTOR);
int result;
ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == erts_dsend_context_dtor);
- ctx->dss.reds = initial_reds;
- result = erts_dsig_send(&ctx->dsd, &ctx->dss);
+ ctx->reds = initial_reds;
+ result = erts_dsig_send(ctx);
switch (result) {
case ERTS_DSIG_SEND_OK:
@@ -2209,7 +2228,7 @@ static BIF_RETTYPE dsend_continue_trap_1(BIF_ALIST_1)
break;
case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/
erts_set_gc_state(BIF_P, 1);
- if (!ctx->suspend)
+ if (ctx->no_suspend)
BIF_RET(am_nosuspend);
ERTS_BIF_YIELD_RETURN(BIF_P, ctx->return_term);
@@ -2234,20 +2253,14 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
Eterm retval;
Eterm ref;
Sint result;
- DeclareTypedTmpHeap(ErtsSendContext, ctx, p);
+ Eterm ctx;
ERTS_MSACC_PUSH_AND_SET_STATE_M_X(ERTS_MSACC_STATE_SEND);
- UseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p);
+
#ifdef DEBUG
ref = NIL;
#endif
- ctx->suspend = !0;
- ctx->connect = !0;
- ctx->deref_dep = 0;
- ctx->return_term = msg;
- ctx->dss.reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR);
- ctx->dss.phase = ERTS_DSIG_SEND_PHASE_INIT;
- result = do_send(p, to, msg, &ref, ctx);
+ result = do_send(p, to, msg, msg, &ref, &ctx, 1, 1);
ERTS_MSACC_POP_STATE_M_X();
@@ -2289,9 +2302,7 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
break;
case SEND_YIELD_CONTINUE:
BUMP_ALL_REDS(p);
- erts_set_gc_state(p, 0);
- ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p,
- erts_dsend_export_trap_context(p, ctx));
+ ERTS_BIF_PREP_TRAP1(retval, &dsend_continue_trap_export, p, ctx);
break;
default:
erts_exit(ERTS_ABORT_EXIT, "invalid send result %d\n", (int)result);
@@ -2299,7 +2310,6 @@ Eterm erl_send(Process *p, Eterm to, Eterm msg)
}
done:
- UnUseTmpHeap(sizeof(ErtsSendContext)/sizeof(Eterm), p);
return retval;
}
@@ -2365,7 +2375,7 @@ accumulate(Eterm acc, Uint size)
* bignum buffer with one extra word to be used if
* the bignum grows in the future.
*/
- Eterm* hp = (Eterm *) erts_alloc(ERTS_ALC_T_TEMP_TERM,
+ Eterm* hp = (Eterm *) erts_alloc(ERTS_ALC_T_SHORT_LIVED_TERM,
(BIG_UINT_HEAP_SIZE+1) *
sizeof(Eterm));
return uint_to_big(size, hp);
@@ -2385,7 +2395,7 @@ accumulate(Eterm acc, Uint size)
* The extra word has been consumed. Grow the
* allocation by one word.
*/
- big = (Eterm *) erts_realloc(ERTS_ALC_T_TEMP_TERM,
+ big = (Eterm *) erts_realloc(ERTS_ALC_T_SHORT_LIVED_TERM,
big_val(acc),
(need_heap+1) * sizeof(Eterm));
acc = make_big(big);
@@ -2414,29 +2424,85 @@ consolidate(Process* p, Eterm acc, Uint size)
while (sz--) {
*hp++ = *big++;
}
- erts_free(ERTS_ALC_T_TEMP_TERM, (void *) big_val(acc));
+ erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(acc));
return res;
}
}
+typedef struct {
+ Eterm obj;
+ Uint size;
+ Eterm acc;
+ Eterm input_list;
+ ErtsEStack stack;
+ int is_trap_at_L_iter_list;
+} ErtsIOListSizeContext;
+
+static int iolist_size_ctx_bin_dtor(Binary *context_bin) {
+ ErtsIOListSizeContext* context = ERTS_MAGIC_BIN_DATA(context_bin);
+ DESTROY_SAVED_ESTACK(&context->stack);
+ if (context->acc != THE_NON_VALUE) {
+ erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(context->acc));
+ }
+ return 1;
+}
+
BIF_RETTYPE iolist_size_1(BIF_ALIST_1)
{
- Eterm obj, hd;
+ static const Uint ITERATIONS_PER_RED = 64;
+ Eterm input_list, obj, hd;
Eterm* objp;
Uint size = 0;
Uint cur_size;
Uint new_size;
Eterm acc = THE_NON_VALUE;
DECLARE_ESTACK(s);
-
- obj = BIF_ARG_1;
+ Uint max_iterations;
+ Uint iterations_until_trap = max_iterations =
+ ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(BIF_P);
+ ErtsIOListSizeContext* context = NULL;
+ Eterm state_mref;
+ int is_trap_at_L_iter_list;
+ ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
+#ifdef DEBUG
+ iterations_until_trap = iterations_until_trap / 10;
+#endif
+ input_list = obj = BIF_ARG_1;
+ if (is_internal_magic_ref(obj)) {
+ /* Restore state after a trap */
+ Binary* state_bin;
+ state_mref = obj;
+ state_bin = erts_magic_ref2bin(state_mref);
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(state_bin) != iolist_size_ctx_bin_dtor) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ context = ERTS_MAGIC_BIN_DATA(state_bin);
+ obj = context->obj;
+ size = context->size;
+ acc = context->acc;
+ input_list = context->input_list;
+ ESTACK_RESTORE(s, &context->stack);
+ ASSERT(BIF_P->flags & F_DISABLE_GC);
+ erts_set_gc_state(BIF_P, 1);
+ if (context->is_trap_at_L_iter_list) {
+ goto L_iter_list;
+ }
+ }
goto L_again;
while (!ESTACK_ISEMPTY(s)) {
obj = ESTACK_POP(s);
+ if (iterations_until_trap == 0) {
+ is_trap_at_L_iter_list = 0;
+ goto L_save_state_and_trap;
+ }
L_again:
if (is_list(obj)) {
L_iter_list:
+ if (iterations_until_trap == 0) {
+ is_trap_at_L_iter_list = 1;
+ goto L_save_state_and_trap;
+ }
objp = list_val(obj);
hd = CAR(objp);
obj = CDR(objp);
@@ -2458,12 +2524,14 @@ BIF_RETTYPE iolist_size_1(BIF_ALIST_1)
} else if (is_list(hd)) {
ESTACK_PUSH(s, obj);
obj = hd;
+ iterations_until_trap--;
goto L_iter_list;
} else if (is_not_nil(hd)) {
goto L_type_error;
}
/* Tail */
if (is_list(obj)) {
+ iterations_until_trap--;
goto L_iter_list;
} else if (is_binary(obj) && binary_bitsize(obj) == 0) {
cur_size = binary_size(obj);
@@ -2487,14 +2555,55 @@ BIF_RETTYPE iolist_size_1(BIF_ALIST_1)
} else if (is_not_nil(obj)) {
goto L_type_error;
}
+ iterations_until_trap--;
}
DESTROY_ESTACK(s);
+ BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED);
+ ASSERT(!(BIF_P->flags & F_DISABLE_GC));
+ if (context != NULL) {
+ /* context->acc needs to be reset so that
+ iolist_size_ctx_bin_dtor does not deallocate twice */
+ context->acc = THE_NON_VALUE;
+ }
BIF_RET(consolidate(BIF_P, acc, size));
L_type_error:
DESTROY_ESTACK(s);
- BIF_ERROR(BIF_P, BADARG);
+ if (acc != THE_NON_VALUE) {
+ erts_free(ERTS_ALC_T_SHORT_LIVED_TERM, (void *) big_val(acc));
+ if (context != NULL) {
+ context->acc = THE_NON_VALUE;
+ }
+ }
+ BUMP_REDS(BIF_P, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED);
+ ASSERT(!(BIF_P->flags & F_DISABLE_GC));
+ if (context == NULL) {
+ BIF_ERROR(BIF_P, BADARG);
+ } else {
+ ERTS_BIF_ERROR_TRAPPED1(BIF_P,
+ BADARG,
+ bif_export[BIF_iolist_size_1],
+ input_list);
+ }
+
+ L_save_state_and_trap:
+ if (context == NULL) {
+ Binary *state_bin = erts_create_magic_binary(sizeof(ErtsIOListSizeContext),
+ iolist_size_ctx_bin_dtor);
+ Eterm* hp = HAlloc(BIF_P, ERTS_MAGIC_REF_THING_SIZE);
+ state_mref = erts_mk_magic_ref(&hp, &MSO(BIF_P), state_bin);
+ context = ERTS_MAGIC_BIN_DATA(state_bin);
+ }
+ context->obj = obj;
+ context->size = size;
+ context->acc = acc;
+ context->is_trap_at_L_iter_list = is_trap_at_L_iter_list;
+ context->input_list = input_list;
+ ESTACK_SAVE(s, &context->stack);
+ erts_set_gc_state(BIF_P, 0);
+ BUMP_ALL_REDS(BIF_P);
+ BIF_TRAP1(bif_export[BIF_iolist_size_1], BIF_P, state_mref);
}
/**********************************************************************/
@@ -4053,10 +4162,12 @@ BIF_RETTYPE list_to_pid_1(BIF_ALIST_1)
if (is_nil(dep->cid))
goto bad;
- enp = erts_find_or_insert_node(dep->sysname, dep->creation);
+ etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1);
+
+ enp = erts_find_or_insert_node(dep->sysname, dep->creation,
+ make_boxed(&etp->header));
ASSERT(enp != erts_this_node);
- etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1);
etp->header = make_external_pid_header(1);
etp->next = MSO(BIF_P).first;
etp->node = enp;
@@ -4120,10 +4231,11 @@ BIF_RETTYPE list_to_port_1(BIF_ALIST_1)
if (is_nil(dep->cid))
goto bad;
- enp = erts_find_or_insert_node(dep->sysname, dep->creation);
+ etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1);
+ enp = erts_find_or_insert_node(dep->sysname, dep->creation,
+ make_boxed(&etp->header));
ASSERT(enp != erts_this_node);
- etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1);
etp->header = make_external_port_header(1);
etp->next = MSO(BIF_P).first;
etp->node = enp;
@@ -4226,9 +4338,6 @@ BIF_RETTYPE list_to_ref_1(BIF_ALIST_1)
if (is_nil(dep->cid))
goto bad;
- enp = erts_find_or_insert_node(dep->sysname, dep->creation);
- ASSERT(enp != erts_this_node);
-
hsz = EXTERNAL_THING_HEAD_SIZE;
#if defined(ARCH_64)
hsz += n/2 + 1;
@@ -4237,6 +4346,11 @@ BIF_RETTYPE list_to_ref_1(BIF_ALIST_1)
#endif
etp = (ExternalThing *) HAlloc(BIF_P, hsz);
+
+ enp = erts_find_or_insert_node(dep->sysname, dep->creation,
+ make_boxed(&etp->header));
+ ASSERT(enp != erts_this_node);
+
etp->header = make_external_ref_header(n/2);
etp->next = BIF_P->off_heap.first;
etp->node = enp;
@@ -4356,21 +4470,21 @@ BIF_RETTYPE erts_internal_group_leader_2(BIF_ALIST_2)
if (is_external_pid(BIF_ARG_2)) {
DistEntry *dep;
int code;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
dep = external_pid_dist_entry(BIF_ARG_2);
ERTS_ASSERT(dep);
if(dep == erts_this_dist_entry)
BIF_ERROR(BIF_P, BADARG);
- code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_PROC_LOCK_MAIN,
- ERTS_DSP_NO_LOCK, 0, 1);
+ code = erts_dsig_prepare(&ctx, dep, BIF_P, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK, 0, 1, 1);
switch (code) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
BIF_RET(am_true);
case ERTS_DSIG_PREP_PENDING:
case ERTS_DSIG_PREP_CONNECTED:
- code = erts_dsig_send_group_leader(&dsd, BIF_ARG_1, BIF_ARG_2);
+ code = erts_dsig_send_group_leader(&ctx, BIF_ARG_1, BIF_ARG_2);
if (code == ERTS_DSIG_SEND_YIELD)
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
BIF_RET(am_true);
@@ -5051,6 +5165,12 @@ erts_schedule_bif(Process *proc,
pc = i;
mfa = &exp->info.mfa;
}
+ else if (BeamIsOpCode(*i, op_call_bif_only_e)) {
+ /* Pointer to bif export in i+1 */
+ exp = (Export *) i[1];
+ pc = i;
+ mfa = &exp->info.mfa;
+ }
else if (BeamIsOpCode(*i, op_apply_bif)) {
/* Pointer to bif in i+1, and mfa in i-3 */
pc = c_p->cp;
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 18586b5ede..11941db8cd 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -737,3 +737,4 @@ bif erts_internal:spawn_system_process/3
bif erlang:integer_to_list/2
bif erlang:integer_to_binary/2
+bif persistent_term:get/2
diff --git a/erts/emulator/beam/bif_instrs.tab b/erts/emulator/beam/bif_instrs.tab
index 418bbe2b23..8e0caa38a3 100644
--- a/erts/emulator/beam/bif_instrs.tab
+++ b/erts/emulator/beam/bif_instrs.tab
@@ -209,8 +209,8 @@ i_length.execute(Fail, Live, Dst) {
}
//
-// The most general BIF call. The BIF may build any amount of data
-// on the heap. The result is always returned in r(0).
+// Call a BIF, store the result in x(0) and transfer control to the
+// next instruction.
//
call_bif(Exp) {
ErtsBifFunc bf;
@@ -219,8 +219,10 @@ call_bif(Exp) {
Export *export = (Export*) $Exp;
if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) {
- /* If we have run out of reductions, we do a context
- switch before calling the bif */
+ /*
+ * If we have run out of reductions, do a context
+ * switch before calling the BIF.
+ */
c_p->arity = GET_BIF_ARITY(export);
c_p->current = &export->info.mfa;
goto context_switch3;
@@ -257,9 +259,12 @@ call_bif(Exp) {
HTOP = HEAP_TOP(c_p);
FCALLS = c_p->fcalls;
ERTS_DBG_CHK_REDS(c_p, FCALLS);
- /* We have to update the cache if we are enabled in order
- to make sure no book keeping is done after we disabled
- msacc. We don't always do this as it is quite expensive. */
+
+ /*
+ * We have to update the cache if we are enabled in order
+ * to make sure no bookkeeping is done after we disabled
+ * msacc. We don't always do this as it is quite expensive.
+ */
if (ERTS_MSACC_IS_ENABLED_CACHED_X()) {
ERTS_MSACC_UPDATE_CACHE_X();
}
@@ -269,7 +274,13 @@ call_bif(Exp) {
CHECK_TERM(r(0));
$NEXT0();
} else if (c_p->freason == TRAP) {
- SET_CP(c_p, I+2);
+ /*
+ * Set the continuation pointer to return to next
+ * instruction after the trap (either by a return from
+ * erlang code or by nif_bif.epilogue() when the BIF
+ * is done).
+ */
+ SET_CP(c_p, $NEXT_INSTRUCTION);
SET_I(c_p->i);
SWAPIN;
Dispatch();
@@ -281,6 +292,95 @@ call_bif(Exp) {
ASSERT(c_p->stop == E);
I = handle_error(c_p, I, reg, &export->info.mfa);
goto post_error_handling;
+ //| -no_next
+}
+
+//
+// Call a BIF tail-recursively, storing the result in x(0) and doing
+// a return to the continuation poiner (c_p->cp).
+//
+
+call_bif_only(Exp) {
+ ErtsBifFunc bf;
+ Eterm result;
+ ErlHeapFragment *live_hf_end;
+ Export *export = (Export*) $Exp;
+
+ if (!((FCALLS - 1) > 0 || (FCALLS-1) > neg_o_reds)) {
+ /*
+ * If we have run out of reductions, do a context
+ * switch before calling the BIF.
+ */
+ c_p->arity = GET_BIF_ARITY(export);
+ c_p->current = &export->info.mfa;
+ goto context_switch3;
+ }
+
+ ERTS_MSACC_SET_BIF_STATE_CACHED_X(GET_BIF_MODULE(export),
+ GET_BIF_ADDRESS(export));
+
+ bf = GET_BIF_ADDRESS(export);
+
+ PRE_BIF_SWAPOUT(c_p);
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ c_p->fcalls = FCALLS - 1;
+ if (FCALLS <= 0) {
+ save_calls(c_p, export);
+ }
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
+ result = (*bf)(c_p, reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
+ ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
+ ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
+ ERTS_HOLE_CHECK(c_p);
+ ERTS_REQ_PROC_MAIN_LOCK(c_p);
+ if (ERTS_IS_GC_DESIRED(c_p)) {
+ Uint arity = GET_BIF_ARITY(export);
+ result = erts_gc_after_bif_call_lhf(c_p, live_hf_end, result,
+ reg, arity);
+ E = c_p->stop;
+ }
+ PROCESS_MAIN_CHK_LOCKS(c_p);
+ HTOP = HEAP_TOP(c_p);
+ FCALLS = c_p->fcalls;
+ ERTS_DBG_CHK_REDS(c_p, FCALLS);
+
+ /*
+ * We have to update the cache if we are enabled in order
+ * to make sure no bookkeeping is done after we disabled
+ * msacc. We don't always do this as it is quite expensive.
+ */
+ if (ERTS_MSACC_IS_ENABLED_CACHED_X()) {
+ ERTS_MSACC_UPDATE_CACHE_X();
+ }
+ ERTS_MSACC_SET_STATE_CACHED_M_X(ERTS_MSACC_STATE_EMULATOR);
+ if (ERTS_LIKELY(is_value(result))) {
+ /*
+ * Success. Store the result and return to the caller.
+ */
+ r(0) = result;
+ CHECK_TERM(r(0));
+ $return();
+ } else if (c_p->freason == TRAP) {
+ /*
+ * Dispatch to a trap. When the trap is done, a jump
+ * to the continuation pointer (c_p->cp) will be done.
+ */
+ SET_I(c_p->i);
+ SWAPIN;
+ Dispatch();
+ }
+
+ /*
+ * Error handling. SWAPOUT is not needed because it was done above.
+ */
+ ASSERT(c_p->stop == E);
+ I = handle_error(c_p, I, reg, &export->info.mfa);
+ goto post_error_handling;
+ //| -no_next
}
//
@@ -313,7 +413,7 @@ send() {
r(0) = result;
CHECK_TERM(r(0));
} else if (c_p->freason == TRAP) {
- SET_CP(c_p, I+1);
+ SET_CP(c_p, $NEXT_INSTRUCTION);
SET_I(c_p->i);
SWAPIN;
Dispatch();
diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h
index da4dc84d10..ad19cce395 100644
--- a/erts/emulator/beam/big.h
+++ b/erts/emulator/beam/big.h
@@ -81,7 +81,11 @@ typedef Uint dsize_t; /* Vector size type */
* a Uint64 argument. Therefore, we must test the size of the argument
* to ensure that the cast does not discard the high-order 32 bits.
*/
-#define _IS_SSMALL32(x) (((Uint32) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2)
+#if defined(ARCH_32)
+# define _IS_SSMALL32(x) (((Uint32) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2)
+#else
+# define _IS_SSMALL32(x) (1)
+#endif
#define _IS_SSMALL64(x) (((Uint64) ((((x)) >> (SMALL_BITS-1)) + 1)) < 2)
#define IS_SSMALL(x) (sizeof(x) == sizeof(Uint32) ? _IS_SSMALL32(x) : _IS_SSMALL64(x))
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 273b598562..27bf2187c2 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -129,7 +129,7 @@ typedef struct {
void *to_arg;
} PrintMonitorContext;
-static void doit_print_link(ErtsLink *lnk, void *vpcontext)
+static int doit_print_link(ErtsLink *lnk, void *vpcontext, Sint reds)
{
PrintMonitorContext *pcontext = vpcontext;
fmtfn_t to = pcontext->to;
@@ -141,10 +141,11 @@ static void doit_print_link(ErtsLink *lnk, void *vpcontext)
} else {
erts_print(to, to_arg, ", %T", lnk->other.item);
}
+ return 1;
}
-static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext)
+static int doit_print_monitor(ErtsMonitor *mon, void *vpcontext, Sint reds)
{
ErtsMonitorData *mdp;
PrintMonitorContext *pcontext = vpcontext;
@@ -196,6 +197,7 @@ static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext)
/* ignore other monitors... */
break;
}
+ return 1;
}
/* Display info about an individual Erlang process */
diff --git a/erts/emulator/beam/bs_instrs.tab b/erts/emulator/beam/bs_instrs.tab
index 2dde70c2e1..652460a66d 100644
--- a/erts/emulator/beam/bs_instrs.tab
+++ b/erts/emulator/beam/bs_instrs.tab
@@ -21,12 +21,57 @@
%if ARCH_64
BS_SAFE_MUL(A, B, Fail, Dst) {
- Uint64 res = ($A) * ($B);
- if (res / $B != $A) {
+ Uint a = $A;
+ Uint b = $B;
+ Uint res;
+#ifdef HAVE_OVERFLOW_CHECK_BUILTINS
+ if (__builtin_mul_overflow(a, b, &res)) {
+ $Fail;
+ }
+#else
+ res = a * b;
+ if (res / b != a) {
$Fail;
}
+#endif
$Dst = res;
}
+
+BS_GET_FIELD_SIZE(Bits, Unit, Fail, Dst) {
+ if (is_small($Bits)) {
+ Uint uint_size;
+ Sint signed_size = signed_val($Bits);
+ if (signed_size < 0) {
+ $Fail;
+ }
+ uint_size = (Uint) signed_size;
+ $BS_SAFE_MUL(uint_size, $Unit, $Fail, $Dst);
+ } else {
+ /*
+ * On a 64-bit architecture, the size of any binary
+ * that would fit in the memory fits in a small.
+ */
+ $Fail;
+ }
+}
+
+BS_GET_UNCHECKED_FIELD_SIZE(Bits, Unit, Fail, Dst) {
+ if (is_small($Bits)) {
+ Uint uint_size;
+ Sint signed_size = signed_val($Bits);
+ if (signed_size < 0) {
+ $Fail;
+ }
+ uint_size = (Uint) signed_size;
+ $Dst = uint_size * $Unit;
+ } else {
+ /*
+ * On a 64-bit architecture, the size of any binary
+ * that would fit in the memory fits in a small.
+ */
+ $Fail;
+ }
+}
%else
BS_SAFE_MUL(A, B, Fail, Dst) {
Uint64 res = (Uint64)($A) * (Uint64)($B);
@@ -35,7 +80,6 @@ BS_SAFE_MUL(A, B, Fail, Dst) {
}
$Dst = res;
}
-%endif
BS_GET_FIELD_SIZE(Bits, Unit, Fail, Dst) {
Sint signed_size;
@@ -76,6 +120,7 @@ BS_GET_UNCHECKED_FIELD_SIZE(Bits, Unit, Fail, Dst) {
}
$Dst = uint_size * $Unit;
}
+%endif
TEST_BIN_VHEAP(VNh, Nh, Live) {
Uint need = $Nh;
@@ -90,12 +135,22 @@ TEST_BIN_VHEAP(VNh, Nh, Live) {
HEAP_SPACE_VERIFIED(need);
}
-i_bs_get_binary_all2(Fail, Ms, Live, Unit, Dst) {
+i_bs_get_binary_all2 := i_bs_get_binary_all2.fetch.execute;
+
+i_bs_get_binary_all2.head() {
+ Eterm context;
+}
+
+i_bs_get_binary_all2.fetch(Ctx) {
+ context = $Ctx;
+}
+
+i_bs_get_binary_all2.execute(Fail, Live, Unit, Dst) {
ErlBinMatchBuffer *_mb;
Eterm _result;
- $GC_TEST(0, ERL_SUB_BIN_SIZE, $Live);
- _mb = ms_matchbuffer($Ms);
+ $GC_TEST_PRESERVE(ERL_SUB_BIN_SIZE, $Live, context);
+ _mb = ms_matchbuffer(context);
if (((_mb->size - _mb->offset) % $Unit) == 0) {
LIGHT_SWAPOUT;
_result = erts_bs_get_binary_all_2(c_p, _mb);
@@ -109,14 +164,23 @@ i_bs_get_binary_all2(Fail, Ms, Live, Unit, Dst) {
$FAIL($Fail);
}
}
+i_bs_get_binary2 := i_bs_get_binary2.fetch.execute;
+
+i_bs_get_binary2.head() {
+ Eterm context;
+}
+
+i_bs_get_binary2.fetch(Ctx) {
+ context = $Ctx;
+}
-i_bs_get_binary2(Fail, Ms, Live, Sz, Flags, Dst) {
+i_bs_get_binary2.execute(Fail, Live, Sz, Flags, Dst) {
ErlBinMatchBuffer *_mb;
Eterm _result;
Uint _size;
$BS_GET_FIELD_SIZE($Sz, (($Flags) >> 3), $FAIL($Fail), _size);
- $GC_TEST(0, ERL_SUB_BIN_SIZE, $Live);
- _mb = ms_matchbuffer($Ms);
+ $GC_TEST_PRESERVE(ERL_SUB_BIN_SIZE, $Live, context);
+ _mb = ms_matchbuffer(context);
LIGHT_SWAPOUT;
_result = erts_bs_get_binary_2(c_p, _size, $Flags, _mb);
LIGHT_SWAPIN;
@@ -129,11 +193,22 @@ i_bs_get_binary2(Fail, Ms, Live, Sz, Flags, Dst) {
}
}
-i_bs_get_binary_imm2(Fail, Ms, Live, Sz, Flags, Dst) {
+i_bs_get_binary_imm2 := i_bs_get_binary_imm2.fetch.execute;
+
+i_bs_get_binary_imm2.head() {
+ Eterm context;
+}
+
+i_bs_get_binary_imm2.fetch(Ctx) {
+ context = $Ctx;
+}
+
+i_bs_get_binary_imm2.execute(Fail, Live, Sz, Flags, Dst) {
ErlBinMatchBuffer *_mb;
Eterm _result;
- $GC_TEST(0, heap_bin_size(ERL_ONHEAP_BIN_LIMIT), $Live);
- _mb = ms_matchbuffer($Ms);
+ $GC_TEST_PRESERVE(heap_bin_size(ERL_ONHEAP_BIN_LIMIT),
+ $Live, context);
+ _mb = ms_matchbuffer(context);
LIGHT_SWAPOUT;
_result = erts_bs_get_binary_2(c_p, $Sz, $Flags, _mb);
LIGHT_SWAPIN;
@@ -145,8 +220,17 @@ i_bs_get_binary_imm2(Fail, Ms, Live, Sz, Flags, Dst) {
$Dst = _result;
}
}
+i_bs_get_float2 := i_bs_get_float2.fetch.execute;
+
+i_bs_get_float2.head() {
+ Eterm context;
+}
+
+i_bs_get_float2.fetch(Ctx) {
+ context = $Ctx;
+}
-i_bs_get_float2(Fail, Ms, Live, Sz, Flags, Dst) {
+i_bs_get_float2.execute(Fail, Live, Sz, Flags, Dst) {
ErlBinMatchBuffer *_mb;
Eterm _result;
Sint _size;
@@ -155,8 +239,8 @@ i_bs_get_float2(Fail, Ms, Live, Sz, Flags, Dst) {
$FAIL($Fail);
}
_size *= (($Flags) >> 3);
- $GC_TEST(0, FLOAT_SIZE_OBJECT, $Live);
- _mb = ms_matchbuffer($Ms);
+ $GC_TEST_PRESERVE(FLOAT_SIZE_OBJECT, $Live, context);
+ _mb = ms_matchbuffer(context);
LIGHT_SWAPOUT;
_result = erts_bs_get_float_2(c_p, _size, ($Flags), _mb);
LIGHT_SWAPIN;
@@ -169,13 +253,24 @@ i_bs_get_float2(Fail, Ms, Live, Sz, Flags, Dst) {
}
}
-i_bs_skip_bits2(Fail, Ms, Bits, Unit) {
+i_bs_skip_bits2 := i_bs_skip_bits2.fetch.execute;
+
+i_bs_skip_bits2.head() {
+ Eterm context, bits;
+}
+
+i_bs_skip_bits2.fetch(Ctx, Bits) {
+ context = $Ctx;
+ bits = $Bits;
+}
+
+i_bs_skip_bits2.execute(Fail, Unit) {
ErlBinMatchBuffer *_mb;
size_t new_offset;
Uint _size;
- _mb = ms_matchbuffer($Ms);
- $BS_GET_FIELD_SIZE($Bits, $Unit, $FAIL($Fail), _size);
+ _mb = ms_matchbuffer(context);
+ $BS_GET_FIELD_SIZE(bits, $Unit, $FAIL($Fail), _size);
new_offset = _mb->offset + _size;
if (new_offset <= _mb->size) {
_mb->offset = new_offset;
@@ -184,16 +279,6 @@ i_bs_skip_bits2(Fail, Ms, Bits, Unit) {
}
}
-i_bs_skip_bits_all2(Fail, Ms, Unit) {
- ErlBinMatchBuffer *_mb;
- _mb = ms_matchbuffer($Ms);
- if (((_mb->size - _mb->offset) % $Unit) == 0) {
- _mb->offset = _mb->size;
- } else {
- $FAIL($Fail);
- }
-}
-
i_bs_skip_bits_imm2(Fail, Ms, Bits) {
ErlBinMatchBuffer *_mb;
size_t new_offset;
@@ -207,15 +292,25 @@ i_bs_skip_bits_imm2(Fail, Ms, Bits) {
}
i_new_bs_put_binary(Fail, Sz, Flags, Src) {
+ Eterm sz = $Sz;
Sint _size;
- $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size);
+ $BS_GET_UNCHECKED_FIELD_SIZE(sz, (($Flags) >> 3), $BADARG($Fail), _size);
if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2(($Src), _size))) {
$BADARG($Fail);
}
}
+i_new_bs_put_binary_all := i_new_bs_put_binary_all.fetch.execute;
+
+i_new_bs_put_binary_all.head() {
+ Eterm src;
+}
+
+i_new_bs_put_binary_all.fetch(Src) {
+ src = $Src;
+}
-i_new_bs_put_binary_all(Fail, Src, Unit) {
- if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2(($Src), ($Unit)))) {
+i_new_bs_put_binary_all.execute(Fail, Unit) {
+ if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2(src, ($Unit)))) {
$BADARG($Fail);
}
}
@@ -227,9 +322,11 @@ i_new_bs_put_binary_imm(Fail, Sz, Src) {
}
i_new_bs_put_float(Fail, Sz, Flags, Src) {
+ Eterm sz = $Sz;
+ Eterm flags = $Flags;
Sint _size;
- $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size);
- if (!erts_new_bs_put_float(c_p, ($Src), _size, ($Flags))) {
+ $BS_GET_UNCHECKED_FIELD_SIZE(sz, (flags >> 3), $BADARG($Fail), _size);
+ if (!erts_new_bs_put_float(c_p, ($Src), _size, flags)) {
$BADARG($Fail);
}
}
@@ -241,15 +338,27 @@ i_new_bs_put_float_imm(Fail, Sz, Flags, Src) {
}
i_new_bs_put_integer(Fail, Sz, Flags, Src) {
- Sint _size;
- $BS_GET_UNCHECKED_FIELD_SIZE($Sz, (($Flags) >> 3), $BADARG($Fail), _size);
- if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), _size, ($Flags)))) {
- $BADARG($Fail);
- }
+ Eterm sz = $Sz;
+ Eterm flags = $Flags;
+ Sint _size;
+ $BS_GET_UNCHECKED_FIELD_SIZE(sz, (flags >> 3), $BADARG($Fail), _size);
+ if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), _size, flags))) {
+ $BADARG($Fail);
+ }
+}
+
+i_new_bs_put_integer_imm := i_new_bs_put_integer_imm.fetch.execute;
+
+i_new_bs_put_integer_imm.head() {
+ Eterm src;
}
-i_new_bs_put_integer_imm(Fail, Sz, Flags, Src) {
- if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(($Src), ($Sz), ($Flags)))) {
+i_new_bs_put_integer_imm.fetch(Src) {
+ src = $Src;
+}
+
+i_new_bs_put_integer_imm.execute(Fail, Sz, Flags) {
+ if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3(src, ($Sz), ($Flags)))) {
$BADARG($Fail);
}
}
@@ -809,9 +918,19 @@ bs_test_unit8(Fail, Ctx) {
}
}
-i_bs_get_integer_8(Ctx, Fail, Dst) {
+i_bs_get_integer_8 := i_bs_get_integer_8.fetch.execute;
+
+i_bs_get_integer_8.head() {
+ Eterm context;
+}
+
+i_bs_get_integer_8.fetch(Ctx) {
+ context = $Ctx;
+}
+
+i_bs_get_integer_8.execute(Fail, Dst) {
Eterm _result;
- ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx);
+ ErlBinMatchBuffer* _mb = ms_matchbuffer(context);
if (_mb->size - _mb->offset < 8) {
$FAIL($Fail);
@@ -825,9 +944,19 @@ i_bs_get_integer_8(Ctx, Fail, Dst) {
$Dst = _result;
}
-i_bs_get_integer_16(Ctx, Fail, Dst) {
+i_bs_get_integer_16 := i_bs_get_integer_16.fetch.execute;
+
+i_bs_get_integer_16.head() {
+ Eterm context;
+}
+
+i_bs_get_integer_16.fetch(Ctx) {
+ context = $Ctx;
+}
+
+i_bs_get_integer_16.execute(Fail, Dst) {
Eterm _result;
- ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx);
+ ErlBinMatchBuffer* _mb = ms_matchbuffer(context);
if (_mb->size - _mb->offset < 16) {
$FAIL($Fail);
@@ -842,9 +971,19 @@ i_bs_get_integer_16(Ctx, Fail, Dst) {
}
%if ARCH_64
-i_bs_get_integer_32(Ctx, Fail, Dst) {
+i_bs_get_integer_32 := i_bs_get_integer_32.fetch.execute;
+
+i_bs_get_integer_32.head() {
+ Eterm context;
+}
+
+i_bs_get_integer_32.fetch(Ctx) {
+ context = $Ctx;
+}
+
+i_bs_get_integer_32.execute(Fail, Dst) {
Uint32 _integer;
- ErlBinMatchBuffer* _mb = ms_matchbuffer($Ctx);
+ ErlBinMatchBuffer* _mb = ms_matchbuffer(context);
if (_mb->size - _mb->offset < 32) {
$FAIL($Fail);
@@ -894,15 +1033,23 @@ bs_get_integer.execute(Fail, Flags, Dst) {
$Dst = result;
}
-i_bs_get_integer(Fail, Live, FlagsAndUnit, Ms, Sz, Dst) {
+i_bs_get_integer := i_bs_get_integer.fetch.execute;
+
+i_bs_get_integer.head() {
+ Eterm context;
+}
+
+i_bs_get_integer.fetch(Ctx) {
+ context = $Ctx;
+}
+
+i_bs_get_integer.execute(Fail, Live, FlagsAndUnit, Sz, Dst) {
Uint flags;
Uint size;
- Eterm ms;
ErlBinMatchBuffer* mb;
Eterm result;
flags = $FlagsAndUnit;
- ms = $Ms;
$BS_GET_FIELD_SIZE($Sz, (flags >> 3), $FAIL($Fail), size);
if (size >= SMALL_BITS) {
Uint wordsneeded;
@@ -913,15 +1060,15 @@ i_bs_get_integer(Fail, Live, FlagsAndUnit, Ms, Sz, Dst) {
* Remember to re-acquire the matchbuffer after gc.
*/
- mb = ms_matchbuffer(ms);
+ mb = ms_matchbuffer(context);
if (mb->size - mb->offset < size) {
$FAIL($Fail);
}
wordsneeded = 1+WSIZE(NBYTES((Uint) size));
- $GC_TEST_PRESERVE(wordsneeded, $Live, ms);
+ $GC_TEST_PRESERVE(wordsneeded, $Live, context);
$REFRESH_GEN_DEST();
}
- mb = ms_matchbuffer(ms);
+ mb = ms_matchbuffer(context);
LIGHT_SWAPOUT;
result = erts_bs_get_integer_2(c_p, size, flags, mb);
LIGHT_SWAPIN;
@@ -932,9 +1079,19 @@ i_bs_get_integer(Fail, Live, FlagsAndUnit, Ms, Sz, Dst) {
$Dst = result;
}
-i_bs_get_utf8(Ctx, Fail, Dst) {
+i_bs_get_utf8 := i_bs_get_utf8.fetch.execute;
+
+i_bs_get_utf8.head() {
+ Eterm context;
+}
+
+i_bs_get_utf8.fetch(Ctx) {
+ context = $Ctx;
+}
+
+i_bs_get_utf8.execute(Fail, Dst) {
Eterm result;
- ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx);
+ ErlBinMatchBuffer* mb = ms_matchbuffer(context);
if (mb->size - mb->offset < 8) {
$FAIL($Fail);
@@ -957,8 +1114,18 @@ i_bs_get_utf8(Ctx, Fail, Dst) {
$Dst = result;
}
-i_bs_get_utf16(Ctx, Fail, Flags, Dst) {
- ErlBinMatchBuffer* mb = ms_matchbuffer($Ctx);
+i_bs_get_utf16 := i_bs_get_utf16.fetch.execute;
+
+i_bs_get_utf16.head() {
+ Eterm context;
+}
+
+i_bs_get_utf16.fetch(Ctx) {
+ context = $Ctx;
+}
+
+i_bs_get_utf16.execute(Fail, Flags, Dst) {
+ ErlBinMatchBuffer* mb = ms_matchbuffer(context);
Eterm result = erts_bs_get_utf16(mb, $Flags);
if (is_non_value(result)) {
@@ -1055,13 +1222,20 @@ i_bs_restore2(Src, Slot) {
_ms->mb.offset = _ms->save_offset[$Slot];
}
-bs_get_tail(Src, Dst, Live) {
- ErlBinMatchBuffer* mb;
- Uint size, offs;
- ErlSubBin* sb;
+bs_get_tail := bs_get_tail.fetch.execute;
+
+bs_get_tail.head() {
Eterm context;
+}
+bs_get_tail.fetch(Src) {
context = $Src;
+}
+
+bs_get_tail.execute(Dst, Live) {
+ ErlBinMatchBuffer* mb;
+ Uint size, offs;
+ ErlSubBin* sb;
ASSERT(header_is_bin_matchstate(*boxed_val(context)));
@@ -1090,11 +1264,20 @@ bs_get_tail(Src, Dst, Live) {
%if ARCH_64
-i_bs_start_match3_gp(Src, Live, Fail, Dst, Pos) {
- Eterm context, header;
- Uint position, live;
+i_bs_start_match3_gp := i_bs_start_match3_gp.fetch.execute;
+i_bs_start_match3_gp.head() {
+ Eterm context;
+}
+
+i_bs_start_match3_gp.fetch(Src) {
context = $Src;
+}
+
+i_bs_start_match3_gp.execute(Live, Fail, Dst, Pos) {
+ Eterm header;
+ Uint position, live;
+
live = $Live;
if (!is_boxed(context)) {
@@ -1139,11 +1322,20 @@ i_bs_start_match3_gp(Src, Live, Fail, Dst, Pos) {
$Pos = make_small(position);
}
-i_bs_start_match3(Src, Live, Fail, Dst) {
- Eterm context, header;
- Uint live;
+i_bs_start_match3 := i_bs_start_match3.fetch.execute;
+
+i_bs_start_match3.head() {
+ Eterm context;
+}
+i_bs_start_match3.fetch(Src) {
context = $Src;
+}
+
+i_bs_start_match3.execute(Live, Fail, Dst) {
+ Eterm header;
+ Uint live;
+
live = $Live;
if (!is_boxed(context)) {
@@ -1213,12 +1405,19 @@ i_bs_get_position(Ctx, Dst) {
# match at a position beyond 16MB.
#
-bs_set_position(Ctx, Pos) {
+bs_set_position := bs_set_position.fetch.execute;
+
+bs_set_position.head() {
Eterm context, position;
- ErlBinMatchState *ms;
+}
+bs_set_position.fetch(Ctx, Pos) {
context = $Ctx;
position = $Pos;
+}
+
+bs_set_position.execute() {
+ ErlBinMatchState *ms;
ASSERT(header_is_bin_matchstate(*boxed_val(context)));
ms = (ErlBinMatchState*)boxed_val(context);
@@ -1231,12 +1430,19 @@ bs_set_position(Ctx, Pos) {
}
}
-bs_get_position(Ctx, Dst, Live) {
- ErlBinMatchState *ms;
+bs_get_position := bs_get_position.fetch.execute;
+
+bs_get_position.head() {
Eterm context;
- Uint position;
+}
+bs_get_position.fetch(Ctx) {
context = $Ctx;
+}
+
+bs_get_position.execute(Dst, Live) {
+ ErlBinMatchState *ms;
+ Uint position;
ASSERT(header_is_bin_matchstate(*boxed_val(context)));
ms = (ErlBinMatchState*)boxed_val(context);
@@ -1261,11 +1467,20 @@ bs_get_position(Ctx, Dst, Live) {
}
}
-i_bs_start_match3(Src, Live, Fail, Dst) {
- Eterm context, header;
- Uint live;
+i_bs_start_match3 := i_bs_start_match3.fetch.execute;
+
+i_bs_start_match3.head() {
+ Eterm context;
+}
+i_bs_start_match3.fetch(Src) {
context = $Src;
+}
+
+i_bs_start_match3.execute(Live, Fail, Dst) {
+ Eterm header;
+ Uint live;
+
live = $Live;
if (!is_boxed(context)) {
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index e7bd046e18..db74b06cc5 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -854,7 +854,7 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap, Uint
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) objp;
- erts_refc_inc(&etp->node->refc, 2);
+ erts_ref_node_entry(etp->node, 2, make_boxed(htop));
}
L_off_heap_node_container_common:
{
@@ -1660,7 +1660,7 @@ Uint copy_shared_perform(Eterm obj, Uint size, erts_shcopy_t *info,
case EXTERNAL_REF_SUBTAG:
{
ExternalThing *etp = (ExternalThing *) ptr;
- erts_refc_inc(&etp->node->refc, 2);
+ erts_ref_node_entry(etp->node, 2, make_boxed(hp));
}
off_heap_node_container_common:
{
@@ -1866,7 +1866,7 @@ Eterm copy_shallow(Eterm* ERTS_RESTRICT ptr, Uint sz, Eterm** hpp,
case EXTERNAL_REF_SUBTAG:
{
ExternalThing* etp = (ExternalThing *) (tp-1);
- erts_refc_inc(&etp->node->refc, 2);
+ erts_ref_node_entry(etp->node, 2, make_boxed(hp-1));
}
off_heap_common:
{
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 15642e1669..b50c8273b1 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -50,19 +50,26 @@
#define DIST_CTL_DEFAULT_SIZE 64
/* Turn this on to get printouts of all distribution messages
- * which go on the line
+ * which go on the line. Enabling this may make some testcases
+ * fail. Especially the broken dist testcases in distribution_SUITE.
*/
#if 0
#define ERTS_DIST_MSG_DBG
+FILE *dbg_file;
#endif
#if 0
+/* Enable this to print the dist debug messages to a file instead */
+#define ERTS_DIST_MSG_DBG_FILE "/tmp/dist_dbg.%d"
+#endif
+#if 0
+/* Enable this to print the raw bytes sent and received */
#define ERTS_RAW_DIST_MSG_DBG
#endif
#if defined(ERTS_DIST_MSG_DBG) || defined(ERTS_RAW_DIST_MSG_DBG)
static void bw(byte *buf, ErlDrvSizeT sz)
{
- bin_write(ERTS_PRINT_STDERR, NULL, buf, sz);
+ bin_write(ERTS_PRINT_FILE, dbg_file, buf, sz);
}
#endif
@@ -70,39 +77,93 @@ static void bw(byte *buf, ErlDrvSizeT sz)
static void
dist_msg_dbg(ErtsDistExternal *edep, char *what, byte *buf, int sz)
{
- ErtsHeapFactory factory;
- DeclareTmpHeapNoproc(ctl_default,DIST_CTL_DEFAULT_SIZE);
- Eterm* ctl = ctl_default;
- byte *extp = edep->extp;
+ byte *extp = edep->data->extp;
Eterm msg;
Sint ctl_len;
- Sint size = ctl_len = erts_decode_dist_ext_size(edep);
+ Sint size = ctl_len = erts_decode_dist_ext_size(edep, 0);
if (size < 0) {
- erts_fprintf(stderr,
+ erts_fprintf(dbg_file,
"DIST MSG DEBUG: erts_decode_dist_ext_size(%s) failed:\n",
what);
bw(buf, sz);
}
else {
- ErlHeapFragment *mbuf = new_message_buffer(size);
- erts_factory_static_init(&factory, ctl, ctl_len, &mbuf->off_heap);
- msg = erts_decode_dist_ext(&factory, edep);
+ ErtsHeapFactory factory;
+ ErtsMessage *mbuf = erts_factory_message_create(&factory, NULL, 0, ctl_len);
+ /* Set mbuf msg to NIL as erts_factory_undo will fail otherwise */
+ ERL_MESSAGE_TERM(mbuf) = NIL;
+ msg = erts_decode_dist_ext(&factory, edep, 0);
if (is_value(msg))
- erts_fprintf(stderr, " %s: %T\n", what, msg);
+ erts_fprintf(dbg_file, " %s: %.80T\n", what, msg);
else {
- erts_fprintf(stderr,
+ erts_fprintf(dbg_file,
"DIST MSG DEBUG: erts_decode_dist_ext(%s) failed:\n",
what);
bw(buf, sz);
}
- free_message_buffer(mbuf);
- edep->extp = extp;
+ erts_factory_undo(&factory);
+ edep->data->extp = extp;
}
}
+static char *erts_dop_to_string(enum dop dop) {
+ if (dop == DOP_LINK)
+ return "LINK";
+ if (dop == DOP_SEND)
+ return "SEND";
+ if (dop == DOP_EXIT)
+ return "EXIT";
+ if (dop == DOP_UNLINK)
+ return "UNLINK";
+ if (dop == DOP_REG_SEND)
+ return "REG_SEND";
+ if (dop == DOP_GROUP_LEADER)
+ return "GROUP_LEADER";
+ if (dop == DOP_EXIT2)
+ return "EXIT2";
+ if (dop == DOP_SEND_TT)
+ return "SEND_TT";
+ if (dop == DOP_EXIT_TT)
+ return "EXIT_TT";
+ if (dop == DOP_REG_SEND_TT)
+ return "REG_SEND_TT";
+ if (dop == DOP_EXIT2_TT)
+ return "EXIT2_TT";
+ if (dop == DOP_MONITOR_P)
+ return "MONITOR_P";
+ if (dop == DOP_DEMONITOR_P)
+ return "DEMONITOR_P";
+ if (dop == DOP_MONITOR_P_EXIT)
+ return "MONITOR_P_EXIT";
+ if (dop == DOP_SEND_SENDER)
+ return "SEND_SENDER";
+ if (dop == DOP_SEND_SENDER_TT)
+ return "SEND_SENDER_TT";
+ if (dop == DOP_PAYLOAD_EXIT)
+ return "PAYLOAD_EXIT";
+ if (dop == DOP_PAYLOAD_EXIT_TT)
+ return "PAYLOAD_EXIT_TT";
+ if (dop == DOP_PAYLOAD_EXIT2)
+ return "PAYLOAD_EXIT2";
+ if (dop == DOP_PAYLOAD_EXIT2_TT)
+ return "PAYLOAD_EXIT2_TT";
+ if (dop == DOP_PAYLOAD_MONITOR_P_EXIT)
+ return "PAYLOAD_MONITOR_P_EXIT";
+ ASSERT(0);
+ return "UNKNOWN";
+}
+
#endif
+#if defined(VALGRIND)
+#include <valgrind/valgrind.h>
+#include <valgrind/memcheck.h>
+# define PURIFY_MSG(msg) \
+ VALGRIND_PRINTF("%s, line %d: %s", __FILE__, __LINE__, msg)
+#else
+# define PURIFY_MSG(msg)
+#endif
int erts_is_alive; /* System must be blocked on change */
int erts_dist_buf_busy_limit;
@@ -116,12 +177,17 @@ static Export *dist_ctrl_put_data_trap;
/* forward declarations */
-static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy);
+static void erts_schedule_dist_command(Port *, DistEntry *);
+static int dsig_send_exit(ErtsDSigSendContext *ctx, Eterm ctl, Eterm msg);
+static int dsig_send_ctl(ErtsDSigSendContext *ctx, Eterm ctl);
static void send_nodes_mon_msgs(Process *, Eterm, Eterm, Eterm, Eterm);
static void init_nodes_monitors(void);
static Sint abort_connection(DistEntry* dep, Uint32 conn_id);
static ErtsDistOutputBuf* clear_de_out_queues(DistEntry*);
static void free_de_out_queues(DistEntry*, ErtsDistOutputBuf*);
+int erts_dist_seq_tree_foreach_delete_yielding(DistSeqNode **root,
+ void **vyspp,
+ Sint limit);
static erts_atomic_t no_caches;
static erts_atomic_t no_nodes;
@@ -142,7 +208,6 @@ delete_cache(ErtsAtomCache *cache)
}
}
-
static void
create_cache(DistEntry *dep)
{
@@ -185,32 +250,36 @@ get_suspended_on_de(DistEntry *dep, erts_aint32_t unset_qflgs)
}
}
-#define ERTS_MON_LNK_FIRE_LIMIT 100
+#define ERTS_MON_LNK_FIRE_REDS 40
-static void monitor_connection_down(ErtsMonitor *mon, void *unused)
+static int monitor_connection_down(ErtsMonitor *mon, void *unused, Sint reds)
{
if (erts_monitor_is_origin(mon))
erts_proc_sig_send_demonitor(mon);
else
erts_proc_sig_send_monitor_down(mon, am_noconnection);
+ return ERTS_MON_LNK_FIRE_REDS;
}
-static void link_connection_down(ErtsLink *lnk, void *vdist)
+static int link_connection_down(ErtsLink *lnk, void *vdist, Sint reds)
{
erts_proc_sig_send_link_exit(NULL, THE_NON_VALUE, lnk,
am_noconnection, NIL);
+ return ERTS_MON_LNK_FIRE_REDS;
}
typedef enum {
ERTS_CML_CLEANUP_STATE_LINKS,
ERTS_CML_CLEANUP_STATE_MONITORS,
ERTS_CML_CLEANUP_STATE_ONAME_MONITORS,
+ ERTS_CML_CLEANUP_STATE_SEQUENCES,
ERTS_CML_CLEANUP_STATE_NODE_MONITORS
-} ErtsConMonLnkCleaupState;
+} ErtsConMonLnkSeqCleanupState;
typedef struct {
- ErtsConMonLnkCleaupState state;
+ ErtsConMonLnkSeqCleanupState state;
ErtsMonLnkDist *dist;
+ DistSeqNode *seq;
void *yield_state;
int trigger_node_monitors;
Eterm nodename;
@@ -218,49 +287,58 @@ typedef struct {
Eterm reason;
ErlOffHeap oh;
Eterm heap[1];
-} ErtsConMonLnkCleanup;
+} ErtsConMonLnkSeqCleanup;
static void
-con_monitor_link_cleanup(void *vcmlcp)
+con_monitor_link_seq_cleanup(void *vcmlcp)
{
- ErtsConMonLnkCleanup *cmlcp = vcmlcp;
+ ErtsConMonLnkSeqCleanup *cmlcp = vcmlcp;
ErtsMonLnkDist *dist = cmlcp->dist;
ErtsSchedulerData *esdp;
- int yield;
+ int reds = CONTEXT_REDS;
switch (cmlcp->state) {
case ERTS_CML_CLEANUP_STATE_LINKS:
- yield = erts_link_list_foreach_delete_yielding(&dist->links,
- link_connection_down,
- NULL, &cmlcp->yield_state,
- ERTS_MON_LNK_FIRE_LIMIT);
- if (yield)
+ reds = erts_link_list_foreach_delete_yielding(&dist->links,
+ link_connection_down,
+ NULL, &cmlcp->yield_state,
+ reds);
+ if (reds <= 0)
break;
ASSERT(!cmlcp->yield_state);
cmlcp->state = ERTS_CML_CLEANUP_STATE_MONITORS;
case ERTS_CML_CLEANUP_STATE_MONITORS:
- yield = erts_monitor_list_foreach_delete_yielding(&dist->monitors,
- monitor_connection_down,
- NULL, &cmlcp->yield_state,
- ERTS_MON_LNK_FIRE_LIMIT);
- if (yield)
+ reds = erts_monitor_list_foreach_delete_yielding(&dist->monitors,
+ monitor_connection_down,
+ NULL, &cmlcp->yield_state,
+ reds);
+ if (reds <= 0)
break;
ASSERT(!cmlcp->yield_state);
cmlcp->state = ERTS_CML_CLEANUP_STATE_ONAME_MONITORS;
case ERTS_CML_CLEANUP_STATE_ONAME_MONITORS:
- yield = erts_monitor_tree_foreach_delete_yielding(&dist->orig_name_monitors,
- monitor_connection_down,
- NULL, &cmlcp->yield_state,
- ERTS_MON_LNK_FIRE_LIMIT/2);
- if (yield)
+ reds = erts_monitor_tree_foreach_delete_yielding(&dist->orig_name_monitors,
+ monitor_connection_down,
+ NULL, &cmlcp->yield_state,
+ reds);
+ if (reds <= 0)
break;
cmlcp->dist = NULL;
erts_mon_link_dist_dec_refc(dist);
ASSERT(!cmlcp->yield_state);
+ cmlcp->state = ERTS_CML_CLEANUP_STATE_SEQUENCES;
+ case ERTS_CML_CLEANUP_STATE_SEQUENCES:
+ reds = erts_dist_seq_tree_foreach_delete_yielding(&cmlcp->seq,
+ &cmlcp->yield_state,
+ reds);
+ if (reds <= 0)
+ break;
+
+ ASSERT(!cmlcp->yield_state);
cmlcp->state = ERTS_CML_CLEANUP_STATE_NODE_MONITORS;
case ERTS_CML_CLEANUP_STATE_NODE_MONITORS:
if (cmlcp->trigger_node_monitors) {
@@ -280,22 +358,23 @@ con_monitor_link_cleanup(void *vcmlcp)
esdp = erts_get_scheduler_data();
ASSERT(esdp && esdp->type == ERTS_SCHED_NORMAL);
erts_schedule_misc_aux_work((int) esdp->no,
- con_monitor_link_cleanup,
+ con_monitor_link_seq_cleanup,
(void *) cmlcp);
}
static void
-schedule_con_monitor_link_cleanup(ErtsMonLnkDist *dist,
- Eterm nodename,
- Eterm visability,
- Eterm reason)
+schedule_con_monitor_link_seq_cleanup(ErtsMonLnkDist *dist,
+ DistSeqNode *seq,
+ Eterm nodename,
+ Eterm visability,
+ Eterm reason)
{
- if (dist || is_value(nodename)) {
+ if (dist || is_value(nodename) || seq) {
ErtsSchedulerData *esdp;
- ErtsConMonLnkCleanup *cmlcp;
+ ErtsConMonLnkSeqCleanup *cmlcp;
Uint rsz, size;
- size = sizeof(ErtsConMonLnkCleanup);
+ size = sizeof(ErtsConMonLnkSeqCleanup);
if (is_non_value(reason) || is_immed(reason)) {
rsz = 0;
@@ -322,6 +401,8 @@ schedule_con_monitor_link_cleanup(ErtsMonLnkDist *dist,
erts_mtx_unlock(&dist->mtx);
}
+ cmlcp->seq = seq;
+
cmlcp->trigger_node_monitors = is_value(nodename);
cmlcp->nodename = nodename;
cmlcp->visability = visability;
@@ -335,13 +416,13 @@ schedule_con_monitor_link_cleanup(ErtsMonLnkDist *dist,
esdp = erts_get_scheduler_data();
ASSERT(esdp && esdp->type == ERTS_SCHED_NORMAL);
erts_schedule_misc_aux_work((int) esdp->no,
- con_monitor_link_cleanup,
+ con_monitor_link_seq_cleanup,
(void *) cmlcp);
}
}
/*
-** A full node name constists of a "n@h"
+** A full node name consists of a "n@h"
**
** n must be a valid node name: string of ([a-z][A-Z][0-9]_-)+
**
@@ -558,6 +639,7 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason)
}
else { /* Call from distribution controller (port/process) */
ErtsMonLnkDist *mld;
+ DistSeqNode *sequences;
ErtsAtomCache *cache;
ErtsProcList *suspendees;
ErtsDistOutputBuf *obuf;
@@ -587,6 +669,9 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason)
mld = dep->mld;
dep->mld = NULL;
+ sequences = dep->sequences;
+ dep->sequences = NULL;
+
nodename = dep->sysname;
flags = dep->flags;
@@ -610,14 +695,15 @@ int erts_do_net_exits(DistEntry *dep, Eterm reason)
erts_de_rwunlock(dep);
- schedule_con_monitor_link_cleanup(mld,
- nodename,
- (flags & DFLAG_PUBLISHED
- ? am_visible
- : am_hidden),
- (reason == am_normal
- ? am_connection_closed
- : reason));
+ schedule_con_monitor_link_seq_cleanup(mld,
+ sequences,
+ nodename,
+ (flags & DFLAG_PUBLISHED
+ ? am_visible
+ : am_hidden),
+ (reason == am_normal
+ ? am_connection_closed
+ : reason));
erts_resume_processes(suspendees);
@@ -651,6 +737,16 @@ void init_dist(void)
{
init_nodes_monitors();
+#ifdef ERTS_DIST_MSG_DBG_FILE
+ {
+ char buff[255];
+ sprintf(buff, ERTS_DIST_MSG_DBG_FILE, getpid());
+ dbg_file = fopen(buff,"w+");
+ }
+#elif defined (ERTS_DIST_MSG_DBG)
+ dbg_file = stderr;
+#endif
+
nodedown.reason = NIL;
nodedown.bp = NULL;
@@ -674,21 +770,79 @@ void init_dist(void)
}
}
-#define ErtsDistOutputBuf2Binary(OB) \
- ((Binary *) (((char *) (OB)) - offsetof(Binary, orig_bytes)))
+#define ErtsDistOutputBuf2Binary(OB) OB->bin
+
+#ifdef DEBUG
+
+struct obuf_list;
+struct obuf_list {
+ erts_refc_t refc;
+ struct obuf_list *next;
+ struct obuf_list *prev;
+};
+#define obuf_list_size sizeof(struct obuf_list)
+static struct obuf_list *erts_obuf_list = NULL;
+static erts_mtx_t erts_obuf_list_mtx;
+
+static void
+insert_obuf(struct obuf_list *obuf, erts_aint_t initial) {
+ erts_mtx_lock(&erts_obuf_list_mtx);
+ obuf->next = erts_obuf_list;
+ obuf->prev = NULL;
+ erts_refc_init(&obuf->refc, initial);
+ if (erts_obuf_list)
+ erts_obuf_list->prev = obuf;
+ erts_obuf_list = obuf;
+ erts_mtx_unlock(&erts_obuf_list_mtx);
+}
+
+static void
+remove_obuf(struct obuf_list *obuf) {
+ if (erts_refc_dectest(&obuf->refc, 0) == 0) {
+ erts_mtx_lock(&erts_obuf_list_mtx);
+ if (obuf->prev) {
+ obuf->prev->next = obuf->next;
+ } else {
+ erts_obuf_list = obuf->next;
+ }
+ if (obuf->next) obuf->next->prev = obuf->prev;
+ erts_mtx_unlock(&erts_obuf_list_mtx);
+ }
+}
+
+void check_obuf(void);
+void check_obuf(void) {
+ erts_mtx_lock(&erts_obuf_list_mtx);
+ ERTS_ASSERT(erts_obuf_list == NULL);
+ erts_mtx_unlock(&erts_obuf_list_mtx);
+}
+#else
+#define insert_obuf(...)
+#define remove_obuf(...)
+#define obuf_list_size 0
+#endif
static ERTS_INLINE ErtsDistOutputBuf *
-alloc_dist_obuf(Uint size)
+alloc_dist_obuf(Uint size, Uint headers)
{
+ int i;
ErtsDistOutputBuf *obuf;
- Uint obuf_size = sizeof(ErtsDistOutputBuf)+sizeof(byte)*(size-1);
+ Uint obuf_size = sizeof(ErtsDistOutputBuf)*(headers) +
+ sizeof(byte)*size + obuf_list_size;
Binary *bin = erts_bin_drv_alloc(obuf_size);
- obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0];
+ size += obuf_list_size;
+ obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[size];
+ erts_refc_add(&bin->intern.refc, headers - 1, 1);
+ for (i = 0; i < headers; i++) {
+ obuf[i].bin = bin;
+ obuf[i].extp = (byte *)&bin->orig_bytes[0] + obuf_list_size;
#ifdef DEBUG
- obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN;
- obuf->alloc_endp = obuf->data + size;
- ASSERT(bin == ErtsDistOutputBuf2Binary(obuf));
+ obuf[i].dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN;
+ obuf[i].alloc_endp = obuf->extp + size;
+ ASSERT(bin == ErtsDistOutputBuf2Binary(obuf));
#endif
+ }
+ insert_obuf((struct obuf_list*)&bin->orig_bytes[0], headers);
return obuf;
}
@@ -697,14 +851,17 @@ free_dist_obuf(ErtsDistOutputBuf *obuf)
{
Binary *bin = ErtsDistOutputBuf2Binary(obuf);
ASSERT(obuf->dbg_pattern == ERTS_DIST_OUTPUT_BUF_DBG_PATTERN);
- erts_bin_release(bin);
+ remove_obuf((struct obuf_list*)&bin->orig_bytes[0]);
+ if (erts_refc_dectest(&bin->intern.refc, 0) == 0) {
+ erts_bin_free(bin);
+ }
}
static ERTS_INLINE Sint
size_obuf(ErtsDistOutputBuf *obuf)
{
- Binary *bin = ErtsDistOutputBuf2Binary(obuf);
- return bin->orig_size;
+ return sizeof(ErtsDistOutputBuf) + (obuf->ext_endp - obuf->ext_start)
+ + (obuf->hdr_endp - obuf->hdrp);
}
static ErtsDistOutputBuf* clear_de_out_queues(DistEntry* dep)
@@ -758,18 +915,20 @@ static void free_de_out_queues(DistEntry* dep, ErtsDistOutputBuf *obuf)
int erts_dsend_context_dtor(Binary* ctx_bin)
{
- ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin);
- switch (ctx->dss.phase) {
+ ErtsDSigSendContext* ctx = ERTS_MAGIC_BIN_DATA(ctx_bin);
+ switch (ctx->phase) {
case ERTS_DSIG_SEND_PHASE_MSG_SIZE:
- DESTROY_SAVED_WSTACK(&ctx->dss.u.sc.wstack);
+ DESTROY_SAVED_WSTACK(&ctx->u.sc.wstack);
break;
case ERTS_DSIG_SEND_PHASE_MSG_ENCODE:
- DESTROY_SAVED_WSTACK(&ctx->dss.u.ec.wstack);
+ DESTROY_SAVED_WSTACK(&ctx->u.ec.wstack);
break;
default:;
}
- if (ctx->dss.phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->dss.obuf) {
- free_dist_obuf(ctx->dss.obuf);
+ if (ctx->phase >= ERTS_DSIG_SEND_PHASE_ALLOC && ctx->obuf) {
+ int i;
+ for (i = 0; i < ctx->fragments; i++)
+ free_dist_obuf(&ctx->obuf[i]);
}
if (ctx->deref_dep)
erts_deref_dist_entry(ctx->dep);
@@ -777,10 +936,10 @@ int erts_dsend_context_dtor(Binary* ctx_bin)
return 1;
}
-Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx)
+Eterm erts_dsend_export_trap_context(Process* p, ErtsDSigSendContext* ctx)
{
struct exported_ctx {
- ErtsSendContext ctx;
+ ErtsDSigSendContext ctx;
ErtsAtomCacheMap acm;
};
Binary* ctx_bin = erts_create_magic_binary(sizeof(struct exported_ctx),
@@ -788,12 +947,12 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx)
struct exported_ctx* dst = ERTS_MAGIC_BIN_DATA(ctx_bin);
Eterm* hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
- sys_memcpy(&dst->ctx, ctx, sizeof(ErtsSendContext));
- ASSERT(ctx->dss.ctl == make_tuple(ctx->ctl_heap));
- dst->ctx.dss.ctl = make_tuple(dst->ctx.ctl_heap);
- if (ctx->dss.acmp) {
- sys_memcpy(&dst->acm, ctx->dss.acmp, sizeof(ErtsAtomCacheMap));
- dst->ctx.dss.acmp = &dst->acm;
+ sys_memcpy(&dst->ctx, ctx, sizeof(ErtsDSigSendContext));
+ ASSERT(ctx->ctl == make_tuple(ctx->ctl_heap));
+ dst->ctx.ctl = make_tuple(dst->ctx.ctl_heap);
+ if (ctx->acmp) {
+ sys_memcpy(&dst->acm, ctx->acmp, sizeof(ErtsAtomCacheMap));
+ dst->ctx.acmp = &dst->acm;
}
return erts_mk_magic_ref(&hp, &MSO(p), ctx_bin);
}
@@ -814,71 +973,58 @@ Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx)
** Send a DOP_LINK link message
*/
int
-erts_dsig_send_link(ErtsDSigData *dsdp, Eterm local, Eterm remote)
+erts_dsig_send_link(ErtsDSigSendContext *ctx, Eterm local, Eterm remote)
{
- DeclareTmpHeapNoproc(ctl_heap,4);
- Eterm ctl = TUPLE3(&ctl_heap[0], make_small(DOP_LINK), local, remote);
- int res;
- UseTmpHeapNoproc(4);
-
- res = dsig_send_ctl(dsdp, ctl, 0);
- UnUseTmpHeapNoproc(4);
- return res;
+ Eterm ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_LINK), local, remote);
+ return dsig_send_ctl(ctx, ctl);
}
int
-erts_dsig_send_unlink(ErtsDSigData *dsdp, Eterm local, Eterm remote)
+erts_dsig_send_unlink(ErtsDSigSendContext *ctx, Eterm local, Eterm remote)
{
- DeclareTmpHeapNoproc(ctl_heap,4);
- Eterm ctl = TUPLE3(&ctl_heap[0], make_small(DOP_UNLINK), local, remote);
- int res;
-
- UseTmpHeapNoproc(4);
- res = dsig_send_ctl(dsdp, ctl, 0);
- UnUseTmpHeapNoproc(4);
- return res;
+ Eterm ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_UNLINK), local, remote);
+ return dsig_send_ctl(ctx, ctl);
}
/* A local process that's being monitored by a remote one exits. We send:
{DOP_MONITOR_P_EXIT, Local pid or name, Remote pid, ref, reason} */
int
-erts_dsig_send_m_exit(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
- Eterm ref, Eterm reason)
+erts_dsig_send_m_exit(ErtsDSigSendContext *ctx, Eterm watcher, Eterm watched,
+ Eterm ref, Eterm reason)
{
- Eterm ctl;
- DeclareTmpHeapNoproc(ctl_heap,6);
- int res;
+ Eterm ctl, msg;
- if (~dsdp->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
+ if (~ctx->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
/*
* Receiver does not support DOP_MONITOR_P_EXIT (see dsig_send_monitor)
*/
return ERTS_DSIG_SEND_OK;
}
- UseTmpHeapNoproc(6);
-
- ctl = TUPLE5(&ctl_heap[0], make_small(DOP_MONITOR_P_EXIT),
- watched, watcher, ref, reason);
+ if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) {
+ ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_PAYLOAD_MONITOR_P_EXIT),
+ watched, watcher, ref);
+ msg = reason;
+ } else {
+ ctl = TUPLE5(&ctx->ctl_heap[0], make_small(DOP_MONITOR_P_EXIT),
+ watched, watcher, ref, reason);
+ msg = THE_NON_VALUE;
+ }
- res = dsig_send_ctl(dsdp, ctl, 1);
- UnUseTmpHeapNoproc(6);
- return res;
+ return dsig_send_exit(ctx, ctl, msg);
}
/* We want to monitor a process (named or unnamed) on another node, we send:
{DOP_MONITOR_P, Local pid, Remote pid or name, Ref}, which is exactly what's
needed on the other side... */
int
-erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
+erts_dsig_send_monitor(ErtsDSigSendContext *ctx, Eterm watcher, Eterm watched,
Eterm ref)
{
Eterm ctl;
- DeclareTmpHeapNoproc(ctl_heap,5);
- int res;
- if (~dsdp->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
+ if (~ctx->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
/*
* Receiver does not support DOP_MONITOR_P.
* Just avoid sending it and by doing that reduce this monitor
@@ -888,48 +1034,40 @@ erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched,
return ERTS_DSIG_SEND_OK;
}
- UseTmpHeapNoproc(5);
- ctl = TUPLE4(&ctl_heap[0],
+ ctl = TUPLE4(&ctx->ctl_heap[0],
make_small(DOP_MONITOR_P),
watcher, watched, ref);
- res = dsig_send_ctl(dsdp, ctl, 0);
- UnUseTmpHeapNoproc(5);
- return res;
+ return dsig_send_ctl(ctx, ctl);
}
/* A local process monitoring a remote one wants to stop monitoring, either
because of a demonitor bif call or because the local process died. We send
{DOP_DEMONITOR_P, Local pid, Remote pid or name, ref} */
int
-erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher,
- Eterm watched, Eterm ref, int force)
+erts_dsig_send_demonitor(ErtsDSigSendContext *ctx, Eterm watcher,
+ Eterm watched, Eterm ref)
{
Eterm ctl;
- DeclareTmpHeapNoproc(ctl_heap,5);
- int res;
- if (~dsdp->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
+ if (~ctx->flags & (DFLAG_DIST_MONITOR | DFLAG_DIST_MONITOR_NAME)) {
/*
* Receiver does not support DOP_DEMONITOR_P (see dsig_send_monitor)
*/
return ERTS_DSIG_SEND_OK;
}
- UseTmpHeapNoproc(5);
- ctl = TUPLE4(&ctl_heap[0],
+ ctl = TUPLE4(&ctx->ctl_heap[0],
make_small(DOP_DEMONITOR_P),
watcher, watched, ref);
- res = dsig_send_ctl(dsdp, ctl, force);
- UnUseTmpHeapNoproc(5);
- return res;
+ return dsig_send_ctl(ctx, ctl);
}
-static int can_send_seqtrace_token(ErtsSendContext* ctx, Eterm token) {
+static int can_send_seqtrace_token(ErtsDSigSendContext* ctx, Eterm token) {
Eterm label;
- if (ctx->dsd.flags & DFLAG_BIG_SEQTRACE_LABELS) {
+ if (ctx->flags & DFLAG_BIG_SEQTRACE_LABELS) {
/* The other end is capable of handling arbitrary seq_trace labels. */
return 1;
}
@@ -945,11 +1083,11 @@ static int can_send_seqtrace_token(ErtsSendContext* ctx, Eterm token) {
}
int
-erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
+erts_dsig_send_msg(ErtsDSigSendContext* ctx, Eterm remote, Eterm message)
{
Eterm ctl;
Eterm token = NIL;
- Process *sender = ctx->dsd.proc;
+ Process *sender = ctx->c_p;
int res;
#ifdef USE_VM_PROBES
Sint tok_label = 0;
@@ -970,7 +1108,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
*node_name = *sender_name = *receiver_name = '\0';
if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) {
erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)),
- "%T", ctx->dsd.dep->sysname);
+ "%T", ctx->dep->sysname);
erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)),
"%T", sender->common.id);
erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)),
@@ -990,7 +1128,7 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
send_token = (token != NIL && can_send_seqtrace_token(ctx, token));
- if (ctx->dsd.flags & DFLAG_SEND_SENDER) {
+ if (ctx->flags & DFLAG_SEND_SENDER) {
dist_op = make_small(send_token ?
DOP_SEND_SENDER_TT :
DOP_SEND_SENDER);
@@ -1013,21 +1151,18 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx)
msize, tok_label, tok_lastcnt, tok_serial);
DTRACE7(message_send_remote, sender_name, node_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
- ctx->dss.ctl = ctl;
- ctx->dss.msg = message;
- ctx->dss.force_busy = 0;
- res = erts_dsig_send(&ctx->dsd, &ctx->dss);
+ ctx->ctl = ctl;
+ ctx->msg = message;
+ res = erts_dsig_send(ctx);
return res;
}
int
-erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
- ErtsSendContext* ctx)
+erts_dsig_send_reg_msg(ErtsDSigSendContext* ctx, Eterm remote_name, Eterm message)
{
Eterm ctl;
Eterm token = NIL;
- Process *sender = ctx->dsd.proc;
- int res;
+ Process *sender = ctx->c_p;
#ifdef USE_VM_PROBES
Sint tok_label = 0;
Sint tok_lastcnt = 0;
@@ -1047,7 +1182,7 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
*node_name = *sender_name = *receiver_name = '\0';
if (DTRACE_ENABLED(message_send) || DTRACE_ENABLED(message_send_remote)) {
erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)),
- "%T", ctx->dsd.dep->sysname);
+ "%T", ctx->dep->sysname);
erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)),
"%T", sender->common.id);
erts_snprintf(receiver_name, sizeof(DTRACE_CHARBUF_NAME(receiver_name)),
@@ -1072,23 +1207,19 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message,
msize, tok_label, tok_lastcnt, tok_serial);
DTRACE7(message_send_remote, sender_name, node_name, receiver_name,
msize, tok_label, tok_lastcnt, tok_serial);
- ctx->dss.ctl = ctl;
- ctx->dss.msg = message;
- ctx->dss.force_busy = 0;
- res = erts_dsig_send(&ctx->dsd, &ctx->dss);
- return res;
+ ctx->ctl = ctl;
+ ctx->msg = message;
+ return erts_dsig_send(ctx);
}
/* local has died, deliver the exit signal to remote */
int
-erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
+erts_dsig_send_exit_tt(ErtsDSigSendContext *ctx, Eterm local, Eterm remote,
Eterm reason, Eterm token)
{
- Eterm ctl;
- DeclareTmpHeapNoproc(ctl_heap,6);
- int res;
+ Eterm ctl, msg = THE_NON_VALUE;
#ifdef USE_VM_PROBES
- Process *sender = dsdp->proc;
+ Process *sender = ctx->c_p;
Sint tok_label = 0;
Sint tok_lastcnt = 0;
Sint tok_serial = 0;
@@ -1098,20 +1229,29 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
DTRACE_CHARBUF(reason_str, 128);
#endif
- UseTmpHeapNoproc(6);
+ if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD)
+ msg = reason;
+
if (have_seqtrace(token)) {
- seq_trace_update_send(dsdp->proc);
+ seq_trace_update_send(ctx->c_p);
seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local);
- ctl = TUPLE5(&ctl_heap[0],
- make_small(DOP_EXIT_TT), local, remote, token, reason);
+ if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) {
+ ctl = TUPLE4(&ctx->ctl_heap[0],
+ make_small(DOP_PAYLOAD_EXIT_TT), local, remote, token);
+ } else
+ ctl = TUPLE5(&ctx->ctl_heap[0],
+ make_small(DOP_EXIT_TT), local, remote, token, reason);
} else {
- ctl = TUPLE4(&ctl_heap[0], make_small(DOP_EXIT), local, remote, reason);
+ if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD)
+ ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_PAYLOAD_EXIT), local, remote);
+ else
+ ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_EXIT), local, remote, reason);
}
#ifdef USE_VM_PROBES
*node_name = *sender_name = *remote_name = '\0';
if (DTRACE_ENABLED(process_exit_signal_remote)) {
erts_snprintf(node_name, sizeof(DTRACE_CHARBUF_NAME(node_name)),
- "%T", dsdp->dep->sysname);
+ "%T", ctx->dep->sysname);
erts_snprintf(sender_name, sizeof(DTRACE_CHARBUF_NAME(sender_name)),
"%T", sender->common.id);
erts_snprintf(remote_name, sizeof(DTRACE_CHARBUF_NAME(remote_name)),
@@ -1127,73 +1267,171 @@ erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote,
#endif
DTRACE7(process_exit_signal_remote, sender_name, node_name,
remote_name, reason_str, tok_label, tok_lastcnt, tok_serial);
- /* forced, i.e ignore busy */
- res = dsig_send_ctl(dsdp, ctl, 1);
- UnUseTmpHeapNoproc(6);
- return res;
+ return dsig_send_exit(ctx, ctl, msg);
}
int
-erts_dsig_send_exit(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason)
+erts_dsig_send_exit(ErtsDSigSendContext *ctx, Eterm local, Eterm remote, Eterm reason)
{
- DeclareTmpHeapNoproc(ctl_heap,5);
- int res;
- Eterm ctl;
+ Eterm ctl, msg = ctx->dep->flags & DFLAG_EXIT_PAYLOAD ? reason : THE_NON_VALUE;
- UseTmpHeapNoproc(5);
- ctl = TUPLE4(&ctl_heap[0],
- make_small(DOP_EXIT), local, remote, reason);
- /* forced, i.e ignore busy */
- res = dsig_send_ctl(dsdp, ctl, 1);
- UnUseTmpHeapNoproc(5);
- return res;
+ if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) {
+ ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_PAYLOAD_EXIT), local, remote);
+ msg = reason;
+ } else {
+ ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_EXIT), local, remote, reason);
+ msg = THE_NON_VALUE;
+ }
+ return dsig_send_exit(ctx, ctl, msg);
}
int
-erts_dsig_send_exit2(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason)
+erts_dsig_send_exit2(ErtsDSigSendContext *ctx, Eterm local, Eterm remote, Eterm reason)
{
- DeclareTmpHeapNoproc(ctl_heap,5);
- int res;
- Eterm ctl;
+ Eterm ctl, msg;
- UseTmpHeapNoproc(5);
- ctl = TUPLE4(&ctl_heap[0],
- make_small(DOP_EXIT2), local, remote, reason);
+ if (ctx->dep->flags & DFLAG_EXIT_PAYLOAD) {
+ ctl = TUPLE3(&ctx->ctl_heap[0],
+ make_small(DOP_PAYLOAD_EXIT2), local, remote);
+ msg = reason;
+ } else {
+ ctl = TUPLE4(&ctx->ctl_heap[0],
+ make_small(DOP_EXIT2), local, remote, reason);
+ msg = THE_NON_VALUE;
+ }
- res = dsig_send_ctl(dsdp, ctl, 0);
- UnUseTmpHeapNoproc(5);
- return res;
+ return dsig_send_exit(ctx, ctl, msg);
}
int
-erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote)
+erts_dsig_send_group_leader(ErtsDSigSendContext *ctx, Eterm leader, Eterm remote)
{
- DeclareTmpHeapNoproc(ctl_heap,4);
- int res;
Eterm ctl;
- UseTmpHeapNoproc(4);
- ctl = TUPLE3(&ctl_heap[0],
+ ctl = TUPLE3(&ctx->ctl_heap[0],
make_small(DOP_GROUP_LEADER), leader, remote);
- res = dsig_send_ctl(dsdp, ctl, 0);
- UnUseTmpHeapNoproc(4);
- return res;
+ return dsig_send_ctl(ctx, ctl);
}
-#if defined(PURIFY)
-# define PURIFY_MSG(msg) \
- purify_printf("%s, line %d: %s", __FILE__, __LINE__, msg)
-#elif defined(VALGRIND)
-#include <valgrind/valgrind.h>
-#include <valgrind/memcheck.h>
+struct dist_sequences {
+ ErlHeapFragment hfrag;
+ struct dist_sequences *parent;
+ struct dist_sequences *left;
+ struct dist_sequences *right;
+ char is_red;
-# define PURIFY_MSG(msg) \
- VALGRIND_PRINTF("%s, line %d: %s", __FILE__, __LINE__, msg)
-#else
-# define PURIFY_MSG(msg)
-#endif
+ Uint64 seq_id;
+ int cnt;
+ Sint ctl_len;
+};
+
+#define ERTS_RBT_PREFIX dist_seq
+#define ERTS_RBT_T DistSeqNode
+#define ERTS_RBT_KEY_T Uint
+#define ERTS_RBT_FLAGS_T int
+#define ERTS_RBT_INIT_EMPTY_TNODE(T) \
+ do { \
+ (T)->parent = NULL; \
+ (T)->left = NULL; \
+ (T)->right = NULL; \
+ (T)->is_red = 0; \
+ } while(0)
+#define ERTS_RBT_IS_RED(T) ((T)->is_red)
+#define ERTS_RBT_SET_RED(T) ((T)->is_red = 1)
+#define ERTS_RBT_IS_BLACK(T) (!ERTS_RBT_IS_RED(T))
+#define ERTS_RBT_SET_BLACK(T) ((T)->is_red = 0)
+#define ERTS_RBT_GET_FLAGS(T) ((T)->is_red)
+#define ERTS_RBT_SET_FLAGS(T, F) ((T)->is_red = F)
+#define ERTS_RBT_GET_PARENT(T) ((T)->parent)
+#define ERTS_RBT_SET_PARENT(T, P) ((T)->parent = P)
+#define ERTS_RBT_GET_RIGHT(T) ((T)->right)
+#define ERTS_RBT_SET_RIGHT(T, R) ((T)->right = (R))
+#define ERTS_RBT_GET_LEFT(T) ((T)->left)
+#define ERTS_RBT_SET_LEFT(T, L) ((T)->left = (L))
+#define ERTS_RBT_GET_KEY(T) ((T)->seq_id)
+#define ERTS_RBT_IS_LT(KX, KY) (KX < KY)
+#define ERTS_RBT_IS_EQ(KX, KY) (KX == KY)
+#define ERTS_RBT_WANT_DELETE
+#define ERTS_RBT_WANT_LOOKUP_INSERT
+#define ERTS_RBT_WANT_LOOKUP
+#define ERTS_RBT_WANT_FOREACH
+#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
+
+#include "erl_rbtree.h"
+
+struct erts_dist_seq_tree_foreach_iter_arg {
+ int (*func)(ErtsDistExternal *, void *, Sint);
+ void *arg;
+};
+
+static int
+erts_dist_seq_tree_foreach_iter(DistSeqNode *seq, void *arg, Sint reds)
+{
+ struct erts_dist_seq_tree_foreach_iter_arg *state = arg;
+ return state->func(erts_get_dist_ext(&seq->hfrag), state->arg, reds);
+}
+
+void
+erts_dist_seq_tree_foreach(DistEntry *dep, int (*func)(ErtsDistExternal *, void *, Sint), void *arg)
+{
+ struct erts_dist_seq_tree_foreach_iter_arg state;
+ state.func = func;
+ state.arg = arg;
+ dist_seq_rbt_foreach(dep->sequences, erts_dist_seq_tree_foreach_iter, &state);
+}
+
+static int dist_seq_cleanup(DistSeqNode *seq, void *unused, Sint reds)
+{
+ erts_free_dist_ext_copy(erts_get_dist_ext(&seq->hfrag));
+ free_message_buffer(&seq->hfrag);
+ return 1;
+}
+
+typedef struct {
+ DistSeqNode *root;
+ dist_seq_rbt_yield_state_t rbt_ystate;
+} DistSeqNodeYieldState;
+
+int
+erts_dist_seq_tree_foreach_delete_yielding(DistSeqNode **root,
+ void **vyspp,
+ Sint limit)
+{
+ DistSeqNodeYieldState ys = {*root, ERTS_RBT_YIELD_STAT_INITER};
+ DistSeqNodeYieldState *ysp;
+ int res;
+
+ ysp = (DistSeqNodeYieldState *) *vyspp;
+ if (!ysp) {
+ *root = NULL;
+ ysp = &ys;
+ }
+ res = dist_seq_rbt_foreach_destroy_yielding(&ysp->root,
+ dist_seq_cleanup,
+ NULL,
+ &ysp->rbt_ystate,
+ limit);
+ if (res > 0) {
+ if (ysp != &ys)
+ erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp);
+ *vyspp = NULL;
+ }
+ else {
+
+ if (ysp == &ys) {
+ ysp = erts_alloc(ERTS_ALC_T_SEQ_YIELD_STATE,
+ sizeof(DistSeqNodeYieldState));
+ sys_memcpy((void *) ysp, (void *) &ys,
+ sizeof(DistSeqNodeYieldState));
+ }
+
+ *vyspp = (void *) ysp;
+ }
+
+ return res;
+}
/*
** Input from distribution port.
@@ -1210,10 +1448,13 @@ int erts_net_message(Port *prt,
Uint32 conn_id,
byte *hbuf,
ErlDrvSizeT hlen,
+ Binary *bin,
byte *buf,
ErlDrvSizeT len)
{
- ErtsDistExternal ede;
+ ErtsDistExternal ede, *edep = &ede;
+ ErtsDistExternalData ede_data;
+ ErlHeapFragment *ede_hfrag = NULL;
Sint ctl_len;
Eterm arg;
Eterm from, to;
@@ -1225,10 +1466,8 @@ int erts_net_message(Port *prt,
DeclareTmpHeapNoproc(ctl_default,DIST_CTL_DEFAULT_SIZE);
Eterm* ctl = ctl_default;
ErtsHeapFactory factory;
- Eterm* hp;
Sint type;
Eterm token;
- Eterm token_size;
Uint tuple_arity;
int res;
#ifdef ERTS_DIST_MSG_DBG
@@ -1254,69 +1493,182 @@ int erts_net_message(Port *prt,
}
#ifdef ERTS_RAW_DIST_MSG_DBG
- erts_fprintf(stderr, "<< ");
+ erts_fprintf(dbg_file, "RECV: ");
bw(buf, len);
#endif
- res = erts_prepare_dist_ext(&ede, buf, len, dep, conn_id, dep->cache);
+ ede.data = &ede_data;
+
+ res = erts_prepare_dist_ext(&ede, buf, len, bin, dep, conn_id, dep->cache);
switch (res) {
case ERTS_PREP_DIST_EXT_CLOSED:
return 0; /* Connection not alive; ignore signal... */
case ERTS_PREP_DIST_EXT_FAILED:
#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n");
+ erts_fprintf(dbg_file, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n");
bw(buf, orig_len);
#endif
goto data_error;
case ERTS_PREP_DIST_EXT_SUCCESS:
- ctl_len = erts_decode_dist_ext_size(&ede);
+ ctl_len = erts_decode_dist_ext_size(&ede, 1);
if (ctl_len < 0) {
#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n");
+ erts_fprintf(dbg_file, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n");
bw(buf, orig_len);
#endif
PURIFY_MSG("data error");
goto data_error;
}
+
+ /* A non-fragmented message */
+ if (!ede.data->seq_id) {
+ if (ctl_len > DIST_CTL_DEFAULT_SIZE) {
+ ctl = erts_alloc(ERTS_ALC_T_DCTRL_BUF, ctl_len * sizeof(Eterm));
+ }
+
+ erts_factory_tmp_init(&factory, ctl, ctl_len, ERTS_ALC_T_DCTRL_BUF);
+ break;
+ } else {
+ DistSeqNode *seq;
+ Uint sz = erts_dist_ext_size(&ede);
+ Uint used_sz = ctl_len * sizeof(Eterm);
+
+ /* We calculate the size of the heap fragment to be allocated.
+ The used_size part has to be larger that the ctl data and the
+ DistSeqNode. */
+ if (used_sz + (sizeof(ErlHeapFragment) - sizeof(Eterm)) < sizeof(DistSeqNode))
+ used_sz = sizeof(DistSeqNode) - (sizeof(ErlHeapFragment) - sizeof(Eterm));
+
+ seq = (DistSeqNode *)new_message_buffer((sz + used_sz) / sizeof(Eterm));
+ seq->hfrag.used_size = used_sz / sizeof(Eterm);
+
+ seq->ctl_len = ctl_len;
+ seq->seq_id = ede.data->seq_id;
+ seq->cnt = ede.data->frag_id;
+ if (dist_seq_rbt_lookup_insert(&dep->sequences, seq) != NULL) {
+ free_message_buffer(&seq->hfrag);
+ goto data_error;
+ }
+
+ erts_make_dist_ext_copy(&ede, erts_get_dist_ext(&seq->hfrag));
+
+ if (ede.data->frag_id > 1) {
+ seq->cnt--;
+ return 0;
+ }
+ }
+
+ /* fall through, the first fragment in the sequence was the last fragment */
+ case ERTS_PREP_DIST_EXT_FRAG_CONT: {
+ DistSeqNode *seq = dist_seq_rbt_lookup(dep->sequences, ede.data->seq_id);
+
+ if (!seq)
+ goto data_error;
+
+ /* If we did a fall-though we already did this */
+ if (res == ERTS_PREP_DIST_EXT_FRAG_CONT)
+ erts_dist_ext_frag(&ede_data, erts_get_dist_ext(&seq->hfrag));
+
+ /* Verify that the fragments have arrived in the correct order */
+ if (seq->cnt != ede.data->frag_id)
+ goto data_error;
+
+ seq->cnt--;
+
+ /* Check if this was the last fragment */
+ if (ede.data->frag_id > 1)
+ return 0;
+
+ /* Last fragment arrived, time to dispatch the signal */
+ dist_seq_rbt_delete(&dep->sequences, seq);
+ ctl_len = seq->ctl_len;
+
+ /* Now that we no longer need the DistSeqNode we re-use the heapfragment
+ to decode the ctl msg into. We don't need the ctl message to be in
+ the heapfragment, but we decode into the heapfragment speculatively
+ in case there is a trace token that we need. */
+ erts_factory_heap_frag_init(&factory, &seq->hfrag);
+ edep = erts_get_dist_ext(&seq->hfrag);
+ ede_hfrag = &seq->hfrag;
+
+ /* If the sequence consisted of more than 1 fragment we create one large
+ binary out of all of the fragments. This because erts_decode_ext
+ cannot handle a segmented buffer.
+ TODO: Move this copy to as late as possible, preferably in in the
+ erts_decode_dist_ext in the receiving process.
+ */
+ if (edep->data->frag_id > 1) {
+ Uint sz = 0;
+ Binary *bin;
+ int i;
+ byte *ep;
+
+ for (i = 0; i < edep->data->frag_id; i++)
+ sz += edep->data[i].ext_endp - edep->data[i].extp;
+
+ bin = erts_bin_nrml_alloc(sz);
+ ep = (byte*)bin->orig_bytes;
+
+ for (i = 0; i < edep->data->frag_id; i++) {
+ sys_memcpy(ep, edep->data[i].extp, edep->data[i].ext_endp - edep->data[i].extp);
+ ep += edep->data[i].ext_endp - edep->data[i].extp;
+ erts_bin_release(edep->data[i].binp);
+ edep->data[i].binp = NULL;
+ edep->data[i].extp = NULL;
+ edep->data[i].ext_endp = NULL;
+ }
+
+ edep->data->frag_id = 1;
+ edep->data->extp = (byte*)bin->orig_bytes;
+ edep->data->ext_endp = ep;
+ edep->data->binp = bin;
+ }
+
break;
+ }
default:
ERTS_INTERNAL_ERROR("Unexpected result from erts_prepare_dist_ext()");
break;
}
- if (ctl_len > DIST_CTL_DEFAULT_SIZE) {
- ctl = erts_alloc(ERTS_ALC_T_DCTRL_BUF, ctl_len * sizeof(Eterm));
- }
- hp = ctl;
-
- erts_factory_tmp_init(&factory, ctl, ctl_len, ERTS_ALC_T_DCTRL_BUF);
- arg = erts_decode_dist_ext(&factory, &ede);
+ arg = erts_decode_dist_ext(&factory, edep, 1);
if (is_non_value(arg)) {
#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext(CTL) failed:\n");
+ erts_fprintf(dbg_file, "DIST MSG DEBUG: erts_decode_dist_ext(CTL) failed:\n");
bw(buf, orig_len);
#endif
PURIFY_MSG("data error");
goto decode_error;
}
-#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, "<< CTL: %T\n", arg);
-#endif
+ /* Fill the unused part of the hfrag with a bignum header */
+ if (ede_hfrag && ede_hfrag->mem + ede_hfrag->used_size > factory.hp) {
+ Uint slot = factory.hp - ede_hfrag->mem;
+ ede_hfrag->mem[slot] = make_pos_bignum_header(ede_hfrag->used_size - slot - 1);
+ }
if (is_not_tuple(arg) ||
(tuple = tuple_val(arg), (tuple_arity = arityval(*tuple)) < 1) ||
is_not_small(tuple[1])) {
+#ifdef ERTS_DIST_MSG_DBG
+ if (is_tuple(arg) && arityval(*tuple) > 1)
+ erts_fprintf(dbg_file, "RECV: CTL: %s: %.80T\n",
+ erts_dop_to_string(unsigned_val(tuple[1])), arg);
+#endif
goto invalid_message;
}
- token_size = 0;
+#ifdef ERTS_DIST_MSG_DBG
+ erts_fprintf(dbg_file, "RECV: CTL: %s: %.80T\n",
+ erts_dop_to_string(unsigned_val(tuple[1])), arg);
+#endif
+
token = NIL;
switch (type = unsigned_val(tuple[1])) {
case DOP_LINK: {
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
int code;
if (tuple_arity != 3) {
@@ -1354,9 +1706,9 @@ int erts_net_message(Port *prt,
erts_link_release_both(ldp);
}
- code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0);
+ code = erts_dsig_prepare(&ctx, dep, NULL, 0, ERTS_DSP_NO_LOCK, 1, 1, 0);
if (code == ERTS_DSIG_PREP_CONNECTED) {
- code = erts_dsig_send_exit(&dsd, to, from, am_noproc);
+ code = erts_dsig_send_exit(&ctx, to, from, am_noproc);
ASSERT(code == ERTS_DSIG_SEND_OK);
}
@@ -1389,7 +1741,7 @@ int erts_net_message(Port *prt,
/* A remote process wants to monitor us, we get:
{DOP_MONITOR_P, Remote pid, local pid or name, ref} */
Eterm pid, name;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
int code;
if (tuple_arity != 4) {
@@ -1444,10 +1796,9 @@ int erts_net_message(Port *prt,
}
- code = erts_dsig_prepare(&dsd, dep, NULL, 0, ERTS_DSP_NO_LOCK, 0, 0);
+ code = erts_dsig_prepare(&ctx, dep, NULL, 0, ERTS_DSP_NO_LOCK, 1, 1, 0);
if (code == ERTS_DSIG_PREP_CONNECTED) {
- code = erts_dsig_send_m_exit(&dsd, watcher, watched, ref,
- am_noproc);
+ code = erts_dsig_send_m_exit(&ctx, watcher, watched, ref, am_noproc);
ASSERT(code == ERTS_DSIG_SEND_OK);
}
@@ -1506,7 +1857,6 @@ int erts_net_message(Port *prt,
goto invalid_message;
}
- token_size = size_object(tuple[5]);
/* Fall through ... */
case DOP_REG_SEND:
/* {DOP_REG_SEND, From, Cookie, ToName} -- Message */
@@ -1521,7 +1871,7 @@ int erts_net_message(Port *prt,
}
#ifdef ERTS_DIST_MSG_DBG
- dist_msg_dbg(&ede, "MSG", buf, orig_len);
+ dist_msg_dbg(edep, "MSG", buf, orig_len);
#endif
from = tuple[2];
@@ -1531,35 +1881,25 @@ int erts_net_message(Port *prt,
}
rp = erts_whereis_process(NULL, 0, to, 0, 0);
if (rp) {
- Uint xsize = (type == DOP_REG_SEND
- ? 0
- : ERTS_HEAP_FRAG_SIZE(token_size));
ErtsProcLocks locks = 0;
- ErtsDistExternal *ede_copy;
- ede_copy = erts_make_dist_ext_copy(&ede, xsize);
if (type == DOP_REG_SEND) {
token = NIL;
} else {
- ErlHeapFragment *heap_frag;
- ErlOffHeap *ohp;
- ASSERT(xsize);
- heap_frag = erts_dist_ext_trailer(ede_copy);
- ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size);
- hp = heap_frag->mem;
- ohp = &heap_frag->off_heap;
token = tuple[5];
- token = copy_struct(token, token_size, &hp, ohp);
}
- erts_queue_dist_message(rp, locks, ede_copy, token, from);
+ erts_queue_dist_message(rp, locks, edep, ede_hfrag, token, from);
+
if (locks)
erts_proc_unlock(rp, locks);
- }
+ } else if (ede_hfrag) {
+ erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag));
+ free_message_buffer(ede_hfrag);
+ }
break;
case DOP_SEND_SENDER_TT: {
- Uint xsize;
case DOP_SEND_TT:
if (tuple_arity != 4) {
@@ -1567,15 +1907,12 @@ int erts_net_message(Port *prt,
}
token = tuple[4];
- token_size = size_object(token);
- xsize = ERTS_HEAP_FRAG_SIZE(token_size);
goto send_common;
case DOP_SEND_SENDER:
case DOP_SEND:
token = NIL;
- xsize = 0;
if (tuple_arity != 3)
goto invalid_message;
@@ -1591,7 +1928,7 @@ int erts_net_message(Port *prt,
: tuple[2] == am_Empty);
#ifdef ERTS_DIST_MSG_DBG
- dist_msg_dbg(&ede, "MSG", buf, orig_len);
+ dist_msg_dbg(edep, "MSG", buf, orig_len);
#endif
to = tuple[3];
if (is_not_pid(to)) {
@@ -1600,39 +1937,38 @@ int erts_net_message(Port *prt,
rp = erts_proc_lookup(to);
if (rp) {
ErtsProcLocks locks = 0;
- ErtsDistExternal *ede_copy;
-
- ede_copy = erts_make_dist_ext_copy(&ede, xsize);
- if (is_not_nil(token)) {
- ErlHeapFragment *heap_frag;
- ErlOffHeap *ohp;
- ASSERT(xsize);
- heap_frag = erts_dist_ext_trailer(ede_copy);
- ERTS_INIT_HEAP_FRAG(heap_frag, token_size, token_size);
- hp = heap_frag->mem;
- ohp = &heap_frag->off_heap;
- token = copy_struct(token, token_size, &hp, ohp);
- }
- erts_queue_dist_message(rp, locks, ede_copy, token, am_Empty);
+ erts_queue_dist_message(rp, locks, edep, ede_hfrag, token, am_Empty);
if (locks)
erts_proc_unlock(rp, locks);
- }
+ } else if (ede_hfrag) {
+ erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag));
+ free_message_buffer(ede_hfrag);
+ }
break;
}
+ case DOP_PAYLOAD_MONITOR_P_EXIT:
case DOP_MONITOR_P_EXIT: {
+
/* We are monitoring a process on the remote node which dies, we get
{DOP_MONITOR_P_EXIT, Remote pid or name, Local pid, ref, reason} */
-
- if (tuple_arity != 5) {
- goto invalid_message;
- }
- watched = tuple[2]; /* remote proc or name which died */
- watcher = tuple[3];
+ watched = tuple[2]; /* remote proc or name which died */
+ watcher = tuple[3];
ref = tuple[4];
- reason = tuple[5];
+
+ if (type == DOP_PAYLOAD_MONITOR_P_EXIT) {
+ if (tuple_arity != 4) {
+ goto invalid_message;
+ }
+ reason = THE_NON_VALUE;
+ } else {
+ if (tuple_arity != 5) {
+ goto invalid_message;
+ }
+ reason = tuple[5];
+ }
if (is_not_ref(ref))
goto invalid_message;
@@ -1648,70 +1984,125 @@ int erts_net_message(Port *prt,
goto invalid_message;
}
- erts_proc_sig_send_dist_monitor_down(dep, ref, watched,
- watcher, reason);
+ if (!erts_proc_lookup(watcher)) break; /* Process not alive */
+
+ if (reason == THE_NON_VALUE) {
+
+#ifdef ERTS_DIST_MSG_DBG
+ dist_msg_dbg(edep, "MSG", buf, orig_len);
+#endif
+
+ }
+
+ erts_proc_sig_send_dist_monitor_down(
+ dep, ref, watched, watcher, edep, ede_hfrag, reason);
break;
}
+ case DOP_PAYLOAD_EXIT:
+ case DOP_PAYLOAD_EXIT_TT:
case DOP_EXIT_TT:
case DOP_EXIT: {
+
/* 'from', which 'to' is linked to, died */
+ from = tuple[2];
+ to = tuple[3];
+
if (type == DOP_EXIT) {
if (tuple_arity != 4) {
goto invalid_message;
}
-
- from = tuple[2];
- to = tuple[3];
- reason = tuple[4];
token = NIL;
- } else {
+ reason = tuple[4];
+ } else if (type == DOP_EXIT_TT){
if (tuple_arity != 5) {
goto invalid_message;
}
- from = tuple[2];
- to = tuple[3];
token = tuple[4];
reason = tuple[5];
- }
+ } else if (type == DOP_PAYLOAD_EXIT) {
+ if (tuple_arity != 3) {
+ goto invalid_message;
+ }
+ token = NIL;
+ reason = THE_NON_VALUE;
+ } else {
+ if (tuple_arity != 4) {
+ goto invalid_message;
+ }
+ token = tuple[4];
+ reason = THE_NON_VALUE;
+ }
if (is_not_external_pid(from)
|| dep != external_pid_dist_entry(from)
|| is_not_internal_pid(to)) {
goto invalid_message;
}
+ if (!erts_proc_lookup(to)) break; /* Process not alive */
+
+ if (reason == THE_NON_VALUE) {
+#ifdef ERTS_DIST_MSG_DBG
+ dist_msg_dbg(edep, "MSG", buf, orig_len);
+#endif
+ }
+
erts_proc_sig_send_dist_link_exit(dep,
- from, to,
+ from, to, edep, ede_hfrag,
reason, token);
break;
}
+ case DOP_PAYLOAD_EXIT2_TT:
+ case DOP_PAYLOAD_EXIT2:
case DOP_EXIT2_TT:
- case DOP_EXIT2:
+ case DOP_EXIT2: {
+
/* 'from' is send an exit signal to 'to' */
+ from = tuple[2];
+ to = tuple[3];
+
if (type == DOP_EXIT2) {
if (tuple_arity != 4) {
goto invalid_message;
}
- from = tuple[2];
- to = tuple[3];
reason = tuple[4];
token = NIL;
- } else {
+ } else if (type == DOP_EXIT2_TT) {
if (tuple_arity != 5) {
goto invalid_message;
}
- from = tuple[2];
- to = tuple[3];
token = tuple[4];
reason = tuple[5];
- }
- if (is_not_pid(from) || is_not_internal_pid(to)) {
+ } else if (type == DOP_PAYLOAD_EXIT2) {
+ if (tuple_arity != 3) {
+ goto invalid_message;
+ }
+ reason = THE_NON_VALUE;
+ token = NIL;
+ } else {
+ if (tuple_arity != 4) {
+ goto invalid_message;
+ }
+ reason = THE_NON_VALUE;
+ token = tuple[4];
+ }
+ if (is_not_pid(from)
+ || dep != external_pid_dist_entry(from)
+ || is_not_internal_pid(to)) {
goto invalid_message;
}
- erts_proc_sig_send_exit(NULL, from, to, reason, token, 0);
- break;
+ if (!erts_proc_lookup(to)) break; /* Process not alive */
+ if (reason == THE_NON_VALUE) {
+#ifdef ERTS_DIST_MSG_DBG
+ dist_msg_dbg(edep, "MSG", buf, orig_len);
+#endif
+ }
+
+ erts_proc_sig_send_dist_exit(dep, from, to, edep, ede_hfrag, reason, token);
+ break;
+ }
case DOP_GROUP_LEADER:
if (tuple_arity != 3) {
goto invalid_message;
@@ -1725,13 +2116,15 @@ int erts_net_message(Port *prt,
(void) erts_proc_sig_send_group_leader(NULL, to, from, NIL);
break;
- default:
+ default:
goto invalid_message;
}
- erts_factory_close(&factory);
- if (ctl != ctl_default) {
- erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl);
+ if (ede_hfrag == NULL) {
+ erts_factory_close(&factory);
+ if (ctl != ctl_default) {
+ erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl);
+ }
}
UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
ERTS_CHK_NO_PROC_LOCKS;
@@ -1744,9 +2137,14 @@ int erts_net_message(Port *prt,
}
decode_error:
PURIFY_MSG("data error");
- erts_factory_close(&factory);
- if (ctl != ctl_default) {
- erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl);
+ if (ede_hfrag == NULL) {
+ erts_factory_close(&factory);
+ if (ctl != ctl_default) {
+ erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl);
+ }
+ } else {
+ erts_free_dist_ext_copy(erts_get_dist_ext(ede_hfrag));
+ free_message_buffer(ede_hfrag);
}
data_error:
UnUseTmpHeapNoproc(DIST_CTL_DEFAULT_SIZE);
@@ -1755,18 +2153,21 @@ data_error:
return -1;
}
-static int dsig_send_ctl(ErtsDSigData* dsdp, Eterm ctl, int force_busy)
+static int dsig_send_exit(ErtsDSigSendContext *ctx, Eterm ctl, Eterm msg)
+{
+ ctx->ctl = ctl;
+ ctx->msg = msg;
+ return erts_dsig_send(ctx);
+}
+
+static int dsig_send_ctl(ErtsDSigSendContext *ctx, Eterm ctl)
{
- struct erts_dsig_send_context ctx;
int ret;
- ctx.ctl = ctl;
- ctx.msg = THE_NON_VALUE;
- ctx.force_busy = force_busy;
- ctx.phase = ERTS_DSIG_SEND_PHASE_INIT;
-#ifdef DEBUG
- ctx.reds = 1; /* provoke assert below (no reduction count without msg) */
-#endif
- ret = erts_dsig_send(dsdp, &ctx);
+ ctx->ctl = ctl;
+ ctx->msg = THE_NON_VALUE;
+ ctx->from = THE_NON_VALUE;
+ ctx->reds = 1; /* provoke assert below (no reduction count without msg) */
+ ret = erts_dsig_send(ctx);
ASSERT(ret != ERTS_DSIG_SEND_CONTINUE);
return ret;
}
@@ -1797,7 +2198,117 @@ notify_dist_data(Process *c_p, Eterm pid)
}
int
-erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
+erts_dsig_prepare(ErtsDSigSendContext *ctx,
+ DistEntry *dep,
+ Process *proc,
+ ErtsProcLocks proc_locks,
+ ErtsDSigPrepLock dspl,
+ int no_suspend,
+ int no_trap,
+ int connect)
+{
+ int res;
+
+ if (!erts_is_alive)
+ return ERTS_DSIG_PREP_NOT_ALIVE;
+ if (!dep) {
+ ASSERT(!connect);
+ return ERTS_DSIG_PREP_NOT_CONNECTED;
+ }
+
+#ifdef ERTS_ENABLE_LOCK_CHECK
+ if (connect) {
+ erts_proc_lc_might_unlock(proc, proc_locks);
+ }
+#endif
+
+retry:
+ erts_de_rlock(dep);
+
+ if (dep->state == ERTS_DE_STATE_CONNECTED) {
+ res = ERTS_DSIG_PREP_CONNECTED;
+ }
+ else if (dep->state == ERTS_DE_STATE_PENDING) {
+ res = ERTS_DSIG_PREP_PENDING;
+ }
+ else if (dep->state == ERTS_DE_STATE_EXITING) {
+ res = ERTS_DSIG_PREP_NOT_CONNECTED;
+ goto fail;
+ }
+ else if (connect) {
+ ASSERT(dep->state == ERTS_DE_STATE_IDLE);
+ erts_de_runlock(dep);
+ if (!erts_auto_connect(dep, proc, proc_locks)) {
+ return ERTS_DSIG_PREP_NOT_ALIVE;
+ }
+ goto retry;
+ }
+ else {
+ ASSERT(dep->state == ERTS_DE_STATE_IDLE);
+ res = ERTS_DSIG_PREP_NOT_CONNECTED;
+ goto fail;
+ }
+
+ if (no_suspend) {
+ if (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY) {
+ res = ERTS_DSIG_PREP_WOULD_SUSPEND;
+ goto fail;
+ }
+ }
+
+ ctx->c_p = proc;
+ ctx->dep = dep;
+ ctx->deref_dep = 0;
+ ctx->cid = dep->cid;
+ ctx->connection_id = dep->connection_id;
+ ctx->no_suspend = no_suspend;
+ ctx->no_trap = no_trap;
+ ctx->flags = dep->flags;
+ ctx->return_term = am_true;
+ ctx->phase = ERTS_DSIG_SEND_PHASE_INIT;
+ ctx->from = proc ? proc->common.id : am_undefined;
+ ctx->reds = no_trap ? 1 : (Sint) (ERTS_BIF_REDS_LEFT(proc) * TERM_TO_BINARY_LOOP_FACTOR);
+ if (dspl == ERTS_DSP_NO_LOCK)
+ erts_de_runlock(dep);
+ return res;
+
+ fail:
+ erts_de_runlock(dep);
+ return res;
+}
+
+static
+void erts_schedule_dist_command(Port *prt, DistEntry *dist_entry)
+{
+ DistEntry *dep;
+ Eterm id;
+
+ if (prt) {
+ ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
+ ASSERT((erts_atomic32_read_nob(&prt->state)
+ & ERTS_PORT_SFLGS_DEAD) == 0);
+
+ dep = (DistEntry*) erts_prtsd_get(prt, ERTS_PRTSD_DIST_ENTRY);
+ ASSERT(dep);
+ id = prt->common.id;
+ }
+ else {
+ ASSERT(dist_entry);
+ ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&dist_entry->rwmtx)
+ || erts_lc_rwmtx_is_rwlocked(&dist_entry->rwmtx));
+ ASSERT(is_internal_port(dist_entry->cid));
+
+ dep = dist_entry;
+ id = dep->cid;
+ }
+
+ if (!erts_atomic_xchg_mb(&dep->dist_cmd_scheduled, 1))
+ erts_port_task_schedule(id, &dep->dist_cmd, ERTS_PORT_TASK_DIST_CMD);
+}
+
+
+int
+erts_dsig_send(ErtsDSigSendContext *ctx)
{
int retval;
Sint initial_reds = ctx->reds;
@@ -1806,11 +2317,13 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
while (1) {
switch (ctx->phase) {
case ERTS_DSIG_SEND_PHASE_INIT:
- ctx->flags = dsdp->flags;
- ctx->c_p = dsdp->proc;
+ ctx->flags = ctx->flags;
+ ctx->c_p = ctx->c_p;
- if (!ctx->c_p || dsdp->no_suspend)
- ctx->force_busy = 1;
+ if (!ctx->c_p) {
+ ctx->no_trap = 1;
+ ctx->no_suspend = 1;
+ }
ERTS_LC_ASSERT(!ctx->c_p
|| (ERTS_PROC_LOCK_MAIN
@@ -1829,9 +2342,11 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
}
#ifdef ERTS_DIST_MSG_DBG
- erts_fprintf(stderr, ">> CTL: %T\n", ctx->ctl);
+ erts_fprintf(dbg_file, "SEND: CTL: %s: %.80T\n",
+ erts_dop_to_string(unsigned_val(tuple_val(ctx->ctl)[1])),
+ ctx->ctl);
if (is_value(ctx->msg))
- erts_fprintf(stderr, " MSG: %T\n", ctx->msg);
+ erts_fprintf(dbg_file, " MSG: %.160T\n", ctx->msg);
#endif
ctx->data_size = ctx->max_finalize_prepend;
@@ -1848,25 +2363,45 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_SIZE;
case ERTS_DSIG_SEND_PHASE_MSG_SIZE:
- if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) {
- retval = ERTS_DSIG_SEND_CONTINUE;
- goto done;
- }
+ if (!ctx->no_trap) {
+ if (erts_encode_dist_ext_size_int(ctx->msg, ctx, &ctx->data_size)) {
+ retval = ERTS_DSIG_SEND_CONTINUE;
+ goto done;
+ }
+ } else {
+ erts_encode_dist_ext_size(ctx->msg, ctx->flags, ctx->acmp, &ctx->data_size);
+ }
ctx->phase = ERTS_DSIG_SEND_PHASE_ALLOC;
case ERTS_DSIG_SEND_PHASE_ALLOC:
erts_finalize_atom_cache_map(ctx->acmp, ctx->flags);
- ctx->dhdr_ext_size = erts_encode_ext_dist_header_size(ctx->acmp);
- ctx->data_size += ctx->dhdr_ext_size;
+ if (ctx->flags & DFLAG_FRAGMENTS && is_value(ctx->msg) && is_not_immed(ctx->msg)) {
+ /* Calculate the max number of fragments that are needed */
+ ASSERT(is_pid(ctx->from) &&
+ "from has to be a pid because it is used as sequence id");
+ ctx->fragments = ctx->data_size / ERTS_DIST_FRAGMENT_SIZE + 1;
+ } else
+ ctx->fragments = 1;
+
+ ctx->dhdr_ext_size = erts_encode_ext_dist_header_size(ctx->acmp, ctx->fragments);
- ctx->obuf = alloc_dist_obuf(ctx->data_size);
- ctx->obuf->ext_endp = &ctx->obuf->data[0] + ctx->max_finalize_prepend + ctx->dhdr_ext_size;
+ ctx->obuf = alloc_dist_obuf(
+ ctx->dhdr_ext_size + ctx->data_size +
+ (ctx->fragments-1) * ERTS_DIST_FRAGMENT_HEADER_SIZE,
+ ctx->fragments);
+ ctx->obuf->ext_start = &ctx->obuf->extp[0];
+ ctx->obuf->ext_endp = &ctx->obuf->extp[0] + ctx->max_finalize_prepend + ctx->dhdr_ext_size;
/* Encode internal version of dist header */
- ctx->obuf->extp = erts_encode_ext_dist_header_setup(ctx->obuf->ext_endp, ctx->acmp);
+ ctx->obuf->extp = erts_encode_ext_dist_header_setup(
+ ctx->obuf->ext_endp, ctx->acmp, ctx->fragments, ctx->from);
/* Encode control message */
erts_encode_dist_ext(ctx->ctl, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, NULL, NULL);
+
+ ctx->obuf->hdrp = NULL;
+ ctx->obuf->hdr_endp = NULL;
+
if (is_non_value(ctx->msg)) {
ctx->obuf->msg_start = NULL;
ctx->phase = ERTS_DSIG_SEND_PHASE_FIN;
@@ -1880,50 +2415,137 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
ctx->phase = ERTS_DSIG_SEND_PHASE_MSG_ENCODE;
case ERTS_DSIG_SEND_PHASE_MSG_ENCODE:
- if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags, ctx->acmp, &ctx->u.ec, &ctx->reds)) {
- retval = ERTS_DSIG_SEND_CONTINUE;
- goto done;
- }
+ if (!ctx->no_trap) {
+ if (erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags,
+ ctx->acmp, &ctx->u.ec, &ctx->reds)) {
+ retval = ERTS_DSIG_SEND_CONTINUE;
+ goto done;
+ }
+ } else {
+ erts_encode_dist_ext(ctx->msg, &ctx->obuf->ext_endp, ctx->flags,
+ ctx->acmp, NULL, NULL);
+ }
- ctx->phase = ERTS_DSIG_SEND_PHASE_FIN;
+ ctx->phase = ERTS_DSIG_SEND_PHASE_FIN;
case ERTS_DSIG_SEND_PHASE_FIN: {
- DistEntry *dep = dsdp->dep;
- int suspended = 0;
- int resume = 0;
ASSERT(ctx->obuf->extp < ctx->obuf->ext_endp);
- ASSERT(&ctx->obuf->data[0] <= ctx->obuf->extp - ctx->max_finalize_prepend);
- ASSERT(ctx->obuf->ext_endp <= &ctx->obuf->data[0] + ctx->data_size);
+ ASSERT(((byte*)&ctx->obuf->bin->orig_bytes[0]+obuf_list_size) <= ctx->obuf->extp - ctx->max_finalize_prepend);
+ ASSERT(ctx->obuf->ext_endp <= ((byte*)ctx->obuf->bin->orig_bytes+obuf_list_size) + ctx->data_size + ctx->dhdr_ext_size);
ctx->data_size = ctx->obuf->ext_endp - ctx->obuf->extp;
- if (ctx->data_size > (Uint) INT_MAX) {
- free_dist_obuf(ctx->obuf);
- ctx->obuf = NULL;
- retval = ERTS_DSIG_SEND_TOO_LRG;
- goto done;
- }
ctx->obuf->hopefull_flags = ctx->u.ec.hopefull_flags;
- /*
+
+ if (ctx->fragments > 1) {
+ int fin_fragments;
+ int i;
+ byte *msg = ctx->obuf->msg_start,
+ *msg_end = ctx->obuf->ext_endp,
+ *hdrp = msg_end;
+
+ ASSERT((ctx->obuf->hopefull_flags & ctx->flags) == ctx->obuf->hopefull_flags);
+ ASSERT(get_int64(ctx->obuf->extp + 1 + 1 + 8) == ctx->fragments);
+
+ /* Now that encoding is done we know how large the term will
+ be so we adjust the number of fragments to send. Note that
+ this can mean that only 1 fragment is sent. */
+ fin_fragments = (ctx->obuf->ext_endp - ctx->obuf->msg_start + ERTS_DIST_FRAGMENT_SIZE-1) /
+ ERTS_DIST_FRAGMENT_SIZE - 1;
+
+ /* Update the frag_id in the DIST_FRAG_HEADER */
+ put_int64(fin_fragments+1, ctx->obuf->extp + 1 + 1 + 8);
+
+ if (fin_fragments > 0)
+ msg += ERTS_DIST_FRAGMENT_SIZE;
+ else
+ msg = msg_end;
+ ctx->obuf->next = &ctx->obuf[1];
+ ctx->obuf->ext_endp = msg;
+
+ /* Loop through all fragments, updating the output buffers
+ to be correct and also writing the DIST_FRAG_CONT header. */
+ for (i = 1; i < fin_fragments + 1; i++) {
+ ctx->obuf[i].hopefull_flags = 0;
+ ctx->obuf[i].extp = msg;
+ ctx->obuf[i].ext_start = msg;
+ if (msg + ERTS_DIST_FRAGMENT_SIZE > msg_end)
+ ctx->obuf[i].ext_endp = msg_end;
+ else {
+ msg += ERTS_DIST_FRAGMENT_SIZE;
+ ctx->obuf[i].ext_endp = msg;
+ }
+ ASSERT(ctx->obuf[i].ext_endp > ctx->obuf[i].extp);
+ ctx->obuf[i].hdrp = erts_encode_ext_dist_header_fragment(
+ &hdrp, fin_fragments - i + 1, ctx->from);
+ ctx->obuf[i].hdr_endp = hdrp;
+ ctx->obuf[i].next = &ctx->obuf[i+1];
+ }
+ /* If the initial fragment calculation was incorrect we free the
+ remaining output buffers. */
+ for (; i < ctx->fragments; i++) {
+ free_dist_obuf(&ctx->obuf[i]);
+ }
+ if (!ctx->no_trap && !ctx->no_suspend)
+ ctx->reds -= ctx->fragments;
+ ctx->fragments = fin_fragments + 1;
+ }
+
+ ctx->phase = ERTS_DSIG_SEND_PHASE_SEND;
+
+ if (ctx->reds <= 0) {
+ retval = ERTS_DSIG_SEND_CONTINUE;
+ goto done;
+ }
+ }
+ case ERTS_DSIG_SEND_PHASE_SEND: {
+ /*
* Signal encoded; now verify that the connection still exists,
* and if so enqueue the signal and schedule it for send.
*/
- ctx->obuf->next = NULL;
+ DistEntry *dep = ctx->dep;
+ int suspended = 0;
+ int resume = 0;
+ int i;
erts_de_rlock(dep);
cid = dep->cid;
if (dep->state == ERTS_DE_STATE_EXITING
|| dep->state == ERTS_DE_STATE_IDLE
- || dep->connection_id != dsdp->connection_id) {
+ || dep->connection_id != ctx->connection_id) {
/* Not the same connection as when we started; drop message... */
erts_de_runlock(dep);
- free_dist_obuf(ctx->obuf);
+ for (i = 0; i < ctx->fragments; i++)
+ free_dist_obuf(&ctx->obuf[i]);
+ ctx->fragments = 0;
}
else {
- Sint qsize;
+ Sint qsize = erts_atomic_read_nob(&dep->qsize);
erts_aint32_t qflgs;
ErtsProcList *plp = NULL;
Eterm notify_proc = NIL;
- Sint obsz = size_obuf(ctx->obuf);
+ Sint obsz;
+ int fragments;
+
+ /* Calculate how many fragments to send. This depends on
+ the available space in the distr queue and the amount
+ of remaining reductions. */
+ for (fragments = 0, obsz = 0;
+ fragments < ctx->fragments &&
+ ((ctx->reds > 0 && (qsize + obsz) < erts_dist_buf_busy_limit) ||
+ ctx->no_trap || ctx->no_suspend);
+ fragments++) {
+#ifdef DEBUG
+ int reds = 100;
+#else
+ int reds = 10;
+#endif
+ if (!ctx->no_trap && !ctx->no_suspend)
+ ctx->reds -= reds;
+ obsz += size_obuf(&ctx->obuf[fragments]);
+ }
+
+ ASSERT(fragments == ctx->fragments ||
+ (!ctx->no_trap && !ctx->no_suspend));
erts_mtx_lock(&dep->qlock);
qsize = erts_atomic_add_read_nob(&dep->qsize, (erts_aint_t) obsz);
@@ -1944,7 +2566,7 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
/* else: requester will send itself the message... */
qflgs &= ~ERTS_DE_QFLG_REQ_INFO;
}
- if (!ctx->force_busy && (qflgs & ERTS_DE_QFLG_BUSY)) {
+ if (!ctx->no_suspend && (qflgs & ERTS_DE_QFLG_BUSY)) {
erts_mtx_unlock(&dep->qlock);
plp = erts_proclist_create(ctx->c_p);
@@ -1953,14 +2575,27 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
erts_mtx_lock(&dep->qlock);
}
- /* Enqueue obuf on dist entry */
- if (dep->out_queue.last)
- dep->out_queue.last->next = ctx->obuf;
- else
- dep->out_queue.first = ctx->obuf;
- dep->out_queue.last = ctx->obuf;
+ if (fragments > 1) {
+ if (!ctx->obuf->hdrp) {
+ ASSERT(get_int64(ctx->obuf->extp + 10) == ctx->fragments);
+ } else {
+ ASSERT(get_int64(ctx->obuf->hdrp + 10) == ctx->fragments);
+ }
+ }
+
+ if (fragments) {
+ ctx->obuf[fragments-1].next = NULL;
+ if (dep->out_queue.last)
+ dep->out_queue.last->next = ctx->obuf;
+ else
+ dep->out_queue.first = ctx->obuf;
+ dep->out_queue.last = &ctx->obuf[fragments-1];
- if (!ctx->force_busy) {
+ ctx->fragments -= fragments;
+ ctx->obuf = &ctx->obuf[fragments];
+ }
+
+ if (!ctx->no_suspend) {
qflgs = erts_atomic32_read_nob(&dep->qflgs);
if (!(qflgs & ERTS_DE_QFLG_BUSY)) {
if (suspended)
@@ -2007,6 +2642,13 @@ erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx)
* erroneously scheduled when it shouldn't be.
*/
}
+ /* More fragments left to be sent, yield and re-schedule */
+ if (ctx->fragments) {
+ retval = ERTS_DSIG_SEND_CONTINUE;
+ if (!resume && erts_system_monitor_flags.busy_dist_port)
+ monitor_generic(ctx->c_p, am_busy_dist_port, cid);
+ goto done;
+ }
}
ctx->obuf = NULL;
@@ -2091,9 +2733,9 @@ static Uint
dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
{
int fpe_was_unmasked;
- ErlDrvSizeT size;
- SysIOVec iov[2];
- ErlDrvBinary* bv[2];
+ ErlDrvSizeT size = 0;
+ SysIOVec iov[3];
+ ErlDrvBinary* bv[3];
ErlIOVec eiov;
ERTS_CHK_NO_PROC_LOCKS;
@@ -2108,12 +2750,31 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
eiov.vsize = 1;
}
else {
- size = obuf->ext_endp - obuf->extp;
+ int i = 1;
eiov.vsize = 2;
- iov[1].iov_base = obuf->extp;
- iov[1].iov_len = size;
- bv[1] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf));
+ if (obuf->hdrp) {
+ eiov.vsize = 3;
+ iov[i].iov_base = obuf->hdrp;
+ iov[i].iov_len = obuf->hdr_endp - obuf->hdrp;
+ size += iov[i].iov_len;
+ bv[i] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf));
+#ifdef ERTS_RAW_DIST_MSG_DBG
+ erts_fprintf(dbg_file, "SEND: ");
+ bw(iov[i].iov_base, iov[i].iov_len);
+#endif
+ i++;
+
+ }
+
+ iov[i].iov_base = obuf->extp;
+ iov[i].iov_len = obuf->ext_endp - obuf->extp;
+#ifdef ERTS_RAW_DIST_MSG_DBG
+ erts_fprintf(dbg_file, "SEND: ");
+ bw(iov[i].iov_base, iov[i].iov_len);
+#endif
+ size += iov[i].iov_len;
+ bv[i] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf));
}
eiov.size = size;
@@ -2220,6 +2881,23 @@ erts_dist_command(Port *prt, int initial_reds)
dep->finalized_out_queue.first = NULL;
dep->finalized_out_queue.last = NULL;
+#ifdef DEBUG
+ {
+ Uint sz = 0;
+ ErtsDistOutputBuf *curr = oq.first;
+ while (curr) {
+ sz += size_obuf(curr);
+ curr = curr->next;
+ }
+ curr = foq.first;
+ while (curr) {
+ sz += size_obuf(curr);
+ curr = curr->next;
+ }
+ ASSERT(sz <= erts_atomic_read_nob(&dep->qsize));
+ }
+#endif
+
sched_flags = erts_atomic32_read_nob(&prt->sched.flags);
if (reds < 0)
@@ -2233,10 +2911,6 @@ erts_dist_command(Port *prt, int initial_reds)
size = (*send)(prt, foq.first);
erts_atomic64_inc_nob(&dep->out);
esdp->io.out += (Uint64) size;
-#ifdef ERTS_RAW_DIST_MSG_DBG
- erts_fprintf(stderr, ">> ");
- bw(foq.first->extp, size);
-#endif
reds -= ERTS_PORT_REDS_DIST_CMD_DATA(size);
fob = foq.first;
obufsize += size_obuf(fob);
@@ -2305,15 +2979,11 @@ erts_dist_command(Port *prt, int initial_reds)
preempt = 1;
break;
}
- ASSERT(&oq.first->data[0] <= oq.first->extp
- && oq.first->extp <= oq.first->ext_endp);
+ ASSERT(oq.first->bin->orig_bytes <= (char*)oq.first->extp
+ && oq.first->extp <= oq.first->ext_endp);
size = (*send)(prt, oq.first);
erts_atomic64_inc_nob(&dep->out);
esdp->io.out += (Uint64) size;
-#ifdef ERTS_RAW_DIST_MSG_DBG
- erts_fprintf(stderr, ">> ");
- bw(oq.first->extp, size);
-#endif
reds -= ERTS_PORT_REDS_DIST_CMD_DATA(size);
fob = oq.first;
obufsize += size_obuf(fob);
@@ -2450,100 +3120,6 @@ erts_dist_command(Port *prt, int initial_reds)
goto done;
}
-#if 0
-
-int
-dist_data_finalize(Process *c_p, int reds_limit)
-{
- int reds = 5;
- DistEntry *dep = ;
- ErtsDistOutputQueue oq, foq;
- ErtsDistOutputBuf *ob;
- int preempt;
-
-
- erts_mtx_lock(&dep->qlock);
- flags = dep->flags;
- oq.first = dep->out_queue.first;
- oq.last = dep->out_queue.last;
- dep->out_queue.first = NULL;
- dep->out_queue.last = NULL;
- erts_mtx_unlock(&dep->qlock);
-
- if (!oq.first) {
- ASSERT(!oq.last);
- oq.first = dep->tmp_out_queue.first;
- oq.last = dep->tmp_out_queue.last;
- }
- else {
- ErtsDistOutputBuf *f, *l;
- ASSERT(oq.last);
- if (dep->tmp_out_queue.last) {
- dep->tmp_out_queue.last->next = oq.first;
- oq.first = dep->tmp_out_queue.first;
- }
- }
-
- if (!oq.first) {
- /* Nothing to do... */
- ASSERT(!oq.last);
- return reds;
- }
-
- foq.first = dep->finalized_out_queue.first;
- foq.last = dep->finalized_out_queue.last;
-
- preempt = 0;
- ob = oq.first;
- ASSERT(ob);
-
- do {
- ob->extp = erts_encode_ext_dist_header_finalize(ob->extp,
- dep->cache,
- flags);
- if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE))
- *--ob->extp = PASS_THROUGH; /* Old node; 'pass through'
- needed */
- ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp);
- reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE;
- preempt = reds > reds_limit;
- if (preempt)
- break;
- ob = ob->next;
- } while (ob);
- /*
- * At least one buffer was finalized; if we got preempted,
- * ob points to the last buffer that we finalized.
- */
- if (foq.last)
- foq.last->next = oq.first;
- else
- foq.first = oq.first;
- if (!preempt) {
- /* All buffers finalized */
- foq.last = oq.last;
- oq.first = oq.last = NULL;
- }
- else {
- /* Not all buffers finalized; split oq. */
- foq.last = ob;
- oq.first = ob->next;
- if (oq.first)
- ob->next = NULL;
- else
- oq.last = NULL;
- }
-
- dep->finalized_out_queue.first = foq.first;
- dep->finalized_out_queue.last = foq.last;
- dep->tmp_out_queue.first = oq.first;
- dep->tmp_out_queue.last = oq.last;
-
- return reds;
-}
-
-#endif
-
BIF_RETTYPE
dist_ctrl_get_data_notification_1(BIF_ALIST_1)
{
@@ -2612,6 +3188,7 @@ dist_ctrl_put_data_2(BIF_ALIST_2)
ErlDrvSizeT size;
Eterm input_handler;
Uint32 conn_id;
+ Binary *bin = NULL;
if (is_binary(BIF_ARG_2))
size = binary_size(BIF_ARG_2);
@@ -2637,13 +3214,27 @@ dist_ctrl_put_data_2(BIF_ALIST_2)
if (size != 0) {
byte *data, *temp_alloc = NULL;
- data = (byte *) erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc);
+ if (binary_bitoffset(BIF_ARG_2))
+ data = (byte *) erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc);
+ else {
+ Eterm real_bin;
+ ProcBin *proc_bin;
+ Uint offset, bitoffs, bitsize;
+
+ ERTS_GET_REAL_BIN(BIF_ARG_2, real_bin, offset, bitoffs, bitsize);
+ ASSERT(bitoffs == 0);
+ data = binary_bytes(real_bin) + offset;
+ proc_bin = (ProcBin *)binary_val(real_bin);
+ if (proc_bin->thing_word == HEADER_PROC_BIN)
+ bin = proc_bin->val;
+ }
+
if (!data)
BIF_ERROR(BIF_P, BADARG);
erts_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN);
- (void) erts_net_message(NULL, dep, conn_id, NULL, 0, data, size);
+ (void) erts_net_message(NULL, dep, conn_id, NULL, 0, bin, data, size);
/*
* We ignore any decode failures. On fatal failures the
* connection will be taken down by killing the
@@ -2877,6 +3468,10 @@ static void kill_connection(DistEntry *dep)
void
erts_kill_dist_connection(DistEntry *dep, Uint32 conn_id)
{
+#ifdef ERTS_DIST_MSG_DBG
+ erts_fprintf(dbg_file, "INTR: kill dist conn to %T:%u\n",
+ dep->sysname, conn_id);
+#endif
erts_de_rwlock(dep);
if (conn_id == dep->connection_id
&& dep->state == ERTS_DE_STATE_CONNECTED) {
@@ -2891,7 +3486,7 @@ struct print_to_data {
void *arg;
};
-static void doit_print_monitor_info(ErtsMonitor *mon, void *vptdp)
+static int doit_print_monitor_info(ErtsMonitor *mon, void *vptdp, Sint reds)
{
fmtfn_t to = ((struct print_to_data *) vptdp)->to;
void *arg = ((struct print_to_data *) vptdp)->arg;
@@ -2914,6 +3509,7 @@ static void doit_print_monitor_info(ErtsMonitor *mon, void *vptdp)
else
erts_print(to, arg, "%T\n", mdep->md.origin.other.item);
}
+ return 1;
}
static void print_monitor_info(fmtfn_t to, void *arg, DistEntry *dep)
@@ -2929,12 +3525,13 @@ static void print_monitor_info(fmtfn_t to, void *arg, DistEntry *dep)
}
}
-static void doit_print_link_info(ErtsLink *lnk, void *vptdp)
+static int doit_print_link_info(ErtsLink *lnk, void *vptdp, Sint reds)
{
struct print_to_data *ptdp = vptdp;
ErtsLink *lnk2 = erts_link_to_other(lnk, NULL);
erts_print(ptdp->to, ptdp->arg, "Remote link: %T %T\n",
lnk2->other.item, lnk->other.item);
+ return 1;
}
static void print_link_info(fmtfn_t to, void *arg, DistEntry *dep)
@@ -3536,8 +4133,9 @@ Sint erts_abort_connection_rwunlock(DistEntry* dep)
erts_set_dist_entry_not_connected(dep);
erts_de_rwunlock(dep);
- schedule_con_monitor_link_cleanup(mld, THE_NON_VALUE,
- THE_NON_VALUE, THE_NON_VALUE);
+ schedule_con_monitor_link_seq_cleanup(
+ mld, NULL, THE_NON_VALUE,
+ THE_NON_VALUE, THE_NON_VALUE);
if (resume_procs) {
int resumed = erts_resume_processes(resume_procs);
@@ -3843,16 +4441,16 @@ monitor_node(Process* p, Eterm Node, Eterm Bool, Eterm Options)
}
case am_true: {
- ErtsDSigData dsd;
- dsd.node = Node;
+ ErtsDSigSendContext ctx;
+ ctx.node = Node;
dep = erts_find_or_insert_dist_entry(Node);
if (dep == erts_this_dist_entry)
break;
- switch (erts_dsig_prepare(&dsd, dep, p,
+ switch (erts_dsig_prepare(&ctx, dep, p,
ERTS_PROC_LOCK_MAIN,
- ERTS_DSP_RLOCK, 0, async_connect)) {
+ ERTS_DSP_RLOCK, 0, 0, async_connect)) {
case ERTS_DSIG_PREP_NOT_ALIVE:
case ERTS_DSIG_PREP_NOT_CONNECTED:
/* Trap to either send 'nodedown' or do passive connection attempt */
@@ -4009,6 +4607,10 @@ init_nodes_monitors(void)
{
erts_mtx_init(&nodes_monitors_mtx, "nodes_monitors", NIL,
ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+#ifdef DEBUG
+ erts_mtx_init(&erts_obuf_list_mtx, "sad", NIL,
+ ERTS_LOCK_FLAGS_PROPERTY_STATIC | ERTS_LOCK_FLAGS_CATEGORY_DISTRIBUTION);
+#endif
nodes_monitors = NULL;
no_nodes_monitors = 0;
}
@@ -4150,8 +4752,8 @@ typedef struct {
Uint i;
} ErtsNodesMonitorContext;
-static void
-save_nodes_monitor(ErtsMonitor *mon, void *vctxt)
+static int
+save_nodes_monitor(ErtsMonitor *mon, void *vctxt, Sint reds)
{
ErtsNodesMonitorContext *ctxt = vctxt;
ErtsMonitorData *mdp = erts_monitor_to_data(mon);
@@ -4163,6 +4765,7 @@ save_nodes_monitor(ErtsMonitor *mon, void *vctxt)
ctxt->nmdp[ctxt->i].options = mdp->origin.other.item;
ctxt->i++;
+ return 1;
}
static void
@@ -4295,8 +4898,8 @@ typedef struct {
} ErtsNodesMonitorInfoContext;
-static void
-nodes_monitor_info(ErtsMonitor *mon, void *vctxt)
+static int
+nodes_monitor_info(ErtsMonitor *mon, void *vctxt, Sint reds)
{
ErtsMonitorDataExtended *mdep;
ErtsNodesMonitorInfoContext *ctxt = vctxt;
@@ -4343,6 +4946,7 @@ nodes_monitor_info(ErtsMonitor *mon, void *vctxt)
ctxt->hpp = hpp;
ctxt->szp = szp;
ctxt->res = res;
+ return 1;
}
Eterm
diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h
index 845fab229a..c4bb967592 100644
--- a/erts/emulator/beam/dist.h
+++ b/erts/emulator/beam/dist.h
@@ -47,6 +47,8 @@
#define DFLAG_SEND_SENDER 0x80000
#define DFLAG_BIG_SEQTRACE_LABELS 0x100000
#define DFLAG_NO_MAGIC 0x200000 /* internal for pending connection */
+#define DFLAG_EXIT_PAYLOAD 0x400000
+#define DFLAG_FRAGMENTS 0x800000
/* Mandatory flags for distribution */
#define DFLAG_DIST_MANDATORY (DFLAG_EXTENDED_REFERENCES \
@@ -75,7 +77,9 @@
| DFLAG_MAP_TAG \
| DFLAG_BIG_CREATION \
| DFLAG_SEND_SENDER \
- | DFLAG_BIG_SEQTRACE_LABELS)
+ | DFLAG_BIG_SEQTRACE_LABELS \
+ | DFLAG_EXIT_PAYLOAD \
+ | DFLAG_FRAGMENTS)
/* Flags addable by local distr implementations */
#define DFLAG_DIST_ADDABLE DFLAG_DIST_DEFAULT
@@ -99,26 +103,35 @@
| DFLAG_BIG_CREATION)
/* opcodes used in distribution messages */
-#define DOP_LINK 1
-#define DOP_SEND 2
-#define DOP_EXIT 3
-#define DOP_UNLINK 4
+enum dop {
+ DOP_LINK = 1,
+ DOP_SEND = 2,
+ DOP_EXIT = 3,
+ DOP_UNLINK = 4,
/* Ancient DOP_NODE_LINK (5) was here, can be reused */
-#define DOP_REG_SEND 6
-#define DOP_GROUP_LEADER 7
-#define DOP_EXIT2 8
-
-#define DOP_SEND_TT 12
-#define DOP_EXIT_TT 13
-#define DOP_REG_SEND_TT 16
-#define DOP_EXIT2_TT 18
-
-#define DOP_MONITOR_P 19
-#define DOP_DEMONITOR_P 20
-#define DOP_MONITOR_P_EXIT 21
-
-#define DOP_SEND_SENDER 22
-#define DOP_SEND_SENDER_TT 23
+ DOP_REG_SEND = 6,
+ DOP_GROUP_LEADER = 7,
+ DOP_EXIT2 = 8,
+
+ DOP_SEND_TT = 12,
+ DOP_EXIT_TT = 13,
+ DOP_REG_SEND_TT = 16,
+ DOP_EXIT2_TT = 18,
+
+ DOP_MONITOR_P = 19,
+ DOP_DEMONITOR_P = 20,
+ DOP_MONITOR_P_EXIT = 21,
+
+ DOP_SEND_SENDER = 22,
+ DOP_SEND_SENDER_TT = 23,
+
+ /* These are used when DFLAG_EXIT_PAYLOAD is detected */
+ DOP_PAYLOAD_EXIT = 24,
+ DOP_PAYLOAD_EXIT_TT = 25,
+ DOP_PAYLOAD_EXIT2 = 26,
+ DOP_PAYLOAD_EXIT2_TT = 27,
+ DOP_PAYLOAD_MONITOR_P_EXIT = 28
+};
/* distribution trap functions */
extern Export* dmonitor_node_trap;
@@ -129,15 +142,15 @@ typedef enum {
} ErtsDSigPrepLock;
-typedef struct {
- Process *proc;
- DistEntry *dep;
- Eterm node; /* used if dep == NULL */
- Eterm cid;
- Eterm connection_id;
- int no_suspend;
- Uint32 flags;
-} ErtsDSigData;
+/* Must be larger or equal to 16 */
+#ifdef DEBUG
+#define ERTS_DIST_FRAGMENT_SIZE 16
+#else
+/* This should be made configurable */
+#define ERTS_DIST_FRAGMENT_SIZE (64 * 1024)
+#endif
+
+#define ERTS_DIST_FRAGMENT_HEADER_SIZE (1 + 1 + 8 + 8) /* magic, header, seq id, frag id*/
#define ERTS_DE_BUSY_LIMIT (1024*1024)
extern int erts_dist_buf_busy_limit;
@@ -159,124 +172,6 @@ extern int erts_is_alive;
/* Pending connection; signals can be enqueued */
#define ERTS_DSIG_PREP_PENDING 4
-ERTS_GLB_INLINE int erts_dsig_prepare(ErtsDSigData *,
- DistEntry*,
- Process *,
- ErtsProcLocks,
- ErtsDSigPrepLock,
- int,
- int);
-
-ERTS_GLB_INLINE
-void erts_schedule_dist_command(Port *, DistEntry *);
-
-int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks);
-
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-ERTS_GLB_INLINE int
-erts_dsig_prepare(ErtsDSigData *dsdp,
- DistEntry *dep,
- Process *proc,
- ErtsProcLocks proc_locks,
- ErtsDSigPrepLock dspl,
- int no_suspend,
- int connect)
-{
- int res;
-
- if (!erts_is_alive)
- return ERTS_DSIG_PREP_NOT_ALIVE;
- if (!dep) {
- ASSERT(!connect);
- return ERTS_DSIG_PREP_NOT_CONNECTED;
- }
-
-#ifdef ERTS_ENABLE_LOCK_CHECK
- if (connect) {
- erts_proc_lc_might_unlock(proc, proc_locks);
- }
-#endif
-
-retry:
- erts_de_rlock(dep);
-
- if (dep->state == ERTS_DE_STATE_CONNECTED) {
- res = ERTS_DSIG_PREP_CONNECTED;
- }
- else if (dep->state == ERTS_DE_STATE_PENDING) {
- res = ERTS_DSIG_PREP_PENDING;
- }
- else if (dep->state == ERTS_DE_STATE_EXITING) {
- res = ERTS_DSIG_PREP_NOT_CONNECTED;
- goto fail;
- }
- else if (connect) {
- ASSERT(dep->state == ERTS_DE_STATE_IDLE);
- erts_de_runlock(dep);
- if (!erts_auto_connect(dep, proc, proc_locks)) {
- return ERTS_DSIG_PREP_NOT_ALIVE;
- }
- goto retry;
- }
- else {
- ASSERT(dep->state == ERTS_DE_STATE_IDLE);
- res = ERTS_DSIG_PREP_NOT_CONNECTED;
- goto fail;
- }
-
- if (no_suspend) {
- if (erts_atomic32_read_acqb(&dep->qflgs) & ERTS_DE_QFLG_BUSY) {
- res = ERTS_DSIG_PREP_WOULD_SUSPEND;
- goto fail;
- }
- }
- dsdp->proc = proc;
- dsdp->dep = dep;
- dsdp->cid = dep->cid;
- dsdp->connection_id = dep->connection_id;
- dsdp->no_suspend = no_suspend;
- dsdp->flags = dep->flags;
- if (dspl == ERTS_DSP_NO_LOCK)
- erts_de_runlock(dep);
- return res;
-
- fail:
- erts_de_runlock(dep);
- return res;
-}
-
-ERTS_GLB_INLINE
-void erts_schedule_dist_command(Port *prt, DistEntry *dist_entry)
-{
- DistEntry *dep;
- Eterm id;
-
- if (prt) {
- ERTS_LC_ASSERT(erts_lc_is_port_locked(prt));
- ASSERT((erts_atomic32_read_nob(&prt->state)
- & ERTS_PORT_SFLGS_DEAD) == 0);
-
- dep = (DistEntry*) erts_prtsd_get(prt, ERTS_PRTSD_DIST_ENTRY);
- ASSERT(dep);
- id = prt->common.id;
- }
- else {
- ASSERT(dist_entry);
- ERTS_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&dist_entry->rwmtx)
- || erts_lc_rwmtx_is_rwlocked(&dist_entry->rwmtx));
- ASSERT(is_internal_port(dist_entry->cid));
-
- dep = dist_entry;
- id = dep->cid;
- }
-
- if (!erts_atomic_xchg_mb(&dep->dist_cmd_scheduled, 1))
- erts_port_task_schedule(id, &dep->dist_cmd, ERTS_PORT_TASK_DIST_CMD);
-}
-
-#endif
-
#ifdef DEBUG
#define ERTS_DBG_CHK_NO_DIST_LNK(D, R, L) \
erts_dbg_chk_no_dist_proc_link((D), (R), (L))
@@ -336,41 +231,45 @@ enum erts_dsig_send_phase {
ERTS_DSIG_SEND_PHASE_MSG_SIZE,
ERTS_DSIG_SEND_PHASE_ALLOC,
ERTS_DSIG_SEND_PHASE_MSG_ENCODE,
- ERTS_DSIG_SEND_PHASE_FIN
+ ERTS_DSIG_SEND_PHASE_FIN,
+ ERTS_DSIG_SEND_PHASE_SEND
};
-struct erts_dsig_send_context {
- enum erts_dsig_send_phase phase;
- Sint reds;
+typedef struct erts_dsig_send_context {
+ int connect;
+ int no_suspend;
+ int no_trap;
Eterm ctl;
Eterm msg;
- int force_busy;
+ Eterm from;
+ Eterm ctl_heap[6];
+ Eterm return_term;
+
+ DistEntry *dep;
+ Eterm node; /* used if dep == NULL */
+ Eterm cid;
+ Eterm connection_id;
+ int deref_dep;
+
+ enum erts_dsig_send_phase phase;
+ Sint reds;
+
Uint32 max_finalize_prepend;
Uint data_size, dhdr_ext_size;
ErtsAtomCacheMap *acmp;
ErtsDistOutputBuf *obuf;
+ Uint fragments;
Uint32 flags;
Process *c_p;
union {
TTBSizeContext sc;
TTBEncodeContext ec;
}u;
-};
-typedef struct {
- int suspend;
- int connect;
-
- Eterm ctl_heap[6];
- ErtsDSigData dsd;
- DistEntry *dep;
- int deref_dep;
- struct erts_dsig_send_context dss;
-
- Eterm return_term;
-}ErtsSendContext;
+} ErtsDSigSendContext;
+typedef struct dist_sequences DistSeqNode;
/*
* erts_dsig_send_* return values.
@@ -380,21 +279,21 @@ typedef struct {
#define ERTS_DSIG_SEND_CONTINUE 2
#define ERTS_DSIG_SEND_TOO_LRG 3
-extern int erts_dsig_send_link(ErtsDSigData *, Eterm, Eterm);
-extern int erts_dsig_send_msg(Eterm, Eterm, ErtsSendContext*);
-extern int erts_dsig_send_exit_tt(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm);
-extern int erts_dsig_send_unlink(ErtsDSigData *, Eterm, Eterm);
-extern int erts_dsig_send_reg_msg(Eterm, Eterm, ErtsSendContext*);
-extern int erts_dsig_send_group_leader(ErtsDSigData *, Eterm, Eterm);
-extern int erts_dsig_send_exit(ErtsDSigData *, Eterm, Eterm, Eterm);
-extern int erts_dsig_send_exit2(ErtsDSigData *, Eterm, Eterm, Eterm);
-extern int erts_dsig_send_demonitor(ErtsDSigData *, Eterm, Eterm, Eterm, int);
-extern int erts_dsig_send_monitor(ErtsDSigData *, Eterm, Eterm, Eterm);
-extern int erts_dsig_send_m_exit(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm);
-
-extern int erts_dsig_send(ErtsDSigData *dsdp, struct erts_dsig_send_context* ctx);
+extern int erts_dsig_send_msg(ErtsDSigSendContext*, Eterm, Eterm);
+extern int erts_dsig_send_reg_msg(ErtsDSigSendContext*, Eterm, Eterm);
+extern int erts_dsig_send_link(ErtsDSigSendContext *, Eterm, Eterm);
+extern int erts_dsig_send_exit_tt(ErtsDSigSendContext *, Eterm, Eterm, Eterm, Eterm);
+extern int erts_dsig_send_unlink(ErtsDSigSendContext *, Eterm, Eterm);
+extern int erts_dsig_send_group_leader(ErtsDSigSendContext *, Eterm, Eterm);
+extern int erts_dsig_send_exit(ErtsDSigSendContext *, Eterm, Eterm, Eterm);
+extern int erts_dsig_send_exit2(ErtsDSigSendContext *, Eterm, Eterm, Eterm);
+extern int erts_dsig_send_demonitor(ErtsDSigSendContext *, Eterm, Eterm, Eterm);
+extern int erts_dsig_send_monitor(ErtsDSigSendContext *, Eterm, Eterm, Eterm);
+extern int erts_dsig_send_m_exit(ErtsDSigSendContext *, Eterm, Eterm, Eterm, Eterm);
+
+extern int erts_dsig_send(ErtsDSigSendContext *dsdp);
extern int erts_dsend_context_dtor(Binary*);
-extern Eterm erts_dsend_export_trap_context(Process* p, ErtsSendContext* ctx);
+extern Eterm erts_dsend_export_trap_context(Process* p, ErtsDSigSendContext* ctx);
extern int erts_dist_command(Port *prt, int reds);
extern void erts_dist_port_not_busy(Port *prt);
@@ -404,5 +303,18 @@ extern Uint erts_dist_cache_size(void);
extern Sint erts_abort_connection_rwunlock(DistEntry *dep);
+extern void erts_dist_seq_tree_foreach(
+ DistEntry *dep,
+ int (*func)(ErtsDistExternal *, void*, Sint), void *args);
+
+extern int erts_dsig_prepare(ErtsDSigSendContext *,
+ DistEntry*,
+ Process *,
+ ErtsProcLocks,
+ ErtsDSigPrepLock,
+ int,
+ int,
+ int);
+int erts_auto_connect(DistEntry* dep, Process *proc, ErtsProcLocks proc_locks);
#endif
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 08dcc5ea9a..e7329daa2d 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -275,6 +275,8 @@ type ML_DIST STANDARD SYSTEM monitor_link_dist
type PF3_ARGS SHORT_LIVED PROCESSES process_flag_3_arguments
type SETUP_CONN_ARG SHORT_LIVED PROCESSES setup_connection_argument
type LIST_TRAP SHORT_LIVED PROCESSES list_bif_trap_state
+type CONT_EXIT_TRAP SHORT_LIVED PROCESSES continue_exit_trap_state
+type SEQ_YIELD_STATE SHORT_LIVED SYSTEM dist_seq_yield_state
type ENVIRONMENT SYSTEM SYSTEM environment
@@ -345,16 +347,17 @@ type COUNTERS STANDARD SYSTEM erl_bif_counters
# Types used by system specific code
#
-type TEMP_TERM TEMPORARY SYSTEM temp_term
-type DRV_TAB LONG_LIVED SYSTEM drv_tab
-type DRV_EV_STATE LONG_LIVED SYSTEM driver_event_state
-type DRV_SEL_D_STATE FIXED_SIZE SYSTEM driver_select_data_state
-type NIF_SEL_D_STATE FIXED_SIZE SYSTEM enif_select_data_state
-type POLLSET LONG_LIVED SYSTEM pollset
-type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req
-type POLL_FDS LONG_LIVED SYSTEM poll_fds
-type FD_STATUS LONG_LIVED SYSTEM fd_status
-type SELECT_FDS LONG_LIVED SYSTEM select_fds
+type TEMP_TERM TEMPORARY SYSTEM temp_term
+type SHORT_LIVED_TERM SHORT_LIVED SYSTEM short_lived_term
+type DRV_TAB LONG_LIVED SYSTEM drv_tab
+type DRV_EV_STATE LONG_LIVED SYSTEM driver_event_state
+type DRV_SEL_D_STATE FIXED_SIZE SYSTEM driver_select_data_state
+type NIF_SEL_D_STATE FIXED_SIZE SYSTEM enif_select_data_state
+type POLLSET LONG_LIVED SYSTEM pollset
+type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req
+type POLL_FDS LONG_LIVED SYSTEM poll_fds
+type FD_STATUS LONG_LIVED SYSTEM fd_status
+type SELECT_FDS LONG_LIVED SYSTEM select_fds
+if unix
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index d238d38d27..8d4464969a 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -7503,7 +7503,7 @@ static int gather_ahist_scan(Allctr_t *allocator,
return blocks_scanned;
}
-static void gather_ahist_append_result(hist_tree_t *node, void *arg)
+static int gather_ahist_append_result(hist_tree_t *node, void *arg, Sint reds)
{
gather_ahist_t *state = (gather_ahist_t*)arg;
@@ -7537,6 +7537,7 @@ static void gather_ahist_append_result(hist_tree_t *node, void *arg)
/* Plain free is intentional. */
free(node);
+ return 1;
}
static void gather_ahist_send(gather_ahist_t *state)
@@ -7595,11 +7596,11 @@ static int gather_ahist_finish(void *arg)
state->building_result = 1;
}
- if (hist_tree_rbt_foreach_destroy_yielding(&state->hist_tree,
- &gather_ahist_append_result,
- state,
- &state->hist_tree_yield,
- BLOCKSCAN_REDUCTIONS)) {
+ if (!hist_tree_rbt_foreach_destroy_yielding(&state->hist_tree,
+ &gather_ahist_append_result,
+ state,
+ &state->hist_tree_yield,
+ BLOCKSCAN_REDUCTIONS)) {
return 1;
}
@@ -7608,10 +7609,11 @@ static int gather_ahist_finish(void *arg)
return 0;
}
-static void gather_ahist_destroy_result(hist_tree_t *node, void *arg)
+static int gather_ahist_destroy_result(hist_tree_t *node, void *arg, Sint reds)
{
(void)arg;
free(node);
+ return 1;
}
static void gather_ahist_abort(void *arg)
diff --git a/erts/emulator/beam/erl_ao_firstfit_alloc.c b/erts/emulator/beam/erl_ao_firstfit_alloc.c
index f2ad2f6532..c19d6d1b1e 100644
--- a/erts/emulator/beam/erl_ao_firstfit_alloc.c
+++ b/erts/emulator/beam/erl_ao_firstfit_alloc.c
@@ -100,8 +100,8 @@
#define AOFF_BLK_SZ(B) MBC_FBLK_SZ(&(B)->hdr)
-#define LIST_NEXT(N) (((AOFF_RBTree_t*)(N))->u.next)
-#define LIST_PREV(N) (((AOFF_RBTree_t*)(N))->parent)
+#define AOFF_LIST_NEXT(N) (((AOFF_RBTree_t*)(N))->u.next)
+#define AOFF_LIST_PREV(N) (((AOFF_RBTree_t*)(N))->parent)
typedef struct AOFF_Carrier_t_ AOFF_Carrier_t;
@@ -154,13 +154,13 @@ static ERTS_INLINE Uint node_max_size(AOFF_RBTree_t *x)
static ERTS_INLINE void lower_max_size(AOFF_RBTree_t *node,
AOFF_RBTree_t* stop_at)
{
- AOFF_RBTree_t* x = node;
+ AOFF_RBTree_t* x = node;
Uint old_max = x->max_sz;
Uint new_max = node_max_size(x);
if (new_max < old_max) {
x->max_sz = new_max;
- while ((x=x->parent) != stop_at && x->max_sz == old_max) {
+ while ((x=x->parent) != stop_at && x->max_sz == old_max) {
x->max_sz = node_max_size(x);
}
ASSERT(x == stop_at || x->max_sz > old_max);
@@ -372,7 +372,7 @@ left_rotate(AOFF_RBTree_t **root, AOFF_RBTree_t *x)
x->parent = y;
y->max_sz = x->max_sz;
- x->max_sz = node_max_size(x);
+ x->max_sz = node_max_size(x);
ASSERT(y->max_sz >= x->max_sz);
}
@@ -397,7 +397,7 @@ right_rotate(AOFF_RBTree_t **root, AOFF_RBTree_t *x)
y->right = x;
x->parent = y;
y->max_sz = x->max_sz;
- x->max_sz = node_max_size(x);
+ x->max_sz = node_max_size(x);
ASSERT(y->max_sz >= x->max_sz);
}
@@ -544,23 +544,23 @@ aoff_unlink_free_block(Allctr_t *allctr, Block_t *blk)
ASSERT(del->flags & IS_BF_FLG);
if (IS_LIST_ELEM(del)) {
/* Remove from list */
- ASSERT(LIST_PREV(del));
- ASSERT(LIST_PREV(del)->flags & IS_BF_FLG);
- LIST_NEXT(LIST_PREV(del)) = LIST_NEXT(del);
- if (LIST_NEXT(del)) {
- ASSERT(LIST_NEXT(del)->flags & IS_BF_FLG);
- LIST_PREV(LIST_NEXT(del)) = LIST_PREV(del);
+ ASSERT(AOFF_LIST_PREV(del));
+ ASSERT(AOFF_LIST_PREV(del)->flags & IS_BF_FLG);
+ AOFF_LIST_NEXT(AOFF_LIST_PREV(del)) = AOFF_LIST_NEXT(del);
+ if (AOFF_LIST_NEXT(del)) {
+ ASSERT(AOFF_LIST_NEXT(del)->flags & IS_BF_FLG);
+ AOFF_LIST_PREV(AOFF_LIST_NEXT(del)) = AOFF_LIST_PREV(del);
}
return;
}
- else if (LIST_NEXT(del)) {
+ else if (AOFF_LIST_NEXT(del)) {
/* Replace tree node by next element in list... */
- ASSERT(AOFF_BLK_SZ(LIST_NEXT(del)) == AOFF_BLK_SZ(del));
- ASSERT(IS_LIST_ELEM(LIST_NEXT(del)));
-
- replace(&crr->root, (AOFF_RBTree_t*)del, LIST_NEXT(del));
-
+ ASSERT(AOFF_BLK_SZ(AOFF_LIST_NEXT(del)) == AOFF_BLK_SZ(del));
+ ASSERT(IS_LIST_ELEM(AOFF_LIST_NEXT(del)));
+
+ replace(&crr->root, (AOFF_RBTree_t*)del, AOFF_LIST_NEXT(del));
+
HARD_CHECK_TREE(&crr->crr, crr->blk_order, crr->root, 0);
return;
}
@@ -571,13 +571,13 @@ aoff_unlink_free_block(Allctr_t *allctr, Block_t *blk)
HARD_CHECK_TREE(&crr->crr, crr->blk_order, crr->root, 0);
/* Update the carrier tree with a potentially new (lower) max_sz
- */
+ */
if (crr->root) {
if (crr->rbt_node.hdr.bhdr == crr->root->max_sz) {
return;
}
ASSERT(crr->rbt_node.hdr.bhdr > crr->root->max_sz);
- crr->rbt_node.hdr.bhdr = crr->root->max_sz;
+ crr->rbt_node.hdr.bhdr = crr->root->max_sz;
}
else {
crr->rbt_node.hdr.bhdr = 0;
@@ -795,7 +795,7 @@ rbt_insert(enum AOFFSortOrder order, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
#ifdef DEBUG
blk->flags = (order == FF_BF) ? IS_BF_FLG : 0;
#else
- blk->flags = 0;
+ blk->flags = 0;
#endif
blk->left = NULL;
blk->right = NULL;
@@ -809,7 +809,7 @@ rbt_insert(enum AOFFSortOrder order, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
else {
AOFF_RBTree_t *x = *root;
while (1) {
- SWord diff;
+ SWord diff;
if (x->max_sz < blk_sz) {
x->max_sz = blk_sz;
}
@@ -832,14 +832,14 @@ rbt_insert(enum AOFFSortOrder order, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
}
else {
ASSERT(order == FF_BF);
- ASSERT(blk->flags & IS_BF_FLG);
- ASSERT(x->flags & IS_BF_FLG);
+ ASSERT(blk->flags & IS_BF_FLG);
+ ASSERT(x->flags & IS_BF_FLG);
SET_LIST_ELEM(blk);
- LIST_NEXT(blk) = LIST_NEXT(x);
- LIST_PREV(blk) = x;
- if (LIST_NEXT(x))
- LIST_PREV(LIST_NEXT(x)) = blk;
- LIST_NEXT(x) = blk;
+ AOFF_LIST_NEXT(blk) = AOFF_LIST_NEXT(x);
+ AOFF_LIST_PREV(blk) = x;
+ if (AOFF_LIST_NEXT(x))
+ AOFF_LIST_PREV(AOFF_LIST_NEXT(x)) = blk;
+ AOFF_LIST_NEXT(x) = blk;
return;
}
}
@@ -853,7 +853,7 @@ rbt_insert(enum AOFFSortOrder order, AOFF_RBTree_t** root, AOFF_RBTree_t* blk)
}
if (order == FF_BF) {
SET_TREE_NODE(blk);
- LIST_NEXT(blk) = NULL;
+ AOFF_LIST_NEXT(blk) = NULL;
}
}
@@ -900,7 +900,7 @@ aoff_get_free_block(Allctr_t *allctr, Uint size,
#ifdef HARD_DEBUG
AOFF_RBTree_t* dbg_blk;
#endif
-
+
ASSERT(!cand_blk || cand_size >= size);
/* Get first-fit carrier
@@ -993,7 +993,7 @@ static void aoff_add_mbc(Allctr_t *allctr, Carrier_t *carrier)
AOFF_RBTree_t **root = &alc->mbc_root;
ASSERT(!IS_CRR_IN_TREE(crr, *root));
- HARD_CHECK_TREE(NULL, alc->crr_order, *root, 0);
+ HARD_CHECK_TREE(NULL, alc->crr_order, *root, 0);
rbt_insert(alc->crr_order, root, &crr->rbt_node);
@@ -1190,7 +1190,7 @@ info_options(Allctr_t *allctr,
}
if (hpp || szp) {
-
+
if (!atoms_initialized)
erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error: Atoms not initialized",
__FILE__, __LINE__);;
@@ -1217,7 +1217,7 @@ erts_aoffalc_test(UWord op, UWord a1, UWord a2)
switch (op) {
case 0x500: return (UWord) ((AOFFAllctr_t *) a1)->blk_order == FF_AOBF;
case 0x501: {
- AOFF_RBTree_t *node = ((AOFFAllctr_t *) a1)->mbc_root;
+ AOFF_RBTree_t *node = ((AOFFAllctr_t *) a1)->mbc_root;
Uint size = (Uint) a2;
node = node ? rbt_search(node, size) : NULL;
return (UWord) (node ? RBT_NODE_TO_MBC(node)->root : NULL);
@@ -1225,13 +1225,13 @@ erts_aoffalc_test(UWord op, UWord a1, UWord a2)
case 0x502: return (UWord) ((AOFF_RBTree_t *) a1)->parent;
case 0x503: return (UWord) ((AOFF_RBTree_t *) a1)->left;
case 0x504: return (UWord) ((AOFF_RBTree_t *) a1)->right;
- case 0x505: return (UWord) LIST_NEXT(a1);
+ case 0x505: return (UWord) AOFF_LIST_NEXT(a1);
case 0x506: return (UWord) IS_BLACK((AOFF_RBTree_t *) a1);
case 0x507: return (UWord) IS_TREE_NODE((AOFF_RBTree_t *) a1);
case 0x508: return (UWord) 0; /* IS_BF_ALGO */
case 0x509: return (UWord) ((AOFF_RBTree_t *) a1)->max_sz;
case 0x50a: return (UWord) ((AOFFAllctr_t *) a1)->blk_order == FF_BF;
- case 0x50b: return (UWord) LIST_PREV(a1);
+ case 0x50b: return (UWord) AOFF_LIST_PREV(a1);
default: ASSERT(0); return ~((UWord) 0);
}
}
@@ -1251,7 +1251,7 @@ static int rbt_is_member(AOFF_RBTree_t* root, AOFF_RBTree_t* node)
return 0;
}
node = node->parent;
- }
+ }
return 1;
}
@@ -1364,15 +1364,15 @@ check_tree(Carrier_t* within_crr, enum AOFFSortOrder order, AOFF_RBTree_t* root,
}
if (order == FF_BF) {
AOFF_RBTree_t* y = x;
- AOFF_RBTree_t* nxt = LIST_NEXT(y);
+ AOFF_RBTree_t* nxt = AOFF_LIST_NEXT(y);
ASSERT(IS_TREE_NODE(x));
while (nxt) {
ASSERT(IS_LIST_ELEM(nxt));
ASSERT(AOFF_BLK_SZ(nxt) == AOFF_BLK_SZ(x));
ASSERT(FBLK_TO_MBC(&nxt->hdr) == within_crr);
- ASSERT(LIST_PREV(nxt) == y);
+ ASSERT(AOFF_LIST_PREV(nxt) == y);
y = nxt;
- nxt = LIST_NEXT(nxt);
+ nxt = AOFF_LIST_NEXT(nxt);
}
}
@@ -1386,13 +1386,13 @@ check_tree(Carrier_t* within_crr, enum AOFFSortOrder order, AOFF_RBTree_t* root,
if (x->left) {
ASSERT(x->left->parent == x);
ASSERT(cmp_blocks(order, x->left, x) < 0);
- ASSERT(x->left->max_sz <= x->max_sz);
+ ASSERT(x->left->max_sz <= x->max_sz);
}
if (x->right) {
ASSERT(x->right->parent == x);
ASSERT(cmp_blocks(order, x->right, x) > 0);
- ASSERT(x->right->max_sz <= x->max_sz);
+ ASSERT(x->right->max_sz <= x->max_sz);
}
ASSERT(x->max_sz >= AOFF_BLK_SZ(x));
ASSERT(x->max_sz == AOFF_BLK_SZ(x)
@@ -1412,7 +1412,7 @@ check_tree(Carrier_t* within_crr, enum AOFFSortOrder order, AOFF_RBTree_t* root,
x = x->parent;
--depth;
}
- ASSERT(depth == 0 || (!root && depth==1));
+ ASSERT(depth == 0 || (!root && depth==1));
ASSERT(curr_blacks == 0);
ASSERT((1 << (max_depth/2)) <= node_cnt);
@@ -1458,4 +1458,3 @@ print_tree(AOFF_RBTree_t* root)
#endif /* PRINT_TREE */
#endif /* HARD_DEBUG */
-
diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c
index ca81c14b96..0e7be99801 100644
--- a/erts/emulator/beam/erl_bestfit_alloc.c
+++ b/erts/emulator/beam/erl_bestfit_alloc.c
@@ -122,8 +122,8 @@ typedef struct {
RBTree_t *next;
} RBTreeList_t;
-#define LIST_NEXT(N) (((RBTreeList_t *) (N))->next)
-#define LIST_PREV(N) (((RBTreeList_t *) (N))->t.parent)
+#define BF_LIST_NEXT(N) (((RBTreeList_t *) (N))->next)
+#define BF_LIST_PREV(N) (((RBTreeList_t *) (N))->t.parent)
#ifdef DEBUG
@@ -595,7 +595,6 @@ aobf_link_free_block(Allctr_t *allctr, Block_t *block)
RBTree_t *blk = (RBTree_t *) block;
Uint blk_sz = BF_BLK_SZ(blk);
-
blk->flags = 0;
blk->left = NULL;
@@ -675,7 +674,7 @@ aobf_get_free_block(Allctr_t *allctr, Uint size,
x = x->left;
}
}
-
+
if (!blk)
return NULL;
@@ -731,11 +730,11 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block)
if (blk_sz == size) {
SET_LIST_ELEM(blk);
- LIST_NEXT(blk) = LIST_NEXT(x);
- LIST_PREV(blk) = x;
- if (LIST_NEXT(x))
- LIST_PREV(LIST_NEXT(x)) = blk;
- LIST_NEXT(x) = blk;
+ BF_LIST_NEXT(blk) = BF_LIST_NEXT(x);
+ BF_LIST_PREV(blk) = x;
+ if (BF_LIST_NEXT(x))
+ BF_LIST_PREV(BF_LIST_NEXT(x)) = blk;
+ BF_LIST_NEXT(x) = blk;
return; /* Finnished */
}
@@ -766,7 +765,7 @@ bf_link_free_block(Allctr_t *allctr, Block_t *block)
}
SET_TREE_NODE(blk);
- LIST_NEXT(blk) = NULL;
+ BF_LIST_NEXT(blk) = NULL;
#ifdef HARD_DEBUG
check_tree(root, 0, 0);
@@ -782,22 +781,22 @@ bf_unlink_free_block(Allctr_t *allctr, Block_t *block)
if (IS_LIST_ELEM(x)) {
/* Remove from list */
- ASSERT(LIST_PREV(x));
- LIST_NEXT(LIST_PREV(x)) = LIST_NEXT(x);
- if (LIST_NEXT(x))
- LIST_PREV(LIST_NEXT(x)) = LIST_PREV(x);
+ ASSERT(BF_LIST_PREV(x));
+ BF_LIST_NEXT(BF_LIST_PREV(x)) = BF_LIST_NEXT(x);
+ if (BF_LIST_NEXT(x))
+ BF_LIST_PREV(BF_LIST_NEXT(x)) = BF_LIST_PREV(x);
}
- else if (LIST_NEXT(x)) {
+ else if (BF_LIST_NEXT(x)) {
/* Replace tree node by next element in list... */
- ASSERT(BF_BLK_SZ(LIST_NEXT(x)) == BF_BLK_SZ(x));
+ ASSERT(BF_BLK_SZ(BF_LIST_NEXT(x)) == BF_BLK_SZ(x));
ASSERT(IS_TREE_NODE(x));
- ASSERT(IS_LIST_ELEM(LIST_NEXT(x)));
+ ASSERT(IS_LIST_ELEM(BF_LIST_NEXT(x)));
#ifdef HARD_DEBUG
check_tree(root, 0, 0);
#endif
- replace(root, x, LIST_NEXT(x));
+ replace(root, x, BF_LIST_NEXT(x));
#ifdef HARD_DEBUG
check_tree(bfallctr, 0);
@@ -836,7 +835,7 @@ bf_get_free_block(Allctr_t *allctr, Uint size,
x = x->left;
}
}
-
+
if (!blk)
return NULL;
@@ -855,7 +854,7 @@ bf_get_free_block(Allctr_t *allctr, Uint size,
/* Use next block if it exist in order to avoid replacing
the tree node */
- blk = LIST_NEXT(blk) ? LIST_NEXT(blk) : blk;
+ blk = BF_LIST_NEXT(blk) ? BF_LIST_NEXT(blk) : blk;
bf_unlink_free_block(allctr, (Block_t *) blk);
return (Block_t *) blk;
@@ -940,7 +939,7 @@ info_options(Allctr_t *allctr,
}
if (hpp || szp) {
-
+
if (!atoms_initialized)
erts_exit(ERTS_ERROR_EXIT, "%s:%d: Internal error: Atoms not initialized",
__FILE__, __LINE__);;
@@ -971,12 +970,12 @@ erts_bfalc_test(UWord op, UWord a1, UWord a2)
case 0x202: return (UWord) ((RBTree_t *) a1)->parent;
case 0x203: return (UWord) ((RBTree_t *) a1)->left;
case 0x204: return (UWord) ((RBTree_t *) a1)->right;
- case 0x205: return (UWord) LIST_NEXT(a1);
+ case 0x205: return (UWord) BF_LIST_NEXT(a1);
case 0x206: return (UWord) IS_BLACK((RBTree_t *) a1);
case 0x207: return (UWord) IS_TREE_NODE((RBTree_t *) a1);
case 0x208: return (UWord) 1; /* IS_BF_ALGO */
case 0x20a: return (UWord) !((BFAllctr_t *) a1)->address_order; /* IS_BF */
- case 0x20b: return (UWord) LIST_PREV(a1);
+ case 0x20b: return (UWord) BF_LIST_PREV(a1);
default: ASSERT(0); return ~((UWord) 0);
}
}
diff --git a/erts/emulator/beam/erl_bif_binary.c b/erts/emulator/beam/erl_bif_binary.c
index ca1ba55b22..4d6d31cd76 100644
--- a/erts/emulator/beam/erl_bif_binary.c
+++ b/erts/emulator/beam/erl_bif_binary.c
@@ -2735,7 +2735,7 @@ static BIF_RETTYPE do_encode_unsigned(Process *p, Eterm uns, Eterm endianess)
dsize_t num_parts = BIG_SIZE(bigp);
Eterm res;
byte *b;
- ErtsDigit d;
+ ErtsDigit d = 0;
if(BIG_SIGN(bigp)) {
goto badarg;
@@ -2751,26 +2751,22 @@ static BIF_RETTYPE do_encode_unsigned(Process *p, Eterm uns, Eterm endianess)
if (endianess == am_big) {
Sint i,j;
j = 0;
- d = BIG_DIGIT(bigp,0);
for (i=n-1;i>=0;--i) {
- b[i] = d & 0xFF;
- if (!((++j) % sizeof(ErtsDigit))) {
+ if (!((j++) % sizeof(ErtsDigit))) {
d = BIG_DIGIT(bigp,j / sizeof(ErtsDigit));
- } else {
- d >>= 8;
}
+ b[i] = d & 0xFF;
+ d >>= 8;
}
} else {
Sint i,j;
j = 0;
- d = BIG_DIGIT(bigp,0);
for (i=0;i<n;++i) {
- b[i] = d & 0xFF;
- if (!((++j) % sizeof(ErtsDigit))) {
+ if (!((j++) % sizeof(ErtsDigit))) {
d = BIG_DIGIT(bigp,j / sizeof(ErtsDigit));
- } else {
- d >>= 8;
}
+ b[i] = d & 0xFF;
+ d >>= 8;
}
}
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 8fb8bd2831..8c51bdb630 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -227,7 +227,7 @@ bld_magic_ref_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
}).
*/
-static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz)
+static int do_calc_mon_size(ErtsMonitor *mon, void *vpsz, Sint reds)
{
ErtsMonitorData *mdp = erts_monitor_to_data(mon);
Uint *psz = vpsz;
@@ -238,7 +238,8 @@ static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz)
else
*psz += is_immed(mon->other.item) ? 0 : NC_HEAP_SIZE(mon->other.item);
- *psz += 9; /* CONS + 6-tuple */
+ *psz += 9; /* CONS + 6-tuple */
+ return 1;
}
typedef struct {
@@ -248,7 +249,7 @@ typedef struct {
Eterm tag;
} MonListContext;
-static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc)
+static int do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc, Sint reds)
{
ErtsMonitorData *mdp = erts_monitor_to_data(mon);
MonListContext *pmlc = vpmlc;
@@ -319,6 +320,7 @@ static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc)
pmlc->hp += 7;
pmlc->res = CONS(pmlc->hp, tup, pmlc->res);
pmlc->hp += 2;
+ return 1;
}
static Eterm
@@ -328,7 +330,7 @@ make_monitor_list(Process *p, int tree, ErtsMonitor *root, Eterm tail)
Uint sz = 0;
MonListContext mlc;
void (*foreach)(ErtsMonitor *,
- void (*)(ErtsMonitor *, void *),
+ ErtsMonitorFunc,
void *);
foreach = tree ? erts_monitor_tree_foreach : erts_monitor_list_foreach;
@@ -354,7 +356,7 @@ make_monitor_list(Process *p, int tree, ErtsMonitor *root, Eterm tail)
}).
*/
-static void calc_lnk_size(ErtsLink *lnk, void *vpsz)
+static int calc_lnk_size(ErtsLink *lnk, void *vpsz, Sint reds)
{
Uint *psz = vpsz;
Uint sz = 0;
@@ -364,7 +366,8 @@ static void calc_lnk_size(ErtsLink *lnk, void *vpsz)
*psz += sz;
*psz += is_immed(lnk->other.item) ? 0 : size_object(lnk->other.item);
- *psz += 7; /* CONS + 4-tuple */
+ *psz += 7; /* CONS + 4-tuple */
+ return 1;
}
typedef struct {
@@ -374,7 +377,7 @@ typedef struct {
Eterm tag;
} LnkListContext;
-static void make_one_lnk_element(ErtsLink *lnk, void * vpllc)
+static int make_one_lnk_element(ErtsLink *lnk, void * vpllc, Sint reds)
{
LnkListContext *pllc = vpllc;
Eterm tup, t, pid, id;
@@ -411,6 +414,7 @@ static void make_one_lnk_element(ErtsLink *lnk, void * vpllc)
pllc->hp += 5;
pllc->res = CONS(pllc->hp, tup, pllc->res);
pllc->hp += 2;
+ return 1;
}
static Eterm
@@ -420,7 +424,7 @@ make_link_list(Process *p, int tree, ErtsLink *root, Eterm tail)
Uint sz = 0;
LnkListContext llc;
void (*foreach)(ErtsLink *,
- void (*)(ErtsLink *, void *),
+ ErtsLinkFunc,
void *);
foreach = tree ? erts_link_tree_foreach : erts_link_list_foreach;
@@ -519,16 +523,17 @@ do { \
} \
} while (0)
-static void collect_one_link(ErtsLink *lnk, void *vmicp)
+static int collect_one_link(ErtsLink *lnk, void *vmicp, Sint reds)
{
MonitorInfoCollection *micp = vmicp;
EXTEND_MONITOR_INFOS(micp);
micp->mi[micp->mi_i].entity.term = lnk->other.item;
micp->sz += 2 + NC_HEAP_SIZE(lnk->other.item);
micp->mi_i++;
+ return 1;
}
-static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp)
+static int collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp, Sint reds)
{
if (erts_monitor_is_origin(mon)) {
MonitorInfoCollection *micp = vmicp;
@@ -573,9 +578,10 @@ static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp)
break;
}
}
+ return 1;
}
-static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp)
+static int collect_one_target_monitor(ErtsMonitor *mon, void *vmicp, Sint reds)
{
MonitorInfoCollection *micp = vmicp;
@@ -612,8 +618,8 @@ static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp)
default:
break;
}
-
}
+ return 1;
}
typedef struct {
@@ -653,8 +659,8 @@ do { \
} \
} while (0)
-static void
-collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp)
+static int
+collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp, Sint reds)
{
if (mon->type == ERTS_MON_TYPE_SUSPEND) {
Sint count;
@@ -678,6 +684,7 @@ collect_one_suspend_monitor(ErtsMonitor *mon, void *vsmicp)
smicp->smi_i++;
}
+ return 1;
}
/*
@@ -2965,7 +2972,7 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
} else if (ERTS_IS_ATOM_STR("context_reductions", BIF_ARG_1)) {
BIF_RET(make_small(CONTEXT_REDS));
} else if (ERTS_IS_ATOM_STR("kernel_poll", BIF_ARG_1)) {
-#ifdef ERTS_ENABLE_KERNEL_POLL
+#if ERTS_ENABLE_KERNEL_POLL
BIF_RET(am_true);
#else
BIF_RET(am_false);
@@ -3144,14 +3151,16 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
-static void monitor_size(ErtsMonitor *mon, void *vsz)
+static int monitor_size(ErtsMonitor *mon, void *vsz, Sint reds)
{
*((Uint *) vsz) = erts_monitor_size(mon);
+ return 1;
}
-static void link_size(ErtsMonitor *lnk, void *vsz)
+static int link_size(ErtsMonitor *lnk, void *vsz, Sint reds)
{
*((Uint *) vsz) = erts_link_size(lnk);
+ return 1;
}
/**********************************************************************/
@@ -4680,6 +4689,16 @@ BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2)
BIF_RET(am_ok);
}
}
+ else if (ERTS_IS_ATOM_STR("mbuf", BIF_ARG_1)) {
+ Uint sz = size_object(BIF_ARG_2);
+ ErlHeapFragment* frag = new_message_buffer(sz);
+ Eterm *hp = frag->mem;
+ Eterm copy = copy_struct(BIF_ARG_2, sz, &hp, &frag->off_heap);
+ frag->next = BIF_P->mbuf;
+ BIF_P->mbuf = frag;
+ BIF_P->mbuf_sz += sz;
+ BIF_RET(copy);
+ }
}
BIF_ERROR(BIF_P, BADARG);
diff --git a/erts/emulator/beam/erl_bif_persistent.c b/erts/emulator/beam/erl_bif_persistent.c
index 9dca768a18..5a78a043ce 100644
--- a/erts/emulator/beam/erl_bif_persistent.c
+++ b/erts/emulator/beam/erl_bif_persistent.c
@@ -332,6 +332,23 @@ BIF_RETTYPE persistent_term_get_1(BIF_ALIST_1)
BIF_ERROR(BIF_P, BADARG);
}
+BIF_RETTYPE persistent_term_get_2(BIF_ALIST_2)
+{
+ Eterm key = BIF_ARG_1;
+ Eterm result = BIF_ARG_2;
+ HashTable* hash_table = (HashTable *) erts_atomic_read_nob(&the_hash_table);
+ Uint entry_index;
+ Eterm term;
+
+ entry_index = lookup(hash_table, key);
+ term = hash_table->term[entry_index];
+ if (is_boxed(term)) {
+ ASSERT(is_tuple_arity(term, 2));
+ result = tuple_val(term)[2];
+ }
+ BIF_RET(result);
+}
+
BIF_RETTYPE persistent_term_erase_1(BIF_ALIST_1)
{
Eterm key = BIF_ARG_1;
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index df6f42edd3..0a50af4d1a 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -81,14 +81,6 @@ static BIF_RETTYPE db_bif_fail(Process* p, Uint freason,
/* Get a key from any table structure and a tagged object */
#define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj))
-
-/* How safe are we from double-hits or missed objects
-** when iterating without fixation? */
-enum DbIterSafety {
- ITER_UNSAFE, /* Must fixate to be safe */
- ITER_SAFE_LOCKED, /* Safe while table is locked, not between trap calls */
- ITER_SAFE /* No need to fixate at all */
-};
# define ITERATION_SAFETY(Proc,Tab) \
((IS_TREE_TABLE((Tab)->common.status) || IS_CATREE_TABLE((Tab)->common.status) \
|| ONLY_WRITER(Proc,Tab)) ? ITER_SAFE \
@@ -195,9 +187,6 @@ static int fixed_tabs_find(DbFixation* first, DbFixation* fix)
#define ERTS_RBT_WANT_DELETE
#define ERTS_RBT_WANT_FOREACH
#define ERTS_RBT_WANT_FOREACH_DESTROY
-#ifdef DEBUG
-# define ERTS_RBT_WANT_LOOKUP
-#endif
#define ERTS_RBT_UNDEF
#include "erl_rbtree.h"
@@ -2287,6 +2276,7 @@ static BIF_RETTYPE ets_select_delete_trap_1(BIF_ALIST_1)
Eterm ret;
Eterm *tptr;
db_lock_kind_t kind = LCK_WRITE_REC;
+ enum DbIterSafety safety = ITER_SAFE;
CHECK_TABLES();
ASSERT(is_tuple(a1));
@@ -2296,10 +2286,11 @@ static BIF_RETTYPE ets_select_delete_trap_1(BIF_ALIST_1)
DB_TRAP_GET_TABLE(tb, tptr[1], DB_WRITE, kind,
&ets_select_delete_continue_exp);
- cret = tb->common.meth->db_select_delete_continue(p,tb,a1,&ret);
+ cret = tb->common.meth->db_select_delete_continue(p,tb,a1,&ret,&safety);
- if(!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) {
- unfix_table_locked(p, tb, &kind);
+ if(!DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ ASSERT(erts_refc_read(&tb->common.fix_count,1));
+ unfix_table_locked(p, tb, &kind);
}
db_unlock(tb, kind);
@@ -2337,7 +2328,8 @@ BIF_RETTYPE ets_internal_select_delete_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, &ret);
+ cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_1, BIF_ARG_2,
+ &ret, safety);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P,tb);
@@ -2729,7 +2721,7 @@ ets_select3(Process* p, DbTable* tb, Eterm tid, Eterm ms, Sint chunk_size)
cret = tb->common.meth->db_select_chunk(p, tb, tid,
ms, chunk_size,
0 /* not reversed */,
- &ret);
+ &ret, safety);
if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
fix_table_locked(p, tb);
}
@@ -2756,7 +2748,8 @@ ets_select3(Process* p, DbTable* tb, Eterm tid, Eterm ms, Sint chunk_size)
}
-/* We get here instead of in the real BIF when trapping */
+/* Trap here from: ets_select_1/2/3
+ */
static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
{
Process *p = BIF_P;
@@ -2767,6 +2760,7 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
Eterm ret;
Eterm *tptr;
db_lock_kind_t kind = LCK_READ;
+ enum DbIterSafety safety = ITER_SAFE;
CHECK_TABLES();
@@ -2776,11 +2770,13 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
DB_TRAP_GET_TABLE(tb, tptr[1], DB_READ, kind,
&ets_select_continue_exp);
- cret = tb->common.meth->db_select_continue(p, tb, a1,
- &ret);
+ cret = tb->common.meth->db_select_continue(p, tb, a1, &ret, &safety);
- if (!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) {
- unfix_table_locked(p, tb, &kind);
+ if (!DID_TRAP(p,ret)) {
+ if (safety != ITER_SAFE) {
+ ASSERT(erts_refc_read(&tb->common.fix_count,1));
+ unfix_table_locked(p, tb, &kind);
+ }
}
db_unlock(tb, kind);
@@ -2805,8 +2801,12 @@ static BIF_RETTYPE ets_select_trap_1(BIF_ALIST_1)
BIF_RETTYPE ets_select_1(BIF_ALIST_1)
{
return ets_select1(BIF_P, BIF_ets_select_1, BIF_ARG_1);
+ /* TRAP: ets_select_trap_1 */
}
+/*
+ * Common impl for select/1, select_reverse/1, match/1 and match_object/1
+ */
static BIF_RETTYPE ets_select1(Process *p, int bif_ix, Eterm arg1)
{
BIF_RETTYPE result;
@@ -2814,7 +2814,7 @@ static BIF_RETTYPE ets_select1(Process *p, int bif_ix, Eterm arg1)
int cret;
Eterm ret;
Eterm *tptr;
- enum DbIterSafety safety;
+ enum DbIterSafety safety, safety_copy;
CHECK_TABLES();
@@ -2839,7 +2839,8 @@ static BIF_RETTYPE ets_select1(Process *p, int bif_ix, Eterm arg1)
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_continue(p,tb, arg1, &ret);
+ safety_copy = safety;
+ cret = tb->common.meth->db_select_continue(p,tb, arg1, &ret, &safety_copy);
if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
fix_table_locked(p, tb);
@@ -2871,6 +2872,7 @@ BIF_RETTYPE ets_select_2(BIF_ALIST_2)
DbTable* tb;
DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_select_2);
return ets_select2(BIF_P, tb, BIF_ARG_1, BIF_ARG_2);
+ /* TRAP: ets_select_trap_1 */
}
static BIF_RETTYPE
@@ -2888,7 +2890,7 @@ ets_select2(Process* p, DbTable* tb, Eterm tid, Eterm ms)
local_fix_table(tb);
}
- cret = tb->common.meth->db_select(p, tb, tid, ms, 0, &ret);
+ cret = tb->common.meth->db_select(p, tb, tid, ms, 0, &ret, safety);
if (DID_TRAP(p,ret) && safety != ITER_SAFE) {
fix_table_locked(p, tb);
@@ -2926,6 +2928,7 @@ static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1)
Eterm ret;
Eterm *tptr;
db_lock_kind_t kind = LCK_READ;
+ enum DbIterSafety safety = ITER_SAFE;
CHECK_TABLES();
@@ -2935,9 +2938,10 @@ static BIF_RETTYPE ets_select_count_1(BIF_ALIST_1)
DB_TRAP_GET_TABLE(tb, tptr[1], DB_READ, kind,
&ets_select_count_continue_exp);
- cret = tb->common.meth->db_select_count_continue(p, tb, a1, &ret);
+ cret = tb->common.meth->db_select_count_continue(p, tb, a1, &ret, &safety);
- if (!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) {
+ if (!DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ ASSERT(erts_refc_read(&tb->common.fix_count,1));
unfix_table_locked(p, tb, &kind);
}
db_unlock(tb, kind);
@@ -2975,7 +2979,8 @@ BIF_RETTYPE ets_select_count_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_count(BIF_P,tb, BIF_ARG_1, BIF_ARG_2, &ret);
+ cret = tb->common.meth->db_select_count(BIF_P,tb, BIF_ARG_1, BIF_ARG_2,
+ &ret, safety);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P, tb);
@@ -3014,6 +3019,7 @@ static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1)
Eterm ret;
Eterm *tptr;
db_lock_kind_t kind = LCK_WRITE_REC;
+ enum DbIterSafety safety = ITER_SAFE;
CHECK_TABLES();
ASSERT(is_tuple(a1));
@@ -3023,9 +3029,10 @@ static BIF_RETTYPE ets_select_replace_1(BIF_ALIST_1)
DB_TRAP_GET_TABLE(tb, tptr[1], DB_WRITE, kind,
&ets_select_replace_continue_exp);
- cret = tb->common.meth->db_select_replace_continue(p,tb,a1,&ret);
+ cret = tb->common.meth->db_select_replace_continue(p,tb,a1,&ret,&safety);
- if(!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) {
+ if(!DID_TRAP(p,ret) && safety != ITER_SAFE) {
+ ASSERT(erts_refc_read(&tb->common.fix_count,1));
unfix_table_locked(p, tb, &kind);
}
@@ -3068,7 +3075,8 @@ BIF_RETTYPE ets_select_replace_2(BIF_ALIST_2)
if (safety == ITER_UNSAFE) {
local_fix_table(tb);
}
- cret = tb->common.meth->db_select_replace(BIF_P, tb, BIF_ARG_1, BIF_ARG_2, &ret);
+ cret = tb->common.meth->db_select_replace(BIF_P, tb, BIF_ARG_1, BIF_ARG_2,
+ &ret, safety);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P,tb);
@@ -3120,7 +3128,7 @@ BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3)
}
cret = tb->common.meth->db_select_chunk(BIF_P,tb, BIF_ARG_1,
BIF_ARG_2, chunk_size,
- 1 /* reversed */, &ret);
+ 1 /* reversed */, &ret, safety);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P, tb);
}
@@ -3165,7 +3173,7 @@ BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2)
local_fix_table(tb);
}
cret = tb->common.meth->db_select(BIF_P,tb, BIF_ARG_1, BIF_ARG_2,
- 1 /*reversed*/, &ret);
+ 1 /*reversed*/, &ret, safety);
if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) {
fix_table_locked(BIF_P, tb);
@@ -3701,7 +3709,7 @@ static SWord proc_cleanup_fixed_table(Process* p, DbFixation* fix)
/*
* erts_db_process_exiting() is called when a process terminates.
* It returns 0 when completely done, and !0 when it wants to
- * yield. c_p->u.terminate can hold a pointer to a state while
+ * yield. *yield_state can hold a pointer to a state while
* yielding.
*/
#define ERTS_DB_INTERNAL_ERROR(LSTR) \
@@ -3709,7 +3717,7 @@ static SWord proc_cleanup_fixed_table(Process* p, DbFixation* fix)
__FILE__, __LINE__)
int
-erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
+erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks, void **yield_state)
{
typedef struct {
enum {
@@ -3719,7 +3727,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
}op;
DbTable *tb;
} CleanupState;
- CleanupState *state = (CleanupState *) c_p->u.terminate;
+ CleanupState *state = (CleanupState *) *yield_state;
Eterm pid = c_p->common.id;
CleanupState default_state;
SWord initial_reds = ERTS_BIF_REDS_LEFT(c_p);
@@ -3792,7 +3800,7 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
if (state != &default_state)
erts_free(ERTS_ALC_T_DB_PROC_CLEANUP, state);
- c_p->u.terminate = NULL;
+ *yield_state = NULL;
BUMP_REDS(c_p, (initial_reds - reds));
return 0;
@@ -3812,12 +3820,12 @@ erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks)
yield:
if (state == &default_state) {
- c_p->u.terminate = erts_alloc(ERTS_ALC_T_DB_PROC_CLEANUP,
- sizeof(CleanupState));
- sys_memcpy(c_p->u.terminate, (void*) state, sizeof(CleanupState));
+ *yield_state = erts_alloc(ERTS_ALC_T_DB_PROC_CLEANUP,
+ sizeof(CleanupState));
+ sys_memcpy(*yield_state, (void*) state, sizeof(CleanupState));
}
else
- ASSERT(state == c_p->u.terminate);
+ ASSERT(state == *yield_state);
return !0;
}
@@ -3912,7 +3920,7 @@ struct free_fixations_ctx
SWord cnt;
};
-static void free_fixations_op(DbFixation* fix, void* vctx)
+static int free_fixations_op(DbFixation* fix, void* vctx, Sint reds)
{
struct free_fixations_ctx* ctx = (struct free_fixations_ctx*) vctx;
erts_aint_t diff;
@@ -3949,6 +3957,7 @@ static void free_fixations_op(DbFixation* fix, void* vctx)
ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation));
}
ctx->cnt++;
+ return 1;
}
int erts_db_execute_free_fixation(Process* p, DbFixation* fix)
@@ -4093,7 +4102,7 @@ struct fixing_procs_info_ctx
Eterm list;
};
-static void fixing_procs_info_op(DbFixation* fix, void* vctx)
+static int fixing_procs_info_op(DbFixation* fix, void* vctx, Sint reds)
{
struct fixing_procs_info_ctx* ctx = (struct fixing_procs_info_ctx*) vctx;
Eterm* hp;
@@ -4103,6 +4112,7 @@ static void fixing_procs_info_op(DbFixation* fix, void* vctx)
tpl = TUPLE2(hp, fix->procs.p->common.id, make_small(fix->counter));
hp += 3;
ctx->list = CONS(hp, tpl, ctx->list);
+ return 1;
}
static Eterm table_info(Process* p, DbTable* tb, Eterm What)
diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h
index 5955d42aae..dc77fbb60c 100644
--- a/erts/emulator/beam/erl_db.h
+++ b/erts/emulator/beam/erl_db.h
@@ -111,7 +111,7 @@ typedef enum {
} ErtsDbSpinCount;
void init_db(ErtsDbSpinCount);
-int erts_db_process_exiting(Process *, ErtsProcLocks);
+int erts_db_process_exiting(Process *, ErtsProcLocks, void **);
int erts_db_execute_free_fixation(Process*, DbFixation*);
void db_info(fmtfn_t, void *, int);
void erts_db_foreach_table(void (*)(DbTable *, void *), void *);
diff --git a/erts/emulator/beam/erl_db_catree.c b/erts/emulator/beam/erl_db_catree.c
index 75ac1c4a93..0402c6b7b4 100644
--- a/erts/emulator/beam/erl_db_catree.c
+++ b/erts/emulator/beam/erl_db_catree.c
@@ -116,24 +116,31 @@ static int db_erase_object_catree(DbTable *tbl, Eterm object,Eterm *ret);
static int db_slot_catree(Process *p, DbTable *tbl,
Eterm slot_term, Eterm *ret);
static int db_select_catree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, int reversed, Eterm *ret);
+ Eterm pattern, int reversed, Eterm *ret,
+ enum DbIterSafety);
static int db_select_count_catree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret, enum DbIterSafety);
static int db_select_chunk_catree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
- int reversed, Eterm *ret);
+ int reversed, Eterm *ret, enum DbIterSafety);
static int db_select_continue_catree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_count_continue_catree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_delete_catree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety);
static int db_select_delete_continue_catree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_replace_catree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety);
static int db_select_replace_continue_catree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_take_catree(Process *, DbTable *, Eterm, Eterm *);
static void db_print_catree(fmtfn_t to, void *to_arg,
int show, DbTable *tbl);
@@ -1843,7 +1850,8 @@ static int db_slot_catree(Process *p, DbTable *tbl,
static int db_select_continue_catree(Process *p,
DbTable *tbl,
Eterm continuation,
- Eterm *ret)
+ Eterm *ret,
+ enum DbIterSafety* safety_p)
{
int result;
CATreeRootIterator iter;
@@ -1856,7 +1864,8 @@ static int db_select_continue_catree(Process *p,
}
static int db_select_catree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, int reverse, Eterm *ret)
+ Eterm pattern, int reverse, Eterm *ret,
+ enum DbIterSafety safety)
{
int result;
CATreeRootIterator iter;
@@ -1871,7 +1880,8 @@ static int db_select_catree(Process *p, DbTable *tbl, Eterm tid,
static int db_select_count_continue_catree(Process *p,
DbTable *tbl,
Eterm continuation,
- Eterm *ret)
+ Eterm *ret,
+ enum DbIterSafety* safety_p)
{
int result;
CATreeRootIterator iter;
@@ -1885,7 +1895,8 @@ static int db_select_count_continue_catree(Process *p,
}
static int db_select_count_catree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret)
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety)
{
int result;
CATreeRootIterator iter;
@@ -1899,7 +1910,8 @@ static int db_select_count_catree(Process *p, DbTable *tbl, Eterm tid,
static int db_select_chunk_catree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
- int reversed, Eterm *ret)
+ int reversed, Eterm *ret,
+ enum DbIterSafety safety)
{
int result;
CATreeRootIterator iter;
@@ -1915,7 +1927,8 @@ static int db_select_chunk_catree(Process *p, DbTable *tbl, Eterm tid,
static int db_select_delete_continue_catree(Process *p,
DbTable *tbl,
Eterm continuation,
- Eterm *ret)
+ Eterm *ret,
+ enum DbIterSafety* safety_p)
{
DbTreeStack stack;
TreeDbTerm * stack_array[STACK_NEED];
@@ -1931,7 +1944,8 @@ static int db_select_delete_continue_catree(Process *p,
}
static int db_select_delete_catree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret)
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety)
{
DbTreeStack stack;
TreeDbTerm * stack_array[STACK_NEED];
@@ -1948,7 +1962,8 @@ static int db_select_delete_catree(Process *p, DbTable *tbl, Eterm tid,
}
static int db_select_replace_catree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret)
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety_p)
{
int result;
CATreeRootIterator iter;
@@ -1961,7 +1976,8 @@ static int db_select_replace_catree(Process *p, DbTable *tbl, Eterm tid,
}
static int db_select_replace_continue_catree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret)
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety* safety_p)
{
int result;
CATreeRootIterator iter;
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index f05a3b51c9..f225730029 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -404,26 +404,31 @@ static int db_slot_hash(Process *p, DbTable *tbl,
static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
- int reverse, Eterm *ret);
+ int reverse, Eterm *ret, enum DbIterSafety);
static int db_select_hash(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, int reverse, Eterm *ret);
+ Eterm pattern, int reverse, Eterm *ret,
+ enum DbIterSafety);
static int db_select_continue_hash(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret, enum DbIterSafety);
static int db_select_count_continue_hash(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
-
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety);
static int db_select_delete_continue_hash(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret, enum DbIterSafety);
static int db_select_replace_continue_hash(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_take_hash(Process *, DbTable *, Eterm, Eterm *);
static void db_print_hash(fmtfn_t to,
@@ -535,7 +540,7 @@ DbTableMethod db_hash =
db_select_chunk_hash,
db_select_hash,
db_select_delete_hash,
- db_select_continue_hash, /* hmm continue_hash? */
+ db_select_continue_hash,
db_select_delete_continue_hash,
db_select_count_hash,
db_select_count_continue_hash,
@@ -1154,8 +1159,9 @@ static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret)
* Match traversal callbacks
*/
-typedef struct match_callbacks_t_ match_callbacks_t;
-struct match_callbacks_t_
+
+typedef struct traverse_context_t_ traverse_context_t;
+struct traverse_context_t_
{
/* Called when no match is possible.
* context_ptr: Pointer to context
@@ -1163,7 +1169,7 @@ struct match_callbacks_t_
*
* Both the direct return value and 'ret' are used as the traversal function return values.
*/
- int (*on_nothing_can_match)(match_callbacks_t* ctx, Eterm* ret);
+ int (*on_nothing_can_match)(traverse_context_t* ctx, Eterm* ret);
/* Called for each match result.
* context_ptr: Pointer to context
@@ -1174,7 +1180,7 @@ struct match_callbacks_t_
*
* Should return 1 for successful match, 0 otherwise.
*/
- int (*on_match_res)(match_callbacks_t* ctx, Sint slot_ix,
+ int (*on_match_res)(traverse_context_t* ctx, Sint slot_ix,
HashDbTerm*** current_ptr_ptr, Eterm match_res);
/* Called when either we've matched enough elements in this cycle or EOT was reached.
@@ -1188,7 +1194,7 @@ struct match_callbacks_t_
* Both the direct return value and 'ret' are used as the traversal function return values.
* If *mpp is set to NULL, it won't be deallocated (useful for trapping.)
*/
- int (*on_loop_ended)(match_callbacks_t* ctx, Sint slot_ix, Sint got,
+ int (*on_loop_ended)(traverse_context_t* ctx, Sint slot_ix, Sint got,
Sint iterations_left, Binary** mpp, Eterm* ret);
/* Called when it's time to trap
@@ -1201,16 +1207,21 @@ struct match_callbacks_t_
* Both the direct return value and 'ret' are used as the traversal function return values.
* If *mpp is set to NULL, it won't be deallocated (useful for trapping.)
*/
- int (*on_trap)(match_callbacks_t* ctx, Sint slot_ix, Sint got, Binary** mpp,
+ int (*on_trap)(traverse_context_t* ctx, Sint slot_ix, Sint got, Binary** mpp,
Eterm* ret);
+ Process* p;
+ DbTableHash* tb;
+ Eterm tid;
+ Eterm* prev_continuation_tptr;
+ enum DbIterSafety safety;
};
/*
* Begin hash table match traversal
*/
-static int match_traverse(Process* p, DbTableHash* tb,
+static int match_traverse(traverse_context_t* ctx,
Eterm pattern,
extra_match_validator_t extra_match_validator, /* Optional */
Sint chunk_size, /* If 0, no chunking */
@@ -1218,9 +1229,9 @@ static int match_traverse(Process* p, DbTableHash* tb,
Eterm** hpp, /* Heap */
int lock_for_write, /* Set to 1 if we're going to delete or
modify existing terms */
- match_callbacks_t* ctx,
Eterm* ret)
{
+ DbTableHash* tb = ctx->tb;
Sint slot_ix; /* Slot index */
HashDbTerm** current_ptr; /* Refers to either the bucket pointer or
* the 'next' pointer in the previous term
@@ -1287,7 +1298,7 @@ static int match_traverse(Process* p, DbTableHash* tb,
for(;;) {
if (*current_ptr != NULL) {
if (!is_pseudo_deleted(*current_ptr)) {
- match_res = db_match_dbterm(&tb->common, p, mpi.mp,
+ match_res = db_match_dbterm(&tb->common, ctx->p, mpi.mp,
&(*current_ptr)->dbterm, hpp, 2);
saved_current = *current_ptr;
if (ctx->on_match_res(ctx, slot_ix, &current_ptr, match_res)) {
@@ -1323,11 +1334,7 @@ static int match_traverse(Process* p, DbTableHash* tb,
unlock_hash_function(lck);
break;
}
- if (iterations_left <= 0 || MBUF(p)) {
- /*
- * We have either reached our limit, or just created some heap fragments.
- * Since many heap fragments will make the GC slower, trap and GC now.
- */
+ if (iterations_left <= 0) {
unlock_hash_function(lck);
ret_value = ctx->on_trap(ctx, slot_ix, got, &mpi.mp, ret);
goto done;
@@ -1356,7 +1363,7 @@ done:
/*
* Continue hash table match traversal
*/
-static int match_traverse_continue(Process* p, DbTableHash* tb,
+static int match_traverse_continue(traverse_context_t* ctx,
Sint chunk_size, /* If 0, no chunking */
Sint iterations_left, /* Nr. of iterations left */
Eterm** hpp, /* Heap */
@@ -1365,9 +1372,9 @@ static int match_traverse_continue(Process* p, DbTableHash* tb,
Binary** mpp, /* Existing match program */
int lock_for_write, /* Set to 1 if we're going to delete or
modify existing terms */
- match_callbacks_t* ctx,
Eterm* ret)
{
+ DbTableHash* tb = ctx->tb;
HashDbTerm** current_ptr; /* Refers to either the bucket pointer or
* the 'next' pointer in the previous term
*/
@@ -1410,7 +1417,7 @@ static int match_traverse_continue(Process* p, DbTableHash* tb,
for(;;) {
if (*current_ptr != NULL) {
if (!is_pseudo_deleted(*current_ptr)) {
- match_res = db_match_dbterm(&tb->common, p, *mpp,
+ match_res = db_match_dbterm(&tb->common, ctx->p, *mpp,
&(*current_ptr)->dbterm, hpp, 2);
saved_current = *current_ptr;
if (ctx->on_match_res(ctx, slot_ix, &current_ptr, match_res)) {
@@ -1433,11 +1440,7 @@ static int match_traverse_continue(Process* p, DbTableHash* tb,
unlock_hash_function(lck);
break;
}
- if (iterations_left <= 0 || MBUF(p)) {
- /*
- * We have either reached our limit, or just created some heap fragments.
- * Since many heap fragments will make the GC slower, trap and GC now.
- */
+ if (iterations_left <= 0) {
unlock_hash_function(lck);
ret_value = ctx->on_trap(ctx, slot_ix, got, mpp, ret);
goto done;
@@ -1464,52 +1467,50 @@ done:
*/
static ERTS_INLINE int on_simple_trap(Export* trap_function,
- Process* p,
- DbTableHash* tb,
- Eterm tid,
- Eterm* prev_continuation_tptr,
- Sint slot_ix,
- Sint got,
- Binary** mpp,
- Eterm* ret)
+ traverse_context_t* ctx,
+ Sint slot_ix,
+ Sint got,
+ Binary** mpp,
+ Eterm* ret)
{
Eterm* hp;
Eterm egot;
Eterm mpb;
Eterm continuation;
- int is_first_trap = (prev_continuation_tptr == NULL);
+ int is_first_trap = (ctx->prev_continuation_tptr == NULL);
size_t base_halloc_sz = (is_first_trap ? ERTS_MAGIC_REF_THING_SIZE : 0);
- BUMP_ALL_REDS(p);
+ BUMP_ALL_REDS(ctx->p);
if (IS_USMALL(0, got)) {
- hp = HAllocX(p, base_halloc_sz + 5, ERTS_MAGIC_REF_THING_SIZE);
+ hp = HAllocX(ctx->p, base_halloc_sz + 6, ERTS_MAGIC_REF_THING_SIZE);
egot = make_small(got);
}
else {
- hp = HAllocX(p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 5,
+ hp = HAllocX(ctx->p, base_halloc_sz + BIG_UINT_HEAP_SIZE + 6,
ERTS_MAGIC_REF_THING_SIZE);
egot = uint_to_big(got, hp);
hp += BIG_UINT_HEAP_SIZE;
}
if (is_first_trap) {
- if (is_atom(tid))
- tid = erts_db_make_tid(p, &tb->common);
- mpb = erts_db_make_match_prog_ref(p, *mpp, &hp);
+ if (is_atom(ctx->tid))
+ ctx->tid = erts_db_make_tid(ctx->p, &ctx->tb->common);
+ mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &hp);
*mpp = NULL; /* otherwise the caller will destroy it */
}
else {
- ASSERT(!is_atom(tid));
- mpb = prev_continuation_tptr[3];
+ ASSERT(!is_atom(ctx->tid));
+ mpb = ctx->prev_continuation_tptr[3];
}
- continuation = TUPLE4(
+ continuation = TUPLE5(
hp,
- tid,
+ ctx->tid,
make_small(slot_ix),
mpb,
- egot);
- ERTS_BIF_PREP_TRAP1(*ret, trap_function, p, continuation);
+ egot,
+ make_small(ctx->safety));
+ ERTS_BIF_PREP_TRAP1(*ret, trap_function, ctx->p, continuation);
return DB_ERROR_NONE;
}
@@ -1518,17 +1519,18 @@ static ERTS_INLINE int unpack_simple_continuation(Eterm continuation,
Eterm* tid_ptr,
Sint* slot_ix_p,
Binary** mpp,
- Sint* got_p)
+ Sint* got_p,
+ enum DbIterSafety* safety_p)
{
Eterm* tptr;
ASSERT(is_tuple(continuation));
tptr = tuple_val(continuation);
- if (arityval(*tptr) != 4)
+ if (*tptr != make_arityval(5))
return 1;
- if (! is_small(tptr[2]) || !(is_big(tptr[4]) || is_small(tptr[4]))) {
+ if (!is_small(tptr[2]) || !(is_big(tptr[4]) || is_small(tptr[4]))
+ || !is_small(tptr[5]))
return 1;
- }
*tptr_ptr = tptr;
*tid_ptr = tptr[1];
@@ -1540,6 +1542,7 @@ static ERTS_INLINE int unpack_simple_continuation(Eterm continuation,
else {
*got_p = unsigned_val(tptr[4]);
}
+ *safety_p = signed_val(tptr[5]);
return 0;
}
@@ -1553,24 +1556,20 @@ static ERTS_INLINE int unpack_simple_continuation(Eterm continuation,
#define MAX_SELECT_CHUNK_ITERATIONS 1000
typedef struct {
- match_callbacks_t base;
- Process* p;
- DbTableHash* tb;
- Eterm tid;
+ traverse_context_t base;
Eterm* hp;
Sint chunk_size;
Eterm match_list;
- Eterm* prev_continuation_tptr;
} select_chunk_context_t;
-static int select_chunk_on_nothing_can_match(match_callbacks_t* ctx_base, Eterm* ret)
+static int select_chunk_on_nothing_can_match(traverse_context_t* ctx_base, Eterm* ret)
{
select_chunk_context_t* ctx = (select_chunk_context_t*) ctx_base;
*ret = (ctx->chunk_size > 0 ? am_EOT : NIL);
return DB_ERROR_NONE;
}
-static int select_chunk_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
+static int select_chunk_on_match_res(traverse_context_t* ctx_base, Sint slot_ix,
HashDbTerm*** current_ptr_ptr,
Eterm match_res)
{
@@ -1582,7 +1581,7 @@ static int select_chunk_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
return 0;
}
-static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base,
+static int select_chunk_on_loop_ended(traverse_context_t* ctx_base,
Sint slot_ix, Sint got,
Sint iterations_left, Binary** mpp,
Eterm* ret)
@@ -1598,7 +1597,7 @@ static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base,
}
else {
ASSERT(iterations_left < MAX_SELECT_CHUNK_ITERATIONS);
- BUMP_REDS(ctx->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
+ BUMP_REDS(ctx->base.p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
if (ctx->chunk_size) {
Eterm continuation;
Eterm rest = NIL;
@@ -1617,14 +1616,14 @@ static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base,
been in 'user space' */
}
if (rest != NIL || slot_ix >= 0) { /* Need more calls */
- Eterm tid = ctx->tid;
- ctx->hp = HAllocX(ctx->p,
+ Eterm tid = ctx->base.tid;
+ ctx->hp = HAllocX(ctx->base.p,
3 + 7 + ERTS_MAGIC_REF_THING_SIZE,
ERTS_MAGIC_REF_THING_SIZE);
- mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &ctx->hp);
+ mpb = erts_db_make_match_prog_ref(ctx->base.p, *mpp, &ctx->hp);
if (is_atom(tid))
- tid = erts_db_make_tid(ctx->p,
- &ctx->tb->common);
+ tid = erts_db_make_tid(ctx->base.p,
+ &ctx->base.tb->common);
continuation = TUPLE6(
ctx->hp,
tid,
@@ -1639,7 +1638,7 @@ static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base,
} else { /* All data is exhausted */
if (ctx->match_list != NIL) { /* No more data to search but still a
result to return to the caller */
- ctx->hp = HAlloc(ctx->p, 3);
+ ctx->hp = HAlloc(ctx->base.p, 3);
*ret = TUPLE2(ctx->hp, ctx->match_list, am_EOT);
return DB_ERROR_NONE;
} else { /* Reached the end of the ttable with no data to return */
@@ -1653,7 +1652,7 @@ static int select_chunk_on_loop_ended(match_callbacks_t* ctx_base,
}
}
-static int select_chunk_on_trap(match_callbacks_t* ctx_base,
+static int select_chunk_on_trap(traverse_context_t* ctx_base,
Sint slot_ix, Sint got,
Binary** mpp, Eterm* ret)
{
@@ -1662,74 +1661,77 @@ static int select_chunk_on_trap(match_callbacks_t* ctx_base,
Eterm continuation;
Eterm* hp;
- BUMP_ALL_REDS(ctx->p);
+ BUMP_ALL_REDS(ctx->base.p);
- if (ctx->prev_continuation_tptr == NULL) {
- Eterm tid = ctx->tid;
+ if (ctx->base.prev_continuation_tptr == NULL) {
+ Eterm tid = ctx->base.tid;
/* First time we're trapping */
- hp = HAllocX(ctx->p, 7 + ERTS_MAGIC_REF_THING_SIZE,
+ hp = HAllocX(ctx->base.p, 8 + ERTS_MAGIC_REF_THING_SIZE,
ERTS_MAGIC_REF_THING_SIZE);
if (is_atom(tid))
- tid = erts_db_make_tid(ctx->p, &ctx->tb->common);
- mpb = erts_db_make_match_prog_ref(ctx->p, *mpp, &hp);
- continuation = TUPLE6(
+ tid = erts_db_make_tid(ctx->base.p, &ctx->base.tb->common);
+ mpb = erts_db_make_match_prog_ref(ctx->base.p, *mpp, &hp);
+ continuation = TUPLE7(
hp,
tid,
make_small(slot_ix),
make_small(ctx->chunk_size),
mpb,
ctx->match_list,
- make_small(got));
+ make_small(got),
+ make_small(ctx->base.safety));
*mpp = NULL; /* otherwise the caller will destroy it */
}
else {
/* Not the first time we're trapping; reuse continuation terms */
- hp = HAlloc(ctx->p, 7);
- continuation = TUPLE6(
+ hp = HAlloc(ctx->base.p, 8);
+ continuation = TUPLE7(
hp,
- ctx->prev_continuation_tptr[1],
+ ctx->base.prev_continuation_tptr[1],
make_small(slot_ix),
- ctx->prev_continuation_tptr[3],
- ctx->prev_continuation_tptr[4],
+ ctx->base.prev_continuation_tptr[3],
+ ctx->base.prev_continuation_tptr[4],
ctx->match_list,
- make_small(got));
+ make_small(got),
+ make_small(ctx->base.safety));
}
- ERTS_BIF_PREP_TRAP1(*ret, &ets_select_continue_exp, ctx->p,
+ ERTS_BIF_PREP_TRAP1(*ret, &ets_select_continue_exp, ctx->base.p,
continuation);
return DB_ERROR_NONE;
}
static int db_select_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern,
- int reverse, Eterm *ret)
+ int reverse, Eterm *ret, enum DbIterSafety safety)
{
- return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret);
+ return db_select_chunk_hash(p, tbl, tid, pattern, 0, reverse, ret, safety);
}
static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
- int reverse, Eterm *ret)
+ int reverse, Eterm *ret, enum DbIterSafety safety)
{
select_chunk_context_t ctx;
ctx.base.on_nothing_can_match = select_chunk_on_nothing_can_match;
ctx.base.on_match_res = select_chunk_on_match_res;
ctx.base.on_loop_ended = select_chunk_on_loop_ended;
- ctx.base.on_trap = select_chunk_on_trap,
- ctx.p = p;
- ctx.tb = &tbl->hash;
- ctx.tid = tid;
+ ctx.base.on_trap = select_chunk_on_trap;
+ ctx.base.p = p;
+ ctx.base.tb = &tbl->hash;
+ ctx.base.tid = tid;
+ ctx.base.prev_continuation_tptr = NULL;
+ ctx.base.safety = safety;
ctx.hp = NULL;
ctx.chunk_size = chunk_size;
ctx.match_list = NIL;
- ctx.prev_continuation_tptr = NULL;
return match_traverse(
- ctx.p, ctx.tb,
+ &ctx.base,
pattern, NULL,
ctx.chunk_size,
MAX_SELECT_CHUNK_ITERATIONS,
&ctx.hp, 0,
- &ctx.base, ret);
+ ret);
}
/*
@@ -1739,7 +1741,7 @@ static int db_select_chunk_hash(Process *p, DbTable *tbl, Eterm tid,
*/
static
-int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base,
+int select_chunk_continue_on_loop_ended(traverse_context_t* ctx_base,
Sint slot_ix, Sint got,
Sint iterations_left, Binary** mpp,
Eterm* ret)
@@ -1750,14 +1752,14 @@ int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base,
Eterm* hp;
ASSERT(iterations_left <= MAX_SELECT_CHUNK_ITERATIONS);
- BUMP_REDS(ctx->p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
+ BUMP_REDS(ctx->base.p, MAX_SELECT_CHUNK_ITERATIONS - iterations_left);
if (ctx->chunk_size) {
Sint rest_size = 0;
if (got > ctx->chunk_size) {
/* Cannot write destructively here,
the list may have
been in user space */
- hp = HAlloc(ctx->p, (got - ctx->chunk_size) * 2);
+ hp = HAlloc(ctx->base.p, (got - ctx->chunk_size) * 2);
while (got-- > ctx->chunk_size) {
rest = CONS(hp, CAR(list_val(ctx->match_list)), rest);
hp += 2;
@@ -1766,13 +1768,13 @@ int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base,
}
}
if (rest != NIL || slot_ix >= 0) {
- hp = HAlloc(ctx->p, 3 + 7);
+ hp = HAlloc(ctx->base.p, 3 + 7);
continuation = TUPLE6(
hp,
- ctx->prev_continuation_tptr[1],
+ ctx->base.prev_continuation_tptr[1],
make_small(slot_ix),
- ctx->prev_continuation_tptr[3],
- ctx->prev_continuation_tptr[4],
+ ctx->base.prev_continuation_tptr[3],
+ ctx->base.prev_continuation_tptr[4],
rest,
make_small(rest_size));
hp += 7;
@@ -1780,7 +1782,7 @@ int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base,
return DB_ERROR_NONE;
} else {
if (ctx->match_list != NIL) {
- hp = HAlloc(ctx->p, 3);
+ hp = HAlloc(ctx->base.p, 3);
*ret = TUPLE2(hp, ctx->match_list, am_EOT);
return DB_ERROR_NONE;
} else {
@@ -1794,10 +1796,11 @@ int select_chunk_continue_on_loop_ended(match_callbacks_t* ctx_base,
}
/*
- * This is called when select traps
+ * This is called when ets:select/1/2/3 traps
+ * and for ets:select/1 with user continuation term.
*/
static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation,
- Eterm* ret)
+ Eterm* ret, enum DbIterSafety* safety_p)
{
select_chunk_context_t ctx;
Eterm* tptr;
@@ -1813,7 +1816,13 @@ static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation,
ASSERT(is_tuple(continuation));
tptr = tuple_val(continuation);
- if (arityval(*tptr) != 6)
+ /*
+ * 6-tuple is select/1 user continuation term
+ * 7-tuple is select trap continuation
+ */
+ if (*tptr == make_arityval(7) && is_small(tptr[7]))
+ *safety_p = signed_val(tptr[7]);
+ else if (*tptr != make_arityval(6))
goto badparam;
if (!is_small(tptr[2]) || !is_small(tptr[3]) ||
@@ -1837,18 +1846,19 @@ static int db_select_continue_hash(Process* p, DbTable* tbl, Eterm continuation,
ctx.base.on_match_res = select_chunk_on_match_res;
ctx.base.on_loop_ended = select_chunk_continue_on_loop_ended;
ctx.base.on_trap = select_chunk_on_trap;
- ctx.p = p;
- ctx.tb = &tbl->hash;
- ctx.tid = tid;
+ ctx.base.p = p;
+ ctx.base.tb = &tbl->hash;
+ ctx.base.tid = tid;
+ ctx.base.prev_continuation_tptr = tptr;
+ ctx.base.safety = *safety_p;
ctx.hp = NULL;
ctx.chunk_size = chunk_size;
ctx.match_list = match_list;
- ctx.prev_continuation_tptr = tptr;
return match_traverse_continue(
- ctx.p, ctx.tb, ctx.chunk_size,
- iterations_left, &ctx.hp, slot_ix, got, &mp, 0,
- &ctx.base, ret);
+ &ctx.base, ctx.chunk_size,
+ iterations_left, &ctx.hp, slot_ix, got, &mp, 0,
+ ret);
badparam:
*ret = NIL;
@@ -1866,84 +1876,73 @@ badparam:
#define MAX_SELECT_COUNT_ITERATIONS 1000
-typedef struct {
- match_callbacks_t base;
- Process* p;
- DbTableHash* tb;
- Eterm tid;
- Eterm* prev_continuation_tptr;
-} select_count_context_t;
-
-static int select_count_on_nothing_can_match(match_callbacks_t* ctx_base,
+static int select_count_on_nothing_can_match(traverse_context_t* ctx_base,
Eterm* ret)
{
*ret = make_small(0);
return DB_ERROR_NONE;
}
-static int select_count_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
+static int select_count_on_match_res(traverse_context_t* ctx_base, Sint slot_ix,
HashDbTerm*** current_ptr_ptr,
Eterm match_res)
{
return (match_res == am_true);
}
-static int select_count_on_loop_ended(match_callbacks_t* ctx_base,
+static int select_count_on_loop_ended(traverse_context_t* ctx,
Sint slot_ix, Sint got,
Sint iterations_left, Binary** mpp,
Eterm* ret)
{
- select_count_context_t* ctx = (select_count_context_t*) ctx_base;
ASSERT(iterations_left <= MAX_SELECT_COUNT_ITERATIONS);
BUMP_REDS(ctx->p, MAX_SELECT_COUNT_ITERATIONS - iterations_left);
*ret = erts_make_integer(got, ctx->p);
return DB_ERROR_NONE;
}
-static int select_count_on_trap(match_callbacks_t* ctx_base,
+static int select_count_on_trap(traverse_context_t* ctx,
Sint slot_ix, Sint got,
Binary** mpp, Eterm* ret)
{
- select_count_context_t* ctx = (select_count_context_t*) ctx_base;
return on_simple_trap(
- &ets_select_count_continue_exp,
- ctx->p,
- ctx->tb,
- ctx->tid,
- ctx->prev_continuation_tptr,
+ &ets_select_count_continue_exp, ctx,
slot_ix, got, mpp, ret);
}
static int db_select_count_hash(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret)
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety)
{
- select_count_context_t ctx;
+ traverse_context_t ctx;
Sint iterations_left = MAX_SELECT_COUNT_ITERATIONS;
Sint chunk_size = 0;
- ctx.base.on_nothing_can_match = select_count_on_nothing_can_match;
- ctx.base.on_match_res = select_count_on_match_res;
- ctx.base.on_loop_ended = select_count_on_loop_ended;
- ctx.base.on_trap = select_count_on_trap;
+ ctx.on_nothing_can_match = select_count_on_nothing_can_match;
+ ctx.on_match_res = select_count_on_match_res;
+ ctx.on_loop_ended = select_count_on_loop_ended;
+ ctx.on_trap = select_count_on_trap;
ctx.p = p;
ctx.tb = &tbl->hash;
ctx.tid = tid;
ctx.prev_continuation_tptr = NULL;
+ ctx.safety = safety;
return match_traverse(
- ctx.p, ctx.tb,
+ &ctx,
pattern, NULL,
chunk_size, iterations_left, NULL, 0,
- &ctx.base, ret);
+ ret);
}
/*
* This is called when select_count traps
*/
static int db_select_count_continue_hash(Process* p, DbTable* tbl,
- Eterm continuation, Eterm* ret)
+ Eterm continuation, Eterm* ret,
+ enum DbIterSafety* safety_p)
{
- select_count_context_t ctx;
+ traverse_context_t ctx;
Eterm* tptr;
Eterm tid;
Binary* mp;
@@ -1952,24 +1951,26 @@ static int db_select_count_continue_hash(Process* p, DbTable* tbl,
Sint chunk_size = 0;
*ret = NIL;
- if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp,
+ &got, safety_p)) {
*ret = NIL;
return DB_ERROR_BADPARAM;
}
- ctx.base.on_match_res = select_count_on_match_res;
- ctx.base.on_loop_ended = select_count_on_loop_ended;
- ctx.base.on_trap = select_count_on_trap;
+ ctx.on_match_res = select_count_on_match_res;
+ ctx.on_loop_ended = select_count_on_loop_ended;
+ ctx.on_trap = select_count_on_trap;
ctx.p = p;
ctx.tb = &tbl->hash;
ctx.tid = tid;
ctx.prev_continuation_tptr = tptr;
+ ctx.safety = *safety_p;
return match_traverse_continue(
- ctx.p, ctx.tb, chunk_size,
+ &ctx, chunk_size,
MAX_SELECT_COUNT_ITERATIONS,
NULL, slot_ix, got, &mp, 0,
- &ctx.base, ret);
+ ret);
}
#undef MAX_SELECT_COUNT_ITERATIONS
@@ -1984,24 +1985,20 @@ static int db_select_count_continue_hash(Process* p, DbTable* tbl,
#define MAX_SELECT_DELETE_ITERATIONS 1000
typedef struct {
- match_callbacks_t base;
- Process* p;
- DbTableHash* tb;
- Eterm tid;
- Eterm* prev_continuation_tptr;
+ traverse_context_t base;
erts_aint_t fixated_by_me;
Uint last_pseudo_delete;
HashDbTerm* free_us;
} select_delete_context_t;
-static int select_delete_on_nothing_can_match(match_callbacks_t* ctx_base,
+static int select_delete_on_nothing_can_match(traverse_context_t* ctx_base,
Eterm* ret)
{
*ret = make_small(0);
return DB_ERROR_NONE;
}
-static int select_delete_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
+static int select_delete_on_match_res(traverse_context_t* ctx_base, Sint slot_ix,
HashDbTerm*** current_ptr_ptr,
Eterm match_res)
{
@@ -2011,9 +2008,9 @@ static int select_delete_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
if (match_res != am_true)
return 0;
- if (NFIXED(ctx->tb) > ctx->fixated_by_me) { /* fixated by others? */
+ if (NFIXED(ctx->base.tb) > ctx->fixated_by_me) { /* fixated by others? */
if (slot_ix != ctx->last_pseudo_delete) {
- if (!add_fixed_deletion(ctx->tb, slot_ix, ctx->fixated_by_me))
+ if (!add_fixed_deletion(ctx->base.tb, slot_ix, ctx->fixated_by_me))
goto do_erase;
ctx->last_pseudo_delete = slot_ix;
}
@@ -2026,46 +2023,43 @@ static int select_delete_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
del->next = ctx->free_us;
ctx->free_us = del;
}
- erts_atomic_dec_nob(&ctx->tb->common.nitems);
+ erts_atomic_dec_nob(&ctx->base.tb->common.nitems);
return 1;
}
-static int select_delete_on_loop_ended(match_callbacks_t* ctx_base,
+static int select_delete_on_loop_ended(traverse_context_t* ctx_base,
Sint slot_ix, Sint got,
Sint iterations_left, Binary** mpp,
Eterm* ret)
{
select_delete_context_t* ctx = (select_delete_context_t*) ctx_base;
- free_term_list(ctx->tb, ctx->free_us);
+ free_term_list(ctx->base.tb, ctx->free_us);
ctx->free_us = NULL;
ASSERT(iterations_left <= MAX_SELECT_DELETE_ITERATIONS);
- BUMP_REDS(ctx->p, MAX_SELECT_DELETE_ITERATIONS - iterations_left);
+ BUMP_REDS(ctx->base.p, MAX_SELECT_DELETE_ITERATIONS - iterations_left);
if (got) {
- try_shrink(ctx->tb);
+ try_shrink(ctx->base.tb);
}
- *ret = erts_make_integer(got, ctx->p);
+ *ret = erts_make_integer(got, ctx->base.p);
return DB_ERROR_NONE;
}
-static int select_delete_on_trap(match_callbacks_t* ctx_base,
+static int select_delete_on_trap(traverse_context_t* ctx_base,
Sint slot_ix, Sint got,
Binary** mpp, Eterm* ret)
{
select_delete_context_t* ctx = (select_delete_context_t*) ctx_base;
- free_term_list(ctx->tb, ctx->free_us);
+ free_term_list(ctx->base.tb, ctx->free_us);
ctx->free_us = NULL;
return on_simple_trap(
- &ets_select_delete_continue_exp,
- ctx->p,
- ctx->tb,
- ctx->tid,
- ctx->prev_continuation_tptr,
+ &ets_select_delete_continue_exp, &ctx->base,
slot_ix, got, mpp, ret);
}
static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret)
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety)
{
select_delete_context_t ctx;
Sint chunk_size = 0;
@@ -2074,27 +2068,29 @@ static int db_select_delete_hash(Process *p, DbTable *tbl, Eterm tid,
ctx.base.on_match_res = select_delete_on_match_res;
ctx.base.on_loop_ended = select_delete_on_loop_ended;
ctx.base.on_trap = select_delete_on_trap;
- ctx.p = p;
- ctx.tb = &tbl->hash;
- ctx.tid = tid;
- ctx.prev_continuation_tptr = NULL;
- ctx.fixated_by_me = ctx.tb->common.is_thread_safe ? 0 : 1; /* TODO: something nicer */
+ ctx.base.p = p;
+ ctx.base.tb = &tbl->hash;
+ ctx.base.tid = tid;
+ ctx.base.prev_continuation_tptr = NULL;
+ ctx.base.safety = safety;
+ ctx.fixated_by_me = ctx.base.tb->common.is_thread_safe ? 0 : 1;
ctx.last_pseudo_delete = (Uint) -1;
ctx.free_us = NULL;
return match_traverse(
- ctx.p, ctx.tb,
+ &ctx.base,
pattern, NULL,
chunk_size,
MAX_SELECT_DELETE_ITERATIONS, NULL, 1,
- &ctx.base, ret);
+ ret);
}
/*
* This is called when select_delete traps
*/
static int db_select_delete_continue_hash(Process* p, DbTable* tbl,
- Eterm continuation, Eterm* ret)
+ Eterm continuation, Eterm* ret,
+ enum DbIterSafety* safety_p)
{
select_delete_context_t ctx;
Eterm* tptr;
@@ -2104,7 +2100,8 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl,
Sint slot_ix;
Sint chunk_size = 0;
- if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp,
+ &got, safety_p)) {
*ret = NIL;
return DB_ERROR_BADPARAM;
}
@@ -2112,19 +2109,20 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl,
ctx.base.on_match_res = select_delete_on_match_res;
ctx.base.on_loop_ended = select_delete_on_loop_ended;
ctx.base.on_trap = select_delete_on_trap;
- ctx.p = p;
- ctx.tb = &tbl->hash;
- ctx.tid = tid;
- ctx.prev_continuation_tptr = tptr;
- ctx.fixated_by_me = ONLY_WRITER(p, ctx.tb) ? 0 : 1; /* TODO: something nicer */
+ ctx.base.p = p;
+ ctx.base.tb = &tbl->hash;
+ ctx.base.tid = tid;
+ ctx.base.prev_continuation_tptr = tptr;
+ ctx.base.safety = *safety_p;
+ ctx.fixated_by_me = ONLY_WRITER(p, ctx.base.tb) ? 0 : 1;
ctx.last_pseudo_delete = (Uint) -1;
ctx.free_us = NULL;
return match_traverse_continue(
- ctx.p, ctx.tb, chunk_size,
+ &ctx.base, chunk_size,
MAX_SELECT_DELETE_ITERATIONS,
NULL, slot_ix, got, &mp, 1,
- &ctx.base, ret);
+ ret);
}
#undef MAX_SELECT_DELETE_ITERATIONS
@@ -2138,26 +2136,17 @@ static int db_select_delete_continue_hash(Process* p, DbTable* tbl,
#define MAX_SELECT_REPLACE_ITERATIONS 1000
-typedef struct {
- match_callbacks_t base;
- Process* p;
- DbTableHash* tb;
- Eterm tid;
- Eterm* prev_continuation_tptr;
-} select_replace_context_t;
-
-static int select_replace_on_nothing_can_match(match_callbacks_t* ctx_base,
+static int select_replace_on_nothing_can_match(traverse_context_t* ctx_base,
Eterm* ret)
{
*ret = make_small(0);
return DB_ERROR_NONE;
}
-static int select_replace_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix,
+static int select_replace_on_match_res(traverse_context_t* ctx, Sint slot_ix,
HashDbTerm*** current_ptr_ptr,
Eterm match_res)
{
- select_replace_context_t* ctx = (select_replace_context_t*) ctx_base;
DbTableHash* tb = ctx->tb;
HashDbTerm* new;
HashDbTerm* next;
@@ -2183,11 +2172,10 @@ static int select_replace_on_match_res(match_callbacks_t* ctx_base, Sint slot_ix
return 0;
}
-static int select_replace_on_loop_ended(match_callbacks_t* ctx_base, Sint slot_ix,
+static int select_replace_on_loop_ended(traverse_context_t* ctx, Sint slot_ix,
Sint got, Sint iterations_left,
Binary** mpp, Eterm* ret)
{
- select_replace_context_t* ctx = (select_replace_context_t*) ctx_base;
ASSERT(iterations_left <= MAX_SELECT_REPLACE_ITERATIONS);
/* the more objects we've replaced, the more reductions we've consumed */
BUMP_REDS(ctx->p,
@@ -2197,23 +2185,20 @@ static int select_replace_on_loop_ended(match_callbacks_t* ctx_base, Sint slot_i
return DB_ERROR_NONE;
}
-static int select_replace_on_trap(match_callbacks_t* ctx_base,
+static int select_replace_on_trap(traverse_context_t* ctx,
Sint slot_ix, Sint got,
Binary** mpp, Eterm* ret)
{
- select_replace_context_t* ctx = (select_replace_context_t*) ctx_base;
return on_simple_trap(
- &ets_select_replace_continue_exp,
- ctx->p,
- ctx->tb,
- ctx->tid,
- ctx->prev_continuation_tptr,
+ &ets_select_replace_continue_exp, ctx,
slot_ix, got, mpp, ret);
}
-static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pattern, Eterm *ret)
+static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid,
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety)
{
- select_replace_context_t ctx;
+ traverse_context_t ctx;
Sint chunk_size = 0;
/* Bag implementation presented both semantic consistency and performance issues,
@@ -2221,29 +2206,32 @@ static int db_select_replace_hash(Process *p, DbTable *tbl, Eterm tid, Eterm pat
*/
ASSERT(!(tbl->hash.common.status & DB_BAG));
- ctx.base.on_nothing_can_match = select_replace_on_nothing_can_match;
- ctx.base.on_match_res = select_replace_on_match_res;
- ctx.base.on_loop_ended = select_replace_on_loop_ended;
- ctx.base.on_trap = select_replace_on_trap;
+ ctx.on_nothing_can_match = select_replace_on_nothing_can_match;
+ ctx.on_match_res = select_replace_on_match_res;
+ ctx.on_loop_ended = select_replace_on_loop_ended;
+ ctx.on_trap = select_replace_on_trap;
ctx.p = p;
ctx.tb = &tbl->hash;
ctx.tid = tid;
ctx.prev_continuation_tptr = NULL;
+ ctx.safety = safety;
return match_traverse(
- ctx.p, ctx.tb,
+ &ctx,
pattern, db_match_keeps_key,
chunk_size,
MAX_SELECT_REPLACE_ITERATIONS, NULL, 1,
- &ctx.base, ret);
+ ret);
}
/*
* This is called when select_replace traps
*/
-static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm continuation, Eterm* ret)
+static int db_select_replace_continue_hash(Process* p, DbTable* tbl,
+ Eterm continuation, Eterm* ret,
+ enum DbIterSafety* safety_p)
{
- select_replace_context_t ctx;
+ traverse_context_t ctx;
Eterm* tptr;
Eterm tid ;
Binary* mp;
@@ -2252,25 +2240,27 @@ static int db_select_replace_continue_hash(Process* p, DbTable* tbl, Eterm conti
Sint chunk_size = 0;
*ret = NIL;
- if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp, &got)) {
+ if (unpack_simple_continuation(continuation, &tptr, &tid, &slot_ix, &mp,
+ &got, safety_p)) {
*ret = NIL;
return DB_ERROR_BADPARAM;
}
/* Proceed */
- ctx.base.on_match_res = select_replace_on_match_res;
- ctx.base.on_loop_ended = select_replace_on_loop_ended;
- ctx.base.on_trap = select_replace_on_trap;
+ ctx.on_match_res = select_replace_on_match_res;
+ ctx.on_loop_ended = select_replace_on_loop_ended;
+ ctx.on_trap = select_replace_on_trap;
ctx.p = p;
ctx.tb = &tbl->hash;
ctx.tid = tid;
ctx.prev_continuation_tptr = tptr;
+ ctx.safety = *safety_p;
return match_traverse_continue(
- ctx.p, ctx.tb, chunk_size,
+ &ctx, chunk_size,
MAX_SELECT_REPLACE_ITERATIONS,
NULL, slot_ix, got, &mp, 1,
- &ctx.base, ret);
+ ret);
}
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index 02a5934a6e..f9ba04f399 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -397,24 +397,31 @@ static int db_erase_object_tree(DbTable *tbl, Eterm object,Eterm *ret);
static int db_slot_tree(Process *p, DbTable *tbl,
Eterm slot_term, Eterm *ret);
static int db_select_tree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, int reversed, Eterm *ret);
+ Eterm pattern, int reversed, Eterm *ret,
+ enum DbIterSafety);
static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret, enum DbIterSafety);
static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
- int reversed, Eterm *ret);
+ int reversed, Eterm *ret, enum DbIterSafety);
static int db_select_continue_tree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_count_continue_tree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety);
static int db_select_delete_continue_tree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret);
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety);
static int db_select_replace_continue_tree(Process *p, DbTable *tbl,
- Eterm continuation, Eterm *ret);
+ Eterm continuation, Eterm *ret,
+ enum DbIterSafety*);
static int db_take_tree(Process *, DbTable *, Eterm, Eterm *);
static void db_print_tree(fmtfn_t to, void *to_arg,
int show, DbTable *tbl);
@@ -1160,7 +1167,8 @@ int db_select_continue_tree_common(Process *p,
static int db_select_continue_tree(Process *p,
DbTable *tbl,
Eterm continuation,
- Eterm *ret)
+ Eterm *ret,
+ enum DbIterSafety* safety_p)
{
DbTableTree *tb = &tbl->tree;
return db_select_continue_tree_common(p, &tb->common,
@@ -1297,7 +1305,8 @@ int db_select_tree_common(Process *p, DbTable *tb,
}
static int db_select_tree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, int reverse, Eterm *ret)
+ Eterm pattern, int reverse, Eterm *ret,
+ enum DbIterSafety safety)
{
return db_select_tree_common(p, tbl, tid,
pattern, reverse, ret, &tbl->tree, NULL);
@@ -1408,7 +1417,8 @@ int db_select_count_continue_tree_common(Process *p,
static int db_select_count_continue_tree(Process *p,
DbTable *tbl,
Eterm continuation,
- Eterm *ret)
+ Eterm *ret,
+ enum DbIterSafety* safety_p)
{
DbTableTree *tb = &tbl->tree;
return db_select_count_continue_tree_common(p, tbl,
@@ -1527,7 +1537,8 @@ int db_select_count_tree_common(Process *p, DbTable *tb,
}
static int db_select_count_tree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret)
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety)
{
DbTableTree *tb = &tbl->tree;
return db_select_count_tree_common(p, tbl,
@@ -1704,7 +1715,7 @@ int db_select_chunk_tree_common(Process *p, DbTable *tb,
static int db_select_chunk_tree(Process *p, DbTable *tbl, Eterm tid,
Eterm pattern, Sint chunk_size,
int reverse,
- Eterm *ret)
+ Eterm *ret, enum DbIterSafety safety)
{
DbTableTree *tb = &tbl->tree;
return db_select_chunk_tree_common(p, tbl,
@@ -1813,7 +1824,8 @@ int db_select_delete_continue_tree_common(Process *p,
static int db_select_delete_continue_tree(Process *p,
DbTable *tbl,
Eterm continuation,
- Eterm *ret)
+ Eterm *ret,
+ enum DbIterSafety* safety_p)
{
DbTableTree *tb = &tbl->tree;
ASSERT(!erts_atomic_read_nob(&tb->is_stack_busy));
@@ -1942,7 +1954,8 @@ int db_select_delete_tree_common(Process *p, DbTable *tbl,
}
static int db_select_delete_tree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret)
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety)
{
DbTableTree *tb = &tbl->tree;
return db_select_delete_tree_common(p, tbl, tid, pattern, ret,
@@ -2052,7 +2065,8 @@ int db_select_replace_continue_tree_common(Process *p,
static int db_select_replace_continue_tree(Process *p,
DbTable *tbl,
Eterm continuation,
- Eterm *ret)
+ Eterm *ret,
+ enum DbIterSafety* safety_p)
{
return db_select_replace_continue_tree_common(p, tbl, continuation, ret,
&tbl->tree, NULL);
@@ -2177,7 +2191,8 @@ int db_select_replace_tree_common(Process *p, DbTable *tbl,
}
static int db_select_replace_tree(Process *p, DbTable *tbl, Eterm tid,
- Eterm pattern, Eterm *ret)
+ Eterm pattern, Eterm *ret,
+ enum DbIterSafety safety)
{
return db_select_replace_tree_common(p, tbl, tid, pattern, ret,
&tbl->tree, NULL);
@@ -3743,13 +3758,6 @@ static int doit_select(DbTableCommon *tb, TreeDbTerm *this,
if (is_value(ret)) {
sc->accum = CONS(hp, ret, sc->accum);
}
- if (MBUF(sc->p)) {
- /*
- * Force a trap and GC if a heap fragment was created. Many heap fragments
- * make the GC slow.
- */
- sc->max = 0;
- }
if (--(sc->max) <= 0) {
return 0;
}
@@ -3806,13 +3814,6 @@ static int doit_select_chunk(DbTableCommon *tb, TreeDbTerm *this,
++(sc->got);
sc->accum = CONS(hp, ret, sc->accum);
}
- if (MBUF(sc->p)) {
- /*
- * Force a trap and GC if a heap fragment was created. Many heap fragments
- * make the GC slow.
- */
- sc->max = 0;
- }
if (--(sc->max) <= 0 || sc->got == sc->chunk_size) {
return 0;
}
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index ec7442aeeb..1ea7074d21 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -3312,7 +3312,7 @@ void db_cleanup_offheap_comp(DbTerm* obj)
default:
ASSERT(is_external_header(u.hdr->thing_word));
ASSERT(u.pb != &tmp);
- erts_deref_node_entry(u.ext->node);
+ erts_deref_node_entry(u.ext->node, make_boxed(u.ep));
break;
}
}
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index e1af9210ea..e3d3c0e804 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -101,6 +101,14 @@ typedef struct {
} u;
} DbUpdateHandle;
+/* How safe are we from double-hits or missed objects
+ * when iterating without fixation?
+ */
+enum DbIterSafety {
+ ITER_UNSAFE, /* Must fixate to be safe */
+ ITER_SAFE_LOCKED, /* Safe while table is locked, not between trap calls */
+ ITER_SAFE /* No need to fixate at all */
+};
typedef struct db_table_method
{
@@ -150,44 +158,53 @@ typedef struct db_table_method
Eterm pattern,
Sint chunk_size,
int reverse,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety);
int (*db_select)(Process* p,
DbTable* tb, /* [in out] */
Eterm tid,
Eterm pattern,
int reverse,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety);
int (*db_select_delete)(Process* p,
DbTable* tb, /* [in out] */
Eterm tid,
Eterm pattern,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety);
int (*db_select_continue)(Process* p,
DbTable* tb, /* [in out] */
Eterm continuation,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety*);
int (*db_select_delete_continue)(Process* p,
DbTable* tb, /* [in out] */
Eterm continuation,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety*);
int (*db_select_count)(Process* p,
DbTable* tb, /* [in out] */
Eterm tid,
Eterm pattern,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety);
int (*db_select_count_continue)(Process* p,
DbTable* tb, /* [in out] */
Eterm continuation,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety*);
int (*db_select_replace)(Process* p,
DbTable* tb, /* [in out] */
Eterm tid,
Eterm pattern,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety);
int (*db_select_replace_continue)(Process* p,
DbTable* tb, /* [in out] */
Eterm continuation,
- Eterm* ret);
+ Eterm* ret,
+ enum DbIterSafety*);
int (*db_take)(Process *, DbTable *, Eterm, Eterm *);
SWord (*db_delete_all_objects)(Process* p, DbTable* db, SWord reds);
diff --git a/erts/emulator/beam/erl_dirty_bif.tab b/erts/emulator/beam/erl_dirty_bif.tab
index 609869ad9f..656acfebdb 100644
--- a/erts/emulator/beam/erl_dirty_bif.tab
+++ b/erts/emulator/beam/erl_dirty_bif.tab
@@ -57,7 +57,6 @@ dirty-cpu erts_debug:lcnt_clear/0
# and debug purposes only. We really do *not* want to execute these
# on dirty schedulers on a real system.
-dirty-cpu-test erlang:iolist_size/1
dirty-cpu-test erlang:make_tuple/2
dirty-cpu-test erlang:make_tuple/3
dirty-cpu-test erlang:append_element/2
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 3a50b294d1..9317850d96 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1303,7 +1303,8 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
ExternalThing *etp;
ASSERT(is_external_header(ptr->thing_word));
etp = (ExternalThing *) ptr;
- erts_refc_inc(&etp->node->refc, 1);
+ erts_ref_node_entry(etp->node, 1,
+ make_boxed(&oh->thing_word));
break;
}
}
@@ -2836,7 +2837,11 @@ sweep_off_heap(Process *p, int fullsweep)
while (ptr) {
if (IS_MOVED_BOXED(ptr->thing_word)) {
ASSERT(!ErtsInArea(ptr, oheap, oheap_sz));
- *prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word);
+ if (is_external_header(((struct erl_off_heap_header*) boxed_val(ptr->thing_word))->thing_word))
+ erts_node_bookkeep(((ExternalThing*)ptr)->node,
+ make_boxed(&ptr->thing_word),
+ ERL_NODE_DEC);
+ *prev = ptr = (struct erl_off_heap_header*) boxed_val(ptr->thing_word);
ASSERT(!IS_MOVED_BOXED(ptr->thing_word));
switch (ptr->thing_word) {
case HEADER_PROC_BIN: {
@@ -2863,6 +2868,11 @@ sweep_off_heap(Process *p, int fullsweep)
/* fall through... */
}
default:
+ if (is_external_header(ptr->thing_word)) {
+ erts_node_bookkeep(((ExternalThing*)ptr)->node,
+ make_boxed(&ptr->thing_word),
+ ERL_NODE_INC);
+ }
prev = &ptr->next;
ptr = ptr->next;
}
@@ -2896,7 +2906,8 @@ sweep_off_heap(Process *p, int fullsweep)
}
default:
ASSERT(is_external_header(ptr->thing_word));
- erts_deref_node_entry(((ExternalThing*)ptr)->node);
+ erts_deref_node_entry(((ExternalThing*)ptr)->node,
+ make_boxed(&ptr->thing_word));
}
*prev = ptr = ptr->next;
}
@@ -3029,6 +3040,13 @@ offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size)
{
struct erl_off_heap_header* oh = (struct erl_off_heap_header*) hp;
+ if (is_external_header(oh->thing_word)) {
+ erts_node_bookkeep(((ExternalThing*)oh)->node,
+ make_boxed(((Eterm*)oh)-offs), ERL_NODE_DEC);
+ erts_node_bookkeep(((ExternalThing*)oh)->node,
+ make_boxed((Eterm*)oh), ERL_NODE_INC);
+ }
+
if (ErtsInArea(oh->next, area, area_size)) {
Eterm** uptr = (Eterm **) (void *) &oh->next;
*uptr += offs; /* Patch the mso chain */
diff --git a/erts/emulator/beam/erl_hl_timer.c b/erts/emulator/beam/erl_hl_timer.c
index ef7a55fa38..b0eb0e85c0 100644
--- a/erts/emulator/beam/erl_hl_timer.c
+++ b/erts/emulator/beam/erl_hl_timer.c
@@ -29,8 +29,6 @@
# include "config.h"
#endif
-/* #define ERTS_MAGIC_REF_BIF_TIMERS */
-
#include "sys.h"
#include "global.h"
#include "bif.h"
@@ -39,9 +37,6 @@
#include "erl_time.h"
#include "erl_hl_timer.h"
#include "erl_proc_sig_queue.h"
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-#include "erl_binary.h"
-#endif
#define ERTS_TMR_CHECK_CANCEL_ON_CREATE 0
@@ -195,14 +190,9 @@ struct ErtsBifTimer_ {
} type;
struct {
erts_atomic32_t state;
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ErtsMagicBinary *mbin;
- ErtsHLTimerList proc_list;
-#else
Uint32 refn[ERTS_REF_NUMBERS];
ErtsBifTimerTree proc_tree;
ErtsBifTimerTree tree;
-#endif
Eterm message;
ErlHeapFragment *bp;
} btm;
@@ -220,11 +210,7 @@ typedef ErtsTimer *(*ErtsCreateTimerFunc)(ErtsSchedulerData *esdp,
int short_time, ErtsTmrType type,
void *rcvrp, Eterm rcvr,
Eterm msg,
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ErtsMagicBinary *mbin,
-#else
Uint32 *refn,
-#endif
void (*callback)(void *), void *arg);
#ifdef SMALL_MEMORY
@@ -303,16 +289,12 @@ typedef struct {
struct ErtsHLTimerService_ {
ErtsHLTCncldTmrQ canceled_queue;
ErtsHLTimer *time_tree;
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
ErtsBifTimer *btm_tree;
-#endif
ErtsHLTimer *next_timeout;
ErtsYieldingTimeoutState yield;
ErtsTWheelTimer service_timer;
};
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
-
static ERTS_INLINE int
refn_is_lt(Uint32 *x, Uint32 *y)
{
@@ -334,8 +316,6 @@ refn_is_eq(Uint32 *x, Uint32 *y)
return (x[0] == y[0]) & (x[1] == y[1]) & (x[2] == y[2]);
}
-#endif
-
#define ERTS_RBT_PREFIX time
#define ERTS_RBT_T ErtsHLTimer
#define ERTS_RBT_KEY_T ErtsMonotonicTime
@@ -525,13 +505,7 @@ same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x)
#endif /* ERTS_HLT_HARD_DEBUG */
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-#define ERTS_BTM_HLT2REFN(T) ((T)->btm.mbin->refn)
-#else
#define ERTS_BTM_HLT2REFN(T) ((T)->btm.refn)
-#endif
-
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
#define ERTS_RBT_PREFIX btm
#define ERTS_RBT_T ErtsBifTimer
@@ -576,87 +550,12 @@ same_time_list_lookup(ErtsHLTimer *root, ErtsHLTimer *x)
#define ERTS_RBT_IS_EQ(KX, KY) refn_is_eq((KX), (KY))
#define ERTS_RBT_WANT_DELETE
#define ERTS_RBT_WANT_INSERT
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
#define ERTS_RBT_WANT_LOOKUP
-#endif
#define ERTS_RBT_WANT_FOREACH
#define ERTS_RBT_UNDEF
#include "erl_rbtree.h"
-#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
-
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-
-static ERTS_INLINE void
-proc_btm_list_insert(ErtsBifTimer **list, ErtsBifTimer *x)
-{
- ErtsBifTimer *y = *list;
- if (!y) {
- x->btm.proc_list.next = x;
- x->btm.proc_list.prev = x;
- *list = x;
- }
- else {
- ERTS_HLT_ASSERT(y->btm.proc_list.prev->btm.proc_list.next == y);
- x->btm.proc_list.next = y;
- x->btm.proc_list.prev = y->btm.proc_list.prev;
- y->btm.proc_list.prev->btm.proc_list.next = x;
- y->btm.proc_list.prev = x;
- }
-}
-
-static ERTS_INLINE void
-proc_btm_list_delete(ErtsBifTimer **list, ErtsBifTimer *x)
-{
- ErtsBifTimer *y = *list;
- if (y == x && x->btm.proc_list.next == x) {
- ERTS_HLT_ASSERT(x->btm.proc_list.prev == x);
- *list = NULL;
- }
- else {
- if (y == x)
- *list = x->btm.proc_list.next;
- ERTS_HLT_ASSERT(x->btm.proc_list.prev->btm.proc_list.next == x);
- ERTS_HLT_ASSERT(x->btm.proc_list.next->btm.proc_list.prev == x);
- x->btm.proc_list.prev->btm.proc_list.next = x->btm.proc_list.next;
- x->btm.proc_list.next->btm.proc_list.prev = x->btm.proc_list.prev;
- }
- x->btm.proc_list.next = NULL;
-}
-
-static ERTS_INLINE int
-proc_btm_list_foreach_destroy_yielding(ErtsBifTimer **list,
- void (*destroy)(ErtsBifTimer *, void *),
- void *arg,
- int limit)
-{
- int i;
- ErtsBifTimer *first, *last;
-
- first = *list;
- if (!first)
- return 0;
-
- last = first->btm.proc_list.prev;
- for (i = 0; i < limit; i++) {
- ErtsBifTimer *x = last;
- last = last->btm.proc_list.prev;
- (*destroy)(x, arg);
- x->btm.proc_list.next = NULL;
- if (x == first) {
- *list = NULL;
- return 0;
- }
- }
-
- last->btm.proc_list.next = first;
- first->btm.proc_list.prev = last;
- return 1;
-}
-
-#else /* !ERTS_MAGIC_REF_BIF_TIMERS */
-
#define ERTS_RBT_PREFIX proc_btm
#define ERTS_RBT_T ErtsBifTimer
#define ERTS_RBT_KEY_T Uint32 *
@@ -700,16 +599,12 @@ proc_btm_list_foreach_destroy_yielding(ErtsBifTimer **list,
#define ERTS_RBT_IS_EQ(KX, KY) refn_is_eq((KX), (KY))
#define ERTS_RBT_WANT_DELETE
#define ERTS_RBT_WANT_INSERT
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
#define ERTS_RBT_WANT_LOOKUP
-#endif
#define ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING
#define ERTS_RBT_UNDEF
#include "erl_rbtree.h"
-#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
-
static void init_canceled_queue(ErtsHLTCncldTmrQ *cq);
void
@@ -728,9 +623,7 @@ erts_create_timer_service(void)
srv = erts_alloc_permanent_cache_aligned(ERTS_ALC_T_TIMER_SERVICE,
sizeof(ErtsHLTimerService));
srv->time_tree = NULL;
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
srv->btm_tree = NULL;
-#endif
srv->next_timeout = NULL;
srv->yield = init_yield;
erts_twheel_init_timer(&srv->service_timer);
@@ -805,40 +698,10 @@ port_timeout_common(Port *port, void *tmr)
return 0;
}
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-
-static erts_atomic_t *
-mbin_to_btmref__(ErtsMagicBinary *mbin)
-{
- return erts_binary_to_magic_indirection((Binary *) mbin);
-}
-
-static ERTS_INLINE void
-magic_binary_init(ErtsMagicBinary *mbin, ErtsBifTimer *tmr)
-{
- erts_atomic_t *aptr = mbin_to_btmref__(mbin);
- erts_atomic_init_nob(aptr, (erts_aint_t) tmr);
-}
-
-static ERTS_INLINE ErtsBifTimer *
-magic_binary_to_btm(ErtsMagicBinary *mbin)
-{
- erts_atomic_t *aptr = mbin_to_btmref__(mbin);
- ErtsBifTimer *tmr = (ErtsBifTimer *) erts_atomic_read_nob(aptr);
- ERTS_HLT_ASSERT(!tmr || tmr->btm.mbin == mbin);
- return tmr;
-}
-
-#endif /* ERTS_MAGIC_REF_BIF_TIMERS */
-
static ERTS_INLINE erts_aint_t
init_btm_specifics(ErtsSchedulerData *esdp,
ErtsBifTimer *tmr, Eterm msg,
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ErtsMagicBinary *mbin
-#else
Uint32 *refn
-#endif
)
{
Uint hsz = is_immed(msg) ? ((Uint) 0) : size_object(msg);
@@ -853,13 +716,6 @@ init_btm_specifics(ErtsSchedulerData *esdp,
tmr->btm.message = copy_struct(msg, hsz, &hp, &bp->off_heap);
tmr->btm.bp = bp;
}
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- refc = 1;
- tmr->btm.mbin = mbin;
- erts_refc_inc(&mbin->refc, 1);
- magic_binary_init(mbin, tmr);
- tmr->btm.proc_list.next = NULL;
-#else
refc = 0;
tmr->btm.refn[0] = refn[0];
tmr->btm.refn[1] = refn[1];
@@ -868,7 +724,6 @@ init_btm_specifics(ErtsSchedulerData *esdp,
tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
btm_rbt_insert(&esdp->timer_service->btm_tree, tmr);
-#endif
erts_atomic32_init_nob(&tmr->btm.state, ERTS_TMR_STATE_ACTIVE);
return refc; /* refc from magic binary... */
@@ -886,11 +741,6 @@ timer_destroy(ErtsTimer *tmr, int twt, int btm)
erts_free(ERTS_ALC_T_HL_PTIMER, tmr);
}
else {
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- Binary *bp = (Binary *) tmr->btm.btm.mbin;
- if (erts_refc_dectest(&bp->refc, 0) == 0)
- erts_bin_free(bp);
-#endif
if (tmr->head.roflgs & ERTS_TMR_ROFLG_PRE_ALC)
bif_timer_pre_free(&tmr->btm);
else
@@ -940,9 +790,6 @@ schedule_tw_timer_destroy(ErtsTWTimer *tmr)
else {
/* Message buffer already dropped... */
size = sizeof(ErtsBifTimer);
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- size += sizeof(ErtsMagicIndirectionWord);
-#endif
}
erts_schedule_thr_prgr_later_cleanup_op(
@@ -1006,11 +853,7 @@ create_tw_timer(ErtsSchedulerData *esdp,
int short_time, ErtsTmrType type,
void *rcvrp, Eterm rcvr,
Eterm msg,
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ErtsMagicBinary *mbin,
-#else
Uint32 *refn,
-#endif
void (*callback)(void *), void *arg)
{
ErtsTWTimer *tmr;
@@ -1087,11 +930,7 @@ create_tw_timer(ErtsSchedulerData *esdp,
refc += init_btm_specifics(esdp,
(ErtsBifTimer *) tmr,
msg,
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- mbin
-#else
refn
-#endif
);
break;
@@ -1152,9 +991,6 @@ schedule_hl_timer_destroy(ErtsHLTimer *tmr, Uint32 roflgs)
else {
/* Message buffer already dropped... */
size = sizeof(ErtsBifTimer);
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- size += sizeof(ErtsMagicIndirectionWord);
-#endif
}
erts_schedule_thr_prgr_later_cleanup_op(
@@ -1192,34 +1028,6 @@ check_canceled_queue(ErtsSchedulerData *esdp, ErtsHLTimerService *srv)
#endif
}
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-
-static int
-bif_timer_ref_destructor(Binary *unused)
-{
- return 1;
-}
-
-static ERTS_INLINE void
-btm_clear_magic_binary(ErtsBifTimer *tmr)
-{
- erts_atomic_t *aptr = mbin_to_btmref__(tmr->btm.mbin);
- Uint32 roflgs = tmr->type.head.roflgs;
-#ifdef ERTS_HLT_DEBUG
- erts_aint_t tval = erts_atomic_xchg_nob(aptr,
- (erts_aint_t) NULL);
- ERTS_HLT_ASSERT(tval == (erts_aint_t) tmr);
-#else
- erts_atomic_set_nob(aptr, (erts_aint_t) NULL);
-#endif
- if (roflgs & ERTS_TMR_ROFLG_HLT)
- hl_timer_dec_refc(&tmr->type.hlt, roflgs);
- else
- tw_timer_dec_refc(&tmr->type.twt);
-}
-
-#endif /* ERTS_MAGIC_REF_BIF_TIMERS */
-
static ERTS_INLINE void
bif_timer_timeout(ErtsHLTimerService *srv,
ErtsBifTimer *tmr,
@@ -1240,10 +1048,6 @@ bif_timer_timeout(ErtsHLTimerService *srv,
if (state == ERTS_TMR_STATE_ACTIVE) {
Process *proc;
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- btm_clear_magic_binary(tmr);
-#endif
-
if (roflgs & ERTS_TMR_ROFLG_REG_NAME) {
Eterm term;
term = tmr->type.head.receiver.name;
@@ -1266,18 +1070,11 @@ bif_timer_timeout(ErtsHLTimerService *srv,
erts_proc_lock(proc, ERTS_PROC_LOCK_BTM);
/* If the process is exiting do not disturb the cleanup... */
if (!ERTS_PROC_IS_EXITING(proc)) {
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- if (tmr->btm.proc_list.next) {
- proc_btm_list_delete(&proc->bif_timers, tmr);
- dec_refc = 1;
- }
-#else
if (tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
proc_btm_rbt_delete(&proc->bif_timers, tmr);
tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
dec_refc = 1;
}
-#endif
}
erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
if (dec_refc)
@@ -1287,25 +1084,18 @@ bif_timer_timeout(ErtsHLTimerService *srv,
free_message_buffer(tmr->btm.bp);
}
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
btm_rbt_delete(&srv->btm_tree, tmr);
tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
}
-#endif
-
}
static void
tw_bif_timer_timeout(void *vbtmp)
{
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ErtsHLTimerService *srv = NULL;
-#else
ErtsSchedulerData *esdp = erts_get_scheduler_data();
ErtsHLTimerService *srv = esdp->timer_service;
-#endif
ErtsBifTimer *btmp = (ErtsBifTimer *) vbtmp;
bif_timer_timeout(srv, btmp, btmp->type.head.roflgs);
tw_timer_dec_refc(&btmp->type.twt);
@@ -1317,11 +1107,7 @@ create_hl_timer(ErtsSchedulerData *esdp,
int short_time, ErtsTmrType type,
void *rcvrp, Eterm rcvr,
Eterm msg,
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ErtsMagicBinary *mbin,
-#else
Uint32 *refn,
-#endif
void (*callback)(void *), void *arg)
{
ErtsHLTimerService *srv = esdp->timer_service;
@@ -1407,11 +1193,7 @@ create_hl_timer(ErtsSchedulerData *esdp,
refc += init_btm_specifics(esdp,
(ErtsBifTimer *) tmr,
msg,
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- mbin
-#else
refn
-#endif
);
}
@@ -1628,7 +1410,6 @@ cleanup_sched_local_canceled_timer(ErtsSchedulerData *esdp,
ERTS_HLT_ASSERT((tmr->head.roflgs & ERTS_TMR_ROFLG_SID_MASK)
== (Uint32) esdp->no);
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
if (roflgs & ERTS_TMR_ROFLG_BIF_TMR) {
ErtsBifTimer *btm = (ErtsBifTimer *) tmr;
if (btm->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
@@ -1636,7 +1417,6 @@ cleanup_sched_local_canceled_timer(ErtsSchedulerData *esdp,
btm->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
}
}
-#endif
if (roflgs & ERTS_TMR_ROFLG_HLT) {
hlt_delete_timer(esdp, &tmr->hlt);
@@ -1909,9 +1689,6 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos,
Eterm ref, tmo_msg, *hp;
ErtsBifTimer *tmr;
ErtsSchedulerData *esdp;
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- Binary *mbin;
-#endif
Eterm tmp_hp[4];
ErtsCreateTimerFunc create_timer;
@@ -1920,18 +1697,10 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos,
esdp = erts_proc_sched_data(c_p);
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- mbin = erts_create_magic_indirection(bif_timer_ref_destructor);
- hp = HAlloc(c_p, ERTS_MAGIC_REF_THING_SIZE);
- ref = erts_mk_magic_ref(&hp, &c_p->off_heap, mbin);
- ASSERT(erts_get_ref_numbers_thr_id(((ErtsMagicBinary *)mbin)->refn)
- == (Uint32) esdp->no);
-#else
hp = HAlloc(c_p, ERTS_REF_THING_SIZE);
ref = erts_sched_make_ref_in_buffer(esdp, hp);
ASSERT(erts_get_ref_numbers_thr_id(internal_ordinary_ref_numbers(ref))
== (Uint32) esdp->no);
-#endif
tmo_msg = wrap ? TUPLE3(tmp_hp, am_timeout, ref, msg) : msg;
@@ -1939,11 +1708,7 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos,
tmr = (ErtsBifTimer *) create_timer(esdp, timeout_pos,
short_time, ERTS_TMR_BIF,
NULL, rcvr, tmo_msg,
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- (ErtsMagicBinary *) mbin,
-#else
internal_ordinary_ref_numbers(ref),
-#endif
NULL, NULL);
if (is_internal_pid(rcvr)) {
@@ -1951,14 +1716,10 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos,
rcvr, ERTS_PROC_LOCK_BTM,
ERTS_P2P_FLG_INC_REFC);
if (!proc) {
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- btm_clear_magic_binary(tmr);
-#else
if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
btm_rbt_delete(&esdp->timer_service->btm_tree, tmr);
tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
}
-#endif
if (tmr->btm.bp)
free_message_buffer(tmr->btm.bp);
if (twheel)
@@ -1968,11 +1729,7 @@ setup_bif_timer(Process *c_p, int twheel, ErtsMonotonicTime timeout_pos,
timer_destroy((ErtsTimer *) tmr, twheel, 1);
}
else {
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- proc_btm_list_insert(&proc->bif_timers, tmr);
-#else
proc_btm_rbt_insert(&proc->bif_timers, tmr);
-#endif
erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
tmr->type.head.receiver.proc = proc;
}
@@ -2000,10 +1757,6 @@ cancel_bif_timer(ErtsBifTimer *tmr)
if (state != ERTS_TMR_STATE_ACTIVE)
return 0;
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- btm_clear_magic_binary(tmr);
-#endif
-
if (tmr->btm.bp)
free_message_buffer(tmr->btm.bp);
@@ -2022,19 +1775,12 @@ cancel_bif_timer(ErtsBifTimer *tmr)
* the btm tree by itself (it may be in
* the middle of tree destruction).
*/
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- if (!ERTS_PROC_IS_EXITING(proc) && tmr->btm.proc_list.next) {
- proc_btm_list_delete(&proc->bif_timers, tmr);
- res = 1;
- }
-#else
if (!ERTS_PROC_IS_EXITING(proc)
&& tmr->btm.proc_tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
proc_btm_rbt_delete(&proc->bif_timers, tmr);
tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
res = 1;
}
-#endif
erts_proc_unlock(proc, ERTS_PROC_LOCK_BTM);
}
@@ -2075,12 +1821,10 @@ access_btm(ErtsBifTimer *tmr, Uint32 sid, ErtsSchedulerData *esdp, int cancel)
queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr);
}
else {
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
btm_rbt_delete(&esdp->timer_service->btm_tree, tmr);
tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
}
-#endif
if (is_hlt) {
if (cncl_res > 0)
hl_timer_dec_refc(&tmr->type.hlt, tmr->type.hlt.head.roflgs);
@@ -2157,52 +1901,6 @@ send_async_info(Process *proc, ErtsProcLocks initial_locks,
return am_ok;
}
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-
-static BIF_RETTYPE
-access_bif_timer(Process *c_p, Eterm tref, int cancel, int async, int info)
-{
- BIF_RETTYPE ret;
- Eterm res;
- Sint64 time_left;
-
- if (!is_internal_magic_ref(tref)) {
- if (is_not_ref(tref)) {
- ERTS_BIF_PREP_ERROR(ret, c_p, BADARG);
- return ret;
- }
- time_left = -1;
- }
- else {
- ErtsMagicBinary *mbin;
- mbin = (ErtsMagicBinary *) erts_magic_ref2bin(tref);
- if (mbin->destructor != bif_timer_ref_destructor)
- time_left = -1;
- else {
- ErtsBifTimer *tmr;
- Uint32 sid;
- tmr = magic_binary_to_btm(mbin);
- sid = erts_get_ref_numbers_thr_id(internal_magic_ref_numbers(tref));
- ASSERT(1 <= sid && sid <= erts_no_schedulers);
- time_left = access_btm(tmr, sid, erts_proc_sched_data(c_p), cancel);
- }
- }
-
- if (!info)
- res = am_ok;
- else if (!async)
- res = return_info(c_p, time_left);
- else
- res = send_async_info(c_p, ERTS_PROC_LOCK_MAIN,
- tref, cancel, time_left);
-
- ERTS_BIF_PREP_RET(ret, res);
-
- return ret;
-}
-
-#else /* !ERTS_MAGIC_REF_BIF_TIMERS */
-
static ERTS_INLINE Eterm
send_sync_info(Process *proc, ErtsProcLocks initial_locks,
Uint32 *refn, int cancel, Sint64 time_left)
@@ -2505,8 +2203,6 @@ no_timer:
return no_timer_result(c_p, tref, cancel, async, info);
}
-#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
-
static ERTS_INLINE int
bool_arg(Eterm val, int *argp)
{
@@ -2567,9 +2263,10 @@ parse_bif_timer_options(Eterm option_list, int *async,
return 1;
}
-static void
-exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp)
+static int
+exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp, Sint reds)
{
+#define ERTS_BTM_CANCEL_REDS 80
ErtsSchedulerData *esdp = (ErtsSchedulerData *) vesdp;
Uint32 sid, roflgs;
erts_aint_t state;
@@ -2584,32 +2281,23 @@ exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp)
is_hlt = !!(roflgs & ERTS_TMR_ROFLG_HLT);
ERTS_HLT_ASSERT(sid == erts_get_ref_numbers_thr_id(ERTS_BTM_HLT2REFN(tmr)));
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ERTS_HLT_ASSERT(tmr->btm.proc_list.next);
-#else
ERTS_HLT_ASSERT(tmr->btm.proc_tree.parent
!= ERTS_HLT_PFIELD_NOT_IN_TABLE);
tmr->btm.proc_tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
-#endif
if (state == ERTS_TMR_STATE_ACTIVE) {
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- btm_clear_magic_binary(tmr);
-#endif
if (tmr->btm.bp)
free_message_buffer(tmr->btm.bp);
if (sid != (Uint32) esdp->no) {
queue_canceled_timer(esdp, sid, (ErtsTimer *) tmr);
- return;
+ return ERTS_BTM_CANCEL_REDS;
}
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
if (tmr->btm.tree.parent != ERTS_HLT_PFIELD_NOT_IN_TABLE) {
btm_rbt_delete(&esdp->timer_service->btm_tree, tmr);
tmr->btm.tree.parent = ERTS_HLT_PFIELD_NOT_IN_TABLE;
}
-#endif
if (is_hlt)
hlt_delete_timer(esdp, &tmr->type.hlt);
else
@@ -2619,36 +2307,19 @@ exit_cancel_bif_timer(ErtsBifTimer *tmr, void *vesdp)
hl_timer_dec_refc(&tmr->type.hlt, roflgs);
else
tw_timer_dec_refc(&tmr->type.twt);
+ return ERTS_BTM_CANCEL_REDS;
}
-#ifdef ERTS_HLT_DEBUG
-# define ERTS_BTM_MAX_DESTROY_LIMIT 2
-#else
-# define ERTS_BTM_MAX_DESTROY_LIMIT 50
-#endif
-
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
typedef struct {
ErtsBifTimers *bif_timers;
union {
proc_btm_rbt_yield_state_t proc_btm_yield_state;
} u;
} ErtsBifTimerYieldState;
-#endif
-int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp)
+int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp, int reds)
{
ErtsSchedulerData *esdp = erts_proc_sched_data(p);
-
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-
- return proc_btm_list_foreach_destroy_yielding(btm,
- exit_cancel_bif_timer,
- (void *) esdp,
- ERTS_BTM_MAX_DESTROY_LIMIT);
-
-#else /* !ERTS_MAGIC_REF_BIF_TIMERS */
-
ErtsBifTimerYieldState ys = {*btm, {ERTS_RBT_YIELD_STAT_INITER}};
ErtsBifTimerYieldState *ysp;
int res;
@@ -2661,9 +2332,9 @@ int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp)
exit_cancel_bif_timer,
(void *) esdp,
&ysp->u.proc_btm_yield_state,
- ERTS_BTM_MAX_DESTROY_LIMIT);
+ reds);
- if (res == 0) {
+ if (res > 0) {
if (ysp != &ys)
erts_free(ERTS_ALC_T_BTM_YIELD_STATE, ysp);
*vyspp = NULL;
@@ -2682,7 +2353,6 @@ int erts_cancel_bif_timers(Process *p, ErtsBifTimers **btm, void **vyspp)
return res;
-#endif /* !ERTS_MAGIC_REF_BIF_TIMERS */
}
static ERTS_INLINE int
@@ -3116,11 +2786,6 @@ btm_print(ErtsBifTimer *tmr, void *vbtmp, ErtsMonotonicTime tpos, int is_hlt)
ErtsMonotonicTime left;
Eterm receiver;
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- if (!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_BIF_TMR))
- return;
-#endif
-
if (is_hlt) {
ERTS_HLT_ASSERT(tmr->type.head.roflgs & ERTS_TMR_ROFLG_HLT);
if (tmr->type.hlt.timeout <= btmp->now)
@@ -3149,24 +2814,8 @@ btm_print(ErtsBifTimer *tmr, void *vbtmp, ErtsMonotonicTime tpos, int is_hlt)
(Sint64) left);
}
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-
-static void
-hlt_btm_print(ErtsHLTimer *tmr, void *vbtmp)
-{
- btm_print((ErtsBifTimer *) tmr, vbtmp, 0, 1);
-}
-
-static void
-twt_btm_print(void *vbtmp, ErtsMonotonicTime tpos, void *vtwtp)
-{
- btm_print((ErtsBifTimer *) vtwtp, vbtmp, tpos, 0);
-}
-
-#else
-
-static void
-btm_tree_print(ErtsBifTimer *tmr, void *vbtmp)
+static int
+btm_tree_print(ErtsBifTimer *tmr, void *vbtmp, Sint reds)
{
int is_hlt = !!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_HLT);
ErtsMonotonicTime tpos;
@@ -3175,10 +2824,9 @@ btm_tree_print(ErtsBifTimer *tmr, void *vbtmp)
else
tpos = erts_tweel_read_timeout(&tmr->type.twt.u.tw_tmr);
btm_print(tmr, vbtmp, tpos, is_hlt);
+ return 1;
}
-#endif
-
void
erts_print_bif_timer_info(fmtfn_t to, void *to_arg)
{
@@ -3196,15 +2844,7 @@ erts_print_bif_timer_info(fmtfn_t to, void *to_arg)
for (six = 0; six < erts_no_schedulers; six++) {
ErtsHLTimerService *srv =
erts_aligned_scheduler_data[six].esd.timer_service;
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ErtsTimerWheel *twheel =
- erts_aligned_scheduler_data[six].esd.timer_wheel;
- erts_twheel_debug_foreach(twheel, tw_bif_timer_timeout,
- twt_btm_print, (void *) &btmp);
- time_rbt_foreach(srv->time_tree, hlt_btm_print, (void *) &btmp);
-#else
btm_rbt_foreach(srv->btm_tree, btm_tree_print, (void *) &btmp);
-#endif
}
}
@@ -3216,13 +2856,9 @@ typedef struct {
void *arg;
} ErtsBTMForeachDebug;
-static void
-debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd)
+static int
+debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd, Sint reds)
{
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- if (!(tmr->type.head.roflgs & ERTS_TMR_ROFLG_BIF_TMR))
- return;
-#endif
if (erts_atomic32_read_nob(&tmr->btm.state) == ERTS_TMR_STATE_ACTIVE) {
ErtsBTMForeachDebug *btmfd = (ErtsBTMForeachDebug *) vbtmfd;
Eterm id = ((tmr->type.head.roflgs & ERTS_TMR_ROFLG_REG_NAME)
@@ -3230,24 +2866,9 @@ debug_btm_foreach(ErtsBifTimer *tmr, void *vbtmfd)
: tmr->type.head.receiver.proc->common.id);
(*btmfd->func)(id, tmr->btm.message, tmr->btm.bp, btmfd->arg);
}
+ return 1;
}
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
-
-static void
-hlt_debug_btm_foreach(ErtsHLTimer *tmr, void *vbtmfd)
-{
- debug_btm_foreach((ErtsBifTimer *) tmr, vbtmfd);
-}
-
-static void
-twt_debug_btm_foreach(void *vbtmfd, ErtsMonotonicTime tpos, void *vtwtp)
-{
- debug_btm_foreach((ErtsBifTimer *) vtwtp, vbtmfd);
-}
-
-#endif
-
void
erts_debug_bif_timer_foreach(void (*func)(Eterm,
Eterm,
@@ -3267,20 +2888,9 @@ erts_debug_bif_timer_foreach(void (*func)(Eterm,
for (six = 0; six < erts_no_schedulers; six++) {
ErtsHLTimerService *srv =
erts_aligned_scheduler_data[six].esd.timer_service;
-#ifdef ERTS_MAGIC_REF_BIF_TIMERS
- ErtsTimerWheel *twheel =
- erts_aligned_scheduler_data[six].esd.timer_wheel;
- erts_twheel_debug_foreach(twheel, tw_bif_timer_timeout,
- twt_debug_btm_foreach,
- (void *) &btmfd);
- time_rbt_foreach(srv->time_tree,
- hlt_debug_btm_foreach,
- (void *) &btmfd);
-#else
btm_rbt_foreach(srv->btm_tree,
debug_btm_foreach,
(void *) &btmfd);
-#endif
}
}
@@ -3305,8 +2915,8 @@ debug_callback_timer_foreach_list(ErtsHLTimer *tmr, void *vdfct)
tmr->head.u.arg);
}
-static void
-debug_callback_timer_foreach(ErtsHLTimer *tmr, void *vdfct)
+static int
+debug_callback_timer_foreach(ErtsHLTimer *tmr, void *vdfct, Sint reds)
{
ErtsDebugForeachCallbackTimer *dfct
= (ErtsDebugForeachCallbackTimer *) vdfct;
@@ -3321,6 +2931,7 @@ debug_callback_timer_foreach(ErtsHLTimer *tmr, void *vdfct)
(*dfct->func)(dfct->arg,
tmr->timeout,
tmr->head.u.arg);
+ return 1;
}
static void
@@ -3368,7 +2979,8 @@ erts_debug_callback_timer_foreach(void (*tclbk)(void *),
if (srv->yield.root)
debug_callback_timer_foreach(srv->yield.root,
- (void *) &dfct);
+ (void *) &dfct,
+ -1);
time_rbt_foreach(srv->time_tree,
debug_callback_timer_foreach,
@@ -3403,9 +3015,7 @@ st_hdbg_func(ErtsHLTimer *tmr, void *vhdbg)
}
ERTS_HLT_ASSERT(tmr->time.tree.u.l.next->time.tree.u.l.prev == tmr);
ERTS_HLT_ASSERT(tmr->time.tree.u.l.prev->time.tree.u.l.next == tmr);
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, ERTS_BTM_HLT2REFN(tmr)) == tmr);
-#endif
}
static void
@@ -3434,10 +3044,8 @@ tt_hdbg_func(ErtsHLTimer *tmr, void *vhdbg)
& ~ERTS_HLT_PFLGS_MASK);
ERTS_HLT_ASSERT(tmr == prnt);
}
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
if (tmr->head.roflgs & ERTS_TMR_ROFLG_BIF_TMR)
ERTS_HLT_ASSERT(btm_rbt_lookup(hdbg->srv->btm_tree, ERTS_BTM_HLT2REFN(tmr)) == tmr);
-#endif
if (tmr->time.tree.same_time) {
ErtsHdbgHLT st_hdbg;
st_hdbg.srv = hdbg->srv;
@@ -3503,7 +3111,6 @@ hdbg_chk_srv(ErtsHLTimerService *srv)
time_rbt_foreach(srv->time_tree, tt_hdbg_func, (void *) &hdbg);
ERTS_HLT_ASSERT(hdbg.found_root);
}
-#ifndef ERTS_MAGIC_REF_BIF_TIMERS
if (srv->btm_tree) {
ErtsHdbgHLT hdbg;
hdbg.srv = srv;
@@ -3512,7 +3119,6 @@ hdbg_chk_srv(ErtsHLTimerService *srv)
btm_rbt_foreach(srv->btm_tree, bt_hdbg_func, (void *) &hdbg);
ERTS_HLT_ASSERT(hdbg.found_root);
}
-#endif
}
#endif /* ERTS_HLT_HARD_DEBUG */
diff --git a/erts/emulator/beam/erl_hl_timer.h b/erts/emulator/beam/erl_hl_timer.h
index e6f5e8b67d..29c873868b 100644
--- a/erts/emulator/beam/erl_hl_timer.h
+++ b/erts/emulator/beam/erl_hl_timer.h
@@ -56,7 +56,7 @@ void erts_cancel_proc_timer(Process *);
void erts_set_port_timer(Port *, Sint64);
void erts_cancel_port_timer(Port *);
Sint64 erts_read_port_timer(Port *);
-int erts_cancel_bif_timers(Process *, ErtsBifTimers **, void **);
+int erts_cancel_bif_timers(Process *, ErtsBifTimers **, void **, int);
int erts_detach_accessor_bif_timers(Process *, ErtsBifTimers *, void **);
ErtsHLTimerService *erts_create_timer_service(void);
void erts_hl_timer_init(void);
diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c
index c0a86ea738..82d5140d1c 100644
--- a/erts/emulator/beam/erl_init.c
+++ b/erts/emulator/beam/erl_init.c
@@ -78,7 +78,7 @@ const char etp_erts_version[] = ERLANG_VERSION;
const char etp_otp_release[] = ERLANG_OTP_RELEASE;
const char etp_compile_date[] = ERLANG_COMPILE_DATE;
const char etp_arch[] = ERLANG_ARCHITECTURE;
-#ifdef ERTS_ENABLE_KERNEL_POLL
+#if ERTS_ENABLE_KERNEL_POLL
const int erts_use_kernel_poll = 1;
const int etp_kernel_poll_support = 1;
#else
@@ -2417,12 +2417,17 @@ erts_exit_vv(int n, int flush_async, char *fmt, va_list args1, va_list args2)
erts_exit_epilogue();
}
+void check_obuf(void);
__decl_noreturn void __noreturn erts_exit_epilogue(void)
{
int n = erts_exit_code;
sys_tty_reset(n);
+#ifdef DEBUG
+ check_obuf();
+#endif
+
if (n == ERTS_INTR_EXIT)
exit(0);
else if (n == ERTS_DUMP_EXIT)
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index 3aab4828cc..39eabb6710 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -164,7 +164,8 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "os_monotonic_time", NULL },
{ "erts_alloc_hard_debug", NULL },
{ "hard_dbg_mseg", NULL },
- { "erts_mmap", NULL }
+ { "erts_mmap", NULL },
+ { "sad", NULL}
};
#define ERTS_LOCK_ORDER_SIZE \
diff --git a/erts/emulator/beam/erl_map.c b/erts/emulator/beam/erl_map.c
index 93816542cd..62dd85e425 100644
--- a/erts/emulator/beam/erl_map.c
+++ b/erts/emulator/beam/erl_map.c
@@ -480,7 +480,7 @@ Eterm erts_hashmap_from_array(ErtsHeapFactory* factory, Eterm *leafs, Uint n,
Eterm erts_map_from_ks_and_vs(ErtsHeapFactory *factory, Eterm *ks0, Eterm *vs0, Uint n)
{
- if (n < MAP_SMALL_MAP_LIMIT) {
+ if (n <= MAP_SMALL_MAP_LIMIT) {
Eterm *ks, *vs, *hp;
flatmap_t *mp;
Eterm keys;
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index 942bec84cf..e350a20339 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -181,7 +181,7 @@ erts_cleanup_offheap(ErlOffHeap *offheap)
break;
default:
ASSERT(is_external_header(u.hdr->thing_word));
- erts_deref_node_entry(u.ext->node);
+ erts_deref_node_entry(u.ext->node, make_boxed(u.ep));
break;
}
}
@@ -201,34 +201,44 @@ free_message_buffer(ErlHeapFragment* bp)
}while (bp != NULL);
}
+static void
+erts_cleanup_message(ErtsMessage *mp)
+{
+ ErlHeapFragment *bp;
+ if (ERTS_SIG_IS_EXTERNAL_MSG(mp) || ERTS_SIG_IS_NON_MSG(mp)) {
+ ErtsDistExternal *edep = erts_proc_sig_get_external(mp);
+ if (edep) {
+ erts_free_dist_ext_copy(edep);
+ if (mp->data.heap_frag == &mp->hfrag) {
+ ASSERT(ERTS_SIG_IS_EXTERNAL_MSG(mp));
+ mp->data.heap_frag = ERTS_MSG_COMBINED_HFRAG;
+ }
+ }
+ }
+
+ if (ERTS_SIG_IS_MSG(mp) && mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
+ bp = mp->data.heap_frag;
+ } else {
+ /* All non msg signals are combined HFRAG messages,
+ but we overwrite the mp->data field with the
+ nm_signal queue ptr so have to fix that here
+ before freeing it. */
+ mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
+ bp = mp->hfrag.next;
+ erts_cleanup_offheap(&mp->hfrag.off_heap);
+ }
+
+ if (bp)
+ free_message_buffer(bp);
+}
+
void
erts_cleanup_messages(ErtsMessage *msgp)
{
ErtsMessage *mp = msgp;
while (mp) {
ErtsMessage *fmp;
- ErlHeapFragment *bp;
- if (ERTS_SIG_IS_EXTERNAL_MSG(mp)) {
- if (is_not_immed(ERL_MESSAGE_TOKEN(mp))) {
- bp = (ErlHeapFragment *) mp->data.dist_ext->ext_endp;
- erts_cleanup_offheap(&bp->off_heap);
- }
- if (mp->data.dist_ext)
- erts_free_dist_ext_copy(mp->data.dist_ext);
- }
- else {
- if (ERTS_SIG_IS_INTERNAL_MSG(mp)
- && mp->data.attached != ERTS_MSG_COMBINED_HFRAG) {
- bp = mp->data.heap_frag;
- }
- else {
- mp->data.attached = ERTS_MSG_COMBINED_HFRAG;
- bp = mp->hfrag.next;
- erts_cleanup_offheap(&mp->hfrag.off_heap);
- }
- if (bp)
- free_message_buffer(bp);
- }
+ erts_cleanup_message(mp);
fmp = mp;
mp = mp->next;
erts_free_message(fmp);
@@ -260,6 +270,7 @@ void
erts_queue_dist_message(Process *rcvr,
ErtsProcLocks rcvr_locks,
ErtsDistExternal *dist_ext,
+ ErlHeapFragment *hfrag,
Eterm token,
Eterm from)
{
@@ -268,8 +279,26 @@ erts_queue_dist_message(Process *rcvr,
ERTS_LC_ASSERT(rcvr_locks == erts_proc_lc_my_proc_locks(rcvr));
- mp = erts_alloc_message(0, NULL);
- mp->data.dist_ext = dist_ext;
+ if (hfrag) {
+ /* Fragmented message, allocate a message reference */
+ mp = erts_alloc_message(0, NULL);
+ mp->data.heap_frag = hfrag;
+ } else {
+ /* Un-fragmented message, allocate space for
+ token and dist_ext in message. */
+ Uint dist_ext_sz = erts_dist_ext_size(dist_ext) / sizeof(Eterm);
+ Uint token_sz = size_object(token);
+ Uint sz = token_sz + dist_ext_sz;
+ Eterm *hp;
+
+ mp = erts_alloc_message(sz, &hp);
+ mp->data.heap_frag = &mp->hfrag;
+ mp->hfrag.used_size = token_sz;
+
+ erts_make_dist_ext_copy(dist_ext, erts_get_dist_ext(mp->data.heap_frag));
+
+ token = copy_struct(token, token_sz, &hp, &mp->data.heap_frag->off_heap);
+ }
ERL_MESSAGE_FROM(mp) = dist_ext->dep->sysname;
ERL_MESSAGE_TERM(mp) = THE_NON_VALUE;
@@ -493,25 +522,27 @@ Uint
erts_msg_attached_data_size_aux(ErtsMessage *msg)
{
Sint sz;
- ASSERT(is_non_value(ERL_MESSAGE_TERM(msg)));
- ASSERT(msg->data.dist_ext);
- ASSERT(msg->data.dist_ext->heap_size < 0);
-
- sz = erts_decode_dist_ext_size(msg->data.dist_ext);
- if (sz < 0) {
- /* Bad external
- * We leave the message intact in this case as it's not worth the trouble
- * to make all callers remove it from queue. It will be detected again
- * and removed from message queue later anyway.
- */
- return 0;
- }
+ ErtsDistExternal *edep = erts_get_dist_ext(msg->data.heap_frag);
+ ASSERT(ERTS_SIG_IS_EXTERNAL_MSG(msg));
+
+ if (edep->heap_size < 0) {
+
+ sz = erts_decode_dist_ext_size(edep, 1);
+ if (sz < 0) {
+ /* Bad external
+ * We leave the message intact in this case as it's not worth the trouble
+ * to make all callers remove it from queue. It will be detected again
+ * and removed from message queue later anyway.
+ */
+ return 0;
+ }
- msg->data.dist_ext->heap_size = sz;
- if (is_not_nil(msg->m[1])) {
- ErlHeapFragment *heap_frag;
- heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
- sz += heap_frag->used_size;
+ edep->heap_size = sz;
+ } else {
+ sz = edep->heap_size;
+ }
+ if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) {
+ sz += msg->data.heap_frag->used_size;
}
return sz;
}
@@ -745,6 +776,13 @@ erts_send_message(Process* sender,
#endif
erts_queue_proc_message(sender, receiver, *receiver_locks, mp, message);
+
+ if (msize > ERTS_MSG_COPY_WORDS_PER_REDUCTION) {
+ Uint reds = msize / ERTS_MSG_COPY_WORDS_PER_REDUCTION;
+ if (reds > CONTEXT_REDS)
+ reds = CONTEXT_REDS;
+ BUMP_REDS(sender, (int) reds);
+ }
}
@@ -1099,80 +1137,6 @@ change_to_off_heap:
return res;
}
-int
-erts_decode_dist_message(Process *proc, ErtsProcLocks proc_locks,
- ErtsMessage *msgp, int force_off_heap)
-{
- ErtsHeapFactory factory;
- Eterm msg;
- ErlHeapFragment *bp;
- Sint need;
- int decode_in_heap_frag;
-
- decode_in_heap_frag = (force_off_heap
- || !(proc_locks & ERTS_PROC_LOCK_MAIN)
- || (proc->flags & F_OFF_HEAP_MSGQ));
-
- if (msgp->data.dist_ext->heap_size >= 0)
- need = msgp->data.dist_ext->heap_size;
- else {
- need = erts_decode_dist_ext_size(msgp->data.dist_ext);
- if (need < 0) {
- /* bad msg; remove it... */
- if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
- bp = erts_dist_ext_trailer(msgp->data.dist_ext);
- erts_cleanup_offheap(&bp->off_heap);
- }
- erts_free_dist_ext_copy(msgp->data.dist_ext);
- msgp->data.dist_ext = NULL;
- return 0;
- }
-
- msgp->data.dist_ext->heap_size = need;
- }
-
- if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
- bp = erts_dist_ext_trailer(msgp->data.dist_ext);
- need += bp->used_size;
- }
-
- if (decode_in_heap_frag)
- erts_factory_heap_frag_init(&factory, new_message_buffer(need));
- else
- erts_factory_proc_prealloc_init(&factory, proc, need);
-
- ASSERT(msgp->data.dist_ext->heap_size >= 0);
- if (is_not_immed(ERL_MESSAGE_TOKEN(msgp))) {
- ErlHeapFragment *heap_frag;
- heap_frag = erts_dist_ext_trailer(msgp->data.dist_ext);
- ERL_MESSAGE_TOKEN(msgp) = copy_struct(ERL_MESSAGE_TOKEN(msgp),
- heap_frag->used_size,
- &factory.hp,
- factory.off_heap);
- erts_cleanup_offheap(&heap_frag->off_heap);
- }
-
- msg = erts_decode_dist_ext(&factory, msgp->data.dist_ext);
- ERL_MESSAGE_TERM(msgp) = msg;
- erts_free_dist_ext_copy(msgp->data.dist_ext);
- msgp->data.attached = NULL;
-
- if (is_non_value(msg)) {
- erts_factory_undo(&factory);
- return 0;
- }
-
- erts_factory_trim_and_close(&factory, msgp->m,
- ERL_MESSAGE_REF_ARRAY_SZ);
-
- ASSERT(!msgp->data.heap_frag);
-
- if (decode_in_heap_frag)
- msgp->data.heap_frag = factory.heap_frags;
-
- return 1;
-}
-
void erts_factory_proc_init(ErtsHeapFactory* factory,
Process* p)
{
@@ -1233,7 +1197,7 @@ erts_factory_message_create(ErtsHeapFactory* factory,
int on_heap;
erts_aint32_t state;
- state = proc ? erts_atomic32_read_nob(&proc->state) : 0;
+ state = proc ? erts_atomic32_read_nob(&proc->state) : ERTS_PSFLG_OFF_HEAP_MSGQ;
if (state & ERTS_PSFLG_OFF_HEAP_MSGQ) {
msgp = erts_alloc_message(sz, &hp);
@@ -1466,8 +1430,8 @@ void erts_factory_close(ErtsHeapFactory* factory)
else
factory->message->data.heap_frag = factory->heap_frags;
- /* Fall through */
- case FACTORY_HEAP_FRAGS:
+ /* Fall through */
+ case FACTORY_HEAP_FRAGS:
bp = factory->heap_frags;
}
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index b2550814fd..e5f623a370 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -26,6 +26,12 @@
#include "erl_proc_sig_queue.h"
#undef ERTS_PROC_SIG_QUEUE_TYPE_ONLY
+#ifdef DEBUG
+#define ERTS_MSG_COPY_WORDS_PER_REDUCTION 4
+#else
+#define ERTS_MSG_COPY_WORDS_PER_REDUCTION 64
+#endif
+
struct proc_bin;
struct external_thing_;
@@ -138,7 +144,7 @@ typedef struct erl_heap_fragment ErlHeapFragment;
struct erl_heap_fragment {
ErlHeapFragment* next; /* Next heap fragment */
ErlOffHeap off_heap; /* Offset heap data. */
- Uint alloc_size; /* Size in (half)words of mem */
+ Uint alloc_size; /* Size in words of mem */
Uint used_size; /* With terms to be moved to heap by GC */
Eterm mem[1]; /* Data */
};
@@ -167,7 +173,6 @@ struct erl_heap_fragment {
#define ERL_MESSAGE_REF_FIELDS__ \
ErtsMessage *next; /* Next message */ \
union { \
- ErtsDistExternal *dist_ext; \
ErlHeapFragment *heap_frag; \
void *attached; \
} data; \
@@ -438,7 +443,8 @@ ErlHeapFragment* new_message_buffer(Uint);
ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint,
Eterm *, Uint);
void free_message_buffer(ErlHeapFragment *);
-void erts_queue_dist_message(Process*, ErtsProcLocks, ErtsDistExternal *, Eterm, Eterm);
+void erts_queue_dist_message(Process*, ErtsProcLocks, ErtsDistExternal *,
+ ErlHeapFragment *, Eterm, Eterm);
void erts_queue_message(Process*, ErtsProcLocks,ErtsMessage*, Eterm, Eterm);
void erts_queue_proc_message(Process* from,Process* to, ErtsProcLocks,ErtsMessage*, Eterm);
void erts_queue_proc_messages(Process* from, Process* to, ErtsProcLocks,
@@ -455,8 +461,6 @@ Sint erts_move_messages_off_heap(Process *c_p);
Sint erts_complete_off_heap_message_queue_change(Process *c_p);
Eterm erts_change_message_queue_management(Process *c_p, Eterm new_state);
-int erts_decode_dist_message(Process *, ErtsProcLocks, ErtsMessage *, int);
-
void erts_cleanup_messages(ErtsMessage *mp);
void *erts_alloc_message_ref(void);
@@ -585,22 +589,11 @@ ERTS_GLB_INLINE Uint erts_used_frag_sz(const ErlHeapFragment* bp)
ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErtsMessage *msg)
{
ASSERT(msg->data.attached);
- if (is_value(ERL_MESSAGE_TERM(msg))) {
- ErlHeapFragment *bp;
- bp = erts_message_to_heap_frag(msg);
- return erts_used_frag_sz(bp);
- }
- else if (msg->data.dist_ext->heap_size < 0)
- return erts_msg_attached_data_size_aux(msg);
- else {
- Uint sz = msg->data.dist_ext->heap_size;
- if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) {
- ErlHeapFragment *heap_frag;
- heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
- sz += heap_frag->used_size;
- }
- return sz;
- }
+
+ if (ERTS_SIG_IS_INTERNAL_MSG(msg))
+ return erts_used_frag_sz(erts_message_to_heap_frag(msg));
+
+ return erts_msg_attached_data_size_aux(msg);
}
#endif
diff --git a/erts/emulator/beam/erl_monitor_link.c b/erts/emulator/beam/erl_monitor_link.c
index 48d9bd4ca5..1c6b4afaa3 100644
--- a/erts/emulator/beam/erl_monitor_link.c
+++ b/erts/emulator/beam/erl_monitor_link.c
@@ -191,7 +191,8 @@ ml_cmp_keys(Eterm key1, Eterm key2)
if (n1->sysname != n2->sysname)
return n1->sysname < n2->sysname ? -1 : 1;
ASSERT(n1->creation != n2->creation);
- return n1->creation < n2->creation ? -1 : 1;
+ if (n1->creation != 0 && n2->creation != 0)
+ return n1->creation < n2->creation ? -1 : 1;
}
ndw1 = external_thing_data_words(et1);
@@ -335,7 +336,7 @@ ml_rbt_delete(ErtsMonLnkNode **root, ErtsMonLnkNode *ml)
static void
ml_rbt_foreach(ErtsMonLnkNode *root,
- void (*func)(ErtsMonLnkNode *, void *),
+ ErtsMonLnkNodeFunc func,
void *arg)
{
mon_lnk_rbt_foreach(root, func, arg);
@@ -348,7 +349,7 @@ typedef struct {
static int
ml_rbt_foreach_yielding(ErtsMonLnkNode *root,
- void (*func)(ErtsMonLnkNode *, void *),
+ ErtsMonLnkNodeFunc func,
void *arg,
void **vyspp,
Sint limit)
@@ -362,7 +363,7 @@ ml_rbt_foreach_yielding(ErtsMonLnkNode *root,
ysp = &ys;
res = mon_lnk_rbt_foreach_yielding(ysp->root, func, arg,
&ysp->rbt_ystate, limit);
- if (res == 0) {
+ if (res > 0) {
if (ysp != &ys)
erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp);
*vyspp = NULL;
@@ -383,22 +384,22 @@ ml_rbt_foreach_yielding(ErtsMonLnkNode *root,
}
typedef struct {
- void (*func)(ErtsMonLnkNode *, void *);
+ ErtsMonLnkNodeFunc func;
void *arg;
} ErtsMonLnkForeachDeleteContext;
-static void
-rbt_wrap_foreach_delete(ErtsMonLnkNode *ml, void *vctxt)
+static int
+rbt_wrap_foreach_delete(ErtsMonLnkNode *ml, void *vctxt, Sint reds)
{
ErtsMonLnkForeachDeleteContext *ctxt = vctxt;
ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE);
ml->flags &= ~ERTS_ML_FLG_IN_TABLE;
- ctxt->func(ml, ctxt->arg);
+ return ctxt->func(ml, ctxt->arg, reds);
}
static void
ml_rbt_foreach_delete(ErtsMonLnkNode **root,
- void (*func)(ErtsMonLnkNode *, void *),
+ ErtsMonLnkNodeFunc func,
void *arg)
{
ErtsMonLnkForeachDeleteContext ctxt;
@@ -411,7 +412,7 @@ ml_rbt_foreach_delete(ErtsMonLnkNode **root,
static int
ml_rbt_foreach_delete_yielding(ErtsMonLnkNode **root,
- void (*func)(ErtsMonLnkNode *, void *),
+ ErtsMonLnkNodeFunc func,
void *arg,
void **vyspp,
Sint limit)
@@ -433,7 +434,7 @@ ml_rbt_foreach_delete_yielding(ErtsMonLnkNode **root,
(void *) &ctxt,
&ysp->rbt_ystate,
limit);
- if (res == 0) {
+ if (res > 0) {
if (ysp != &ys)
erts_free(ERTS_ALC_T_ML_YIELD_STATE, ysp);
*vyspp = NULL;
@@ -459,12 +460,11 @@ ml_rbt_foreach_delete_yielding(ErtsMonLnkNode **root,
static int
ml_dl_list_foreach_yielding(ErtsMonLnkNode *list,
- void (*func)(ErtsMonLnkNode *, void *),
+ ErtsMonLnkNodeFunc func,
void *arg,
void **vyspp,
- Sint limit)
+ Sint reds)
{
- Sint cnt = 0;
ErtsMonLnkNode *ml = (ErtsMonLnkNode *) *vyspp;
ERTS_ML_ASSERT(!ml || list);
@@ -475,28 +475,26 @@ ml_dl_list_foreach_yielding(ErtsMonLnkNode *list,
if (ml) {
do {
ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE);
- func(ml, arg);
+ reds -= func(ml, arg, reds);
ml = ml->node.list.next;
- cnt++;
- } while (ml != list && cnt < limit);
+ } while (ml != list && reds > 0);
if (ml != list) {
*vyspp = (void *) ml;
- return 1; /* yield */
+ return 0; /* yield */
}
}
*vyspp = NULL;
- return 0; /* done */
+ return reds <= 0 ? 1 : reds; /* done */
}
static int
ml_dl_list_foreach_delete_yielding(ErtsMonLnkNode **list,
- void (*func)(ErtsMonLnkNode *, void *),
+ ErtsMonLnkNodeFunc func,
void *arg,
void **vyspp,
- Sint limit)
+ Sint reds)
{
- Sint cnt = 0;
ErtsMonLnkNode *first = *list;
ErtsMonLnkNode *ml = (ErtsMonLnkNode *) *vyspp;
@@ -510,19 +508,18 @@ ml_dl_list_foreach_delete_yielding(ErtsMonLnkNode **list,
ErtsMonLnkNode *next = ml->node.list.next;
ERTS_ML_ASSERT(ml->flags & ERTS_ML_FLG_IN_TABLE);
ml->flags &= ~ERTS_ML_FLG_IN_TABLE;
- func(ml, arg);
+ reds -= func(ml, arg, reds);
ml = next;
- cnt++;
- } while (ml != first && cnt < limit);
+ } while (ml != first && reds > 0);
if (ml != first) {
*vyspp = (void *) ml;
- return 1; /* yield */
+ return 0; /* yield */
}
}
*vyspp = NULL;
*list = NULL;
- return 0; /* done */
+ return reds <= 0 ? 1 : reds; /* done */
}
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
@@ -666,91 +663,91 @@ erts_monitor_tree_delete(ErtsMonitor **root, ErtsMonitor *mon)
void
erts_monitor_tree_foreach(ErtsMonitor *root,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg)
{
ml_rbt_foreach((ErtsMonLnkNode *) root,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (ErtsMonLnkNodeFunc) func,
arg);
}
int
erts_monitor_tree_foreach_yielding(ErtsMonitor *root,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg,
void **vyspp,
Sint limit)
{
return ml_rbt_foreach_yielding((ErtsMonLnkNode *) root,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (int (*)(ErtsMonLnkNode*, void*, Sint)) func,
arg, vyspp, limit);
}
void
erts_monitor_tree_foreach_delete(ErtsMonitor **root,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg)
{
ml_rbt_foreach_delete((ErtsMonLnkNode **) root,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (int (*)(ErtsMonLnkNode*, void*, Sint)) func,
arg);
}
int
erts_monitor_tree_foreach_delete_yielding(ErtsMonitor **root,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg,
void **vyspp,
Sint limit)
{
return ml_rbt_foreach_delete_yielding((ErtsMonLnkNode **) root,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (int (*)(ErtsMonLnkNode*, void*, Sint)) func,
arg, vyspp, limit);
}
void
erts_monitor_list_foreach(ErtsMonitor *list,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg)
{
void *ystate = NULL;
- while (ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
- (void (*)(ErtsMonLnkNode *, void *)) func,
- arg, &ystate, (Sint) INT_MAX));
+ while (!ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
+ (int (*)(ErtsMonLnkNode *, void *, Sint)) func,
+ arg, &ystate, (Sint) INT_MAX));
}
int
erts_monitor_list_foreach_yielding(ErtsMonitor *list,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg,
void **vyspp,
Sint limit)
{
return ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
- (void (*)(ErtsMonLnkNode *, void *)) func,
+ (int (*)(ErtsMonLnkNode *, void *, Sint)) func,
arg, vyspp, limit);
}
void
erts_monitor_list_foreach_delete(ErtsMonitor **list,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg)
{
void *ystate = NULL;
- while (ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
- (void (*)(ErtsMonLnkNode*, void*)) func,
- arg, &ystate, (Sint) INT_MAX));
+ while (!ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
+ (int (*)(ErtsMonLnkNode*, void*, Sint)) func,
+ arg, &ystate, (Sint) INT_MAX));
}
int
erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg,
void **vyspp,
Sint limit)
{
return ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (int (*)(ErtsMonLnkNode*, void*, Sint)) func,
arg, vyspp, limit);
}
@@ -1074,92 +1071,92 @@ erts_link_tree_delete(ErtsLink **root, ErtsLink *lnk)
void
erts_link_tree_foreach(ErtsLink *root,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg)
{
ml_rbt_foreach((ErtsMonLnkNode *) root,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (ErtsMonLnkNodeFunc) func,
arg);
}
int
erts_link_tree_foreach_yielding(ErtsLink *root,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg,
void **vyspp,
Sint limit)
{
return ml_rbt_foreach_yielding((ErtsMonLnkNode *) root,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (ErtsMonLnkNodeFunc) func,
arg, vyspp, limit);
}
void
erts_link_tree_foreach_delete(ErtsLink **root,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg)
{
ml_rbt_foreach_delete((ErtsMonLnkNode **) root,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (ErtsMonLnkNodeFunc) func,
arg);
}
int
erts_link_tree_foreach_delete_yielding(ErtsLink **root,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg,
void **vyspp,
Sint limit)
{
return ml_rbt_foreach_delete_yielding((ErtsMonLnkNode **) root,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (ErtsMonLnkNodeFunc) func,
arg, vyspp, limit);
}
void
erts_link_list_foreach(ErtsLink *list,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg)
{
void *ystate = NULL;
- while (ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
- (void (*)(ErtsMonLnkNode *, void *)) func,
- arg, &ystate, (Sint) INT_MAX));
+ while (!ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
+ (ErtsMonLnkNodeFunc) func,
+ arg, &ystate, (Sint) INT_MAX));
}
int
erts_link_list_foreach_yielding(ErtsLink *list,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg,
void **vyspp,
Sint limit)
{
return ml_dl_list_foreach_yielding((ErtsMonLnkNode *) list,
- (void (*)(ErtsMonLnkNode *, void *)) func,
+ (ErtsMonLnkNodeFunc) func,
arg, vyspp, limit);
}
void
erts_link_list_foreach_delete(ErtsLink **list,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg)
{
void *ystate = NULL;
- while (ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
- (void (*)(ErtsMonLnkNode*, void*)) func,
- arg, &ystate, (Sint) INT_MAX));
+ while (!ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
+ (ErtsMonLnkNodeFunc) func,
+ arg, &ystate, (Sint) INT_MAX));
}
int
erts_link_list_foreach_delete_yielding(ErtsLink **list,
- void (*func)(ErtsLink *, void *),
+ int (*func)(ErtsLink *, void *, Sint),
void *arg,
void **vyspp,
Sint limit)
{
return ml_dl_list_foreach_delete_yielding((ErtsMonLnkNode **) list,
- (void (*)(ErtsMonLnkNode*, void*)) func,
+ (ErtsMonLnkNodeFunc) func,
arg, vyspp, limit);
}
diff --git a/erts/emulator/beam/erl_monitor_link.h b/erts/emulator/beam/erl_monitor_link.h
index ed7bf7d54a..eff861fce8 100644
--- a/erts/emulator/beam/erl_monitor_link.h
+++ b/erts/emulator/beam/erl_monitor_link.h
@@ -439,6 +439,7 @@
(ERTS_ML_FLG_EXTENDED|ERTS_ML_FLG_NAME)
typedef struct ErtsMonLnkNode__ ErtsMonLnkNode;
+typedef int (*ErtsMonLnkNodeFunc)(ErtsMonLnkNode *, void *, Sint);
typedef struct {
UWord parent; /* Parent ptr and flags... */
@@ -622,6 +623,7 @@ erts_ml_dl_list_last__(ErtsMonLnkNode *list)
typedef struct ErtsMonLnkNode__ ErtsMonitor;
+typedef int (*ErtsMonitorFunc)(ErtsMonitor *, void *, Sint);
typedef struct {
ErtsMonitor origin;
@@ -653,6 +655,7 @@ struct ErtsMonitorDataExtended__ {
typedef struct ErtsMonitorSuspend__ ErtsMonitorSuspend;
+
struct ErtsMonitorSuspend__ {
ErtsMonitorData md; /* origin = suspender; target = suspendee */
ErtsMonitorSuspend *next;
@@ -685,7 +688,7 @@ ErtsMonitor *erts_monitor_tree_lookup(ErtsMonitor *root, Eterm key);
*
* @brief Lookup or insert a monitor in a monitor tree
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'mon' monitor is not part of any tree or list
* If the above is not true, bad things will happen.
*
@@ -711,7 +714,7 @@ ErtsMonitor *erts_monotor_tree_lookup_insert(ErtsMonitor **root,
* If it is not found, creates a monitor and returns a pointer to the
* origin monitor.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - no target monitors with the key 'target' exists in the tree.
* If the above is not true, bad things will happen.
*
@@ -738,7 +741,7 @@ ErtsMonitor *erts_monitor_tree_lookup_create(ErtsMonitor **root, int *created,
*
* @brief Insert a monitor in a monitor tree
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - no monitors with the same key that 'mon' exist in the tree
* - 'mon' is not part of any list of tree
* If the above are not true, bad things will happen.
@@ -754,7 +757,7 @@ void erts_monitor_tree_insert(ErtsMonitor **root, ErtsMonitor *mon);
*
* @brief Replace a monitor in a monitor tree
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'old' monitor and 'new' monitor have exactly the same key
* - 'old' monitor is part of the tree
* - 'new' monitor is not part of any tree or list
@@ -774,7 +777,7 @@ void erts_monitor_tree_replace(ErtsMonitor **root, ErtsMonitor *old,
*
* @brief Delete a monitor from a monitor tree
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'mon' monitor is part of the tree
* If the above is not true, bad things will happen.
*
@@ -789,7 +792,7 @@ void erts_monitor_tree_delete(ErtsMonitor **root, ErtsMonitor *mon);
*
* @brief Call a function for each monitor in a monitor tree
*
- * The funcion 'func' will be called with a pointer to a monitor
+ * The function 'func' will be called with a pointer to a monitor
* as first argument and 'arg' as second argument for each monitor
* in the tree referred to by 'root'.
*
@@ -802,7 +805,7 @@ void erts_monitor_tree_delete(ErtsMonitor **root, ErtsMonitor *mon);
*
*/
void erts_monitor_tree_foreach(ErtsMonitor *root,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg);
/**
@@ -810,9 +813,10 @@ void erts_monitor_tree_foreach(ErtsMonitor *root,
* @brief Call a function for each monitor in a monitor tree. Yield
* if lots of monitors exist.
*
- * The funcion 'func' will be called with a pointer to a monitor
+ * The function 'func' will be called with a pointer to a monitor
* as first argument and 'arg' as second argument for each monitor
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* It is assumed that:
* - *yspp equals NULL on first call
@@ -835,27 +839,28 @@ void erts_monitor_tree_foreach(ErtsMonitor *root,
* *yspp should be NULL. When done *yspp
* will be NULL.
*
- * @param[in] limit Maximum amount of monitors to process
- * before yielding.
+ * @param[in] reds Reductions available to execute before yielding.
*
- * @returns A non-zero value when all monitors has been
- * processed, and zero when more work is needed.
+ * @returns The unconsumed reductions when all monitors
+ * have been processed, and zero when more work
+ * is needed.
*
*/
int erts_monitor_tree_foreach_yielding(ErtsMonitor *root,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg,
void **vyspp,
- Sint limit);
+ Sint reds);
/**
*
* @brief Delete all monitors from a monitor tree and call a function for
* each monitor
*
- * The funcion 'func' will be called with a pointer to a monitor
+ * The function 'func' will be called with a pointer to a monitor
* as first argument and 'arg' as second argument for each monitor
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* @param[in,out] root Pointer to pointer to root of monitor tree
*
@@ -866,7 +871,7 @@ int erts_monitor_tree_foreach_yielding(ErtsMonitor *root,
*
*/
void erts_monitor_tree_foreach_delete(ErtsMonitor **root,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg);
/**
@@ -874,9 +879,10 @@ void erts_monitor_tree_foreach_delete(ErtsMonitor **root,
* @brief Delete all monitors from a monitor tree and call a function for
* each monitor
*
- * The funcion 'func' will be called with a pointer to a monitor
+ * The function 'func' will be called with a pointer to a monitor
* as first argument and 'arg' as second argument for each monitor
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* It is assumed that:
* - *yspp equals NULL on first call
@@ -899,18 +905,18 @@ void erts_monitor_tree_foreach_delete(ErtsMonitor **root,
* *yspp should be NULL. When done *yspp
* will be NULL.
*
- * @param[in] limit Maximum amount of monitors to process
- * before yielding.
+ * @param[in] reds Reductions available to execute before yielding.
*
- * @returns A non-zero value when all monitors has been
- * processed, and zero when more work is needed.
+ * @returns The unconsumed reductions when all monitors
+ * have been processed, and zero when more work
+ * is needed.
*
*/
int erts_monitor_tree_foreach_delete_yielding(ErtsMonitor **root,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg,
void **vyspp,
- Sint limit);
+ Sint reds);
/*
* --- Monitor list operations --
@@ -920,7 +926,7 @@ int erts_monitor_tree_foreach_delete_yielding(ErtsMonitor **root,
*
* @brief Insert a monitor in a monitor list
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'mon' monitor is not part of any list or tree
* If the above is not true, bad things will happen.
*
@@ -935,7 +941,7 @@ ERTS_GLB_INLINE void erts_monitor_list_insert(ErtsMonitor **list, ErtsMonitor *m
*
* @brief Delete a monitor from a monitor list
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'mon' monitor is part of the list
* If the above is not true, bad things will happen.
*
@@ -980,7 +986,7 @@ ERTS_GLB_INLINE ErtsMonitor *erts_monitor_list_last(ErtsMonitor *list);
*
* @brief Call a function for each monitor in a monitor list
*
- * The funcion 'func' will be called with a pointer to a monitor
+ * The function 'func' will be called with a pointer to a monitor
* as first argument and 'arg' as second argument for each monitor
* in the tree referred to by 'list'.
*
@@ -993,7 +999,7 @@ ERTS_GLB_INLINE ErtsMonitor *erts_monitor_list_last(ErtsMonitor *list);
*
*/
void erts_monitor_list_foreach(ErtsMonitor *list,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg);
/**
@@ -1001,9 +1007,10 @@ void erts_monitor_list_foreach(ErtsMonitor *list,
* @brief Call a function for each monitor in a monitor list. Yield
* if lots of monitors exist.
*
- * The funcion 'func' will be called with a pointer to a monitor
+ * The function 'func' will be called with a pointer to a monitor
* as first argument and 'arg' as second argument for each monitor
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* It is assumed that:
* - *yspp equals NULL on first call
@@ -1026,25 +1033,25 @@ void erts_monitor_list_foreach(ErtsMonitor *list,
* *yspp should be NULL. When done *yspp
* will be NULL.
*
- * @param[in] limit Maximum amount of monitors to process
- * before yielding.
+ * @param[in] reds Reductions available to execute before yielding.
*
- * @returns A non-zero value when all monitors has been
- * processed, and zero when more work is needed.
+ * @returns The unconsumed reductions when all monitors
+ * have been processed, and zero when more work
+ * is needed.
*
*/
int erts_monitor_list_foreach_yielding(ErtsMonitor *list,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg,
void **vyspp,
- Sint limit);
+ Sint reds);
/**
*
* @brief Delete all monitors from a monitor list and call a function for
* each monitor
*
- * The funcion 'func' will be called with a pointer to a monitor
+ * The function 'func' will be called with a pointer to a monitor
* as first argument and 'arg' as second argument for each monitor
* in the tree referred to by 'root'.
*
@@ -1057,7 +1064,7 @@ int erts_monitor_list_foreach_yielding(ErtsMonitor *list,
*
*/
void erts_monitor_list_foreach_delete(ErtsMonitor **list,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg);
/**
@@ -1065,9 +1072,10 @@ void erts_monitor_list_foreach_delete(ErtsMonitor **list,
* @brief Delete all monitors from a monitor list and call a function for
* each monitor
*
- * The funcion 'func' will be called with a pointer to a monitor
+ * The function 'func' will be called with a pointer to a monitor
* as first argument and 'arg' as second argument for each monitor
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* It is assumed that:
* - *yspp equals NULL on first call
@@ -1090,18 +1098,18 @@ void erts_monitor_list_foreach_delete(ErtsMonitor **list,
* *yspp should be NULL. When done *yspp
* will be NULL.
*
- * @param[in] limit Maximum amount of monitors to process
- * before yielding.
+ * @param[in] reds Reductions available to execute before yielding.
*
- * @returns A non-zero value when all monitors has been
- * processed, and zero when more work is needed.
+ * @returns The unconsumed reductions when all monitors
+ * have been processed, and zero when more work
+ * is needed.
*
*/
int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list,
- void (*func)(ErtsMonitor *, void *),
+ ErtsMonitorFunc func,
void *arg,
void **vyspp,
- Sint limit);
+ Sint reds);
/*
* --- Misc monitor operations ---
@@ -1113,7 +1121,7 @@ int erts_monitor_list_foreach_delete_yielding(ErtsMonitor **list,
*
* Can create all types of monitors
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'ref' is an internal ordinary reference if type is ERTS_MON_TYPE_PROC,
* ERTS_MON_TYPE_PORT, ERTS_MON_TYPE_TIME_OFFSET, or ERTS_MON_TYPE_RESOURCE
* - 'ref' is NIL if type is ERTS_MON_TYPE_NODE, ERTS_MON_TYPE_NODES, or
@@ -1199,7 +1207,7 @@ ERTS_GLB_INLINE int erts_monitor_is_in_table(ErtsMonitor *mon);
* When both the origin and the target part of the monitor have
* been released the monitor structure will be deallocated.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'mon' monitor is not part of any list or tree
* - 'mon' is not referred to by any other structures
* If the above are not true, bad things will happen.
@@ -1216,7 +1224,7 @@ ERTS_GLB_INLINE void erts_monitor_release(ErtsMonitor *mon);
* Release both the origin and target parts of the monitor
* simultaneously and deallocate the structure.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - Neither the origin part nor the target part of the monitor
* are not part of any list or tree
* - Neither the origin part nor the target part of the monitor
@@ -1232,7 +1240,7 @@ ERTS_GLB_INLINE void erts_monitor_release_both(ErtsMonitorData *mdp);
*
* @brief Insert monitor in dist monitor tree or list
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'mon' monitor is not part of any list or tree
* If the above is not true, bad things will happen.
*
@@ -1253,7 +1261,7 @@ ERTS_GLB_INLINE int erts_monitor_dist_insert(ErtsMonitor *mon, ErtsMonLnkDist *d
*
* @brief Delete monitor from dist monitor tree or list
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'mon' monitor earler has been inserted into 'dist'
* If the above is not true, bad things will happen.
*
@@ -1291,7 +1299,7 @@ erts_monitor_set_dead_dist(ErtsMonitor *mon, Eterm nodename);
* whole size of the monitor data structure is returned; otherwise,
* half of the size is returned.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'mon' has not been released
* If the above is not true, bad things will happen.
*
@@ -1507,6 +1515,8 @@ ERTS_GLB_INLINE ErtsMonitorSuspend *erts_monitor_suspend(ErtsMonitor *mon)
typedef struct ErtsMonLnkNode__ ErtsLink;
+typedef int (*ErtsLinkFunc)(ErtsLink *, void *, Sint);
+
typedef struct {
ErtsLink a;
ErtsLink b;
@@ -1544,7 +1554,7 @@ ErtsLink *erts_link_tree_lookup(ErtsLink *root, Eterm item);
*
* @brief Lookup or insert a link in a link tree
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' link is not part of any tree or list
* If the above is not true, bad things will happen.
*
@@ -1590,7 +1600,7 @@ ErtsLink *erts_link_tree_lookup_create(ErtsLink **root, int *created,
*
* @brief Insert a link in a link tree
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - no links with the same key that 'lnk' exist in the tree
* - 'lnk' is not part of any list of tree
* If the above are not true, bad things will happen.
@@ -1606,7 +1616,7 @@ void erts_link_tree_insert(ErtsLink **root, ErtsLink *lnk);
*
* @brief Replace a link in a link tree
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'old' link and 'new' link have exactly the same key
* - 'old' link is part of the tree
* - 'new' link is not part of any tree or list
@@ -1630,7 +1640,7 @@ void erts_link_tree_replace(ErtsLink **root, ErtsLink *old, ErtsLink *new);
* the tree and 'lnk' has a lower address than the link in the
* tree, the existing link in the tree is replaced by 'lnk'.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' link is not part of any tree or list
* If the above are not true, bad things will happen.
*
@@ -1649,7 +1659,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_tree_insert_addr_replace(ErtsLink **root,
*
* @brief Delete a link from a link tree
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' link is part of the tree
* If the above is not true, bad things will happen.
*
@@ -1668,7 +1678,7 @@ void erts_link_tree_delete(ErtsLink **root, ErtsLink *lnk);
* If link 'lnk' is not in the tree, another link with the same
* key as 'lnk' is deleted from the tree if such a link exist.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - if 'lnk' link is part of a tree or list, it is part of this tree
* If the above is not true, bad things will happen.
*
@@ -1687,7 +1697,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_tree_key_delete(ErtsLink **root, ErtsLink *l
*
* @brief Call a function for each link in a link tree
*
- * The funcion 'func' will be called with a pointer to a link
+ * The function 'func' will be called with a pointer to a link
* as first argument and 'arg' as second argument for each link
* in the tree referred to by 'root'.
*
@@ -1700,7 +1710,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_tree_key_delete(ErtsLink **root, ErtsLink *l
*
*/
void erts_link_tree_foreach(ErtsLink *root,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc,
void *arg);
/**
@@ -1708,9 +1718,10 @@ void erts_link_tree_foreach(ErtsLink *root,
* @brief Call a function for each link in a link tree. Yield if lots
* of links exist.
*
- * The funcion 'func' will be called with a pointer to a link
+ * The function 'func' will be called with a pointer to a link
* as first argument and 'arg' as second argument for each link
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* It is assumed that:
* - *yspp equals NULL on first call
@@ -1733,25 +1744,25 @@ void erts_link_tree_foreach(ErtsLink *root,
* *yspp should be NULL. When done *yspp
* will be NULL.
*
- * @param[in] limit Maximum amount of links to process
- * before yielding.
+ * @param[in] reds Reductions available to execute before yielding.
*
- * @returns A non-zero value when all links has been
- * processed, and zero when more work is needed.
+ * @returns The unconsumed reductions when all links
+ * have been processed, and zero when more work
+ * is needed.
*
*/
int erts_link_tree_foreach_yielding(ErtsLink *root,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg,
void **vyspp,
- Sint limit);
+ Sint reds);
/**
*
* @brief Delete all links from a link tree and call a function for
* each link
*
- * The funcion 'func' will be called with a pointer to a link
+ * The function 'func' will be called with a pointer to a link
* as first argument and 'arg' as second argument for each link
* in the tree referred to by 'root'.
*
@@ -1764,7 +1775,7 @@ int erts_link_tree_foreach_yielding(ErtsLink *root,
*
*/
void erts_link_tree_foreach_delete(ErtsLink **root,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg);
/**
@@ -1772,9 +1783,10 @@ void erts_link_tree_foreach_delete(ErtsLink **root,
* @brief Delete all links from a link tree and call a function for
* each link
*
- * The funcion 'func' will be called with a pointer to a link
+ * The function 'func' will be called with a pointer to a link
* as first argument and 'arg' as second argument for each link
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* It is assumed that:
* - *yspp equals NULL on first call
@@ -1797,18 +1809,18 @@ void erts_link_tree_foreach_delete(ErtsLink **root,
* *yspp should be NULL. When done *yspp
* will be NULL.
*
- * @param[in] limit Maximum amount of links to process
- * before yielding.
+ * @param[in] reds Reductions available to execute before yielding.
*
- * @returns A non-zero value when all links has been
- * processed, and zero when more work is needed.
+ * @returns The unconsumed reductions when all links
+ * have been processed, and zero when more work
+ * is needed.
*
*/
int erts_link_tree_foreach_delete_yielding(ErtsLink **root,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg,
void **vyspp,
- Sint limit);
+ Sint reds);
/*
* --- Link list operations ---
@@ -1818,7 +1830,7 @@ int erts_link_tree_foreach_delete_yielding(ErtsLink **root,
*
* @brief Insert a link in a link list
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' link is not part of any list or tree
* If the above is not true, bad things will happen.
*
@@ -1833,7 +1845,7 @@ ERTS_GLB_INLINE void erts_link_list_insert(ErtsLink **list, ErtsLink *lnk);
*
* @brief Delete a link from a link list
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' link is part of the list
* If the above is not true, bad things will happen.
*
@@ -1878,7 +1890,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_list_last(ErtsLink *list);
*
* @brief Call a function for each link in a link list
*
- * The funcion 'func' will be called with a pointer to a link
+ * The function 'func' will be called with a pointer to a link
* as first argument and 'arg' as second argument for each link
* in the tree referred to by 'list'.
*
@@ -1891,7 +1903,7 @@ ERTS_GLB_INLINE ErtsLink *erts_link_list_last(ErtsLink *list);
*
*/
void erts_link_list_foreach(ErtsLink *list,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg);
/**
@@ -1899,9 +1911,10 @@ void erts_link_list_foreach(ErtsLink *list,
* @brief Call a function for each link in a link list. Yield
* if lots of links exist.
*
- * The funcion 'func' will be called with a pointer to a link
+ * The function 'func' will be called with a pointer to a link
* as first argument and 'arg' as second argument for each link
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* It is assumed that:
* - *yspp equals NULL on first call
@@ -1924,25 +1937,25 @@ void erts_link_list_foreach(ErtsLink *list,
* *yspp should be NULL. When done *yspp
* will be NULL.
*
- * @param[in] limit Maximum amount of links to process
- * before yielding.
+ * @param[in] reds Reductions available to execute before yielding.
*
- * @returns A non-zero value when all links has been
- * processed, and zero when more work is needed.
+ * @returns The unconsumed reductions when all links
+ * have been processed, and zero when more work
+ * is needed.
*
*/
int erts_link_list_foreach_yielding(ErtsLink *list,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg,
void **vyspp,
- Sint limit);
+ Sint reds);
/**
*
* @brief Delete all links from a link list and call a function for
* each link
*
- * The funcion 'func' will be called with a pointer to a link
+ * The function 'func' will be called with a pointer to a link
* as first argument and 'arg' as second argument for each link
* in the tree referred to by 'root'.
*
@@ -1955,7 +1968,7 @@ int erts_link_list_foreach_yielding(ErtsLink *list,
*
*/
void erts_link_list_foreach_delete(ErtsLink **list,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg);
/**
@@ -1963,9 +1976,10 @@ void erts_link_list_foreach_delete(ErtsLink **list,
* @brief Delete all links from a link list and call a function for
* each link
*
- * The funcion 'func' will be called with a pointer to a link
+ * The function 'func' will be called with a pointer to a link
* as first argument and 'arg' as second argument for each link
- * in the tree referred to by 'root'.
+ * in the tree referred to by 'root'. It should return the number of
+ * reductions the operator took to perform.
*
* It is assumed that:
* - *yspp equals NULL on first call
@@ -1988,18 +2002,18 @@ void erts_link_list_foreach_delete(ErtsLink **list,
* *yspp should be NULL. When done *yspp
* will be NULL.
*
- * @param[in] limit Maximum amount of links to process
- * before yielding.
+ * @param[in] reds Reductions available to execute before yielding.
*
- * @returns A non-zero value when all links has been
- * processed, and zero when more work is needed.
+ * @returns The unconsumed reductions when all links
+ * have been processed, and zero when more work
+ * is needed.
*
*/
int erts_link_list_foreach_delete_yielding(ErtsLink **list,
- void (*func)(ErtsLink *, void *),
+ ErtsLinkFunc func,
void *arg,
void **vyspp,
- Sint limit);
+ Sint reds);
/*
* --- Misc link operations ---
@@ -2011,7 +2025,7 @@ int erts_link_list_foreach_delete_yielding(ErtsLink **list,
*
* Can create all types of links
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'ref' is an internal ordinary reference if type is ERTS_MON_TYPE_PROC,
* ERTS_MON_TYPE_PORT, ERTS_MON_TYPE_TIME_OFFSET, or ERTS_MON_TYPE_RESOURCE
* - 'ref' is NIL if type is ERTS_MON_TYPE_NODE or ERTS_MON_TYPE_NODES
@@ -2081,7 +2095,7 @@ ERTS_GLB_INLINE int erts_link_is_in_table(ErtsLink *lnk);
* When both link halves part of the link have been released the link
* structure will be deallocated.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' link is not part of any list or tree
* - 'lnk' is not referred to by any other structures
* If the above are not true, bad things will happen.
@@ -2098,7 +2112,7 @@ ERTS_GLB_INLINE void erts_link_release(ErtsLink *lnk);
* Release both halves of a link simultaneously and deallocate
* the structure.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - Neither of the parts of the link are part of any list or tree
* - Neither of the parts of the link or the link data structure
* are referred to by any other structures
@@ -2113,7 +2127,7 @@ ERTS_GLB_INLINE void erts_link_release_both(ErtsLinkData *ldp);
*
* @brief Insert link in dist link list
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' link is not part of any list or tree
* If the above is not true, bad things will happen.
*
@@ -2134,7 +2148,7 @@ ERTS_GLB_INLINE int erts_link_dist_insert(ErtsLink *lnk, ErtsMonLnkDist *dist);
*
* @brief Delete link from dist link list
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' link earler has been inserted into 'dist'
* If the above is not true, bad things will happen.
*
@@ -2172,7 +2186,7 @@ erts_link_set_dead_dist(ErtsLink *lnk, Eterm nodename);
* whole size of the link data structure is returned; otherwise,
* half of the size is returned.
*
- * When the funcion is called it is assumed that:
+ * When the function is called it is assumed that:
* - 'lnk' has not been released
* If the above is not true, bad things will happen.
*
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index a48d0391f6..af1acbfc90 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -731,6 +731,23 @@ ErtsMessage* erts_create_message_from_nif_env(ErlNifEnv* msg_env)
return mp;
}
+static ERTS_INLINE ERL_NIF_TERM make_copy(ErlNifEnv* dst_env,
+ ERL_NIF_TERM src_term,
+ Uint *cpy_szp)
+{
+ Uint sz;
+ Eterm* hp;
+ /*
+ * No preserved sharing allowed as long as literals are also preserved.
+ * Process independent environment can not be reached by purge.
+ */
+ sz = size_object(src_term);
+ if (cpy_szp)
+ *cpy_szp += sz;
+ hp = alloc_heap(dst_env, sz);
+ return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc));
+}
+
int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
ErlNifEnv* msg_env, ERL_NIF_TERM msg)
{
@@ -743,6 +760,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
Eterm from;
Eterm receiver = to_pid->pid;
int scheduler;
+ Uint copy_sz = 0;
execution_state(env, &c_p, &scheduler);
@@ -806,14 +824,14 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
stoken = NIL;
}
#endif
- token = enif_make_copy(msg_env, stoken);
+ token = make_copy(msg_env, stoken, &copy_sz);
#ifdef USE_VM_PROBES
if (DT_UTAG_FLAGS(c_p) & DT_UTAG_SPREADING) {
if (is_immed(DT_UTAG(c_p)))
utag = DT_UTAG(c_p);
else
- utag = enif_make_copy(msg_env, DT_UTAG(c_p));
+ utag = make_copy(msg_env, DT_UTAG(c_p), &copy_sz);
}
if (DTRACE_ENABLED(message_send)) {
if (have_seqtrace(stoken)) {
@@ -835,6 +853,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
Uint sz;
INITIALIZE_LITERAL_PURGE_AREA(litarea);
sz = size_object_litopt(msg, &litarea);
+ copy_sz += sz;
if (c_p && !env->tracee) {
full_flush_env(env);
mp = erts_alloc_message_heap(rp, &rp_locks, sz, &hp, &ohp);
@@ -867,6 +886,12 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
trace_send(c_p, receiver, msg);
full_cache_env(env);
}
+ if (c_p && scheduler > 0 && copy_sz > ERTS_MSG_COPY_WORDS_PER_REDUCTION) {
+ Uint reds = copy_sz / ERTS_MSG_COPY_WORDS_PER_REDUCTION;
+ if (reds > CONTEXT_REDS)
+ reds = CONTEXT_REDS;
+ BUMP_REDS(c_p, (int) reds);
+ }
}
else {
/* This clause is taken when the nif is called in the context
@@ -935,6 +960,7 @@ int enif_send(ErlNifEnv* env, const ErlNifPid* to_pid,
erts_queue_message(rp, rp_locks, mp, msg, from);
done:
+
if (c_p == rp)
rp_locks &= ~ERTS_PROC_LOCK_MAIN;
if (rp_locks & ~lc_locks)
@@ -1047,18 +1073,9 @@ int enif_whereis_port(ErlNifEnv *env, ERL_NIF_TERM name, ErlNifPort *port)
ERL_NIF_TERM enif_make_copy(ErlNifEnv* dst_env, ERL_NIF_TERM src_term)
{
- Uint sz;
- Eterm* hp;
- /*
- * No preserved sharing allowed as long as literals are also preserved.
- * Process independent environment cannot be reached by purge.
- */
- sz = size_object(src_term);
- hp = alloc_heap(dst_env, sz);
- return copy_struct(src_term, sz, &hp, &MSO(dst_env->proc));
+ return make_copy(dst_env, src_term, NULL);
}
-
#ifdef DEBUG
static int is_offheap(const ErlOffHeap* oh)
{
@@ -1083,6 +1100,17 @@ int enif_get_local_pid(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPid* pid)
return 0;
}
+void enif_set_pid_undefined(ErlNifPid* pid)
+{
+ pid->pid = am_undefined;
+}
+
+int enif_is_pid_undefined(const ErlNifPid* pid)
+{
+ ASSERT(pid->pid == am_undefined || is_internal_pid(pid->pid));
+ return pid->pid == am_undefined;
+}
+
int enif_get_local_port(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifPort* port)
{
if (is_internal_port(term)) {
@@ -1147,6 +1175,47 @@ int enif_is_number(ErlNifEnv* env, ERL_NIF_TERM term)
return is_number(term);
}
+ErlNifTermType enif_term_type(ErlNifEnv* env, ERL_NIF_TERM term) {
+ (void)env;
+
+ switch (tag_val_def(term)) {
+ case ATOM_DEF:
+ return ERL_NIF_TERM_TYPE_ATOM;
+ case BINARY_DEF:
+ return ERL_NIF_TERM_TYPE_BITSTRING;
+ case FLOAT_DEF:
+ return ERL_NIF_TERM_TYPE_FLOAT;
+ case EXPORT_DEF:
+ case FUN_DEF:
+ return ERL_NIF_TERM_TYPE_FUN;
+ case BIG_DEF:
+ case SMALL_DEF:
+ return ERL_NIF_TERM_TYPE_INTEGER;
+ case LIST_DEF:
+ case NIL_DEF:
+ return ERL_NIF_TERM_TYPE_LIST;
+ case MAP_DEF:
+ return ERL_NIF_TERM_TYPE_MAP;
+ case EXTERNAL_PID_DEF:
+ case PID_DEF:
+ return ERL_NIF_TERM_TYPE_PID;
+ case EXTERNAL_PORT_DEF:
+ case PORT_DEF:
+ return ERL_NIF_TERM_TYPE_PORT;
+ case EXTERNAL_REF_DEF:
+ case REF_DEF:
+ return ERL_NIF_TERM_TYPE_REFERENCE;
+ case TUPLE_DEF:
+ return ERL_NIF_TERM_TYPE_TUPLE;
+ default:
+ /* tag_val_def() aborts on its own when passed complete garbage, but
+ * it's possible that the user has given us garbage that just happens
+ * to match something that tag_val_def() accepts but we don't, like
+ * binary match contexts. */
+ ERTS_INTERNAL_ERROR("Invalid term passed to enif_term_type");
+ }
+}
+
static void aligned_binary_dtor(struct enif_tmp_obj_t* obj)
{
erts_free_aligned_binary_bytes_extra((byte*)obj, obj->allocator);
@@ -2357,14 +2426,22 @@ rmon_refc_read(ErtsResourceMonitors *rms)
return rms->refc & ERTS_RESOURCE_REFC_MASK;
}
-static void dtor_demonitor(ErtsMonitor* mon, void* context)
+static int dtor_demonitor(ErtsMonitor* mon, void* context, Sint reds)
{
ASSERT(erts_monitor_is_origin(mon));
ASSERT(is_internal_pid(mon->other.item));
erts_proc_sig_send_demonitor(mon);
+ return 1;
}
+#ifdef DEBUG
+int erts_dbg_is_resource_dying(ErtsResource* resource)
+{
+ return resource->monitors && rmon_is_dying(resource->monitors);
+}
+#endif
+
# define NIF_RESOURCE_DTOR &nif_resource_dtor
static int nif_resource_dtor(Binary* bin)
@@ -2705,8 +2782,12 @@ int enif_consume_timeslice(ErlNifEnv* env, int percent)
{
Process *proc;
Sint reds;
+ int sched;
- execution_state(env, &proc, NULL);
+ execution_state(env, &proc, &sched);
+
+ if (sched < 0)
+ return 0; /* no-op on dirty scheduler */
ASSERT(is_proc_bound(env) && percent >= 1 && percent <= 100);
if (percent < 1) percent = 1;
@@ -3329,6 +3410,9 @@ int enif_monitor_process(ErlNifEnv* env, void* obj, const ErlNifPid* target_pid,
}
ASSERT(rsrc->type->down);
+ if (target_pid->pid == am_undefined)
+ return 1;
+
ref = erts_make_ref_in_buffer(tmp);
mdp = erts_monitor_create(ERTS_MON_TYPE_RESOURCE, ref,
@@ -3362,6 +3446,12 @@ int enif_monitor_process(ErlNifEnv* env, void* obj, const ErlNifPid* target_pid,
return 0;
}
+ERL_NIF_TERM enif_make_monitor_term(ErlNifEnv* env, const ErlNifMonitor* monitor)
+{
+ Eterm* hp = alloc_heap(env, ERTS_REF_THING_SIZE);
+ return erts_driver_monitor_to_ref(hp, monitor);
+}
+
int enif_demonitor_process(ErlNifEnv* env, void* obj, const ErlNifMonitor* monitor)
{
ErtsResource* rsrc = DATA_TO_RESOURCE(obj);
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index 3fd1a8fd4c..a599511c78 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -55,6 +55,7 @@
** 2.14: 21.0 add enif_ioq_peek_head, enif_(mutex|cond|rwlock|thread)_name
** enif_vfprintf, enif_vsnprintf, enif_make_map_from_arrays
** 2.15: 22.0 ERL_NIF_SELECT_CANCEL, enif_select_(read|write)
+** enif_term_type
*/
#define ERL_NIF_MAJOR_VERSION 2
#define ERL_NIF_MINOR_VERSION 15
@@ -63,7 +64,7 @@
* with ticket syntax like "erts-@OTP-12345@", or a temporary placeholder
* between two @ like "erts-@MyName@", if you don't know what a ticket is.
*/
-#define ERL_NIF_MIN_ERTS_VERSION "erts-@OTP-15095@ (OTP-22)"
+#define ERL_NIF_MIN_ERTS_VERSION "erts-@OTP-15095 OTP-15640@ (OTP-22)"
/*
* The emulator will refuse to load a nif-lib with a major version
@@ -282,6 +283,26 @@ typedef enum {
ERL_NIF_IOQ_NORMAL = 1
} ErlNifIOQueueOpts;
+typedef enum {
+ ERL_NIF_TERM_TYPE_ATOM = 1,
+ ERL_NIF_TERM_TYPE_BITSTRING = 2,
+ ERL_NIF_TERM_TYPE_FLOAT = 3,
+ ERL_NIF_TERM_TYPE_FUN = 4,
+ ERL_NIF_TERM_TYPE_INTEGER = 5,
+ ERL_NIF_TERM_TYPE_LIST = 6,
+ ERL_NIF_TERM_TYPE_MAP = 7,
+ ERL_NIF_TERM_TYPE_PID = 8,
+ ERL_NIF_TERM_TYPE_PORT = 9,
+ ERL_NIF_TERM_TYPE_REFERENCE = 10,
+ ERL_NIF_TERM_TYPE_TUPLE = 11,
+
+ /* This is a dummy value intended to coax the compiler into warning about
+ * unhandled values in a switch even if all the above values have been
+ * handled. We can add new entries at any time so the user must always
+ * have a default case. */
+ ERL_NIF_TERM_TYPE__MISSING_DEFAULT_CASE__READ_THE_MANUAL = -1
+} ErlNifTermType;
+
/*
* Return values from enif_thread_type(). Negative values
* reserved for specific types of non-scheduler threads.
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index 129166562d..d57f6ec97c 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -211,7 +211,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_vsnprintf,(char*, size_t, const char *fmt, va_lis
ERL_NIF_API_FUNC_DECL(int,enif_make_map_from_arrays,(ErlNifEnv *env, ERL_NIF_TERM keys[], ERL_NIF_TERM values[], size_t cnt, ERL_NIF_TERM *map_out));
ERL_NIF_API_FUNC_DECL(int,enif_select_x,(ErlNifEnv* env, ErlNifEvent e, enum ErlNifSelectFlags flags, void* obj, const ErlNifPid* pid, ERL_NIF_TERM msg, ErlNifEnv* msg_env));
+ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_monitor_term,(ErlNifEnv* env, const ErlNifMonitor*));
+ERL_NIF_API_FUNC_DECL(void,enif_set_pid_undefined,(ErlNifPid* pid));
+ERL_NIF_API_FUNC_DECL(int,enif_is_pid_undefined,(const ErlNifPid* pid));
+ERL_NIF_API_FUNC_DECL(ErlNifTermType,enif_term_type,(ErlNifEnv* env, ERL_NIF_TERM term));
/*
** ADD NEW ENTRIES HERE (before this comment) !!!
@@ -396,6 +400,10 @@ ERL_NIF_API_FUNC_DECL(int,enif_select_x,(ErlNifEnv* env, ErlNifEvent e, enum Erl
# define enif_vsnprintf ERL_NIF_API_FUNC_MACRO(enif_vsnprintf)
# define enif_make_map_from_arrays ERL_NIF_API_FUNC_MACRO(enif_make_map_from_arrays)
# define enif_select_x ERL_NIF_API_FUNC_MACRO(enif_select_x)
+# define enif_make_monitor_term ERL_NIF_API_FUNC_MACRO(enif_make_monitor_term)
+# define enif_set_pid_undefined ERL_NIF_API_FUNC_MACRO(enif_set_pid_undefined)
+# define enif_is_pid_undefined ERL_NIF_API_FUNC_MACRO(enif_is_pid_undefined)
+# define enif_term_type ERL_NIF_API_FUNC_MACRO(enif_term_type)
/*
** ADD NEW ENTRIES HERE (before this comment)
@@ -627,6 +635,7 @@ static ERL_NIF_INLINE ERL_NIF_TERM enif_make_list9(ErlNifEnv* env,
#ifndef enif_make_pid
# define enif_make_pid(ENV, PID) ((void)(ENV),(const ERL_NIF_TERM)((PID)->pid))
+# define enif_compare_pids(A, B) (enif_compare((A)->pid,(B)->pid))
# define enif_select_read(ENV, E, OBJ, PID, MSG, MSG_ENV) \
enif_select_x(ENV, E, ERL_NIF_SELECT_READ | ERL_NIF_SELECT_CUSTOM_MSG, \
OBJ, PID, MSG, MSG_ENV)
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index 18ed782ae3..afafaf48dc 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -201,6 +201,7 @@ dist_table_alloc(void *dep_tmpl)
dep->send = NULL;
dep->cache = NULL;
dep->transcode_ctx = NULL;
+ dep->sequences = NULL;
/* Link in */
@@ -801,8 +802,9 @@ node_table_hash(void *venp)
static int
node_table_cmp(void *venp1, void *venp2)
{
- return ((((ErlNode *) venp1)->sysname == ((ErlNode *) venp2)->sysname
- && ((ErlNode *) venp1)->creation == ((ErlNode *) venp2)->creation)
+ return ((((ErlNode *) venp1)->sysname == ((ErlNode *) venp2)->sysname) &&
+ ((((ErlNode *) venp1)->creation == ((ErlNode *) venp2)->creation) ||
+ (((ErlNode *) venp1)->creation == 0 || ((ErlNode *) venp2)->creation == 0))
? 0
: 1);
}
@@ -816,11 +818,16 @@ node_table_alloc(void *venp_tmpl)
node_entries++;
- erts_refc_init(&enp->refc, -1);
+ erts_init_node_entry(enp, -1);
enp->creation = ((ErlNode *) venp_tmpl)->creation;
enp->sysname = ((ErlNode *) venp_tmpl)->sysname;
enp->dist_entry = erts_find_or_insert_dist_entry(((ErlNode *) venp_tmpl)->sysname);
+#ifdef ERL_NODE_BOOKKEEP
+ erts_atomic_init_nob(&enp->slot, 0);
+ sys_memzero(enp->books, sizeof(struct erl_node_bookkeeping) * 1024);
+#endif
+
return (void *) enp;
}
@@ -873,7 +880,7 @@ erts_node_table_info(fmtfn_t to, void *to_arg)
}
-ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation)
+ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation, Eterm book)
{
ErlNode *res;
ErlNode ne;
@@ -883,9 +890,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation)
erts_rwmtx_rlock(&erts_node_table_rwmtx);
res = hash_get(&erts_node_table, (void *) &ne);
if (res && res != erts_this_node) {
- erts_aint_t refc = erts_refc_inctest(&res->refc, 0);
+ erts_aint_t refc = erts_ref_node_entry(res, 0, book);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_ref_node_entry(res, 1, THE_NON_VALUE);
}
erts_rwmtx_runlock(&erts_node_table_rwmtx);
if (res)
@@ -895,9 +902,9 @@ ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation)
res = hash_put(&erts_node_table, (void *) &ne);
ASSERT(res);
if (res != erts_this_node) {
- erts_aint_t refc = erts_refc_inctest(&res->refc, 0);
+ erts_aint_t refc = erts_ref_node_entry(res, 0, book);
if (refc < 2) /* New or pending delete */
- erts_refc_inc(&res->refc, 1);
+ erts_ref_node_entry(res, 1, THE_NON_VALUE);
}
erts_rwmtx_rwunlock(&erts_node_table_rwmtx);
return res;
@@ -924,6 +931,7 @@ static void try_delete_node(void *venp)
*
* If refc > 0, the entry is in use. Keep the entry.
*/
+ erts_node_bookkeep(enp, THE_NON_VALUE, ERL_NODE_DEC);
refc = erts_refc_dectest(&enp->refc, -1);
if (refc == -1)
(void) hash_erase(&erts_node_table, (void *) enp);
@@ -1021,7 +1029,7 @@ erts_set_this_node(Eterm sysname, Uint creation)
erts_deref_dist_entry(erts_this_dist_entry);
erts_this_node = NULL; /* to make sure refc is bumped for this node */
- erts_this_node = erts_find_or_insert_node(sysname, creation);
+ erts_this_node = erts_find_or_insert_node(sysname, creation, THE_NON_VALUE);
erts_this_dist_entry = erts_this_node->dist_entry;
erts_ref_dist_entry(erts_this_dist_entry);
@@ -1090,7 +1098,7 @@ void erts_init_node_tables(int dd_sec)
node_tmpl.creation = 0;
erts_this_node = hash_put(&erts_node_table, &node_tmpl);
/* +1 for erts_this_node */
- erts_refc_init(&erts_this_node->refc, 1);
+ erts_init_node_entry(erts_this_node, 1);
ASSERT(erts_this_node->dist_entry != NULL);
erts_this_dist_entry = erts_this_node->dist_entry;
@@ -1177,6 +1185,7 @@ static Eterm AM_system;
static Eterm AM_timer;
static Eterm AM_delayed_delete_timer;
static Eterm AM_thread_progress_delete_timer;
+static Eterm AM_sequence;
static Eterm AM_signal;
static void setup_reference_table(void);
@@ -1218,6 +1227,7 @@ typedef struct dist_referrer_ {
int ctrl_ref;
int system_ref;
int signal_ref;
+ int sequence_ref;
Eterm id;
Uint creation;
Uint id_heap[ID_HEAP_SIZE];
@@ -1272,6 +1282,7 @@ erts_get_node_and_dist_references(struct process *proc)
INIT_AM(delayed_delete_timer);
INIT_AM(thread_progress_delete_timer);
INIT_AM(signal);
+ INIT_AM(sequence);
references_atoms_need_init = 0;
}
@@ -1309,8 +1320,9 @@ erts_get_node_and_dist_references(struct process *proc)
#define TIMER_REF 8
#define SYSTEM_REF 9
#define SIGNAL_REF 10
+#define SEQUENCE_REF 11
-#define INC_TAB_SZ 10
+#define INC_TAB_SZ 11
static void
insert_dist_referrer(ReferredDist *referred_dist,
@@ -1344,6 +1356,7 @@ insert_dist_referrer(ReferredDist *referred_dist,
drp->ctrl_ref = 0;
drp->system_ref = 0;
drp->signal_ref = 0;
+ drp->sequence_ref = 0;
}
switch (type) {
@@ -1353,6 +1366,7 @@ insert_dist_referrer(ReferredDist *referred_dist,
case ETS_REF: drp->ets_ref++; break;
case SYSTEM_REF: drp->system_ref++; break;
case SIGNAL_REF: drp->signal_ref++; break;
+ case SEQUENCE_REF: drp->sequence_ref++; break;
default: ASSERT(0);
}
}
@@ -1509,7 +1523,7 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
}
}
else if (IsSendCtxBinary(u.mref->mb)) {
- ErtsSendContext* ctx = ERTS_MAGIC_BIN_DATA(u.mref->mb);
+ ErtsDSigSendContext* ctx = ERTS_MAGIC_BIN_DATA(u.mref->mb);
if (ctx->deref_dep)
insert_dist_entry(ctx->dep, type, id, 0);
}
@@ -1544,16 +1558,18 @@ static void insert_monitor_data(ErtsMonitor *mon, int type, Eterm id)
mdp->origin.flags |= ERTS_ML_FLG_DBG_VISITED;
}
-static void insert_monitor(ErtsMonitor *mon, void *idp)
+static int insert_monitor(ErtsMonitor *mon, void *idp, Sint reds)
{
Eterm id = *((Eterm *) idp);
insert_monitor_data(mon, MONITOR_REF, id);
+ return 1;
}
-static void clear_visited_monitor(ErtsMonitor *mon, void *p)
+static int clear_visited_monitor(ErtsMonitor *mon, void *p, Sint reds)
{
ErtsMonitorData *mdp = erts_monitor_to_data(mon);
mdp->origin.flags &= ~ERTS_ML_FLG_DBG_VISITED;
+ return 1;
}
static void
@@ -1581,6 +1597,20 @@ insert_dist_monitors(DistEntry *dep)
}
}
+
+static int
+insert_sequence(ErtsDistExternal *edep, void *arg, Sint reds)
+{
+ insert_dist_entry(edep->dep, SEQUENCE_REF, *(Eterm*)arg, 0);
+ return 1;
+}
+
+static void
+insert_dist_sequences(DistEntry *dep)
+{
+ erts_dist_seq_tree_foreach(dep, insert_sequence, (void *) &dep->sysname);
+}
+
static void
clear_visited_p_monitors(ErtsPTabElementCommon *p)
{
@@ -1621,16 +1651,18 @@ static void insert_link_data(ErtsLink *lnk, int type, Eterm id)
ldp->a.flags |= ERTS_ML_FLG_DBG_VISITED;
}
-static void insert_link(ErtsLink *lnk, void *idp)
+static int insert_link(ErtsLink *lnk, void *idp, Sint reds)
{
Eterm id = *((Eterm *) idp);
insert_link_data(lnk, LINK_REF, id);
+ return 1;
}
-static void clear_visited_link(ErtsLink *lnk, void *p)
+static int clear_visited_link(ErtsLink *lnk, void *p, Sint reds)
{
ErtsLinkData *ldp = erts_link_to_data(lnk);
ldp->a.flags &= ~ERTS_ML_FLG_DBG_VISITED;
+ return 1;
}
static void
@@ -1770,11 +1802,9 @@ insert_message(ErtsMessage *msg, int type, Process *proc)
else if (ERTS_SIG_IS_INTERNAL_MSG(msg))
heap_frag = msg->data.heap_frag;
else {
- if (msg->data.dist_ext->dep)
- insert_dist_entry(msg->data.dist_ext->dep,
- type, proc->common.id, 0);
- if (is_not_nil(ERL_MESSAGE_TOKEN(msg)))
- heap_frag = erts_dist_ext_trailer(msg->data.dist_ext);
+ heap_frag = msg->data.heap_frag;
+ insert_dist_entry(erts_get_dist_ext(heap_frag)->dep,
+ type, proc->common.id, 0);
}
}
while (heap_frag) {
@@ -1798,24 +1828,115 @@ insert_sig_offheap(ErlOffHeap *ohp, void *arg)
insert_offheap(ohp, SIGNAL_REF, proc->common.id);
}
-static void
-insert_sig_monitor(ErtsMonitor *mon, void *arg)
+static int
+insert_sig_monitor(ErtsMonitor *mon, void *arg, Sint reds)
{
Process *proc = arg;
insert_monitor_data(mon, SIGNAL_REF, proc->common.id);
+ return 1;
}
-static void
-insert_sig_link(ErtsLink *lnk, void *arg)
+static int
+insert_sig_link(ErtsLink *lnk, void *arg, Sint reds)
{
Process *proc = arg;
insert_link_data(lnk, SIGNAL_REF, proc->common.id);
+ return 1;
}
static void
-setup_reference_table(void)
+insert_sig_ext(ErtsDistExternal *edep, void *arg)
{
+ Process *proc = arg;
+ insert_dist_entry(edep->dep, SIGNAL_REF, proc->common.id, 0);
+}
+
+static void
+insert_process(Process *proc)
+{
+ int mli;
+ ErtsMessage *msg_list[] = {proc->msg_frag};
ErlHeapFragment *hfp;
+
+ /* Insert Heap */
+ insert_offheap(&(proc->off_heap),
+ HEAP_REF,
+ proc->common.id);
+ /* Insert heap fragments buffers */
+ for(hfp = proc->mbuf; hfp; hfp = hfp->next)
+ insert_offheap(&(hfp->off_heap),
+ HEAP_REF,
+ proc->common.id);
+
+ /* Insert msg buffers */
+ for (mli = 0; mli < sizeof(msg_list)/sizeof(msg_list[0]); mli++) {
+ ErtsMessage *msg;
+ for (msg = msg_list[mli]; msg; msg = msg->next)
+ insert_message(msg, HEAP_REF, proc);
+ }
+
+ /* Insert signal queue */
+ erts_proc_sig_debug_foreach_sig(proc,
+ insert_sig_msg,
+ insert_sig_offheap,
+ insert_sig_monitor,
+ insert_sig_link,
+ insert_sig_ext,
+ (void *) proc);
+
+ /* If the process is FREE, the proc->common field has been
+ re-used by the ptab delete, so we cannot trust it. */
+ if (!(erts_atomic32_read_nob(&proc->state) & ERTS_PSFLG_FREE)) {
+ /* Insert links */
+ insert_p_links(&proc->common);
+
+ /* Insert monitors */
+ insert_p_monitors(&proc->common);
+ }
+
+ {
+ DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(proc);
+ if (dep)
+ insert_dist_entry(dep,
+ CTRL_REF,
+ proc->common.id,
+ 0);
+ }
+}
+
+static void
+insert_dist_suspended_procs(DistEntry *dep)
+{
+ ErtsProcList *plist = erts_proclist_peek_first(dep->suspended);
+ while (plist) {
+ if (is_not_immed(plist->u.pid))
+ insert_process(plist->u.p);
+ plist = erts_proclist_peek_next(dep->suspended, plist);
+ }
+}
+
+#ifdef ERL_NODE_BOOKKEEP
+void
+erts_node_bookkeep(ErlNode *np, Eterm term, int what)
+{
+ erts_aint_t slot = (erts_atomic_inc_read_nob(&np->slot) - 1) % 1024;
+ ErtsSchedulerData *esdp = erts_get_scheduler_data();
+ Eterm who = THE_NON_VALUE;
+ ASSERT(np);
+ np->books[slot].what = what;
+ np->books[slot].term = term;
+ if (esdp->current_process) {
+ who = esdp->current_process->common.id;
+ } else if (esdp->current_port) {
+ who = esdp->current_port->common.id;
+ }
+ np->books[slot].who = who;
+}
+#endif
+
+static void
+setup_reference_table(void)
+{
DistEntry *dep;
HashInfo hi;
int i, max;
@@ -1865,52 +1986,10 @@ setup_reference_table(void)
/* Insert all processes */
for (i = 0; i < max; i++) {
Process *proc = erts_pix2proc(i);
- if (proc) {
- int mli;
- ErtsMessage *msg_list[] = {proc->msg_frag};
-
- /* Insert Heap */
- insert_offheap(&(proc->off_heap),
- HEAP_REF,
- proc->common.id);
- /* Insert heap fragments buffers */
- for(hfp = proc->mbuf; hfp; hfp = hfp->next)
- insert_offheap(&(hfp->off_heap),
- HEAP_REF,
- proc->common.id);
-
- /* Insert msg buffers */
- for (mli = 0; mli < sizeof(msg_list)/sizeof(msg_list[0]); mli++) {
- ErtsMessage *msg;
- for (msg = msg_list[mli]; msg; msg = msg->next)
- insert_message(msg, HEAP_REF, proc);
- }
-
- /* Insert signal queue */
- erts_proc_sig_debug_foreach_sig(proc,
- insert_sig_msg,
- insert_sig_offheap,
- insert_sig_monitor,
- insert_sig_link,
- (void *) proc);
-
- /* Insert links */
- insert_p_links(&proc->common);
-
- /* Insert monitors */
- insert_p_monitors(&proc->common);
-
- {
- DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(proc);
- if (dep)
- insert_dist_entry(dep,
- CTRL_REF,
- proc->common.id,
- 0);
- }
- }
+ if (proc)
+ insert_process(proc);
}
-
+
erts_foreach_sys_msg_in_q(insert_sys_msg);
/* Insert all ports */
@@ -1983,16 +2062,22 @@ setup_reference_table(void)
for(dep = erts_visible_dist_entries; dep; dep = dep->next) {
insert_dist_links(dep);
insert_dist_monitors(dep);
+ insert_dist_sequences(dep);
+ insert_dist_suspended_procs(dep);
}
for(dep = erts_hidden_dist_entries; dep; dep = dep->next) {
insert_dist_links(dep);
insert_dist_monitors(dep);
+ insert_dist_sequences(dep);
+ insert_dist_suspended_procs(dep);
}
for(dep = erts_pending_dist_entries; dep; dep = dep->next) {
insert_dist_links(dep);
insert_dist_monitors(dep);
+ insert_dist_sequences(dep);
+ insert_dist_suspended_procs(dep);
}
/* Not connected dist entries should not have any links,
@@ -2000,6 +2085,8 @@ setup_reference_table(void)
for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) {
insert_dist_links(dep);
insert_dist_monitors(dep);
+ insert_dist_sequences(dep);
+ insert_dist_suspended_procs(dep);
}
/* Insert all ets tables */
@@ -2173,6 +2260,10 @@ reference_table_term(Uint **hpp, ErlOffHeap *ohp, Uint *szp)
tup = MK_2TUP(AM_system, MK_UINT(drp->system_ref));
drl = MK_CONS(tup, drl);
}
+ if(drp->sequence_ref) {
+ tup = MK_2TUP(AM_sequence, MK_UINT(drp->sequence_ref));
+ drl = MK_CONS(tup, drl);
+ }
if(drp->signal_ref) {
tup = MK_2TUP(AM_signal, MK_UINT(drp->signal_ref));
drl = MK_CONS(tup, drl);
@@ -2247,6 +2338,12 @@ static void noop_sig_offheap(ErlOffHeap *oh, void *arg)
}
+static void noop_sig_ext(ErtsDistExternal *ext, void *arg)
+{
+
+}
+
+
static void
delete_reference_table(void)
{
@@ -2297,6 +2394,7 @@ delete_reference_table(void)
noop_sig_offheap,
clear_visited_monitor,
clear_visited_link,
+ noop_sig_ext,
(void *) proc);
}
}
diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h
index c44f1f8991..d5daf0c2df 100644
--- a/erts/emulator/beam/erl_node_tables.h
+++ b/erts/emulator/beam/erl_node_tables.h
@@ -98,11 +98,22 @@ struct ErtsDistOutputBuf_ {
byte *alloc_endp;
#endif
ErtsDistOutputBuf *next;
- Uint hopefull_flags;
+ Binary *bin;
+ /* Pointers to the distribution header,
+ if NULL the distr header is in the extp */
+ byte *hdrp;
+ byte *hdr_endp;
+ /* Pointers to the ctl + payload */
byte *extp;
byte *ext_endp;
+ /* Start of payload and hopefull_flags, used by transcode */
+ Uint hopefull_flags;
byte *msg_start;
- byte data[1];
+ /* start of the ext buffer, this is not always the same as extp
+ as the atom cache handling can use less then the allotted buffer.
+ This value is needed to calculate the size of this output buffer.*/
+ byte *ext_start;
+
};
typedef struct {
@@ -161,7 +172,46 @@ struct dist_entry_ {
ErtsThrPrgrLaterOp later_op;
struct transcode_context* transcode_ctx;
+
+ struct dist_sequences *sequences; /* Ongoing distribution sequences */
+};
+
+/*
+#define ERL_NODE_BOOKKEEP
+ * Bookkeeping of ErlNode inc and dec operations to help debug refc problems.
+ * This is best used together with cerl -rr. Type the below into gdb:
+ * gdb:
+set pagination off
+set $i = 0
+set $node = referred_nodes[$node_ix].node
+while $i < $node->slot.counter
+ printf "%p: ", $node->books[$i].term
+ etp-1 $node->books[$i].who
+ printf " "
+ p $node->books[$i].what
+ set $i++
+end
+
+ * Then save that into a file called test.txt and run the below in
+ * an erlang shell in order to get all inc/dec that do not have a
+ * match.
+
+f(), {ok, B} = file:read_file("test.txt").
+Vs = [begin [Val, _, _, _, What] = All = string:lexemes(Ln, " "),{Val,What,All} end || Ln <- string:lexemes(B,"\n")].
+Accs = lists:foldl(fun({V,<<"ERL_NODE_INC">>,_},M) -> Val = maps:get(V,M,0), M#{ V => Val + 1 }; ({V,<<"ERL_NODE_DEC">>,_},M) -> Val = maps:get(V,M,0), M#{ V => Val - 1 } end, #{}, Vs).
+lists:usort(lists:filter(fun({V,N}) -> N /= 0 end, maps:to_list(Accs))).
+
+ * There are bound to be bugs in the the instrumentation code, but
+ * atleast this is a place to start when hunting refc bugs.
+ *
+ */
+#ifdef ERL_NODE_BOOKKEEP
+struct erl_node_bookkeeping {
+ Eterm who;
+ Eterm term;
+ enum { ERL_NODE_INC, ERL_NODE_DEC } what;
};
+#endif
typedef struct erl_node_ {
HashBucket hash_bucket; /* Hash bucket */
@@ -169,6 +219,10 @@ typedef struct erl_node_ {
Eterm sysname; /* name@host atom for efficiency */
Uint32 creation; /* Creation */
DistEntry *dist_entry; /* Corresponding dist entry */
+#ifdef ERL_NODE_BOOKKEEP
+ struct erl_node_bookkeeping books[1024];
+ erts_atomic_t slot;
+#endif
} ErlNode;
@@ -201,7 +255,7 @@ void erts_dist_table_info(fmtfn_t, void *);
void erts_set_dist_entry_not_connected(DistEntry *);
void erts_set_dist_entry_pending(DistEntry *);
void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint);
-ErlNode *erts_find_or_insert_node(Eterm, Uint32);
+ErlNode *erts_find_or_insert_node(Eterm, Uint32, Eterm);
void erts_schedule_delete_node(ErlNode *);
void erts_set_this_node(Eterm, Uint);
Uint erts_node_table_size(void);
@@ -219,18 +273,38 @@ DistEntry *erts_dhandle_to_dist_entry(Eterm dhandle, Uint32* connection_id);
Eterm erts_build_dhandle(Eterm **hpp, ErlOffHeap*, DistEntry*, Uint32 conn_id);
Eterm erts_make_dhandle(Process *c_p, DistEntry*, Uint32 conn_id);
-ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np);
+ERTS_GLB_INLINE void erts_init_node_entry(ErlNode *np, erts_aint_t val);
+ERTS_GLB_INLINE erts_aint_t erts_ref_node_entry(ErlNode *np, int min_val, Eterm term);
+ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np, Eterm term);
ERTS_GLB_INLINE void erts_de_rlock(DistEntry *dep);
ERTS_GLB_INLINE void erts_de_runlock(DistEntry *dep);
ERTS_GLB_INLINE void erts_de_rwlock(DistEntry *dep);
ERTS_GLB_INLINE void erts_de_rwunlock(DistEntry *dep);
+#ifdef ERL_NODE_BOOKKEEP
+void erts_node_bookkeep(ErlNode *, Eterm , int);
+#else
+#define erts_node_bookkeep(...)
+#endif
#if ERTS_GLB_INLINE_INCL_FUNC_DEF
ERTS_GLB_INLINE void
-erts_deref_node_entry(ErlNode *np)
+erts_init_node_entry(ErlNode *np, erts_aint_t val)
+{
+ erts_refc_init(&np->refc, val);
+}
+
+ERTS_GLB_INLINE erts_aint_t
+erts_ref_node_entry(ErlNode *np, int min_val, Eterm term)
+{
+ erts_node_bookkeep(np, term, ERL_NODE_INC);
+ return erts_refc_inctest(&np->refc, min_val);
+}
+
+ERTS_GLB_INLINE void
+erts_deref_node_entry(ErlNode *np, Eterm term)
{
- ASSERT(np);
+ erts_node_bookkeep(np, term, ERL_NODE_DEC);
if (erts_refc_dectest(&np->refc, 0) == 0)
erts_schedule_delete_node(np);
}
diff --git a/erts/emulator/beam/erl_port.h b/erts/emulator/beam/erl_port.h
index 25976d38cc..039d8cf67a 100644
--- a/erts/emulator/beam/erl_port.h
+++ b/erts/emulator/beam/erl_port.h
@@ -1018,6 +1018,6 @@ int erts_port_output_async(Port *, Eterm, Eterm);
/*
* Signals from ports to ports. Used by sys drivers.
*/
-int erl_drv_port_control(Eterm, char, char*, ErlDrvSizeT);
+int erl_drv_port_control(Eterm, unsigned int, char*, ErlDrvSizeT);
#endif
diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c
index c8f2e88127..30a7875387 100644
--- a/erts/emulator/beam/erl_port_task.c
+++ b/erts/emulator/beam/erl_port_task.c
@@ -2094,7 +2094,7 @@ begin_port_cleanup(Port *pp, ErtsPortTask **execqp, int *processing_busy_q_p)
erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", pp->common.id);
while (plp2 != NULL) {
- erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->pid);
+ erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->u.pid);
DTRACE2(process_port_unblocked, pid_str, port_str);
}
}
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
index 9cfb7fc681..2e33a8a782 100644
--- a/erts/emulator/beam/erl_printf_term.c
+++ b/erts/emulator/beam/erl_printf_term.c
@@ -487,6 +487,8 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) {
PRINT_UWORD(res, fn, arg, 'u', 0, 1, octet);
++bytep;
--bytesize;
+ if ((*dcount)-- <= 0)
+ goto L_done;
}
if (bitsize) {
Uint bits = bitoffs + bitsize;
@@ -521,6 +523,8 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) {
PRINT_CHAR(res, fn, arg, octet);
++bytep;
--bytesize;
+ if ((*dcount)-- <= 0)
+ goto L_done;
}
PRINT_STRING(res, fn, arg, "\">>");
}
diff --git a/erts/emulator/beam/erl_proc_sig_queue.c b/erts/emulator/beam/erl_proc_sig_queue.c
index 18418a76e1..9c74a2c355 100644
--- a/erts/emulator/beam/erl_proc_sig_queue.c
+++ b/erts/emulator/beam/erl_proc_sig_queue.c
@@ -36,6 +36,7 @@
#include "erl_port_task.h"
#include "erl_trace.h"
#include "beam_bp.h"
+#include "erl_binary.h"
#include "big.h"
#include "erl_gc.h"
#include "bif.h"
@@ -80,6 +81,11 @@
#define ERTS_SIG_Q_TYPE_ADJUST_TRACE_INFO \
ERTS_SIG_Q_TYPE_MAX
+#define ERTS_SIG_IS_GEN_EXIT(sig) \
+ (ERTS_PROC_SIG_TYPE(((ErtsSignal *) sig)->common.tag) == ERTS_SIG_Q_TYPE_GEN_EXIT)
+#define ERTS_SIG_IS_GEN_EXIT_EXTERNAL(sig) \
+ (ASSERT(ERTS_SIG_IS_GEN_EXIT(sig)),is_non_value(get_exit_signal_data(sig)->reason))
+
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler);
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_high);
Process *ERTS_WRITE_UNLIKELY(erts_dirty_process_signal_handler_max);
@@ -259,7 +265,7 @@ destroy_dist_proc_demonitor(ErtsSigDistProcDemonitor *dmon)
Eterm ref = dmon->ref;
if (is_external(ref)) {
ExternalThing *etp = external_thing_ptr(ref);
- erts_deref_node_entry(etp->node);
+ erts_deref_node_entry(etp->node, ref);
}
erts_free(ERTS_ALC_T_DIST_DEMONITOR, dmon);
}
@@ -294,7 +300,8 @@ destroy_sig_dist_link_op(ErtsSigDistLinkOp *sdlnk)
{
ASSERT(is_external_pid(sdlnk->remote));
ASSERT(boxed_val(sdlnk->remote) == &sdlnk->heap[0]);
- erts_deref_node_entry(((ExternalThing *) &sdlnk->heap[0])->node);
+ erts_deref_node_entry(((ExternalThing *) &sdlnk->heap[0])->node,
+ make_boxed(&sdlnk->heap[0]));
erts_free(ERTS_ALC_T_SIG_DATA, sdlnk);
}
@@ -936,29 +943,54 @@ erts_proc_sig_privqs_len(Process *c_p)
return proc_sig_privqs_len(c_p, 0);
}
+ErtsDistExternal *
+erts_proc_sig_get_external(ErtsMessage *msgp)
+{
+ if (ERTS_SIG_IS_EXTERNAL_MSG(msgp)) {
+ return erts_get_dist_ext(msgp->data.heap_frag);
+ } else if (ERTS_SIG_IS_NON_MSG(msgp) &&
+ ERTS_SIG_IS_GEN_EXIT(msgp) &&
+ ERTS_SIG_IS_GEN_EXIT_EXTERNAL(msgp)) {
+ ErtsDistExternal *edep;
+ ErtsExitSignalData *xsigd = get_exit_signal_data(msgp);
+ ASSERT(ERTS_PROC_SIG_TYPE(((ErtsSignal *) msgp)->common.tag) == ERTS_SIG_Q_TYPE_GEN_EXIT);
+ ASSERT(is_non_value(xsigd->reason));
+ if (msgp->hfrag.next == NULL)
+ edep = (ErtsDistExternal*)(xsigd + 1);
+ else
+ edep = erts_get_dist_ext(msgp->hfrag.next);
+ return edep;
+ }
+ return NULL;
+}
+
static void do_seq_trace_output(Eterm to, Eterm token, Eterm msg);
static void
send_gen_exit_signal(Process *c_p, Eterm from_tag,
Eterm from, Eterm to,
- Sint16 op, Eterm reason, Eterm ref,
- Eterm token, int normal_kills)
+ Sint16 op, Eterm reason, ErtsDistExternal *dist_ext,
+ ErlHeapFragment *dist_ext_hfrag,
+ Eterm ref, Eterm token, int normal_kills)
{
ErtsExitSignalData *xsigd;
Eterm *hp, *start_hp, s_reason, s_ref, s_message, s_token, s_from;
ErtsMessage *mp;
ErlHeapFragment *hfrag;
ErlOffHeap *ohp;
- Uint hsz, from_sz, reason_sz, ref_sz, token_sz;
+ Uint hsz, from_sz, reason_sz, ref_sz, token_sz, dist_ext_sz;
int seq_trace;
#ifdef USE_VM_PROBES
Eterm s_utag, utag;
Uint utag_sz;
#endif
+ ASSERT((is_value(reason) && dist_ext == NULL) ||
+ (is_non_value(reason) && dist_ext != NULL));
+
ASSERT(is_immed(from_tag));
- hsz = sizeof(ErtsExitSignalData)/sizeof(Uint);
+ hsz = sizeof(ErtsExitSignalData)/sizeof(Eterm);
seq_trace = c_p && have_seqtrace(token);
if (seq_trace)
@@ -977,33 +1009,42 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag,
hsz += utag_sz;
#endif
- token_sz = is_immed(token) ? 0 : size_object(token);
+ token_sz = size_object(token);
hsz += token_sz;
- from_sz = is_immed(from) ? 0 : size_object(from);
+ from_sz = size_object(from);
hsz += from_sz;
- reason_sz = is_immed(reason) ? 0 : size_object(reason);
- hsz += reason_sz;
+ ref_sz = size_object(ref);
+ hsz += ref_sz;
- switch (op) {
- case ERTS_SIG_Q_OP_EXIT:
- case ERTS_SIG_Q_OP_EXIT_LINKED: {
- /* {'EXIT', From, Reason} */
- hsz += 4; /* 3-tuple */
- ref_sz = 0;
- break;
- }
- case ERTS_SIG_Q_OP_MONITOR_DOWN: {
- /* {'DOWN', Ref, process, From, Reason} */
- hsz += 6; /* 5-tuple */
- ref_sz = NC_HEAP_SIZE(ref);
- hsz += ref_sz;
- break;
- }
- default:
- ERTS_INTERNAL_ERROR("Invalid exit signal op");
- break;
+ /* The reason was part of the control message,
+ just use copy it into the xsigd */
+ if (is_value(reason)) {
+ reason_sz = size_object(reason);
+ hsz += reason_sz;
+
+ switch (op) {
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED: {
+ /* {'EXIT', From, Reason} */
+ hsz += 4; /* 3-tuple */
+ break;
+ }
+ case ERTS_SIG_Q_OP_MONITOR_DOWN: {
+ /* {'DOWN', Ref, process, From, Reason} */
+ hsz += 6; /* 5-tuple */
+ break;
+ }
+ default:
+ ERTS_INTERNAL_ERROR("Invalid exit signal op");
+ break;
+ }
+ } else if (dist_ext != NULL && dist_ext_hfrag == NULL) {
+ /* The message was not fragmented so we need to create space
+ for a single dist_ext element */
+ dist_ext_sz = erts_dist_ext_size(dist_ext) / sizeof(Eterm);
+ hsz += dist_ext_sz;
}
/*
@@ -1015,35 +1056,33 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag,
ohp = &hfrag->off_heap;
start_hp = hp;
- s_token = (is_immed(token)
- ? token
- : copy_struct(token, token_sz, &hp, ohp));
-
- s_reason = (is_immed(reason)
- ? reason
- : copy_struct(reason, reason_sz, &hp, ohp));
+ s_token = copy_struct(token, token_sz, &hp, ohp);
+ s_from = copy_struct(from, from_sz, &hp, ohp);
+ s_ref = copy_struct(ref, ref_sz, &hp, ohp);
- s_from = (is_immed(from)
- ? from
- : copy_struct(from, from_sz, &hp, ohp));
+ if (is_value(reason)) {
+ s_reason = copy_struct(reason, reason_sz, &hp, ohp);
- if (!ref_sz)
- s_ref = NIL;
- else
- s_ref = STORE_NC(&hp, ohp, ref);
-
- switch (op) {
- case ERTS_SIG_Q_OP_EXIT:
- case ERTS_SIG_Q_OP_EXIT_LINKED:
- /* {'EXIT', From, Reason} */
- s_message = TUPLE3(hp, am_EXIT, s_from, s_reason);
- hp += 4;
- break;
- case ERTS_SIG_Q_OP_MONITOR_DOWN:
- /* {'DOWN', Ref, process, From, Reason} */
- s_message = TUPLE5(hp, am_DOWN, s_ref, am_process, s_from, s_reason);
- hp += 6;
- break;
+ switch (op) {
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+ /* {'EXIT', From, Reason} */
+ s_message = TUPLE3(hp, am_EXIT, s_from, s_reason);
+ hp += 4;
+ break;
+ case ERTS_SIG_Q_OP_MONITOR_DOWN:
+ /* {'DOWN', Ref, process, From, Reason} */
+ s_message = TUPLE5(hp, am_DOWN, s_ref, am_process, s_from, s_reason);
+ hp += 6;
+ break;
+ default:
+ /* This cannot happen, used to silence gcc warning */
+ s_message = THE_NON_VALUE;
+ break;
+ }
+ } else {
+ s_message = THE_NON_VALUE;
+ s_reason = THE_NON_VALUE;
}
#ifdef USE_VM_PROBES
@@ -1061,11 +1100,13 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag,
hfrag->used_size = hp - start_hp;
- xsigd = (ErtsExitSignalData *) (char *) hp;
+ xsigd = (ErtsExitSignalData *) hp;
xsigd->message = s_message;
xsigd->from = s_from;
xsigd->reason = s_reason;
+ hfrag->next = dist_ext_hfrag;
+
if (is_nil(s_ref))
xsigd->u.normal_kills = normal_kills;
else {
@@ -1073,6 +1114,15 @@ send_gen_exit_signal(Process *c_p, Eterm from_tag,
xsigd->u.ref = s_ref;
}
+ hp += sizeof(ErtsExitSignalData)/sizeof(Eterm);
+
+ if (dist_ext != NULL && dist_ext_hfrag == NULL && is_non_value(reason)) {
+ erts_make_dist_ext_copy(dist_ext, (ErtsDistExternal *) hp);
+ hp += dist_ext_sz;
+ }
+
+ ASSERT(hp == mp->hfrag.mem + mp->hfrag.alloc_size);
+
if (seq_trace)
do_seq_trace_output(to, s_token, s_message);
@@ -1205,7 +1255,19 @@ erts_proc_sig_send_exit(Process *c_p, Eterm from, Eterm to,
from_tag = dep->sysname;
}
send_gen_exit_signal(c_p, from_tag, from, to, ERTS_SIG_Q_OP_EXIT,
- reason, NIL, token, normal_kills);
+ reason, NULL, NULL, NIL, token, normal_kills);
+}
+
+void
+erts_proc_sig_send_dist_exit(DistEntry *dep,
+ Eterm from, Eterm to,
+ ErtsDistExternal *dist_ext,
+ ErlHeapFragment *hfrag,
+ Eterm reason, Eterm token)
+{
+ send_gen_exit_signal(NULL, dep->sysname, from, to, ERTS_SIG_Q_OP_EXIT,
+ reason, dist_ext, hfrag, NIL, token, 0);
+
}
void
@@ -1219,7 +1281,7 @@ erts_proc_sig_send_link_exit(Process *c_p, Eterm from, ErtsLink *lnk,
if (is_not_immed(reason) || is_not_nil(token)) {
ASSERT(is_internal_pid(from) || is_internal_port(from));
send_gen_exit_signal(c_p, from, from, to, ERTS_SIG_Q_OP_EXIT_LINKED,
- reason, NIL, token, 0);
+ reason, NULL, NULL, NIL, token, 0);
}
else {
/* Pass signal using old link structure... */
@@ -1274,10 +1336,13 @@ erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk)
void
erts_proc_sig_send_dist_link_exit(DistEntry *dep,
Eterm from, Eterm to,
+ ErtsDistExternal *dist_ext,
+ ErlHeapFragment *hfrag,
Eterm reason, Eterm token)
{
send_gen_exit_signal(NULL, dep->sysname, from, to, ERTS_SIG_Q_OP_EXIT_LINKED,
- reason, NIL, token, 0);
+ reason, dist_ext, hfrag, NIL, token, 0);
+
}
void
@@ -1299,16 +1364,18 @@ erts_proc_sig_send_dist_unlink(DistEntry *dep, Eterm from, Eterm to)
void
erts_proc_sig_send_dist_monitor_down(DistEntry *dep, Eterm ref,
Eterm from, Eterm to,
+ ErtsDistExternal *dist_ext,
+ ErlHeapFragment *hfrag,
Eterm reason)
{
Eterm monitored, heap[3];
- if (is_atom(from))
+ if (is_atom(from))
monitored = TUPLE2(&heap[0], from, dep->sysname);
else
monitored = from;
send_gen_exit_signal(NULL, dep->sysname, monitored,
to, ERTS_SIG_Q_OP_MONITOR_DOWN,
- reason, ref, NIL, 0);
+ reason, dist_ext, hfrag, ref, NIL, 0);
}
void
@@ -1376,10 +1443,10 @@ erts_proc_sig_send_monitor_down(ErtsMonitor *mon, Eterm reason)
|| is_internal_pid(from_tag)
|| is_atom(from_tag));
monitored = TUPLE2(&heap[0], name, node);
- }
+ }
send_gen_exit_signal(NULL, from_tag, monitored,
to, ERTS_SIG_Q_OP_MONITOR_DOWN,
- reason, mdp->ref, NIL, 0);
+ reason, NULL, NULL, mdp->ref, NIL, 0);
}
erts_monitor_release(mon);
}
@@ -2037,7 +2104,6 @@ handle_exit_signal(Process *c_p, ErtsSigRecvTracing *tracing,
if (type == ERTS_SIG_Q_TYPE_GEN_EXIT) {
xsigd = get_exit_signal_data(sig);
from = xsigd->from;
- reason = xsigd->reason;
if (op != ERTS_SIG_Q_OP_EXIT_LINKED)
ignore = 0;
else {
@@ -2062,6 +2128,18 @@ handle_exit_signal(Process *c_p, ErtsSigRecvTracing *tracing,
}
}
+ /* This GEN_EXIT was received from another node, decode the exit reason */
+ if (ERTS_SIG_IS_GEN_EXIT_EXTERNAL(sig))
+ erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, sig, 1);
+
+ reason = xsigd->reason;
+
+ if (is_non_value(reason)) {
+ /* Bad distribution message; remove it from queue... */
+ ignore = !0;
+ destroy = !0;
+ }
+
if (!ignore) {
if ((op != ERTS_SIG_Q_OP_EXIT || reason != am_kill)
@@ -2929,6 +3007,104 @@ handle_sync_suspend(Process *c_p, ErtsMessage *mp)
}
}
+int
+erts_proc_sig_decode_dist(Process *proc, ErtsProcLocks proc_locks,
+ ErtsMessage *msgp, int force_off_heap)
+{
+ ErtsHeapFactory factory;
+ ErlHeapFragment *hfrag;
+ Eterm msg;
+ Sint need;
+ ErtsDistExternal *edep;
+ ErtsExitSignalData *xsigd = NULL;
+
+ edep = erts_proc_sig_get_external(msgp);
+ if (!ERTS_SIG_IS_EXTERNAL_MSG(msgp))
+ xsigd = get_exit_signal_data(msgp);
+
+ if (edep->heap_size >= 0)
+ need = edep->heap_size;
+ else {
+ need = erts_decode_dist_ext_size(edep, 1);
+ if (need < 0) {
+ /* bad signal; remove it... */
+ return 0;
+ }
+
+ edep->heap_size = need;
+ }
+
+ if (ERTS_SIG_IS_NON_MSG(msgp)) {
+ switch (ERTS_PROC_SIG_OP(ERL_MESSAGE_TERM(msgp))) {
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+ /* {'EXIT', From, Reason} */
+ need += 4;
+ break;
+ case ERTS_SIG_Q_OP_MONITOR_DOWN:
+ /* {'DOWN', Ref, process, From, Reason} */
+ need += 6; /* 5-tuple */
+ break;
+ default:
+ ERTS_INTERNAL_ERROR("Invalid exit signal op");
+ break;
+ }
+ }
+
+ hfrag = new_message_buffer(need);
+ erts_factory_heap_frag_init(&factory, hfrag);
+
+ ASSERT(edep->heap_size >= 0);
+
+ msg = erts_decode_dist_ext(&factory, edep, 1);
+
+ if (is_non_value(msg)) {
+ erts_factory_undo(&factory);
+ return 0;
+ }
+
+ if (ERTS_SIG_IS_MSG(msgp)) {
+ ERL_MESSAGE_TERM(msgp) = msg;
+ if (msgp->data.heap_frag == &msgp->hfrag)
+ msgp->data.heap_frag = ERTS_MSG_COMBINED_HFRAG;
+ } else {
+ switch (ERTS_PROC_SIG_OP(ERL_MESSAGE_TERM(msgp))) {
+ case ERTS_SIG_Q_OP_EXIT:
+ case ERTS_SIG_Q_OP_EXIT_LINKED:
+ /* {'EXIT', From, Reason} */
+ erts_reserve_heap(&factory, 4);
+ xsigd->message = TUPLE3(factory.hp, am_EXIT, xsigd->from, msg);
+ factory.hp += 4;
+ break;
+ case ERTS_SIG_Q_OP_MONITOR_DOWN:
+ /* {'DOWN', Ref, process, From, Reason} */
+ erts_reserve_heap(&factory, 6);
+ xsigd->message = TUPLE5(factory.hp, am_DOWN, xsigd->u.ref, am_process, xsigd->from, msg);
+ factory.hp += 6;
+ break;
+ }
+ xsigd->reason = msg;
+ }
+
+ erts_free_dist_ext_copy(edep);
+
+ erts_factory_close(&factory);
+
+ hfrag = factory.heap_frags;
+ while (hfrag->next)
+ hfrag = hfrag->next;
+
+ if (ERTS_SIG_IS_MSG(msgp) && msgp->data.heap_frag != ERTS_MSG_COMBINED_HFRAG) {
+ hfrag->next = msgp->data.heap_frag;
+ msgp->data.heap_frag = factory.heap_frags;
+ } else {
+ hfrag->next = msgp->hfrag.next;
+ msgp->hfrag.next = factory.heap_frags;
+ }
+
+ return 1;
+}
+
void
erts_proc_sig_handle_pending_suspend(Process *c_p)
{
@@ -3045,7 +3221,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
ASSERT(ERTS_SIG_IS_NON_MSG(sig));
tag = ((ErtsSignal *) sig)->common.tag;
-
+
switch (ERTS_PROC_SIG_OP(tag)) {
case ERTS_SIG_Q_OP_EXIT:
@@ -3091,6 +3267,12 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
break;
case ERTS_SIG_Q_TYPE_GEN_EXIT:
xsigd = get_exit_signal_data(sig);
+
+ /* This GEN_EXIT was received from another node, decode the exit reason */
+ if (ERTS_SIG_IS_GEN_EXIT_EXTERNAL(sig))
+ if (!erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, sig, 1))
+ break; /* Decode failed, just remove signal */
+
omon = erts_monitor_tree_lookup(ERTS_P_MONITORS(c_p),
xsigd->u.ref);
if (omon) {
@@ -3590,9 +3772,10 @@ stretch_limit(Process *c_p, ErtsSigRecvTracing *tp,
int
-erts_proc_sig_handle_exit(Process *c_p, int *redsp)
+erts_proc_sig_handle_exit(Process *c_p, Sint *redsp)
{
- int cnt, limit;
+ int cnt;
+ Sint limit;
ErtsMessage *sig, ***next_nm_sig;
ERTS_HDBG_CHECK_SIGNAL_PRIV_QUEUE(c_p, 0);
@@ -3671,9 +3854,9 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp)
break;
case ERTS_SIG_Q_OP_MONITOR: {
- ErtsProcExitContext pectxt = {c_p, am_noproc};
+ ErtsProcExitContext pectxt = {c_p, am_noproc, NULL, NULL, NIL};
erts_proc_exit_handle_monitor((ErtsMonitor *) sig,
- (void *) &pectxt);
+ (void *) &pectxt, -1);
cnt += 4;
break;
}
@@ -3687,7 +3870,7 @@ erts_proc_sig_handle_exit(Process *c_p, int *redsp)
case ERTS_SIG_Q_OP_LINK: {
ErtsProcExitContext pectxt = {c_p, am_noproc};
- erts_proc_exit_handle_link((ErtsLink *) sig, (void *) &pectxt);
+ erts_proc_exit_handle_link((ErtsLink *) sig, (void *) &pectxt, -1);
break;
}
@@ -4188,11 +4371,13 @@ handle_msg_tracing(Process *c_p, ErtsSigRecvTracing *tracing,
return -1; /* Yield... */
}
if (ERTS_SIG_IS_EXTERNAL_MSG(sig)) {
- cnt++;
- if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN,
- sig, 0)) {
+ cnt += 50; /* Decode is expensive... */
+ if (!erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN,
+ sig, 0)) {
/* Bad dist message; remove it... */
remove_mq_m_sig(c_p, sig, next_sig, next_nm_sig);
+ sig->next = NULL;
+ erts_cleanup_messages(sig);
sig = *next_sig;
continue;
}
@@ -4264,18 +4449,12 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p,
if (ERTS_SIG_IS_EXTERNAL_MSG(mp)) {
/* decode it... */
- if (mp->data.attached)
- erts_decode_dist_message(rp, rp_locks, mp, !0);
-
- msg = ERL_MESSAGE_TERM(mp);
-
- if (is_non_value(msg)) {
+ if (!erts_proc_sig_decode_dist(rp, rp_locks, mp, !0)) {
ErtsMessage *bad_mp = mp;
/*
* Bad distribution message; remove
* it from the queue...
*/
- ASSERT(!mp->data.attached);
ASSERT(*mpp == bad_mp);
@@ -4287,6 +4466,8 @@ erts_proc_sig_prep_msgq_for_inspection(Process *c_p,
erts_cleanup_messages(bad_mp);
continue;
}
+
+ msg = ERL_MESSAGE_TERM(mp);
}
ASSERT(is_value(msg));
@@ -4445,12 +4626,21 @@ debug_foreach_sig_fake_oh(Eterm term,
}
+static void
+debug_foreach_sig_external(ErtsMessage *msgp,
+ void (*ext_func)(ErtsDistExternal *, void *),
+ void *arg)
+{
+ ext_func(erts_proc_sig_get_external(msgp), arg);
+}
+
void
erts_proc_sig_debug_foreach_sig(Process *c_p,
void (*msg_func)(ErtsMessage *, void *),
void (*oh_func)(ErlOffHeap *, void *),
- void (*mon_func)(ErtsMonitor *, void *),
- void (*lnk_func)(ErtsLink *, void *),
+ ErtsMonitorFunc mon_func,
+ ErtsLinkFunc lnk_func,
+ void (*ext_func)(ErtsDistExternal *, void *),
void *arg)
{
ErtsMessage *queue[] = {c_p->sig_qs.first, c_p->sig_qs.cont, c_p->sig_inq.first};
@@ -4459,10 +4649,10 @@ erts_proc_sig_debug_foreach_sig(Process *c_p,
for (qix = 0; qix < sizeof(queue)/sizeof(queue[0]); qix++) {
ErtsMessage *sig;
for (sig = queue[qix]; sig; sig = sig->next) {
-
- if (ERTS_SIG_IS_MSG(sig))
+
+ if (ERTS_SIG_IS_MSG(sig)) {
msg_func(sig, arg);
- else {
+ } else {
Eterm tag;
Uint16 type;
int op;
@@ -4481,18 +4671,21 @@ erts_proc_sig_debug_foreach_sig(Process *c_p,
case ERTS_SIG_Q_OP_MONITOR_DOWN:
switch (type) {
case ERTS_SIG_Q_TYPE_GEN_EXIT:
- debug_foreach_sig_heap_frags(&sig->hfrag, oh_func, arg);
+ if (ERTS_SIG_IS_GEN_EXIT_EXTERNAL(sig))
+ debug_foreach_sig_external(sig, ext_func, arg);
+ else
+ debug_foreach_sig_heap_frags(&sig->hfrag, oh_func, arg);
break;
case ERTS_LNK_TYPE_PORT:
case ERTS_LNK_TYPE_PROC:
case ERTS_LNK_TYPE_DIST_PROC:
- lnk_func((ErtsLink *) sig, arg);
+ lnk_func((ErtsLink *) sig, arg, -1);
break;
case ERTS_MON_TYPE_PORT:
case ERTS_MON_TYPE_PROC:
case ERTS_MON_TYPE_DIST_PROC:
case ERTS_MON_TYPE_NODE:
- mon_func((ErtsMonitor *) sig, arg);
+ mon_func((ErtsMonitor *) sig, arg, -1);
break;
default:
ERTS_INTERNAL_ERROR("Unexpected sig type");
@@ -4513,7 +4706,7 @@ erts_proc_sig_debug_foreach_sig(Process *c_p,
/* Fall through... */
case ERTS_SIG_Q_OP_MONITOR:
- mon_func((ErtsMonitor *) sig, arg);
+ mon_func((ErtsMonitor *) sig, arg, -1);
break;
case ERTS_SIG_Q_OP_UNLINK:
@@ -4525,7 +4718,7 @@ erts_proc_sig_debug_foreach_sig(Process *c_p,
/* Fall through... */
case ERTS_SIG_Q_OP_LINK:
- lnk_func((ErtsLink *) sig, arg);
+ lnk_func((ErtsLink *) sig, arg, -1);
break;
case ERTS_SIG_Q_OP_GROUP_LEADER: {
diff --git a/erts/emulator/beam/erl_proc_sig_queue.h b/erts/emulator/beam/erl_proc_sig_queue.h
index 6b065a7add..2b055e73bc 100644
--- a/erts/emulator/beam/erl_proc_sig_queue.h
+++ b/erts/emulator/beam/erl_proc_sig_queue.h
@@ -89,6 +89,7 @@
#endif
struct erl_mesg;
+struct erl_dist_external;
typedef struct {
struct erl_mesg *next;
@@ -212,6 +213,38 @@ erts_proc_sig_send_exit(Process *c_p, Eterm from, Eterm to,
/**
*
+ * @brief Send an exit signal to a process.
+ *
+ * This function is used instead of erts_proc_sig_send_link_exit()
+ * when the signal arrives via the distribution and
+ * therefore no link structure is available.
+ *
+ * @param[in] dep Distribution entry of channel
+ * that the signal arrived on.
+ *
+ * @param[in] from Identifier of sender.
+ *
+ * @param[in] to Identifier of receiver.
+ *
+ * @param[in] dist_ext The exit reason in external term format
+ *
+ * @param[in] hfrag Heap frag with trace token and dist_ext
+ * iff available, otherwise NULL.
+ *
+ * @param[in] reason Exit reason.
+ *
+ * @param[in] token Seq trace token.
+ *
+ */
+void
+erts_proc_sig_send_dist_exit(DistEntry *dep,
+ Eterm from, Eterm to,
+ ErtsDistExternal *dist_ext,
+ ErlHeapFragment *hfrag,
+ Eterm reason, Eterm token);
+
+/**
+ *
* @brief Send an exit signal due to broken link to a process.
*
*
@@ -282,7 +315,7 @@ erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk);
*
* This function is used instead of erts_proc_sig_send_link_exit()
* when the signal arrives via the distribution and
- * no link structure is available.
+ * therefore no link structure is available.
*
* @param[in] dep Distribution entry of channel
* that the signal arrived on.
@@ -291,6 +324,11 @@ erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk);
*
* @param[in] to Identifier of receiver.
*
+ * @param[in] dist_ext The exit reason in external term format
+ *
+ * @param[in] hfrag Heap frag with trace token and dist_ext
+ * iff available, otherwise NULL.
+ *
* @param[in] reason Exit reason.
*
* @param[in] token Seq trace token.
@@ -299,6 +337,8 @@ erts_proc_sig_send_unlink(Process *c_p, ErtsLink *lnk);
void
erts_proc_sig_send_dist_link_exit(struct dist_entry_ *dep,
Eterm from, Eterm to,
+ ErtsDistExternal *dist_ext,
+ ErlHeapFragment *hfrag,
Eterm reason, Eterm token);
/**
@@ -307,7 +347,7 @@ erts_proc_sig_send_dist_link_exit(struct dist_entry_ *dep,
*
* This function is used instead of erts_proc_sig_send_unlink()
* when the signal arrives via the distribution and
- * no link structure is available.
+ * therefore no link structure is available.
*
* @param[in] dep Distribution entry of channel
* that the signal arrived on.
@@ -380,7 +420,7 @@ erts_proc_sig_send_monitor(ErtsMonitor *mon, Eterm to);
*
* This function is used instead of erts_proc_sig_send_monitor_down()
* when the signal arrives via the distribution and
- * no link structure is available.
+ * therefore no monitor structure is available.
*
* @param[in] dep Pointer to distribution entry
* of channel that the signal
@@ -392,12 +432,19 @@ erts_proc_sig_send_monitor(ErtsMonitor *mon, Eterm to);
*
* @param[in] to Identifier of receiver.
*
+ * @param[in] dist_ext The exit reason in external term format
+ *
+ * @param[in] hfrag Heap frag with trace token and dist_ext
+ * iff available, otherwise NULL.
+ *
* @param[in] reason Exit reason.
*
*/
void
erts_proc_sig_send_dist_monitor_down(DistEntry *dep, Eterm ref,
Eterm from, Eterm to,
+ ErtsDistExternal *dist_ext,
+ ErlHeapFragment *hfrag,
Eterm reason);
/**
@@ -740,7 +787,7 @@ erts_proc_sig_handle_incoming(Process *c_p, erts_aint32_t *statep,
* queue.
*/
int
-erts_proc_sig_handle_exit(Process *c_p, int *redsp);
+erts_proc_sig_handle_exit(Process *c_p, Sint *redsp);
/**
*
@@ -962,6 +1009,34 @@ void
erts_proc_sig_handle_pending_suspend(Process *c_p);
/**
+ *
+ * @brief Decode the reason term in an external signal
+ *
+ * Any distributed signal with a payload only has the control
+ * message decoded by the dist entry. The final decode of the
+ * payload is done by the process when it inspects the signal
+ * by calling this function.
+ *
+ * This functions handles both messages and link/monitor exits.
+ *
+ * Return true if the decode was successful, false otherwise.
+ *
+ * @param[in] c_p Pointer to executing process
+ *
+ * @param[in] proc_lock Locks held by process. Should always be MAIN.
+ *
+ * @param[in] msgp The signal to decode
+ *
+ * @param[in] force_off_heap If the term should be forced to be off-heap
+ */
+int
+erts_proc_sig_decode_dist(Process *proc, ErtsProcLocks proc_locks,
+ ErtsMessage *msgp, int force_off_heap);
+
+ErtsDistExternal *
+erts_proc_sig_get_external(ErtsMessage *msgp);
+
+/**
* @brief Initialize this functionality
*/
void erts_proc_sig_queue_init(void);
@@ -970,8 +1045,9 @@ void
erts_proc_sig_debug_foreach_sig(Process *c_p,
void (*msg_func)(ErtsMessage *, void *),
void (*oh_func)(ErlOffHeap *, void *),
- void (*mon_func)(ErtsMonitor *, void *),
- void (*lnk_func)(ErtsLink *, void *),
+ ErtsMonitorFunc mon_func,
+ ErtsLinkFunc lnk_func,
+ void (*ext_func)(ErtsDistExternal *, void *),
void *arg);
extern Process *erts_dirty_process_signal_handler;
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index c2799f6612..0a099e69bb 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -735,12 +735,6 @@ erts_pre_init_process(void)
#endif
}
-static void
-release_process(void *vproc)
-{
- erts_proc_dec_refc((Process *) vproc);
-}
-
/* initialize the scheduler */
void
erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab)
@@ -752,7 +746,7 @@ erts_init_process(int ncpu, int proc_tab_size, int legacy_proc_tab)
erts_ptab_init_table(&erts_proc,
ERTS_ALC_T_PROC_TABLE,
- release_process,
+ NULL,
(ErtsPTabElementCommon *) &erts_invalid_process.common,
proc_tab_size,
sizeof(Process),
@@ -1476,7 +1470,10 @@ proclist_create(Process *p)
{
ErtsProcList *plp = proclist_alloc();
ensure_later_proc_interval(p->common.u.alive.started_interval);
- plp->pid = p->common.id;
+ if (erts_atomic32_read_nob(&p->state) & ERTS_PSFLG_FREE)
+ plp->u.p = p;
+ else
+ plp->u.pid = p->common.id;
plp->started_interval = p->common.u.alive.started_interval;
return plp;
}
@@ -1485,7 +1482,7 @@ static ERTS_INLINE ErtsProcList *
proclist_copy(ErtsProcList *plp0)
{
ErtsProcList *plp1 = proclist_alloc();
- plp1->pid = plp0->pid;
+ plp1->u.pid = plp0->u.pid;
plp1->started_interval = plp0->started_interval;
return plp1;
}
@@ -1520,7 +1517,10 @@ erts_proclist_dump(fmtfn_t to, void *to_arg, ErtsProcList *plp)
ErtsProcList *first = plp;
while (plp) {
- erts_print(to, to_arg, "%T", plp->pid);
+ if (is_pid(plp->u.pid))
+ erts_print(to, to_arg, "%T", plp->u.pid);
+ else
+ erts_print(to, to_arg, "%T", plp->u.p->common.id);
plp = plp->next;
if (plp == first)
break;
@@ -2462,6 +2462,13 @@ handle_reap_ports(ErtsAuxWorkData *awdp, erts_aint32_t aux_work, int waiting)
erts_port_lock(prt);
+ if (prt->common.u.alive.reg &&
+ prt->common.u.alive.reg->name == am_heart_port) {
+ /* Leave heart port to not get killed before flushing is done*/
+ erts_port_release(prt);
+ continue;
+ }
+
state = erts_atomic32_read_nob(&prt->state);
if (!(state & (ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP
| ERTS_PORT_SFLG_HALT))) {
@@ -6519,8 +6526,7 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
n &= ~running_flgs;
if ((!!(a & (ERTS_PSFLG_ACTIVE_SYS|ERTS_PSFLG_DIRTY_ACTIVE_SYS))
- | ((a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE))
- & !(a & ERTS_PSFLG_FREE)) {
+ | ((a & (ERTS_PSFLG_ACTIVE|ERTS_PSFLG_SUSPENDED)) == ERTS_PSFLG_ACTIVE))) {
enqueue = check_enqueue_in_prio_queue(p, &enq_prio, &n, a);
}
a = erts_atomic32_cmpxchg_mb(&p->state, n, e);
@@ -6555,7 +6561,6 @@ schedule_out_process(ErtsRunQueue *c_rq, erts_aint32_t state, Process *p,
else {
Process* sched_p;
- ASSERT(!(n & ERTS_PSFLG_FREE));
ASSERT(!(n & ERTS_PSFLG_SUSPENDED) || (n & (ERTS_PSFLG_ACTIVE_SYS
| ERTS_PSFLG_DIRTY_ACTIVE_SYS)));
@@ -6685,8 +6690,8 @@ change_proc_schedule_state(Process *p,
enqueue = ERTS_ENQUEUE_NOT;
- if (a & ERTS_PSFLG_FREE)
- break; /* We don't want to schedule free processes... */
+ if ((a & (ERTS_PSFLG_FREE|ERTS_PSFLG_ACTIVE)) == ERTS_PSFLG_FREE)
+ break; /* If free and not active, do not schedule */
if (clear_state_flags)
n &= ~clear_state_flags;
@@ -7212,8 +7217,7 @@ schdlr_sspnd_resume_procs(ErtsSchedType sched_type,
while (resume->msb.chngrs) {
ErtsProcList *plp = resume->msb.chngrs;
resume->msb.chngrs = plp->next;
- schdlr_sspnd_resume_proc(sched_type,
- plp->pid);
+ schdlr_sspnd_resume_proc(sched_type, plp->u.pid);
proclist_destroy(plp);
}
}
@@ -7645,7 +7649,7 @@ suspend_scheduler(ErtsSchedulerData *esdp)
else {
schdlr_sspnd.changer = am_true; /* change right in transit */
/* resume process that is queued for next change... */
- resume.onln.nxt = plp->pid;
+ resume.onln.nxt = plp->u.pid;
ASSERT(is_internal_pid(resume.onln.nxt));
}
}
@@ -7865,7 +7869,7 @@ abort_sched_onln_chng_waitq(Process *p)
proclist_destroy(plp);
plp = erts_proclist_peek_first(schdlr_sspnd.chngq);
if (plp)
- resume = plp->pid;
+ resume = plp->u.pid;
else
schdlr_sspnd.changer = am_false;
}
@@ -8131,7 +8135,8 @@ done:
ErtsSchedSuspendResult
erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int normal, int all)
{
- int resume_proc, ix, res, have_unlocked_plocks = 0;
+ ErtsSchedSuspendResult res;
+ int resume_proc, ix, have_unlocked_plocks = 0;
ErtsProcList *plp;
ErtsMultiSchedulingBlock *msbp;
erts_aint32_t chng_flg;
@@ -8364,10 +8369,10 @@ erts_multi_scheduling_blockers(Process *p, int normal)
plp1;
plp1 = erts_proclist_peek_next(msbp->blckrs, plp1)) {
for (plp2 = erts_proclist_peek_first(msbp->blckrs);
- plp2->pid != plp1->pid;
+ plp2->u.pid != plp1->u.pid;
plp2 = erts_proclist_peek_next(msbp->blckrs, plp2));
if (plp2 == plp1) {
- res = CONS(hp, plp1->pid, res);
+ res = CONS(hp, plp1->u.pid, res);
hp += 2;
}
/* else: already in result list */
@@ -9036,8 +9041,13 @@ erts_resume_processes(ErtsProcList *list)
while (plp) {
Process *proc;
ErtsProcList *fplp;
- ASSERT(is_internal_pid(plp->pid));
- proc = erts_pid2proc(NULL, 0, plp->pid, ERTS_PROC_LOCK_STATUS);
+ ASSERT(is_internal_pid(plp->u.pid) || is_CP((Eterm)plp->u.p));
+ if (is_internal_pid(plp->u.pid))
+ proc = erts_pid2proc(NULL, 0, plp->u.pid, ERTS_PROC_LOCK_STATUS);
+ else {
+ proc = plp->u.p;
+ erts_proc_lock(proc, ERTS_PROC_LOCK_STATUS);
+ }
if (proc) {
if (erts_proclist_same(plp, proc)) {
resume_process(proc, ERTS_PROC_LOCK_STATUS);
@@ -9629,7 +9639,8 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
while (1) {
erts_aint32_t exp, new;
- int run_process;
+ int run_process, not_running, exiting_on_normal_sched,
+ not_suspended, not_exiting_on_dirty_sched;
new = exp = state;
new &= psflg_band_mask;
/*
@@ -9638,29 +9649,33 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
* scheduler, and not suspended (and not in a
* state where suspend should be ignored).
*/
- run_process = (((!(state & (ERTS_PSFLG_RUNNING
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS
- | ERTS_PSFLG_FREE)))
- | (((state & (ERTS_PSFLG_RUNNING
-
- | ERTS_PSFLG_FREE
- | ERTS_PSFLG_RUNNING_SYS
- | ERTS_PSFLG_DIRTY_RUNNING_SYS
- | ERTS_PSFLG_EXITING))
- == ERTS_PSFLG_EXITING)
- & (!!is_normal_sched))
- )
- & ((state & (ERTS_PSFLG_SUSPENDED
- | ERTS_PSFLG_EXITING
- | ERTS_PSFLG_FREE
- | ERTS_PSFLG_ACTIVE_SYS
- | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
- != ERTS_PSFLG_SUSPENDED)
- & (!(state & ERTS_PSFLG_EXITING)
- | (!!is_normal_sched))
- );
+ not_running = !(state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
+ | ERTS_PSFLG_FREE));
+ exiting_on_normal_sched =
+ ((state & (ERTS_PSFLG_RUNNING
+ | ERTS_PSFLG_ACTIVE
+ | ERTS_PSFLG_RUNNING_SYS
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS
+ | ERTS_PSFLG_EXITING))
+ == (ERTS_PSFLG_EXITING|ERTS_PSFLG_ACTIVE))
+ & (!!is_normal_sched);
+
+
+ not_suspended = ((state & (ERTS_PSFLG_SUSPENDED
+ | ERTS_PSFLG_EXITING
+ | ERTS_PSFLG_FREE
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS))
+ != ERTS_PSFLG_SUSPENDED);
+
+ not_exiting_on_dirty_sched = !(state & ERTS_PSFLG_EXITING) | (!!is_normal_sched);
+
+ run_process = (not_running | exiting_on_normal_sched)
+ & not_suspended
+ & not_exiting_on_dirty_sched;
if (run_process) {
if (state & (ERTS_PSFLG_ACTIVE_SYS
@@ -9951,7 +9966,7 @@ trace_schedule_in(Process *p, erts_aint32_t state)
/* Clear tracer if it has been removed */
if (erts_is_tracer_proc_enabled(p, ERTS_PROC_LOCK_MAIN, &p->common)) {
- if (state & ERTS_PSFLG_EXITING) {
+ if (state & ERTS_PSFLG_EXITING && p->u.terminate) {
if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT))
trace_sched(p, ERTS_PROC_LOCK_MAIN, am_in_exiting);
}
@@ -9975,12 +9990,9 @@ trace_schedule_out(Process *p, erts_aint32_t state)
if (IS_TRACED_FL(p, F_TRACE_CALLS) && !(state & ERTS_PSFLG_FREE))
erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_OUT);
- if ((state & (ERTS_PSFLG_FREE|ERTS_PSFLG_EXITING)) == ERTS_PSFLG_EXITING) {
+ if (state & ERTS_PSFLG_EXITING && p->u.terminate) {
if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT))
- trace_sched(p, ERTS_PROC_LOCK_MAIN,
- ((state & ERTS_PSFLG_FREE)
- ? am_out_exited
- : am_out_exiting));
+ trace_sched(p, ERTS_PROC_LOCK_MAIN, am_out_exiting);
}
else {
if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED) ||
@@ -12055,12 +12067,91 @@ erts_set_self_exiting(Process *c_p, Eterm reason)
add2runq(enqueue, enq_prio, c_p, state, NULL);
}
-void
-erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
+static int
+erts_proc_exit_handle_dist_monitor(ErtsMonitor *mon, void *vctxt, Sint reds)
+{
+ ErtsProcExitContext *ctxt = (ErtsProcExitContext *) vctxt;
+ Process *c_p = ctxt->c_p;
+ Eterm reason = ctxt->reason;
+ int code;
+ ErtsDSigSendContext ctx;
+ ErtsMonLnkDist *dist;
+ DistEntry *dep;
+ Eterm watcher;
+ ErtsMonitorData *mdp = NULL;
+ Eterm watched;
+
+ ASSERT(erts_monitor_is_target(mon) && mon->type == ERTS_MON_TYPE_DIST_PROC);
+
+ mdp = erts_monitor_to_data(mon);
+
+ if (mon->flags & ERTS_ML_FLG_NAME)
+ watched = ((ErtsMonitorDataExtended *) mdp)->u.name;
+ else
+ watched = c_p->common.id;
+ ASSERT(is_internal_pid(watched) || is_atom(watched));
+
+ watcher = mon->other.item;
+ ASSERT(is_external_pid(watcher));
+ dep = external_pid_dist_entry(watcher);
+ ASSERT(dep);
+ dist = ((ErtsMonitorDataExtended *) mdp)->dist;
+ ASSERT(dist);
+
+ code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK, 0, 0, 1);
+
+ ctx.reds = (Sint) (reds * TERM_TO_BINARY_LOOP_FACTOR);
+
+ switch (code) {
+ case ERTS_DSIG_PREP_NOT_ALIVE:
+ case ERTS_DSIG_PREP_NOT_CONNECTED:
+ break;
+ case ERTS_DSIG_PREP_PENDING:
+ case ERTS_DSIG_PREP_CONNECTED:
+ if (dist->connection_id != ctx.connection_id)
+ break;
+ code = erts_dsig_send_m_exit(&ctx,
+ watcher,
+ watched,
+ mdp->ref,
+ reason);
+ switch (code) {
+ case ERTS_DSIG_SEND_CONTINUE:
+ erts_set_gc_state(c_p, 0);
+ ctxt->dist_state = erts_dsend_export_trap_context(c_p, &ctx);
+ /* fall-through */
+ case ERTS_DSIG_SEND_YIELD:
+ break;
+ case ERTS_DSIG_SEND_OK:
+ break;
+ case ERTS_DSIG_SEND_TOO_LRG:
+ erts_set_gc_state(c_p, 1);
+ break;
+ default:
+ ASSERT(! "Invalid dsig send exit monitor result");
+ break;
+ }
+ break;
+ default:
+ ASSERT(! "Invalid dsig prep exit monitor result");
+ break;
+ }
+ if (!erts_monitor_dist_delete(&mdp->origin))
+ erts_monitor_release(mon);
+ else
+ erts_monitor_release_both(mdp);
+ return reds - (ctx.reds / TERM_TO_BINARY_LOOP_FACTOR);
+}
+
+int
+erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt, Sint reds)
{
- Process *c_p = ((ErtsProcExitContext *) vctxt)->c_p;
- Eterm reason = ((ErtsProcExitContext *) vctxt)->reason;
+ ErtsProcExitContext *ctxt = (ErtsProcExitContext *) vctxt;
+ Process *c_p = ctxt->c_p;
+ Eterm reason = ctxt->reason;
ErtsMonitorData *mdp = NULL;
+ int res = 1;
if (erts_monitor_is_target(mon)) {
/* We are being watched... */
@@ -12090,43 +12181,48 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
case ERTS_MON_TYPE_DIST_PROC: {
ErtsMonLnkDist *dist;
DistEntry *dep;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
int code;
Eterm watcher;
Eterm watched;
- mdp = erts_monitor_to_data(mon);
+ if (is_immed(reason)) {
+ mdp = erts_monitor_to_data(mon);
- if (mon->flags & ERTS_ML_FLG_NAME)
- watched = ((ErtsMonitorDataExtended *) mdp)->u.name;
- else
- watched = c_p->common.id;
- ASSERT(is_internal_pid(watched) || is_atom(watched));
-
- watcher = mon->other.item;
- ASSERT(is_external_pid(watcher));
- dep = external_pid_dist_entry(watcher);
- ASSERT(dep);
- dist = ((ErtsMonitorDataExtended *) mdp)->dist;
- ASSERT(dist);
- code = erts_dsig_prepare(&dsd, dep, NULL, 0,
- ERTS_DSP_NO_LOCK, 0, 0);
- switch (code) {
- case ERTS_DSIG_PREP_CONNECTED:
- case ERTS_DSIG_PREP_PENDING:
- if (dist->connection_id == dsd.connection_id) {
- code = erts_dsig_send_m_exit(&dsd,
- watcher,
- watched,
- mdp->ref,
- reason);
- ASSERT(code == ERTS_DSIG_SEND_OK);
+ if (mon->flags & ERTS_ML_FLG_NAME)
+ watched = ((ErtsMonitorDataExtended *) mdp)->u.name;
+ else
+ watched = c_p->common.id;
+ ASSERT(is_internal_pid(watched) || is_atom(watched));
+
+ watcher = mon->other.item;
+ ASSERT(is_external_pid(watcher));
+ dep = external_pid_dist_entry(watcher);
+ ASSERT(dep);
+ dist = ((ErtsMonitorDataExtended *) mdp)->dist;
+ ASSERT(dist);
+ code = erts_dsig_prepare(&ctx, dep, NULL, 0,
+ ERTS_DSP_NO_LOCK, 1, 1, 0);
+ switch (code) {
+ case ERTS_DSIG_PREP_CONNECTED:
+ case ERTS_DSIG_PREP_PENDING:
+ if (dist->connection_id == ctx.connection_id) {
+ code = erts_dsig_send_m_exit(&ctx,
+ watcher,
+ watched,
+ mdp->ref,
+ reason);
+ ASSERT(code == ERTS_DSIG_SEND_OK);
+ }
+ default:
+ break;
}
- default:
- break;
+ if (!erts_monitor_dist_delete(&mdp->origin))
+ mdp = NULL;
+ } else {
+ erts_monitor_tree_insert(&ctxt->dist_monitors, mon);
+ return 1;
}
- if (!erts_monitor_dist_delete(&mdp->origin))
- mdp = NULL;
break;
}
default:
@@ -12168,7 +12264,7 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
case ERTS_MON_TYPE_DIST_PROC: {
ErtsMonLnkDist *dist;
DistEntry *dep;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
int code;
Eterm watched;
@@ -12185,17 +12281,16 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
ASSERT(is_external_pid(watched));
dep = external_pid_dist_entry(watched);
}
- code = erts_dsig_prepare(&dsd, dep, NULL, 0,
- ERTS_DSP_NO_LOCK, 0, 0);
+ code = erts_dsig_prepare(&ctx, dep, NULL, 0,
+ ERTS_DSP_NO_LOCK, 1, 1, 0);
switch (code) {
case ERTS_DSIG_PREP_CONNECTED:
case ERTS_DSIG_PREP_PENDING:
- if (dist->connection_id == dsd.connection_id) {
- code = erts_dsig_send_demonitor(&dsd,
+ if (dist->connection_id == ctx.connection_id) {
+ code = erts_dsig_send_demonitor(&ctx,
c_p->common.id,
watched,
- mdp->ref,
- 1);
+ mdp->ref);
ASSERT(code == ERTS_DSIG_SEND_OK);
}
default:
@@ -12203,6 +12298,7 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
}
if (!erts_monitor_dist_delete(&mdp->target))
mdp = NULL;
+ res = 100;
break;
}
default:
@@ -12215,11 +12311,84 @@ erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt)
erts_monitor_release_both(mdp);
else if (mon)
erts_monitor_release(mon);
+ return res;
}
-void
-erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt)
+static int
+erts_proc_exit_handle_dist_link(ErtsLink *lnk, void *vctxt, Sint reds)
+{
+ ErtsProcExitContext *ctxt = (ErtsProcExitContext *) vctxt;
+ Process *c_p = ctxt->c_p;
+ Eterm reason = ctxt->reason;
+ int code;
+ ErtsDSigSendContext ctx;
+ ErtsMonLnkDist *dist;
+ DistEntry *dep;
+ ErtsLink *dlnk;
+ ErtsLinkData *ldp = NULL;
+
+ ASSERT(lnk->type == ERTS_LNK_TYPE_DIST_PROC);
+ dlnk = erts_link_to_other(lnk, &ldp);
+ dist = ((ErtsLinkDataExtended *) ldp)->dist;
+
+ ASSERT(is_external_pid(lnk->other.item));
+ dep = external_pid_dist_entry(lnk->other.item);
+
+ ASSERT(dep != erts_this_dist_entry);
+
+ if (!erts_link_dist_delete(dlnk))
+ ldp = NULL;
+
+ code = erts_dsig_prepare(&ctx, dep, c_p, ERTS_PROC_LOCK_MAIN,
+ ERTS_DSP_NO_LOCK, 0, 0, 0);
+
+ ctx.reds = (Sint) (reds * TERM_TO_BINARY_LOOP_FACTOR);
+
+ switch (code) {
+ case ERTS_DSIG_PREP_NOT_ALIVE:
+ case ERTS_DSIG_PREP_NOT_CONNECTED:
+ break;
+ case ERTS_DSIG_PREP_PENDING:
+ case ERTS_DSIG_PREP_CONNECTED:
+ if (dist->connection_id != ctx.connection_id)
+ break;
+ code = erts_dsig_send_exit_tt(&ctx,
+ c_p->common.id,
+ lnk->other.item,
+ reason,
+ SEQ_TRACE_TOKEN(c_p));
+ switch (code) {
+ case ERTS_DSIG_SEND_CONTINUE:
+ erts_set_gc_state(c_p, 0);
+ ctxt->dist_state = erts_dsend_export_trap_context(c_p, &ctx);
+ /* fall-through */
+ case ERTS_DSIG_SEND_YIELD:
+ break;
+ case ERTS_DSIG_SEND_OK:
+ break;
+ case ERTS_DSIG_SEND_TOO_LRG:
+ erts_set_gc_state(c_p, 1);
+ break;
+ default:
+ ASSERT(! "Invalid dsig send exit monitor result");
+ break;
+ }
+ break;
+ default:
+ ASSERT(! "Invalid dsig prep exit monitor result");
+ break;
+ }
+ if (ldp)
+ erts_link_release_both(ldp);
+ else if (lnk)
+ erts_link_release(lnk);
+ return reds - (ctx.reds / TERM_TO_BINARY_LOOP_FACTOR);
+}
+
+int
+erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt, Sint reds)
{
+ ErtsProcExitContext *ctxt = (ErtsProcExitContext *) vctxt;
Process *c_p = ((ErtsProcExitContext *) vctxt)->c_p;
Eterm reason = ((ErtsProcExitContext *) vctxt)->reason;
ErtsLinkData *ldp = NULL;
@@ -12250,32 +12419,40 @@ erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt)
DistEntry *dep;
ErtsMonLnkDist *dist;
ErtsLink *dlnk;
- ErtsDSigData dsd;
+ ErtsDSigSendContext ctx;
int code;
- dlnk = erts_link_to_other(lnk, &ldp);
- dist = ((ErtsLinkDataExtended *) ldp)->dist;
+ if (is_immed(reason)) {
+ dlnk = erts_link_to_other(lnk, &ldp);
+ dist = ((ErtsLinkDataExtended *) ldp)->dist;
- ASSERT(is_external_pid(lnk->other.item));
- dep = external_pid_dist_entry(lnk->other.item);
+ ASSERT(is_external_pid(lnk->other.item));
+ dep = external_pid_dist_entry(lnk->other.item);
- ASSERT(dep != erts_this_dist_entry);
+ ASSERT(dep != erts_this_dist_entry);
- if (!erts_link_dist_delete(dlnk))
- ldp = NULL;
+ if (!erts_link_dist_delete(dlnk))
+ ldp = NULL;
- code = erts_dsig_prepare(&dsd, dep, c_p, 0, ERTS_DSP_NO_LOCK, 0, 0);
- switch (code) {
- case ERTS_DSIG_PREP_CONNECTED:
- case ERTS_DSIG_PREP_PENDING:
- if (dist->connection_id == dsd.connection_id) {
- code = erts_dsig_send_exit_tt(&dsd,
- c_p->common.id,
- lnk->other.item,
- reason,
- SEQ_TRACE_TOKEN(c_p));
- ASSERT(code == ERTS_DSIG_SEND_OK);
+ code = erts_dsig_prepare(&ctx, dep, c_p, 0, ERTS_DSP_NO_LOCK, 1, 1, 0);
+ switch (code) {
+ case ERTS_DSIG_PREP_CONNECTED:
+ case ERTS_DSIG_PREP_PENDING:
+ if (dist->connection_id == ctx.connection_id) {
+ code = erts_dsig_send_exit_tt(&ctx,
+ c_p->common.id,
+ lnk->other.item,
+ reason,
+ SEQ_TRACE_TOKEN(c_p));
+ ASSERT(code == ERTS_DSIG_SEND_OK);
+ }
+ break;
+ default:
+ break;
}
+ } else {
+ erts_link_tree_insert(&ctxt->dist_links, lnk);
+ return 1;
}
break;
}
@@ -12288,6 +12465,7 @@ erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt)
erts_link_release_both(ldp);
else if (lnk)
erts_link_release(lnk);
+ return 1;
}
/* this function fishishes a process and propagates exit messages - called
@@ -12321,11 +12499,8 @@ erts_do_exit_process(Process* p, Eterm reason)
set_self_exiting(p, reason, NULL, NULL, NULL);
- if (IS_TRACED(p)) {
- if (IS_TRACED_FL(p, F_TRACE_CALLS))
- erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING);
-
- }
+ if (IS_TRACED_FL(p, F_TRACE_CALLS))
+ erts_schedule_time_break(p, ERTS_BP_CALL_TIME_SCHEDULE_EXITING);
erts_trace_check_exiting(p->common.id);
@@ -12340,288 +12515,444 @@ erts_do_exit_process(Process* p, Eterm reason)
erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
- if (IS_TRACED_FL(p,F_TRACE_PROCS))
+ if (IS_TRACED_FL(p, F_TRACE_PROCS))
trace_proc(p, ERTS_PROC_LOCK_MAIN, p, am_exit, reason);
-
/*
* p->u.initial of this process can *not* be used anymore;
* will be overwritten by misc termination data.
*/
p->u.terminate = NULL;
+ BUMP_REDS(p, 100);
+
erts_continue_exit_process(p);
}
-void
-erts_continue_exit_process(Process *p)
-{
+enum continue_exit_phase {
+ ERTS_CONTINUE_EXIT_TIMERS,
+ ERTS_CONTINUE_EXIT_BLCKD_MSHED,
+ ERTS_CONTINUE_EXIT_BLCKD_NMSHED,
+ ERTS_CONTINUE_EXIT_USING_DB,
+ ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS,
+ ERTS_CONTINUE_EXIT_FREE,
+ ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS_AFTER,
+ ERTS_CONTINUE_EXIT_LINKS,
+ ERTS_CONTINUE_EXIT_MONITORS,
+ ERTS_CONTINUE_EXIT_LT_MONITORS,
+ ERTS_CONTINUE_EXIT_HANDLE_PROC_SIG,
+ ERTS_CONTINUE_EXIT_DIST_LINKS,
+ ERTS_CONTINUE_EXIT_DIST_MONITORS,
+ ERTS_CONTINUE_EXIT_DONE,
+};
+
+struct continue_exit_state {
+ enum continue_exit_phase phase;
ErtsLink *links;
ErtsMonitor *monitors;
ErtsMonitor *lt_monitors;
+ Eterm reason;
+ ErtsProcExitContext pectxt;
+ DistEntry *dep;
+ void *yield_state;
+};
+
+void
+erts_continue_exit_process(Process *p)
+{
+ struct continue_exit_state static_state, *trap_state = &static_state;
ErtsProcLocks curr_locks = ERTS_PROC_LOCK_MAIN;
- Eterm reason = p->fvalue;
- DistEntry *dep = NULL;
erts_aint32_t state;
int delay_del_proc = 0;
- ErtsProcExitContext pectxt;
-
+ Sint reds = ERTS_BIF_REDS_LEFT(p);
#ifdef DEBUG
int yield_allowed = 1;
#endif
+ if (p->u.terminate) {
+ trap_state = p->u.terminate;
+ } else {
+ trap_state->phase = ERTS_CONTINUE_EXIT_TIMERS;
+ trap_state->reason = p->fvalue;
+ trap_state->dep = NULL;
+ trap_state->yield_state = NULL;
+ }
+
ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p));
ASSERT(ERTS_PROC_IS_EXITING(p));
ASSERT(erts_proc_read_refc(p) > 0);
- if (p->bif_timers) {
- if (erts_cancel_bif_timers(p, &p->bif_timers, &p->u.terminate)) {
- ASSERT(erts_proc_read_refc(p) > 0);
- goto yield;
- }
- ASSERT(erts_proc_read_refc(p) > 0);
- p->bif_timers = NULL;
- }
-
- if (p->flags & F_SCHDLR_ONLN_WAITQ)
- abort_sched_onln_chng_waitq(p);
-
- if (p->flags & F_HAVE_BLCKD_MSCHED) {
- ErtsSchedSuspendResult ssr;
- ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 0, 1);
- switch (ssr) {
- case ERTS_SCHDLR_SSPND_YIELD_RESTART:
- goto yield;
- case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
- case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED:
- case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED:
- case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED:
- case ERTS_SCHDLR_SSPND_DONE:
- case ERTS_SCHDLR_SSPND_YIELD_DONE:
- p->flags &= ~F_HAVE_BLCKD_MSCHED;
- break;
- case ERTS_SCHDLR_SSPND_EINVAL:
- default:
- erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n",
- __FILE__, __LINE__, (int) ssr);
- }
- }
- if (p->flags & F_HAVE_BLCKD_NMSCHED) {
- ErtsSchedSuspendResult ssr;
- ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1, 1);
- switch (ssr) {
- case ERTS_SCHDLR_SSPND_YIELD_RESTART:
- goto yield;
- case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
- case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED:
- case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED:
- case ERTS_SCHDLR_SSPND_YIELD_DONE_NMSCHED_BLOCKED:
- case ERTS_SCHDLR_SSPND_DONE:
- case ERTS_SCHDLR_SSPND_YIELD_DONE:
- p->flags &= ~F_HAVE_BLCKD_MSCHED;
- break;
- case ERTS_SCHDLR_SSPND_EINVAL:
- default:
- erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n",
- __FILE__, __LINE__, (int) ssr);
- }
- }
+restart:
+ switch (trap_state->phase) {
+ case ERTS_CONTINUE_EXIT_TIMERS:
+ if (p->bif_timers) {
+ reds = erts_cancel_bif_timers(p, &p->bif_timers, &trap_state->yield_state, reds);
+ if (reds <= 0) goto yield;
+ p->bif_timers = NULL;
+ }
- if (p->flags & F_USING_DB) {
- if (erts_db_process_exiting(p, ERTS_PROC_LOCK_MAIN))
- goto yield;
- p->flags &= ~F_USING_DB;
- }
+ if (p->flags & F_SCHDLR_ONLN_WAITQ) {
+ abort_sched_onln_chng_waitq(p);
+ reds -= 100;
+ }
- erts_set_gc_state(p, 1);
- state = erts_atomic32_read_acqb(&p->state);
- if ((state & ERTS_PSFLG_SYS_TASKS) || p->dirty_sys_tasks) {
- if (cleanup_sys_tasks(p, state, CONTEXT_REDS) >= CONTEXT_REDS/2)
- goto yield;
- }
+ trap_state->phase = ERTS_CONTINUE_EXIT_BLCKD_MSHED;
+ if (reds <= 0) goto yield;
+ case ERTS_CONTINUE_EXIT_BLCKD_MSHED:
+
+ if (p->flags & F_HAVE_BLCKD_MSCHED) {
+ ErtsSchedSuspendResult ssr;
+ ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 0, 1);
+ switch (ssr) {
+ case ERTS_SCHDLR_SSPND_DONE:
+ case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
+ case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED:
+ p->flags &= ~F_HAVE_BLCKD_MSCHED;
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n",
+ __FILE__, __LINE__, (int) ssr);
+ }
+ reds -= 100;
+ }
-#ifdef DEBUG
- erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
- ASSERT(ERTS_PROC_GET_DELAYED_GC_TASK_QS(p) == NULL);
- ASSERT(p->dirty_sys_tasks == NULL);
- erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
-#endif
+ trap_state->phase = ERTS_CONTINUE_EXIT_BLCKD_NMSHED;
+ if (reds <= 0) goto yield;
+ case ERTS_CONTINUE_EXIT_BLCKD_NMSHED:
+
+ if (p->flags & F_HAVE_BLCKD_NMSCHED) {
+ ErtsSchedSuspendResult ssr;
+ ssr = erts_block_multi_scheduling(p, ERTS_PROC_LOCK_MAIN, 0, 1, 1);
+ switch (ssr) {
+ case ERTS_SCHDLR_SSPND_DONE:
+ case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED:
+ case ERTS_SCHDLR_SSPND_DONE_NMSCHED_BLOCKED:
+ p->flags &= ~F_HAVE_BLCKD_MSCHED;
+ break;
+ default:
+ erts_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error: %d\n",
+ __FILE__, __LINE__, (int) ssr);
+ }
+ reds -= 100;
+ }
- if (p->flags & F_USING_DDLL) {
- erts_ddll_proc_dead(p, ERTS_PROC_LOCK_MAIN);
- p->flags &= ~F_USING_DDLL;
- }
+ trap_state->yield_state = NULL;
+ trap_state->phase = ERTS_CONTINUE_EXIT_USING_DB;
+ if (reds <= 0) goto yield;
+ case ERTS_CONTINUE_EXIT_USING_DB:
- /*
- * The registered name *should* be the last "erlang resource" to
- * cleanup.
- */
- if (p->common.u.alive.reg) {
- (void) erts_unregister_name(p, ERTS_PROC_LOCK_MAIN, NULL, THE_NON_VALUE);
- ASSERT(!p->common.u.alive.reg);
- }
+ if (p->flags & F_USING_DB) {
+ if (erts_db_process_exiting(p, ERTS_PROC_LOCK_MAIN, &trap_state->yield_state))
+ goto yield;
+ p->flags &= ~F_USING_DB;
+ }
- if (IS_TRACED_FL(p, F_TRACE_SCHED_EXIT))
- trace_sched(p, curr_locks, am_out_exited);
+ erts_set_gc_state(p, 1);
- erts_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
- curr_locks = ERTS_PROC_LOCKS_ALL;
+ trap_state->phase = ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS;
+ case ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS:
+
+ state = erts_atomic32_read_acqb(&p->state);
+ if ((state & ERTS_PSFLG_SYS_TASKS) || p->dirty_sys_tasks) {
+ reds -= cleanup_sys_tasks(p, state, reds);
+ if (reds <= 0) goto yield;
+ }
+
+ trap_state->phase = ERTS_CONTINUE_EXIT_FREE;
+ case ERTS_CONTINUE_EXIT_FREE:
- /*
- * From this point on we are no longer allowed to yield
- * this process.
- */
#ifdef DEBUG
- yield_allowed = 0;
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ ASSERT(ERTS_PROC_GET_DELAYED_GC_TASK_QS(p) == NULL);
+ ASSERT(p->dirty_sys_tasks == NULL);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
#endif
- /*
- * Note! The monitor and link fields will be overwritten
- * by erts_ptab_delete_element() below.
- */
- links = ERTS_P_LINKS(p);
- monitors = ERTS_P_MONITORS(p);
- lt_monitors = ERTS_P_LT_MONITORS(p);
+ if (p->flags & F_USING_DDLL) {
+ erts_ddll_proc_dead(p, ERTS_PROC_LOCK_MAIN);
+ p->flags &= ~F_USING_DDLL;
+ }
- {
- /* Do *not* use erts_get_runq_proc() */
- ErtsRunQueue *rq;
- rq = erts_get_runq_current(erts_proc_sched_data(p));
+ /*
+ * The registered name *should* be the last "erlang resource" to
+ * cleanup.
+ */
+ if (p->common.u.alive.reg) {
+ (void) erts_unregister_name(p, ERTS_PROC_LOCK_MAIN, NULL, THE_NON_VALUE);
+ ASSERT(!p->common.u.alive.reg);
+ }
- erts_runq_lock(rq);
+ erts_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+ curr_locks = ERTS_PROC_LOCKS_ALL;
- ASSERT(p->scheduler_data);
- ASSERT(p->scheduler_data->current_process == p);
- ASSERT(p->scheduler_data->free_process == NULL);
+ /*
+ * Note! The monitor and link fields will be overwritten
+ * by erts_ptab_delete_element() below.
+ */
+ trap_state->links = ERTS_P_LINKS(p);
+ trap_state->monitors = ERTS_P_MONITORS(p);
+ trap_state->lt_monitors = ERTS_P_LT_MONITORS(p);
- p->scheduler_data->current_process = NULL;
- p->scheduler_data->free_process = p;
+ {
+ /* Do *not* use erts_get_runq_proc() */
+ ErtsRunQueue *rq;
+ rq = erts_get_runq_current(erts_proc_sched_data(p));
- /* Time of death! */
- erts_ptab_delete_element(&erts_proc, &p->common);
+ erts_runq_lock(rq);
- erts_runq_unlock(rq);
- }
+ ASSERT(p->scheduler_data);
+ ASSERT(p->scheduler_data->current_process == p);
+ ASSERT(p->scheduler_data->free_process == NULL);
- /*
- * All "erlang resources" have to be deallocated before this point,
- * e.g. registered name, so monitoring and linked processes can
- * be sure that all interesting resources have been deallocated
- * when the monitors and/or links hit.
- */
+ /* Time of death! */
+ erts_ptab_delete_element(&erts_proc, &p->common);
- {
- /* Inactivate and notify free */
- erts_aint32_t n, e, a = erts_atomic32_read_nob(&p->state);
- int refc_inced = 0;
- while (1) {
- n = e = a;
- ASSERT(a & ERTS_PSFLG_EXITING);
- n |= ERTS_PSFLG_FREE;
- n &= ~(ERTS_PSFLG_ACTIVE
- | ERTS_PSFLG_ACTIVE_SYS
- | ERTS_PSFLG_DIRTY_ACTIVE_SYS);
- if ((n & ERTS_PSFLG_IN_RUNQ) && !refc_inced) {
- erts_proc_inc_refc(p);
- refc_inced = 1;
- }
- a = erts_atomic32_cmpxchg_mb(&p->state, n, e);
- if (a == e)
- break;
- }
+ erts_runq_unlock(rq);
+ }
- if (a & (ERTS_PSFLG_DIRTY_RUNNING
- | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
- p->flags |= F_DELAYED_DEL_PROC;
- delay_del_proc = 1;
- /*
- * The dirty scheduler decrease refc
- * when done with the process...
- */
- }
+ /*
+ * All "erlang resources" have to be deallocated before this point,
+ * e.g. registered name, so monitoring and linked processes can
+ * be sure that all interesting resources have been deallocated
+ * when the monitors and/or links hit.
+ */
- if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ))
- erts_proc_dec_refc(p);
- }
+ {
+ /* Inactivate and notify free */
+ erts_aint32_t n, e, a = erts_atomic32_read_nob(&p->state);
+ int refc_inced = 0;
+ while (1) {
+ n = e = a;
+ ASSERT(a & ERTS_PSFLG_EXITING);
+ n |= ERTS_PSFLG_FREE;
+ if ((n & ERTS_PSFLG_IN_RUNQ) && !refc_inced) {
+ erts_proc_inc_refc(p);
+ refc_inced = 1;
+ }
+ a = erts_atomic32_cmpxchg_mb(&p->state, n, e);
+ if (a == e)
+ break;
+ }
- dep = ((p->flags & F_DISTRIBUTION)
- ? ERTS_PROC_SET_DIST_ENTRY(p, NULL)
- : NULL);
+ if (refc_inced && !(n & ERTS_PSFLG_IN_RUNQ))
+ erts_proc_dec_refc(p);
+ }
+ trap_state->dep = ((p->flags & F_DISTRIBUTION)
+ ? ERTS_PROC_SET_DIST_ENTRY(p, NULL)
+ : NULL);
+
+ reds -= 50;
- /*
- * It might show up signal prio elevation tasks until we
- * have entered free state. Cleanup such tasks now.
- */
- state = erts_atomic32_read_acqb(&p->state);
- if (!(state & ERTS_PSFLG_SYS_TASKS))
- erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL);
- else {
erts_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR);
+ curr_locks = ERTS_PROC_LOCK_MAIN;
+ trap_state->phase = ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS_AFTER;
+ case ERTS_CONTINUE_EXIT_CLEAN_SYS_TASKS_AFTER:
+ /*
+ * It might show up signal prio elevation tasks until we
+ * have entered free state. Cleanup such tasks now.
+ */
- do {
- (void) cleanup_sys_tasks(p, state, CONTEXT_REDS);
- state = erts_atomic32_read_acqb(&p->state);
- } while (state & ERTS_PSFLG_SYS_TASKS);
-
- erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
- }
+ state = erts_atomic32_read_acqb(&p->state);
+ if ((state & ERTS_PSFLG_SYS_TASKS) || p->dirty_sys_tasks) {
+ reds -= cleanup_sys_tasks(p, state, reds);
+ if (reds <= 0) goto yield;
+ }
+
+ /* Needs to be unlocked for erts_do_net_exits to work?!? */
+ // erts_proc_unlock(p, ERTS_PROC_LOCK_MAIN);
#ifdef DEBUG
- erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
- ASSERT(p->sys_task_qs == NULL);
- erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
+ ASSERT(p->sys_task_qs == NULL);
+ erts_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
#endif
- if (dep) {
- erts_do_net_exits(dep, (reason == am_kill) ? am_killed : reason);
- erts_deref_dist_entry(dep);
- }
+ if (trap_state->dep) {
+ erts_do_net_exits(trap_state->dep,
+ (trap_state->reason == am_kill) ? am_killed : trap_state->reason);
+ erts_deref_dist_entry(trap_state->dep);
+ }
- pectxt.c_p = p;
- pectxt.reason = reason;
+ trap_state->pectxt.c_p = p;
+ trap_state->pectxt.reason = trap_state->reason;
+ trap_state->pectxt.dist_links = NULL;
+ trap_state->pectxt.dist_monitors = NULL;
+ trap_state->pectxt.dist_state = NIL;
+
+ erts_proc_lock(p, ERTS_PROC_LOCK_MSGQ);
+
+ erts_proc_sig_fetch(p);
+
+ erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
+
+ trap_state->yield_state = NULL;
+ trap_state->phase = ERTS_CONTINUE_EXIT_LINKS;
+ if (reds <= 0) goto yield;
+ case ERTS_CONTINUE_EXIT_LINKS:
+
+ reds = erts_link_tree_foreach_delete_yielding(
+ &trap_state->links,
+ erts_proc_exit_handle_link,
+ (void *) &trap_state->pectxt,
+ &trap_state->yield_state,
+ reds);
+ if (reds <= 0)
+ goto yield;
+
+ ASSERT(!trap_state->links);
+ trap_state->yield_state = NULL;
+ trap_state->phase = ERTS_CONTINUE_EXIT_MONITORS;
+ case ERTS_CONTINUE_EXIT_MONITORS:
+
+ reds = erts_monitor_tree_foreach_delete_yielding(
+ &trap_state->monitors,
+ erts_proc_exit_handle_monitor,
+ (void *) &trap_state->pectxt,
+ &trap_state->yield_state,
+ reds);
+ if (reds <= 0)
+ goto yield;
+
+ ASSERT(!trap_state->monitors);
+ trap_state->yield_state = NULL;
+ trap_state->phase = ERTS_CONTINUE_EXIT_LT_MONITORS;
+ case ERTS_CONTINUE_EXIT_LT_MONITORS:
+
+ reds = erts_monitor_list_foreach_delete_yielding(
+ &trap_state->lt_monitors,
+ erts_proc_exit_handle_monitor,
+ (void *) &trap_state->pectxt,
+ &trap_state->yield_state,
+ reds);
+ if (reds <= 0)
+ goto yield;
+
+ ASSERT(!trap_state->lt_monitors);
+ trap_state->phase = ERTS_CONTINUE_EXIT_HANDLE_PROC_SIG;
+ case ERTS_CONTINUE_EXIT_HANDLE_PROC_SIG: {
+ Sint r = reds;
+
+ if (!erts_proc_sig_handle_exit(p, &r))
+ goto yield;
+
+ reds -= r;
+
+ trap_state->phase = ERTS_CONTINUE_EXIT_DIST_LINKS;
+ }
+ case ERTS_CONTINUE_EXIT_DIST_LINKS: {
+
+ continue_dist_send:
+ if (is_not_nil(trap_state->pectxt.dist_state)) {
+ Binary* bin = erts_magic_ref2bin(trap_state->pectxt.dist_state);
+ ErtsDSigSendContext* ctx = (ErtsDSigSendContext*) ERTS_MAGIC_BIN_DATA(bin);
+ Sint initial_reds = (Sint) (ERTS_BIF_REDS_LEFT(p) * TERM_TO_BINARY_LOOP_FACTOR);
+ int result;
+
+ ctx->reds = initial_reds;
+ result = erts_dsig_send(ctx);
+
+ /* erts_dsig_send bumps reductions on the process in the ctx */
+ reds = ERTS_BIF_REDS_LEFT(p);
+
+ switch (result) {
+ case ERTS_DSIG_SEND_OK:
+ case ERTS_DSIG_SEND_TOO_LRG: /*SEND_SYSTEM_LIMIT*/
+ case ERTS_DSIG_SEND_YIELD: /*SEND_YIELD_RETURN*/
+ break;
+ case ERTS_DSIG_SEND_CONTINUE: { /*SEND_YIELD_CONTINUE*/
+ goto yield;
+ }
+ }
+ erts_set_gc_state(p, 1);
+ trap_state->pectxt.dist_state = NIL;
+ if (reds <= 0)
+ goto yield;
+ goto restart;
+ }
- erts_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ);
+ reds = erts_link_tree_foreach_delete_yielding(
+ &trap_state->pectxt.dist_links,
+ erts_proc_exit_handle_dist_link,
+ (void *) &trap_state->pectxt,
+ &trap_state->yield_state,
+ reds);
+ if (reds <= 0 || is_not_nil(trap_state->pectxt.dist_state))
+ goto yield;
+ trap_state->phase = ERTS_CONTINUE_EXIT_DIST_MONITORS;
+ }
+ case ERTS_CONTINUE_EXIT_DIST_MONITORS: {
+
+ if (is_not_nil(trap_state->pectxt.dist_state))
+ goto continue_dist_send;
+
+ reds = erts_monitor_tree_foreach_delete_yielding(
+ &trap_state->pectxt.dist_monitors,
+ erts_proc_exit_handle_dist_monitor,
+ (void *) &trap_state->pectxt,
+ &trap_state->yield_state,
+ reds);
+ if (reds <= 0 || is_not_nil(trap_state->pectxt.dist_state))
+ goto yield;
+
+ trap_state->phase = ERTS_CONTINUE_EXIT_DONE;
+ }
+ case ERTS_CONTINUE_EXIT_DONE: {
+ erts_aint_t state;
+ /*
+ * From this point on we are no longer allowed to yield
+ * this process.
+ */
- erts_proc_sig_fetch(p);
+#ifdef DEBUG
+ yield_allowed = 0;
+#endif
- erts_proc_unlock(p, ERTS_PROC_LOCK_MSGQ);
+ /* Set state to not active as we don't want this process
+ to be scheduled in again after this. */
+ state = erts_atomic32_read_band_relb(&p->state,
+ ~(ERTS_PSFLG_ACTIVE
+ | ERTS_PSFLG_ACTIVE_SYS
+ | ERTS_PSFLG_DIRTY_ACTIVE_SYS));
- if (links) {
- erts_link_tree_foreach_delete(&links,
- erts_proc_exit_handle_link,
- (void *) &pectxt);
- ASSERT(!links);
- }
+ ASSERT(p->scheduler_data);
+ ASSERT(p->scheduler_data->current_process == p);
+ ASSERT(p->scheduler_data->free_process == NULL);
- if (monitors) {
- erts_monitor_tree_foreach_delete(&monitors,
- erts_proc_exit_handle_monitor,
- (void *) &pectxt);
- ASSERT(!monitors);
- }
+ p->scheduler_data->current_process = NULL;
+ p->scheduler_data->free_process = p;
- if (lt_monitors) {
- erts_monitor_list_foreach_delete(&lt_monitors,
- erts_proc_exit_handle_monitor,
- (void *) &pectxt);
- ASSERT(!lt_monitors);
- }
+ if (state & (ERTS_PSFLG_DIRTY_RUNNING
+ | ERTS_PSFLG_DIRTY_RUNNING_SYS)) {
+ p->flags |= F_DELAYED_DEL_PROC;
+ delay_del_proc = 1;
+ /*
+ * The dirty scheduler decrease refc
+ * when done with the process...
+ */
+ }
- /*
- * erts_proc_sig_handle_exit() implements yielding.
- * However, this function cannot handle it yet... loop
- * until done...
- */
- while (!0) {
- int reds = CONTEXT_REDS;
- if (erts_proc_sig_handle_exit(p, &reds))
- break;
+ erts_schedule_thr_prgr_later_cleanup_op(
+ (void (*)(void*))erts_proc_dec_refc,
+ (void *) &p->common,
+ &p->common.u.release,
+ sizeof(Process));
+
+ break;
+ }
}
+ if (trap_state != &static_state) {
+ erts_free(ERTS_ALC_T_CONT_EXIT_TRAP, trap_state);
+ p->u.terminate = NULL;
+ }
+
ERTS_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p);
+ if (IS_TRACED_FL(p, F_TRACE_SCHED_EXIT))
+ trace_sched(p, curr_locks, am_out_exited);
+
erts_flush_trace_messages(p, ERTS_PROC_LOCK_MAIN);
ERTS_TRACER_CLEAR(&ERTS_TRACER(p));
@@ -12637,9 +12968,26 @@ erts_continue_exit_process(Process *p)
ERTS_LC_ASSERT(curr_locks == erts_proc_lc_my_proc_locks(p));
ERTS_LC_ASSERT(ERTS_PROC_LOCK_MAIN & curr_locks);
+ ASSERT(erts_proc_read_refc(p) > 0);
+
+ if (trap_state == &static_state) {
+ trap_state = erts_alloc(ERTS_ALC_T_CONT_EXIT_TRAP, sizeof(*trap_state));
+ sys_memcpy(trap_state, &static_state, sizeof(*trap_state));
+ p->u.terminate = trap_state;
+ }
+
+ ASSERT(p->scheduler_data);
+ ASSERT(p->scheduler_data->current_process == p);
+ ASSERT(p->scheduler_data->free_process == NULL);
+
+ if (trap_state->phase >= ERTS_CONTINUE_EXIT_FREE) {
+ p->scheduler_data->current_process = NULL;
+ p->scheduler_data->free_process = p;
+ }
p->i = (BeamInstr *) beam_continue_exit;
+ /* Why is this lock take??? */
if (!(curr_locks & ERTS_PROC_LOCK_STATUS)) {
erts_proc_lock(p, ERTS_PROC_LOCK_STATUS);
curr_locks |= ERTS_PROC_LOCK_STATUS;
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 43937f216c..3b593bce02 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -381,7 +381,10 @@ struct ErtsSchedulerSleepInfo_ {
typedef struct ErtsProcList_ ErtsProcList;
struct ErtsProcList_ {
- Eterm pid;
+ union {
+ Eterm pid;
+ Process *p;
+ } u;
Uint64 started_interval;
ErtsProcList* next;
ErtsProcList* prev;
@@ -1580,7 +1583,7 @@ ERTS_GLB_INLINE int erts_proclist_is_last(ErtsProcList *, ErtsProcList *);
ERTS_GLB_INLINE int
erts_proclist_same(ErtsProcList *plp, Process *p)
{
- return (plp->pid == p->common.id
+ return ((plp->u.pid == p->common.id || plp->u.p == p)
&& (plp->started_interval
== p->common.u.alive.started_interval));
}
@@ -1819,9 +1822,12 @@ Eterm erts_process_info(Process *c_p, ErtsHeapFactory *hfact,
typedef struct {
Process *c_p;
Eterm reason;
+ ErtsLink *dist_links;
+ ErtsMonitor *dist_monitors;
+ Eterm dist_state;
} ErtsProcExitContext;
-void erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt);
-void erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt);
+int erts_proc_exit_handle_monitor(ErtsMonitor *mon, void *vctxt, Sint reds);
+int erts_proc_exit_handle_link(ErtsLink *lnk, void *vctxt, Sint reds);
Eterm erts_get_process_priority(erts_aint32_t state);
Eterm erts_set_process_priority(Process *p, Eterm prio);
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 10ea401022..a164ed543e 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -100,16 +100,18 @@ erts_deep_process_dump(fmtfn_t to, void *to_arg)
dump_binaries(to, to_arg, all_binaries);
}
-static void
-monitor_size(ErtsMonitor *mon, void *vsize)
+static int
+monitor_size(ErtsMonitor *mon, void *vsize, Sint reds)
{
*((Uint *) vsize) += erts_monitor_size(mon);
+ return 1;
}
-static void
-link_size(ErtsMonitor *lnk, void *vsize)
+static int
+link_size(ErtsMonitor *lnk, void *vsize, Sint reds)
{
*((Uint *) vsize) += erts_link_size(lnk);
+ return 1;
}
Uint erts_process_memory(Process *p, int include_sigs_in_transit)
@@ -189,11 +191,11 @@ static ERTS_INLINE void
dump_msg(fmtfn_t to, void *to_arg, ErtsMessage *mp)
{
if (ERTS_SIG_IS_MSG((ErtsSignal *) mp)) {
- Eterm mesg = ERL_MESSAGE_TERM(mp);
- if (is_value(mesg))
- dump_element(to, to_arg, mesg);
+ Eterm mesg;
+ if (ERTS_SIG_IS_INTERNAL_MSG(mp))
+ dump_element(to, to_arg, ERL_MESSAGE_TERM(mp));
else
- dump_dist_ext(to, to_arg, mp->data.dist_ext);
+ dump_dist_ext(to, to_arg, erts_get_dist_ext(mp->data.heap_frag));
mesg = ERL_MESSAGE_TOKEN(mp);
erts_print(to, to_arg, ":");
dump_element(to, to_arg, mesg);
@@ -265,6 +267,7 @@ dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep)
else {
byte *e;
size_t sz;
+ int i;
if (!(edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB))
erts_print(to, to_arg, "D0:");
@@ -274,8 +277,8 @@ dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep)
for (i = 0; i < edep->attab.size; i++)
dump_element(to, to_arg, edep->attab.atom[i]);
}
- sz = edep->ext_endp - edep->extp;
- e = edep->extp;
+ sz = edep->data->ext_endp - edep->data->extp;
+ e = edep->data->extp;
if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) {
ASSERT(*e != VERSION_MAGIC);
sz++;
@@ -286,15 +289,19 @@ dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep)
erts_print(to, to_arg, "E%X:", sz);
if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) {
byte sbuf[3];
- int i = 0;
+
+ i = 0;
sbuf[i++] = VERSION_MAGIC;
- while (i < sizeof(sbuf) && e < edep->ext_endp) {
+ while (i < sizeof(sbuf) && e < edep->data->ext_endp) {
sbuf[i++] = *e++;
}
erts_print_base64(to, to_arg, sbuf, i);
}
- erts_print_base64(to, to_arg, e, edep->ext_endp - e);
+ erts_print_base64(to, to_arg, e, edep->data->ext_endp - e);
+ for (i = 1; i < edep->data->frag_id; i++)
+ erts_print_base64(to, to_arg, edep->data[i].extp,
+ edep->data[i].ext_endp - edep->data[i].extp);
}
}
diff --git a/erts/emulator/beam/erl_ptab.h b/erts/emulator/beam/erl_ptab.h
index 94f0247492..c30a684002 100644
--- a/erts/emulator/beam/erl_ptab.h
+++ b/erts/emulator/beam/erl_ptab.h
@@ -68,8 +68,11 @@ typedef struct {
Uint64 started_interval;
struct reg_proc *reg;
ErtsLink *links;
- ErtsMonitor *monitors;
+ /* Local target monitors, double linked list
+ contains the remote part of local monitors */
ErtsMonitor *lt_monitors;
+ /* other monitors, rb tree */
+ ErtsMonitor *monitors;
} alive;
/* --- While being released --- */
diff --git a/erts/emulator/beam/erl_rbtree.h b/erts/emulator/beam/erl_rbtree.h
index e50abf5cec..ce401fa7e7 100644
--- a/erts/emulator/beam/erl_rbtree.h
+++ b/erts/emulator/beam/erl_rbtree.h
@@ -161,7 +161,7 @@
*
* - void <ERTS_RBT_PREFIX>_rbt_foreach(
* ERTS_RBT_T *tree,
- * void (*op)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
* void *arg);
* Operate by calling the operator 'op' on each element.
* Order is undefined.
@@ -170,7 +170,7 @@
*
* - void <ERTS_RBT_PREFIX>_rbt_foreach_destroy(
* ERTS_RBT_T *tree,
- * void (*op)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
* void *arg);
* Operate by calling the operator 'op' on each element.
* Order is undefined. Each element should be destroyed
@@ -180,39 +180,46 @@
*
* - int <ERTS_RBT_PREFIX>_rbt_foreach_yielding(
* ERTS_RBT_T *tree,
- * void (*op)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
* void *arg,
* <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
- * Sint ylimit);
+ * Sint reds);
* Operate by calling the operator 'op' on each element.
* Order is undefined.
*
- * Yield when 'ylimit' elements has been processed. True is
- * returned when yielding, and false is returned when
- * the whole tree has been processed. The tree should not be
- * modified until all of it has been processed.
+ * Yield when 'reds' reductions has been processed. The 'op'
+ * function return the number of reductions that each element
+ * took to process. The number of reductions remaining is returned,
+ * meaning that if 0 is returned, there are more elements to be
+ * processed. If a value greater than 0 is returned the foreach has
+ * ended. The tree should not be modified until all of it has been
+ * processed.
*
* 'arg' is passed as argument to 'op'.
*
* - int <ERTS_RBT_PREFIX>_rbt_foreach_destroy_yielding(
* ERTS_RBT_T *tree,
- * void (*op)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
* void *arg,
* <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
- * Sint ylimit);
+ * Sint reds);
* Operate by calling the operator 'op' on each element.
* Order is undefined. Each element should be destroyed
* by 'op'.
*
- * Yield when 'ylimit' elements has been processed. True is
- * returned when yielding, and false is returned when
- * the whole tree has been processed.
+ * Yield when 'reds' reductions has been processed. The 'op'
+ * function return the number of reductions that each element
+ * took to process. The number of reductions remaining is returned,
+ * meaning that if 0 is returned, there are more elements to be
+ * processed. If a value greater than 0 is returned the foreach has
+ * ended. The tree should not be modified until all of it has been
+ * processed.
*
* 'arg' is passed as argument to 'op'.
*
* - void <ERTS_RBT_PREFIX>_rbt_foreach_small(
* ERTS_RBT_T *tree,
- * void (*op)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
* void *arg);
* Operate by calling the operator 'op' on each element from
* smallest towards larger elements.
@@ -221,7 +228,7 @@
*
* - void <ERTS_RBT_PREFIX>_rbt_foreach_large(
* ERTS_RBT_T *tree,
- * void (*op)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
* void *arg);
* Operate by calling the operator 'op' on each element from
* largest towards smaller elements.
@@ -230,40 +237,46 @@
*
* - int <ERTS_RBT_PREFIX>_rbt_foreach_small_yielding(
* ERTS_RBT_T *tree,
- * void (*op)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
* void *arg,
* <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
- * Sint ylimit);
+ * Sint reds);
* Operate by calling the operator 'op' on each element from
* smallest towards larger elements.
*
- * Yield when 'ylimit' elements has been processed. True is
- * returned when yielding, and false is returned when
- * the whole tree has been processed. The tree should not be
- * modified until all of it has been processed.
+ * Yield when 'reds' reductions has been processed. The 'op'
+ * function return the number of reductions that each element
+ * took to process. The number of reductions remaining is returned,
+ * meaning that if 0 is returned, there are more elements to be
+ * processed. If a value greater than 0 is returned the foreach has
+ * ended. The tree should not be modified until all of it has been
+ * processed.
*
* 'arg' is passed as argument to 'op'.
*
* - int <ERTS_RBT_PREFIX>_rbt_foreach_large_yielding(
* ERTS_RBT_T *tree,
- * void (*op)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
* void *arg,
* <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
- * Sint ylimit);
+ * Sint reds);
* Operate by calling the operator 'op' on each element from
* largest towards smaller elements.
*
- * Yield when 'ylimit' elements has been processed. True is
- * returned when yielding, and false is returned when
- * the whole tree has been processed. The tree should not be
- * modified until all of it has been processed.
+ * Yield when 'reds' reductions has been processed. The 'op'
+ * function return the number of reductions that each element
+ * took to process. The number of reductions remaining is returned,
+ * meaning that if 0 is returned, there are more elements to be
+ * processed. If a value greater than 0 is returned the foreach has
+ * ended. The tree should not be modified until all of it has been
+ * processed.
*
* 'arg' is passed as argument to 'op'.
*
* - void <ERTS_RBT_PREFIX>_rbt_foreach_small_destroy(
* ERTS_RBT_T **tree,
- * void (*op)(ERTS_RBT_T *, void *),
- * void (*destr)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
+ * int (*destr)(ERTS_RBT_T *, void *),
* void *arg);
* Operate by calling the operator 'op' on each element from
* smallest towards larger elements.
@@ -277,8 +290,8 @@
*
* - void <ERTS_RBT_PREFIX>_rbt_foreach_large_destroy(
* ERTS_RBT_T **tree,
- * void (*op)(ERTS_RBT_T *, void *),
- * void (*destr)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
+ * int (*destr)(ERTS_RBT_T *, void *),
* void *arg);
* Operate by calling the operator 'op' on each element from
* largest towards smaller elements.
@@ -292,11 +305,11 @@
*
* - int <ERTS_RBT_PREFIX>_rbt_foreach_small_destroy_yielding(
* ERTS_RBT_T **tree,
- * void (*op)(ERTS_RBT_T *, void *),
- * void (*destr)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
+ * int (*destr)(ERTS_RBT_T *, void *),
* void *arg,
* <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
- * Sint ylimit);
+ * Sint reds);
* Operate by calling the operator 'op' on each element from
* smallest towards larger elements.
*
@@ -305,20 +318,23 @@
* Note that elements are often destroyed in another order
* than the order that the elements are operated on.
*
- * Yield when 'ylimit' elements has been processed. True is
- * returned when yielding, and false is returned when
- * the whole tree has been processed. The tree should not be
- * modified until all of it has been processed.
+ * Yield when 'reds' reductions has been processed. The 'op' and
+ * 'destr' functions return the number of reductions that each element
+ * took to process. The number of reductions remaining is returned,
+ * meaning that if 0 is returned, there are more elements to be
+ * processed. If a value greater than 0 is returned the foreach has
+ * ended. The tree should not be modified until all of it has been
+ * processed.
*
* 'arg' is passed as argument to 'op' and 'destroy'.
*
* - int <ERTS_RBT_PREFIX>_rbt_foreach_large_destroy_yielding(
* ERTS_RBT_T **tree,
- * void (*op)(ERTS_RBT_T *, void *),
- * void (*destr)(ERTS_RBT_T *, void *),
+ * int (*op)(ERTS_RBT_T *, void *),
+ * int (*destr)(ERTS_RBT_T *, void *),
* void *arg,
* <ERTS_RBT_PREFIX>_rbt_yield_state_t *ystate,
- * Sint ylimit);
+ * Sint reds);
* Operate by calling the operator 'op' on each element from
* largest towards smaller elements.
*
@@ -327,10 +343,13 @@
* Note that elements are often destroyed in another order
* than the order that the elements are operated on.
*
- * Yield when 'ylimit' elements has been processed. True is
- * returned when yielding, and false is returned when
- * the whole tree has been processed. The tree should not be
- * modified until all of it has been processed.
+ * Yield when 'reds' reductions has been processed. The 'op' and
+ * 'destr' functions return the number of reductions that each element
+ * took to process. The number of reductions remaining is returned,
+ * meaning that if 0 is returned, there are more elements to be
+ * processed. If a value greater than 0 is returned the foreach has
+ * ended. The tree should not be modified until all of it has been
+ * processed.
*
* 'arg' is passed as argument to 'op' and 'destroy'.
*
@@ -447,17 +466,6 @@
# define ERTS_RBT_API_INLINE__ ERTS_INLINE
#endif
-#ifndef ERTS_RBT_YIELD_STAT_INITER
-# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0}
-#endif
-#ifndef ERTS_RBT_YIELD_STAT_INIT
-# define ERTS_RBT_YIELD_STAT_INIT(YS) \
- do { \
- (YS)->x = NULL; \
- (YS)->up = 0; \
- } while (0)
-#endif
-
#define ERTS_RBT_CONCAT_MACRO_VALUES___(X, Y) \
X ## Y
#define ERTS_RBT_CONCAT_MACRO_VALUES__(X, Y) \
@@ -470,8 +478,38 @@
typedef struct {
ERTS_RBT_T *x;
int up;
+#ifdef DEBUG
+ int debug_red_adj;
+#endif
} ERTS_RBT_YIELD_STATE_T__;
+#define ERTS_RBT_CALLBACK_FOREACH_FUNC(NAME) int (*NAME)(ERTS_RBT_T *, void *, Sint)
+
+#ifndef ERTS_RBT_YIELD_STAT_INITER
+# ifdef DEBUG
+# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0, CONTEXT_REDS}
+# else
+# define ERTS_RBT_YIELD_STAT_INITER {NULL, 0}
+# endif
+#endif
+#ifndef ERTS_RBT_YIELD_STAT_INIT
+# define ERTS_RBT_YIELD_STAT_INIT__(YS) \
+ do { \
+ (YS)->x = NULL; \
+ (YS)->up = 0; \
+ } while (0)
+# ifdef DEBUG
+# define ERTS_RBT_YIELD_STAT_INIT(YS) \
+ do { \
+ ERTS_RBT_YIELD_STAT_INIT__(YS); \
+ (YS)->debug_red_adj = CONTEXT_REDS; \
+ } while(0)
+# else
+# define ERTS_RBT_YIELD_STAT_INIT(YS) ERTS_RBT_YIELD_STAT_INIT__(YS)
+# endif
+#endif
+
+
#define ERTS_RBT_FUNC__(Name) \
ERTS_RBT_CONCAT_MACRO_VALUES__(ERTS_RBT_PREFIX, _rbt_ ## Name)
@@ -1302,11 +1340,11 @@ ERTS_RBT_FUNC__(largest)(ERTS_RBT_T *root)
static ERTS_INLINE int
ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root,
int destroying,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg,
- int yielding,
+ int yielding,
ERTS_RBT_YIELD_STATE_T__ *ystate,
- Sint ylimit)
+ Sint reds)
{
ERTS_RBT_T *c, *p, *x;
@@ -1314,13 +1352,17 @@ ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root,
if (yielding && ystate->x) {
x = ystate->x;
+#ifdef DEBUG
+ if (ystate->debug_red_adj > 0)
+ ystate->debug_red_adj -= 100;
+#endif
ERTS_RBT_ASSERT(ystate->up);
goto restart_up;
}
else {
x = *root;
if (!x)
- return 0;
+ return reds;
if (destroying)
*root = NULL;
}
@@ -1346,10 +1388,10 @@ ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root,
#ifdef ERTS_RBT_DEBUG
int cdir;
#endif
- if (yielding && ylimit-- <= 0) {
+ if (yielding && reds <= 0) {
ystate->x = x;
ystate->up = 1;
- return 1;
+ return 0;
}
restart_up:
@@ -1375,14 +1417,20 @@ ERTS_RBT_FUNC__(foreach_unordered__)(ERTS_RBT_T **root,
}
#endif
- (*op)(x, arg);
+ reds -= (*op)(x, arg, reds);
+#ifdef DEBUG
+ if (yielding)
+ reds -= ystate->debug_red_adj;
+#endif
if (!p) {
+ /* Done */
if (yielding) {
ystate->x = NULL;
ystate->up = 0;
+ return reds <= 0 ? 1 : reds;
}
- return 0; /* Done */
+ return 1;
}
c = ERTS_RBT_GET_RIGHT(p);
@@ -1407,20 +1455,26 @@ static ERTS_INLINE int
ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root,
int from_small,
int destroying,
- void (*op)(ERTS_RBT_T *, void *),
- void (*destroy)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(destroy),
void *arg,
- int yielding,
+ int yielding,
ERTS_RBT_YIELD_STATE_T__ *ystate,
- Sint ylimit)
+ Sint reds)
{
ERTS_RBT_T *c, *p, *x;
ERTS_RBT_ASSERT(!yielding || ystate);
ERTS_RBT_ASSERT(!destroying || destroy);
+ ERTS_RBT_ASSERT(!yielding || yop);
+ ERTS_RBT_ASSERT(yielding || op);
if (yielding && ystate->x) {
x = ystate->x;
+#ifdef DEBUG
+ if (ystate->debug_red_adj > 0)
+ ystate->debug_red_adj -= 100;
+#endif
if (ystate->up)
goto restart_up;
else
@@ -1429,7 +1483,7 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root,
else {
x = *root;
if (!x)
- return 0;
+ return reds;
if (destroying)
*root = NULL;
}
@@ -1445,12 +1499,16 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root,
x = c;
}
- (*op)(x, arg);
+ reds -= (*op)(x, arg, reds);
+#ifdef DEBUG
+ if (yielding)
+ reds -= ystate->debug_red_adj;
+#endif
- if (yielding && --ylimit <= 0) {
+ if (yielding && reds <= 0) {
ystate->x = x;
ystate->up = 0;
- return 1;
+ return 0;
}
restart_down:
@@ -1472,12 +1530,16 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root,
? ERTS_RBT_GET_LEFT(p)
: ERTS_RBT_GET_RIGHT(p)) == x);
- (*op)(p, arg);
+ reds -= (*op)(p, arg, reds);
+#ifdef DEBUG
+ if (yielding)
+ reds -= ystate->debug_red_adj;
+#endif
- if (yielding && --ylimit <= 0) {
+ if (yielding && reds <= 0) {
ystate->x = x;
ystate->up = 1;
- return 1;
+ return 0;
restart_up:
p = ERTS_RBT_GET_PARENT(x);
}
@@ -1510,15 +1572,20 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root,
}
#endif
- (*destroy)(x, arg);
+ reds -= (*destroy)(x, arg, reds);
+#ifdef DEBUG
+ if (yielding)
+ reds -= ystate->debug_red_adj;
+#endif
}
if (!p) {
if (yielding) {
ystate->x = NULL;
ystate->up = 0;
+ return reds <= 0 ? 1 : reds;
}
- return 0; /* Done */
+ return 1; /* Done */
}
x = p;
}
@@ -1531,7 +1598,7 @@ ERTS_RBT_FUNC__(foreach_ordered__)(ERTS_RBT_T **root,
static ERTS_RBT_API_INLINE__ void
ERTS_RBT_FUNC__(foreach)(ERTS_RBT_T *root,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg)
{
(void) ERTS_RBT_FUNC__(foreach_unordered__)(&root, 0, op, arg,
@@ -1544,7 +1611,7 @@ ERTS_RBT_FUNC__(foreach)(ERTS_RBT_T *root,
static ERTS_RBT_API_INLINE__ void
ERTS_RBT_FUNC__(foreach_small)(ERTS_RBT_T *root,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg)
{
(void) ERTS_RBT_FUNC__(foreach_ordered__)(&root, 1, 0,
@@ -1558,7 +1625,7 @@ ERTS_RBT_FUNC__(foreach_small)(ERTS_RBT_T *root,
static ERTS_RBT_API_INLINE__ void
ERTS_RBT_FUNC__(foreach_large)(ERTS_RBT_T *root,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg)
{
(void) ERTS_RBT_FUNC__(foreach_ordered__)(&root, 0, 0,
@@ -1572,13 +1639,13 @@ ERTS_RBT_FUNC__(foreach_large)(ERTS_RBT_T *root,
static ERTS_RBT_API_INLINE__ int
ERTS_RBT_FUNC__(foreach_yielding)(ERTS_RBT_T *root,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg,
ERTS_RBT_YIELD_STATE_T__ *ystate,
- Sint ylimit)
+ Sint reds)
{
return ERTS_RBT_FUNC__(foreach_unordered__)(&root, 0, op, arg,
- 1, ystate, ylimit);
+ 1, ystate, reds);
}
#endif /* ERTS_RBT_WANT_FOREACH_YIELDING */
@@ -1587,14 +1654,14 @@ ERTS_RBT_FUNC__(foreach_yielding)(ERTS_RBT_T *root,
static ERTS_RBT_API_INLINE__ int
ERTS_RBT_FUNC__(foreach_small_yielding)(ERTS_RBT_T *root,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg,
ERTS_RBT_YIELD_STATE_T__ *ystate,
- Sint ylimit)
+ Sint reds)
{
return ERTS_RBT_FUNC__(foreach_ordered__)(&root, 1, 0,
op, NULL, arg,
- 1, ystate, ylimit);
+ 1, ystate, reds);
}
#endif /* ERTS_RBT_WANT_FOREACH_SMALL_YIELDING */
@@ -1603,14 +1670,14 @@ ERTS_RBT_FUNC__(foreach_small_yielding)(ERTS_RBT_T *root,
static ERTS_RBT_API_INLINE__ int
ERTS_RBT_FUNC__(foreach_large_yielding)(ERTS_RBT_T *root,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg,
ERTS_RBT_YIELD_STATE_T__ *ystate,
- Sint ylimit)
+ Sint reds)
{
return ERTS_RBT_FUNC__(foreach_ordered__)(&root, 0, 0,
op, NULL, arg,
- 1, ystate, ylimit);
+ 1, ystate, reds);
}
#endif /* ERTS_RBT_WANT_FOREACH_LARGE_YIELDING */
@@ -1619,11 +1686,11 @@ ERTS_RBT_FUNC__(foreach_large_yielding)(ERTS_RBT_T *root,
static ERTS_RBT_API_INLINE__ void
ERTS_RBT_FUNC__(foreach_destroy)(ERTS_RBT_T **root,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg)
{
(void) ERTS_RBT_FUNC__(foreach_unordered__)(root, 1, op, arg,
- 0, NULL, 0);
+ 0, NULL, 0);
}
#endif /* ERTS_RBT_WANT_FOREACH_DESTROY */
@@ -1632,8 +1699,8 @@ ERTS_RBT_FUNC__(foreach_destroy)(ERTS_RBT_T **root,
static ERTS_RBT_API_INLINE__ void
ERTS_RBT_FUNC__(foreach_small_destroy)(ERTS_RBT_T **root,
- void (*op)(ERTS_RBT_T *, void *),
- void (*destr)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(destr),
void *arg)
{
(void) ERTS_RBT_FUNC__(foreach_ordered__)(root, 1, 1,
@@ -1647,8 +1714,8 @@ ERTS_RBT_FUNC__(foreach_small_destroy)(ERTS_RBT_T **root,
static ERTS_RBT_API_INLINE__ void
ERTS_RBT_FUNC__(foreach_large_destroy)(ERTS_RBT_T **root,
- void (*op)(ERTS_RBT_T *, void *),
- void (*destr)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(destr),
void *arg)
{
(void) ERTS_RBT_FUNC__(foreach_ordered__)(root, 0, 1,
@@ -1662,13 +1729,13 @@ ERTS_RBT_FUNC__(foreach_large_destroy)(ERTS_RBT_T **root,
static ERTS_RBT_API_INLINE__ int
ERTS_RBT_FUNC__(foreach_destroy_yielding)(ERTS_RBT_T **root,
- void (*op)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
void *arg,
ERTS_RBT_YIELD_STATE_T__ *ystate,
- Sint ylimit)
+ Sint reds)
{
return ERTS_RBT_FUNC__(foreach_unordered__)(root, 1, op, arg,
- 1, ystate, ylimit);
+ 1, ystate, reds);
}
#endif /* ERTS_RBT_WANT_FOREACH_DESTROY_YIELDING */
@@ -1677,15 +1744,15 @@ ERTS_RBT_FUNC__(foreach_destroy_yielding)(ERTS_RBT_T **root,
static ERTS_RBT_API_INLINE__ int
ERTS_RBT_FUNC__(foreach_small_destroy_yielding)(ERTS_RBT_T **root,
- void (*op)(ERTS_RBT_T *, void *),
- void (*destr)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(destr),
void *arg,
ERTS_RBT_YIELD_STATE_T__ *ystate,
- Sint ylimit)
+ Sint reds)
{
return ERTS_RBT_FUNC__(foreach_ordered__)(root, 1, 1,
op, destr, arg,
- 1, ystate, ylimit);
+ 1, ystate, reds);
}
#endif /* ERTS_RBT_WANT_FOREACH_SMALL_DESTROY_YIELDING */
@@ -1694,15 +1761,15 @@ ERTS_RBT_FUNC__(foreach_small_destroy_yielding)(ERTS_RBT_T **root,
static ERTS_RBT_API_INLINE__ int
ERTS_RBT_FUNC__(foreach_large_destroy_yielding)(ERTS_RBT_T **root,
- void (*op)(ERTS_RBT_T *, void *),
- void (*destr)(ERTS_RBT_T *, void *),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(op),
+ ERTS_RBT_CALLBACK_FOREACH_FUNC(destr),
void *arg,
ERTS_RBT_YIELD_STATE_T__ *ystate,
- Sint ylimit)
+ Sint reds)
{
return ERTS_RBT_FUNC__(foreach_ordered__)(root, 0, 1,
op, destr, arg,
- 1, ystate, ylimit);
+ 1, ystate, reds);
}
#endif /* ERTS_RBT_WANT_FOREACH_LARGE_DESTROY_YIELDING */
@@ -1855,6 +1922,7 @@ ERTS_RBT_FUNC__(hdbg_check_tree)(ERTS_RBT_T *root, ERTS_RBT_T *n)
#ifdef ERTS_RBT_UNDEF
# undef ERTS_RBT_PREFIX
# undef ERTS_RBT_T
+# undef ERTS_RBT_CALLBACK_FOREACH_FUNC
# undef ERTS_RBT_KEY_T
# undef ERTS_RBT_FLAGS_T
# undef ERTS_RBT_INIT_EMPTY_TNODE
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 29c698e34f..d26ea19494 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -1911,8 +1911,8 @@ typedef struct {
ErtsTimeOffsetMonitorInfo *to_mon_info;
} ErtsTimeOffsetMonitorContext;
-static void
-save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt)
+static int
+save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt, Sint reds)
{
ErtsTimeOffsetMonitorContext *cntxt;
ErtsMonitorData *mdp = erts_monitor_to_data(mon);
@@ -1935,7 +1935,7 @@ save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt)
cntxt->to_mon_info[mix].ref
= make_internal_ref(&cntxt->to_mon_info[mix].heap[0]);
-
+ return 1;
}
static void
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 9a66e491f3..73eae614fa 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -102,7 +102,7 @@ static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32, struct erl_off_h
struct TTBEncodeContext_;
static int enc_term_int(struct TTBEncodeContext_*,ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags,
struct erl_off_heap_header** off_heap, Sint *reds, byte **res);
-static Uint is_external_string(Eterm obj, int* p_is_string);
+static int is_external_string(Eterm obj, Uint* lenp);
static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32);
static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32);
struct B2TContext_t;
@@ -262,19 +262,12 @@ erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags)
if (acmp) {
int long_atoms = 0; /* !0 if one or more atoms are longer than 255. */
int i;
- int sz;
- int fix_sz
- = 1 /* VERSION_MAGIC */
- + 1 /* DIST_HEADER */
- + 1 /* dist header flags */
- + 1 /* number of internal cache entries */
- ;
+ int sz = 0;
int min_sz;
ASSERT(dflags & DFLAG_UTF8_ATOMS);
ASSERT(acmp->hdr_sz < 0);
/* Make sure cache update instructions fit */
- min_sz = fix_sz+(2+4)*acmp->sz;
- sz = fix_sz;
+ min_sz = (2+4)*acmp->sz;
for (i = 0; i < acmp->sz; i++) {
Atom *a;
Eterm atom;
@@ -302,17 +295,28 @@ erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp, Uint32 dflags)
}
Uint
-erts_encode_ext_dist_header_size(ErtsAtomCacheMap *acmp)
+erts_encode_ext_dist_header_size(ErtsAtomCacheMap *acmp, Uint fragments)
{
if (!acmp)
return 0;
else {
+ int fix_sz
+ = 1 /* VERSION_MAGIC */
+ + 1 /* DIST_HEADER */
+ + 1 /* dist header flags */
+ + 1 /* number of internal cache entries */
+ ;
ASSERT(acmp->hdr_sz >= 0);
- return acmp->hdr_sz;
+ if (fragments > 1)
+ fix_sz += 8 /* sequence id */
+ + 8 /* number of fragments */
+ ;
+ return fix_sz + acmp->hdr_sz;
}
}
-byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp)
+byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp,
+ Uint fragments, Eterm from)
{
/* Maximum number of atom must be less than the maximum of a 32 bits
unsigned integer. Check is done in erl_init.c, erl_start function. */
@@ -346,12 +350,37 @@ byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp)
put_int8(acmp->sz, ep);
--ep;
put_int8(dist_hdr_flags, ep);
- *--ep = DIST_HEADER;
- *--ep = VERSION_MAGIC;
+ if (fragments > 1) {
+ ASSERT(is_pid(from));
+ ep -= 8;
+ put_int64(fragments, ep);
+ ep -= 8;
+ put_int64(from, ep);
+ *--ep = DIST_FRAG_HEADER;
+ } else {
+ *--ep = DIST_HEADER;
+ }
+ *--ep = VERSION_MAGIC;
return ep;
}
}
+byte *erts_encode_ext_dist_header_fragment(byte **hdrpp,
+ Uint fragment,
+ Eterm from)
+{
+ byte *ep = *hdrpp, *start = ep;
+ ASSERT(is_pid(from));
+ *ep++ = VERSION_MAGIC;
+ *ep++ = DIST_FRAG_CONT;
+ put_int64(from, ep);
+ ep += 8;
+ put_int64(fragment, ep);
+ ep += 8;
+ *hdrpp = ep;
+ return start;
+}
+
#define PASS_THROUGH 'p'
@@ -365,7 +394,8 @@ Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob,
int ci, sz;
byte dist_hdr_flags;
int long_atoms;
- register byte *ep = ob->extp;
+ Uint64 seq_id = 0, frag_id = 0;
+ register byte *ep = ob->hdrp ? ob->hdrp : ob->extp;
ASSERT(dflags & DFLAG_UTF8_ATOMS);
/*
@@ -416,7 +446,7 @@ Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob,
}
goto done;
}
- else if (ep[1] != DIST_HEADER) {
+ else if (ep[1] != DIST_HEADER && ep[1] != DIST_FRAG_HEADER && ep[1] != DIST_FRAG_CONT) {
ASSERT(ep[1] == SMALL_TUPLE_EXT || ep[1] == LARGE_TUPLE_EXT);
ASSERT(!(dflags & DFLAG_DIST_HDR_ATOM_CACHE));
/* Node without atom cache, 'pass through' needed */
@@ -424,6 +454,17 @@ Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob,
goto done;
}
+ if (ep[1] == DIST_FRAG_CONT) {
+ ep = ob->extp;
+ goto done;
+ } else if (ep[1] == DIST_FRAG_HEADER) {
+ /* skip the seq id and frag id */
+ seq_id = get_int64(&ep[2]);
+ ep += 8;
+ frag_id = get_int64(&ep[2]);
+ ep += 8;
+ }
+
dist_hdr_flags = ep[2];
long_atoms = ERTS_DIST_HDR_LONG_ATOMS_FLG & ((int) dist_hdr_flags);
@@ -546,11 +587,19 @@ Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf* ob,
}
--ep;
put_int8(ci, ep);
- *--ep = DIST_HEADER;
+ if (seq_id) {
+ ep -= 8;
+ put_int64(frag_id, ep);
+ ep -= 8;
+ put_int64(seq_id, ep);
+ *--ep = DIST_FRAG_HEADER;
+ } else {
+ *--ep = DIST_HEADER;
+ }
*--ep = VERSION_MAGIC;
done:
ob->extp = ep;
- ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp);
+ ASSERT((byte*)ob->bin->orig_bytes <= ob->extp && ob->extp < ob->ext_endp);
return reds < 0 ? 0 : reds;
}
@@ -571,7 +620,7 @@ int erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp,
}
}
-int erts_encode_dist_ext_size_int(Eterm term, struct erts_dsig_send_context* ctx, Uint* szp)
+int erts_encode_dist_ext_size_int(Eterm term, ErtsDSigSendContext *ctx, Uint* szp)
{
Uint sz;
if (encode_size_struct_int(&ctx->u.sc, ctx->acmp, term, ctx->flags, &ctx->reds, &sz)) {
@@ -635,56 +684,106 @@ byte* erts_encode_ext_ets(Eterm term, byte *ep, struct erl_off_heap_header** off
off_heap);
}
-ErtsDistExternal *
-erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize)
+
+static Uint
+dist_ext_size(ErtsDistExternal *edep)
{
- size_t align_sz;
- size_t dist_ext_sz;
- size_t ext_sz;
- byte *ep;
- ErtsDistExternal *new_edep;
+ Uint sz = sizeof(ErtsDistExternal);
+
+ ASSERT(edep->data->ext_endp && edep->data->extp);
+ ASSERT(edep->data->ext_endp >= edep->data->extp);
+
+ if (edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) {
+ ASSERT(0 <= edep->attab.size \
+ && edep->attab.size <= ERTS_ATOM_CACHE_SIZE);
+ sz -= sizeof(Eterm)*(ERTS_ATOM_CACHE_SIZE - edep->attab.size);
+ } else {
+ sz -= sizeof(ErtsAtomTranslationTable);
+ }
+ return sz;
+}
+
+Uint
+erts_dist_ext_size(ErtsDistExternal *edep)
+{
+ Uint sz = dist_ext_size(edep);
+ sz += edep->data[0].frag_id * sizeof(ErtsDistExternalData);
+ return sz + ERTS_EXTRA_DATA_ALIGN_SZ(sz);
+}
- dist_ext_sz = ERTS_DIST_EXT_SIZE(edep);
- ASSERT(edep->ext_endp && edep->extp);
- ASSERT(edep->ext_endp >= edep->extp);
- ext_sz = edep->ext_endp - edep->extp;
+Uint
+erts_dist_ext_data_size(ErtsDistExternal *edep)
+{
+ Uint sz = 0, i;
+ for (i = 0; i < edep->data->frag_id; i++)
+ sz += edep->data[i].ext_endp - edep->data[i].extp;
+ return sz;
+}
- align_sz = ERTS_EXTRA_DATA_ALIGN_SZ(dist_ext_sz + ext_sz);
+void
+erts_dist_ext_frag(ErtsDistExternalData *ede_datap, ErtsDistExternal *edep)
+{
+ ErtsDistExternalData *new_ede_datap = &edep->data[edep->data->frag_id - ede_datap->frag_id];
+ sys_memcpy(new_ede_datap, ede_datap, sizeof(ErtsDistExternalData));
+
+ /* If the data is not backed by a binary, we create one here to keep
+ things simple. Only custom distribution drivers should use lists. */
+ if (new_ede_datap->binp == NULL) {
+ size_t ext_sz = ede_datap->ext_endp - ede_datap->extp;
+ new_ede_datap->binp = erts_bin_nrml_alloc(ext_sz);
+ sys_memcpy(new_ede_datap->binp->orig_bytes, (void *) ede_datap->extp, ext_sz);
+ new_ede_datap->extp = (byte*)new_ede_datap->binp->orig_bytes;
+ new_ede_datap->ext_endp = (byte*)new_ede_datap->binp->orig_bytes + ext_sz;
+ } else {
+ erts_refc_inc(&new_ede_datap->binp->intern.refc, 2);
+ }
+}
- new_edep = erts_alloc(ERTS_ALC_T_EXT_TERM_DATA,
- dist_ext_sz + ext_sz + align_sz + xsize);
+void
+erts_make_dist_ext_copy(ErtsDistExternal *edep, ErtsDistExternal *new_edep)
+{
+ size_t dist_ext_sz = dist_ext_size(edep);
+ byte *ep;
ep = (byte *) new_edep;
sys_memcpy((void *) ep, (void *) edep, dist_ext_sz);
+ erts_ref_dist_entry(new_edep->dep);
+
ep += dist_ext_sz;
- if (new_edep->dep)
- erts_ref_dist_entry(new_edep->dep);
- new_edep->extp = ep;
- new_edep->ext_endp = ep + ext_sz;
- new_edep->heap_size = -1;
- sys_memcpy((void *) ep, (void *) edep->extp, ext_sz);
- return new_edep;
+
+ new_edep->data = (ErtsDistExternalData*)ep;
+ sys_memzero(new_edep->data, sizeof(ErtsDistExternalData) * edep->data->frag_id);
+ new_edep->data->frag_id = edep->data->frag_id;
+ erts_dist_ext_frag(edep->data, new_edep);
}
-int
+void
+erts_free_dist_ext_copy(ErtsDistExternal *edep)
+{
+ int i;
+ erts_deref_dist_entry(edep->dep);
+ for (i = 0; i < edep->data->frag_id; i++)
+ if (edep->data[i].binp)
+ erts_bin_release(edep->data[i].binp);
+}
+
+ErtsPrepDistExtRes
erts_prepare_dist_ext(ErtsDistExternal *edep,
byte *ext,
Uint size,
+ Binary *binp,
DistEntry *dep,
Uint32 conn_id,
ErtsAtomCache *cache)
{
register byte *ep;
- edep->heap_size = -1;
- edep->flags = 0;
- edep->dep = dep;
-
ASSERT(dep);
erts_de_rlock(dep);
ASSERT(dep->flags & DFLAG_UTF8_ATOMS);
+
if ((dep->state != ERTS_DE_STATE_CONNECTED &&
dep->state != ERTS_DE_STATE_PENDING)
|| dep->connection_id != conn_id) {
@@ -697,7 +796,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
ext++;
size--;
}
- edep->ext_endp = ext + size;
+
ep = ext;
if (size < 2)
@@ -713,16 +812,33 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
goto fail;
}
+ edep->heap_size = -1;
+ edep->flags = 0;
+ edep->dep = dep;
+ edep->connection_id = conn_id;
+ edep->data->ext_endp = ext+size;
+ edep->data->binp = binp;
+ edep->data->seq_id = 0;
+ edep->data->frag_id = 1;
+
if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE)
edep->flags |= ERTS_DIST_EXT_DFLAG_HDR;
- edep->connection_id = dep->connection_id;
-
- if (ep[1] != DIST_HEADER) {
+ if (ep[1] != DIST_HEADER && ep[1] != DIST_FRAG_HEADER && ep[1] != DIST_FRAG_CONT) {
if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR)
goto bad_hdr;
edep->attab.size = 0;
- edep->extp = ext;
+ edep->data->extp = ext;
+ }
+ else if (ep[1] == DIST_FRAG_CONT) {
+ if (!(dep->flags & DFLAG_FRAGMENTS))
+ goto bad_hdr;
+ edep->attab.size = 0;
+ edep->data->extp = ext + 1 + 1 + 8 + 8;
+ edep->data->seq_id = get_int64(&ep[2]);
+ edep->data->frag_id = get_int64(&ep[2+8]);
+ erts_de_runlock(dep);
+ return ERTS_PREP_DIST_EXT_FRAG_CONT;
}
else {
int tix;
@@ -731,9 +847,17 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
if (!(edep->flags & ERTS_DIST_EXT_DFLAG_HDR))
goto bad_hdr;
+ if (ep[1] == DIST_FRAG_HEADER) {
+ if (!(dep->flags & DFLAG_FRAGMENTS))
+ goto bad_hdr;
+ edep->data->seq_id = get_int64(&ep[2]);
+ edep->data->frag_id = get_int64(&ep[2+8]);
+ ep += 16;
+ }
+
#undef CHKSIZE
#define CHKSIZE(SZ) \
- do { if ((SZ) > edep->ext_endp - ep) goto bad_hdr; } while(0)
+ do { if ((SZ) > edep->data->ext_endp - ep) goto bad_hdr; } while(0)
CHKSIZE(1+1+1);
ep += 2;
@@ -863,7 +987,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
#endif
}
}
- edep->extp = ep;
+ edep->data->extp = ep;
#ifdef ERTS_DEBUG_USE_DIST_SEP
if (*ep != VERSION_MAGIC)
goto bad_hdr;
@@ -888,7 +1012,7 @@ erts_prepare_dist_ext(ErtsDistExternal *edep,
erts_this_node->sysname,
edep->dep->sysname,
dist_entry_channel_no(edep->dep));
- for (ep = ext; ep < edep->ext_endp; ep++)
+ for (ep = ext; ep < edep->data->ext_endp; ep++)
erts_dsprintf(dsbufp, ep != ext ? ",%b8u" : "<<%b8u", *ep);
erts_dsprintf(dsbufp, ">>");
erts_send_warning_to_logger_nogl(dsbufp);
@@ -913,9 +1037,9 @@ bad_dist_ext(ErtsDistExternal *edep)
erts_this_node->sysname,
dep->sysname,
dist_entry_channel_no(dep));
- for (ep = edep->extp; ep < edep->ext_endp; ep++)
+ for (ep = edep->data->extp; ep < edep->data->ext_endp; ep++)
erts_dsprintf(dsbufp,
- ep != edep->extp ? ",%b8u" : "<<...,%b8u",
+ ep != edep->data->extp ? ",%b8u" : "<<...,%b8u",
*ep);
erts_dsprintf(dsbufp, ">>\n");
erts_dsprintf(dsbufp, "ATOM_CACHE_REF translations: ");
@@ -933,30 +1057,32 @@ bad_dist_ext(ErtsDistExternal *edep)
}
Sint
-erts_decode_dist_ext_size(ErtsDistExternal *edep)
+erts_decode_dist_ext_size(ErtsDistExternal *edep, int kill_connection)
{
Sint res;
byte *ep;
- if (edep->extp >= edep->ext_endp)
+
+ if (edep->data->extp >= edep->data->ext_endp)
goto fail;
#ifndef ERTS_DEBUG_USE_DIST_SEP
if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) {
- if (*edep->extp == VERSION_MAGIC)
+ if (*edep->data->extp == VERSION_MAGIC)
goto fail;
- ep = edep->extp;
+ ep = edep->data->extp;
}
else
#endif
{
- if (*edep->extp != VERSION_MAGIC)
+ if (*edep->data->extp != VERSION_MAGIC)
goto fail;
- ep = edep->extp+1;
+ ep = edep->data->extp+1;
}
- res = decoded_size(ep, edep->ext_endp, 0, NULL);
+ res = decoded_size(ep, edep->data->ext_endp, 0, NULL);
if (res >= 0)
return res;
fail:
- bad_dist_ext(edep);
+ if (kill_connection)
+ bad_dist_ext(edep);
return -1;
}
@@ -982,12 +1108,15 @@ Sint erts_decode_ext_size_ets(byte *ext, Uint size)
*/
Eterm
erts_decode_dist_ext(ErtsHeapFactory* factory,
- ErtsDistExternal *edep)
+ ErtsDistExternal *edep,
+ int kill_connection)
{
Eterm obj;
- byte* ep = edep->extp;
+ byte* ep;
- if (ep >= edep->ext_endp)
+ ep = edep->data->extp;
+
+ if (ep >= edep->data->ext_endp)
goto error;
#ifndef ERTS_DEBUG_USE_DIST_SEP
if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) {
@@ -1005,14 +1134,15 @@ erts_decode_dist_ext(ErtsHeapFactory* factory,
if (!ep)
goto error;
- edep->extp = ep;
+ edep->data->extp = ep;
return obj;
error:
erts_factory_undo(factory);
- bad_dist_ext(edep);
+ if (kill_connection)
+ bad_dist_ext(edep);
return THE_NON_VALUE;
}
@@ -1057,6 +1187,7 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
Eterm res;
Sint hsz;
ErtsDistExternal ede;
+ ErtsDistExternalData ede_data;
Eterm *tp;
Eterm real_bin;
Uint offset;
@@ -1069,7 +1200,8 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
ede.flags = ERTS_DIST_EXT_ATOM_TRANS_TAB;
ede.dep = NULL;
ede.heap_size = -1;
-
+ ede.data = &ede_data;
+
if (is_not_tuple(BIF_ARG_1))
goto badarg;
tp = tuple_val(BIF_ARG_1);
@@ -1094,15 +1226,15 @@ BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2)
if (bitsize != 0)
goto badarg;
- ede.extp = binary_bytes(real_bin)+offset;
- ede.ext_endp = ede.extp + size;
+ ede.data->extp = binary_bytes(real_bin)+offset;
+ ede.data->ext_endp = ede.data->extp + size;
- hsz = erts_decode_dist_ext_size(&ede);
+ hsz = erts_decode_dist_ext_size(&ede, 1);
if (hsz < 0)
goto badarg;
erts_factory_proc_prealloc_init(&factory, BIF_P, hsz);
- res = erts_decode_dist_ext(&factory, &ede);
+ res = erts_decode_dist_ext(&factory, &ede, 1);
erts_factory_close(&factory);
if (is_value(res))
@@ -2348,7 +2480,7 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp)
return ep;
}
-static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation)
+static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation, Eterm book)
{
if (sysname == INTERNAL_LOCAL_SYSNAME) /* && DFLAG_INTERNAL_TAGS */
return erts_this_node;
@@ -2357,7 +2489,7 @@ static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation)
&& (creation == erts_this_node->creation || creation == ORIG_CREATION))
return erts_this_node;
- return erts_find_or_insert_node(sysname,creation);
+ return erts_find_or_insert_node(sysname,creation,book);
}
static byte*
@@ -2403,7 +2535,7 @@ dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep,
* We are careful to create the node entry only after all
* validity tests are done.
*/
- node = dec_get_node(sysname, cre);
+ node = dec_get_node(sysname, cre, make_boxed(factory->hp));
if(node == erts_this_node) {
*objp = make_internal_pid(data);
@@ -2481,11 +2613,21 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
{
Eterm* cons = list_val(obj);
Eterm tl;
+ Uint len_cnt = WSTACK_POP(s);
obj = CAR(cons);
tl = CDR(cons);
- WSTACK_PUSH2(s, (is_list(tl) ? ENC_ONE_CONS : ENC_TERM),
- tl);
+ if (is_list(tl)) {
+ len_cnt++;
+ WSTACK_PUSH3(s, len_cnt, ENC_ONE_CONS, tl);
+ }
+ else {
+ byte* list_lenp = (byte*) WSTACK_POP(s);
+ ASSERT(list_lenp[-1] == LIST_EXT);
+ put_int32(len_cnt, list_lenp);
+
+ WSTACK_PUSH2(s, ENC_TERM, tl);
+ }
}
break;
case ENC_PATCH_FUN_SIZE:
@@ -2689,10 +2831,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
}
case LIST_DEF:
{
- int is_str;
-
- i = is_external_string(obj, &is_str);
- if (is_str) {
+ if (is_external_string(obj, &i)) {
*ep++ = STRING_EXT;
put_int16(i, ep);
ep += 2;
@@ -2701,9 +2840,12 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
*ep++ = unsigned_val(CAR(cons));
obj = CDR(cons);
}
+ r -= i;
} else {
+ r -= i/2;
*ep++ = LIST_EXT;
- put_int32(i, ep);
+ /* Patch list length when we find end of list */
+ WSTACK_PUSH2(s, (UWord)ep, 1);
ep += 4;
goto encode_one_cons;
}
@@ -2961,9 +3103,13 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
return 0;
}
+/** @brief Is it a list of bytes not longer than MAX_STRING_LEN?
+ * @param lenp out: string length or number of list cells traversed
+ * @return true/false
+ */
static
-Uint
-is_external_string(Eterm list, int* p_is_string)
+int
+is_external_string(Eterm list, Uint* lenp)
{
Uint len = 0;
@@ -2975,29 +3121,15 @@ is_external_string(Eterm list, int* p_is_string)
Eterm* consp = list_val(list);
Eterm hd = CAR(consp);
- if (!is_byte(hd)) {
- break;
+ if (!is_byte(hd) || ++len > MAX_STRING_LEN) {
+ *lenp = len;
+ return 0;
}
- len++;
list = CDR(consp);
}
- /*
- * If we have reached the end of the list, and we have
- * not exceeded the maximum length of a string, this
- * is a string.
- */
- *p_is_string = is_nil(list) && len < MAX_STRING_LEN;
-
- /*
- * Continue to calculate the length.
- */
- while (is_list(list)) {
- Eterm* consp = list_val(list);
- len++;
- list = CDR(consp);
- }
- return len;
+ *lenp = len;
+ return is_nil(list);
}
@@ -3397,7 +3529,7 @@ dec_term_atom_common:
cre = get_int32(ep);
ep += 4;
}
- node = dec_get_node(sysname, cre);
+ node = dec_get_node(sysname, cre, make_boxed(hp));
if(node == erts_this_node) {
*objp = make_internal_port(num);
}
@@ -3477,7 +3609,7 @@ dec_term_atom_common:
if (ref_words > ERTS_MAX_REF_NUMBERS)
goto error;
- node = dec_get_node(sysname, cre);
+ node = dec_get_node(sysname, cre, make_boxed(hp));
if(node == erts_this_node) {
rtp = (ErtsORefThing *) hp;
@@ -4075,8 +4207,8 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
for (;;) {
ASSERT(!is_header(obj));
- if (ctx && --r == 0) {
- *reds = r;
+ if (ctx && --r <= 0) {
+ *reds = 0;
ctx->obj = obj;
ctx->result = result;
WSTACK_SAVE(s, &ctx->wstack);
@@ -4166,8 +4298,10 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
result += (1 + encode_size_struct2(acmp, port_node_name(obj), dflags) +
4 + 1);
break;
- case LIST_DEF:
- if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) {
+ case LIST_DEF: {
+ int is_str = is_external_string(obj, &m);
+ r -= m/2;
+ if (is_str) {
result += m + 2 + 1;
} else {
result += 5;
@@ -4176,6 +4310,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
continue; /* big loop */
}
break;
+ }
case TUPLE_DEF:
{
Eterm* ptr = tuple_val(obj);
@@ -4317,7 +4452,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
if (is_header(obj)) {
switch (obj) {
- case LIST_TAIL_OP:
+ case LIST_TAIL_OP:
obj = (Eterm) WSTACK_POP(s);
if (is_list(obj)) {
Eterm* cons = list_val(obj);
@@ -4343,7 +4478,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
WSTACK_DESTROY(s);
if (ctx) {
ASSERT(ctx->wstack.wstart == NULL);
- *reds = r;
+ *reds = r < 0 ? 0 : r;
}
*res = result;
return 0;
diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h
index edac177cc6..396cd9f802 100644
--- a/erts/emulator/beam/external.h
+++ b/erts/emulator/beam/external.h
@@ -58,6 +58,8 @@
#define SMALL_ATOM_UTF8_EXT 'w'
#define DIST_HEADER 'D'
+#define DIST_FRAG_HEADER 'E'
+#define DIST_FRAG_CONT 'F'
#define ATOM_CACHE_REF 'R'
#define ATOM_INTERNAL_REF2 'I'
#define ATOM_INTERNAL_REF3 'K'
@@ -122,13 +124,23 @@ typedef struct {
#define ERTS_DIST_CON_ID_MASK ((Uint32) 0x00ffffff) /* also in net_kernel.erl */
-typedef struct {
- DistEntry *dep;
+struct binary;
+typedef struct erl_dist_external_data ErtsDistExternalData;
+
+struct erl_dist_external_data {
+ Uint64 seq_id;
+ Uint64 frag_id;
byte *extp;
byte *ext_endp;
+ struct binary *binp;
+};
+
+typedef struct erl_dist_external {
Sint heap_size;
- Uint32 connection_id;
+ DistEntry *dep;
Uint32 flags;
+ Uint32 connection_id;
+ ErtsDistExternalData *data;
ErtsAtomTranslationTable attab;
} ErtsDistExternal;
@@ -155,8 +167,9 @@ void erts_reset_atom_cache_map(ErtsAtomCacheMap *);
void erts_destroy_atom_cache_map(ErtsAtomCacheMap *);
void erts_finalize_atom_cache_map(ErtsAtomCacheMap *, Uint32);
-Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *);
-byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *);
+Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *, Uint);
+byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *, Uint, Eterm);
+byte *erts_encode_ext_dist_header_fragment(byte **, Uint, Eterm);
Sint erts_encode_ext_dist_header_finalize(ErtsDistOutputBuf*, DistEntry *, Uint32 dflags, Sint reds);
struct erts_dsig_send_context;
int erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap*, Uint* szp);
@@ -171,20 +184,24 @@ Uint erts_encode_ext_size_ets(Eterm);
void erts_encode_ext(Eterm, byte **);
byte* erts_encode_ext_ets(Eterm, byte *, struct erl_off_heap_header** ext_off_heap);
-ERTS_GLB_INLINE void erts_free_dist_ext_copy(ErtsDistExternal *);
-ERTS_GLB_INLINE void *erts_dist_ext_trailer(ErtsDistExternal *);
-ErtsDistExternal *erts_make_dist_ext_copy(ErtsDistExternal *, Uint);
-void *erts_dist_ext_trailer(ErtsDistExternal *);
-void erts_destroy_dist_ext_copy(ErtsDistExternal *);
-
-#define ERTS_PREP_DIST_EXT_FAILED (-1)
-#define ERTS_PREP_DIST_EXT_SUCCESS (0)
-#define ERTS_PREP_DIST_EXT_CLOSED (1)
-
-int erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint,
- DistEntry *, Uint32 conn_id, ErtsAtomCache *);
-Sint erts_decode_dist_ext_size(ErtsDistExternal *);
-Eterm erts_decode_dist_ext(ErtsHeapFactory* factory, ErtsDistExternal *);
+Uint erts_dist_ext_size(ErtsDistExternal *);
+Uint erts_dist_ext_data_size(ErtsDistExternal *);
+void erts_free_dist_ext_copy(ErtsDistExternal *);
+void erts_make_dist_ext_copy(ErtsDistExternal *, ErtsDistExternal *);
+void erts_dist_ext_frag(ErtsDistExternalData *, ErtsDistExternal *);
+#define erts_get_dist_ext(HFRAG) ((ErtsDistExternal*)((HFRAG)->mem + (HFRAG)->used_size))
+
+typedef enum {
+ ERTS_PREP_DIST_EXT_FAILED,
+ ERTS_PREP_DIST_EXT_SUCCESS,
+ ERTS_PREP_DIST_EXT_FRAG_CONT,
+ ERTS_PREP_DIST_EXT_CLOSED
+} ErtsPrepDistExtRes;
+
+ErtsPrepDistExtRes erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint, struct binary *,
+ DistEntry *, Uint32, ErtsAtomCache *);
+Sint erts_decode_dist_ext_size(ErtsDistExternal *, int);
+Eterm erts_decode_dist_ext(ErtsHeapFactory*, ErtsDistExternal *, int);
Sint erts_decode_ext_size(byte*, Uint);
Sint erts_decode_ext_size_ets(byte*, Uint);
@@ -200,25 +217,4 @@ int erts_debug_max_atom_out_cache_index(void);
int erts_debug_atom_to_out_cache_index(Eterm);
void transcode_free_ctx(DistEntry* dep);
-#if ERTS_GLB_INLINE_INCL_FUNC_DEF
-
-ERTS_GLB_INLINE void
-erts_free_dist_ext_copy(ErtsDistExternal *edep)
-{
- if (edep->dep)
- erts_deref_dist_entry(edep->dep);
- erts_free(ERTS_ALC_T_EXT_TERM_DATA, edep);
-}
-
-ERTS_GLB_INLINE void *
-erts_dist_ext_trailer(ErtsDistExternal *edep)
-{
- void *res = (void *) (edep->ext_endp
- + ERTS_EXTRA_DATA_ALIGN_SZ(edep->ext_endp));
- ASSERT((((UWord) res) % sizeof(Uint)) == 0);
- return res;
-}
-
-#endif
-
#endif /* ERL_EXTERNAL_H__ */
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 29de162b42..f9bbe4167f 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -113,6 +113,9 @@ extern Eterm erts_bld_resource_ref(Eterm** hp, ErlOffHeap*, ErtsResource*);
extern void erts_pre_nif(struct enif_environment_t*, Process*,
struct erl_module_nif*, Process* tracee);
extern void erts_post_nif(struct enif_environment_t* env);
+#ifdef DEBUG
+int erts_dbg_is_resource_dying(ErtsResource*);
+#endif
extern void erts_resource_stop(ErtsResource*, ErlNifEvent, int is_direct_call);
void erts_fire_nif_monitor(ErtsMonitor *tmon);
void erts_nif_demonitored(ErtsResource* resource);
@@ -1093,7 +1096,7 @@ extern int distribution_info(fmtfn_t, void *);
extern int is_node_name_atom(Eterm a);
extern int erts_net_message(Port *, DistEntry *, Uint32 conn_id,
- byte *, ErlDrvSizeT, byte *, ErlDrvSizeT);
+ byte *, ErlDrvSizeT, Binary *, byte *, ErlDrvSizeT);
extern void init_dist(void);
extern int stop_dist(void);
diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab
index e55c4a112d..1eb83b61f2 100644
--- a/erts/emulator/beam/instrs.tab
+++ b/erts/emulator/beam/instrs.tab
@@ -359,7 +359,7 @@ i_get_tuple_element2(Src, Element, Dst) {
dst[1] = E2;
}
-i_get_tuple_element2y(Src, Element, D1, D2) {
+i_get_tuple_element2_dst(Src, Element, D1, D2) {
Eterm* src;
Eterm E1, E2;
src = ADD_BYTE_OFFSET(tuple_val($Src), $Element);
@@ -436,6 +436,30 @@ init(Y) {
make_blank($Y);
}
+init_seq3(Y1) {
+ Eterm* dst = &$Y1;
+ make_blank(dst[0]);
+ make_blank(dst[1]);
+ make_blank(dst[2]);
+}
+
+init_seq4(Y1) {
+ Eterm* dst = &$Y1;
+ make_blank(dst[0]);
+ make_blank(dst[1]);
+ make_blank(dst[2]);
+ make_blank(dst[3]);
+}
+
+init_seq5(Y1) {
+ Eterm* dst = &$Y1;
+ make_blank(dst[0]);
+ make_blank(dst[1]);
+ make_blank(dst[2]);
+ make_blank(dst[3]);
+ make_blank(dst[4]);
+}
+
init2(Y1, Y2) {
make_blank($Y1);
make_blank($Y2);
@@ -488,6 +512,15 @@ move_shift(Src, SD, D) {
$SD = V;
}
+move_window2(S1, S2, D) {
+ Eterm xt0, xt1;
+ Eterm* y = &$D;
+ xt0 = $S1;
+ xt1 = $S2;
+ y[0] = xt0;
+ y[1] = xt1;
+}
+
move_window3(S1, S2, S3, D) {
Eterm xt0, xt1, xt2;
Eterm* y = &$D;
@@ -642,12 +675,6 @@ is_nonempty_list(Fail, Src) {
}
}
-is_nonempty_list_test_heap(Fail, Need, Live) {
- //| -no_prefetch
- $is_nonempty_list($Fail, x(0));
- $test_heap($Need, $Live);
-}
-
is_nonempty_list_allocate(Fail, Src, Need, Live) {
//| -no_prefetch
$is_nonempty_list($Fail, $Src);
@@ -660,6 +687,18 @@ is_nonempty_list_get_list(Fail, Src, Hd, Tl) {
$get_list($Src, $Hd, $Tl);
}
+is_nonempty_list_get_hd(Fail, Src, Hd) {
+ //| -no_prefetch
+ $is_nonempty_list($Fail, $Src);
+ $get_hd($Src, $Hd);
+}
+
+is_nonempty_list_get_tl(Fail, Src, Tl) {
+ //| -no_prefetch
+ $is_nonempty_list($Fail, $Src);
+ $get_tl($Src, $Tl);
+}
+
jump(Fail) {
$JUMP($Fail);
}
@@ -797,6 +836,16 @@ test_arity(Fail, Pointer, Arity) {
}
}
+test_arity_get_tuple_element(Fail, Pointer, Arity, Pos, Dst) {
+ Eterm* ptr = tuple_val($Pointer);
+ Eterm* src;
+ if (*ptr != $Arity) {
+ $FAIL($Fail);
+ }
+ src = ADD_BYTE_OFFSET(ptr, $Pos);
+ $Dst = *src;
+}
+
i_is_eq_exact_immed(Fail, X, Y) {
if ($X != $Y) {
$FAIL($Fail);
@@ -835,12 +884,16 @@ i_is_ne_exact_literal(Fail, Src, Literal) {
}
}
-is_eq(Fail, X, Y) {
- CMP_EQ_ACTION($X, $Y, $FAIL($Fail));
+is_eq(Fail, A, B) {
+ Eterm a = $A;
+ Eterm b = $B;
+ CMP_EQ_ACTION(a, b, $FAIL($Fail));
}
-is_ne(Fail, X, Y) {
- CMP_NE_ACTION($X, $Y, $FAIL($Fail));
+is_ne(Fail, A, B) {
+ Eterm a = $A;
+ Eterm b = $B;
+ CMP_NE_ACTION(a, b, $FAIL($Fail));
}
is_lt(Fail, X, Y) {
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index 5325480901..b961c639f5 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -3644,20 +3644,22 @@ typedef struct {
Eterm reason;
} ErtsPortExitContext;
-static void link_port_exit(ErtsLink *lnk, void *vpectxt)
+static int link_port_exit(ErtsLink *lnk, void *vpectxt, Sint reds)
{
ErtsPortExitContext *pectxt = vpectxt;
erts_proc_sig_send_link_exit(NULL, pectxt->port_id,
lnk, pectxt->reason, NIL);
+ return 1;
}
-static void monitor_port_exit(ErtsMonitor *mon, void *vpectxt)
+static int monitor_port_exit(ErtsMonitor *mon, void *vpectxt, Sint reds)
{
ErtsPortExitContext *pectxt = vpectxt;
if (erts_monitor_is_target(mon))
erts_proc_sig_send_monitor_down(mon, pectxt->reason);
else
erts_proc_sig_send_demonitor(mon);
+ return 1;
}
/* 'from' is sending 'this_port' an exit signal, (this_port must be internal).
@@ -4073,7 +4075,7 @@ done:
* to the caller.
*/
int
-erl_drv_port_control(Eterm port_num, char cmd, char* buff, ErlDrvSizeT size)
+erl_drv_port_control(Eterm port_num, unsigned int cmd, char* buff, ErlDrvSizeT size)
{
ErtsProc2PortSigData *sigdp = erts_port_task_alloc_p2p_sig_data();
@@ -4836,7 +4838,7 @@ typedef struct {
void *arg;
} prt_one_lnk_data;
-static void prt_one_monitor(ErtsMonitor *mon, void *vprtd)
+static int prt_one_monitor(ErtsMonitor *mon, void *vprtd, Sint reds)
{
ErtsMonitorData *mdp = erts_monitor_to_data(mon);
prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd;
@@ -4844,12 +4846,14 @@ static void prt_one_monitor(ErtsMonitor *mon, void *vprtd)
erts_print(prtd->to, prtd->arg, "(%p,%T)", mon->other.ptr, mdp->ref);
else
erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->other.item, mdp->ref);
+ return 1;
}
-static void prt_one_lnk(ErtsLink *lnk, void *vprtd)
+static int prt_one_lnk(ErtsLink *lnk, void *vprtd, Sint reds)
{
prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd;
erts_print(prtd->to, prtd->arg, "%T", lnk->other.item);
+ return 1;
}
static void dump_port_state(fmtfn_t to, void *arg, erts_aint32_t state)
@@ -5100,7 +5104,7 @@ erts_port_resume_procs(Port *prt)
erts_snprintf(port_str, sizeof(DTRACE_CHARBUF_NAME(port_str)), "%T", prt->common.id);
while (plp2 != NULL) {
- erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->pid);
+ erts_snprintf(pid_str, sizeof(DTRACE_CHARBUF_NAME(pid_str)), "%T", plp2->u.pid);
DTRACE2(process_port_unblocked, pid_str, port_str);
}
}
@@ -6177,6 +6181,7 @@ int driver_output_binary(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
dep,
conn_id,
(byte*) hbuf, hlen,
+ ErlDrvBinary2Binary(bin),
(byte*) (bin->orig_bytes+offs), len);
}
else
@@ -6222,12 +6227,14 @@ int driver_output2(ErlDrvPort ix, char* hbuf, ErlDrvSizeT hlen,
dep,
conn_id,
NULL, 0,
+ NULL,
(byte*) hbuf, hlen);
else
return erts_net_message(prt,
dep,
conn_id,
(byte*) hbuf, hlen,
+ NULL,
(byte*) buf, len);
}
else if (state & ERTS_PORT_SFLG_LINEBUF_IO)
diff --git a/erts/emulator/beam/msg_instrs.tab b/erts/emulator/beam/msg_instrs.tab
index 9bf3aefaca..6f8d1469ef 100644
--- a/erts/emulator/beam/msg_instrs.tab
+++ b/erts/emulator/beam/msg_instrs.tab
@@ -137,8 +137,8 @@ i_loop_rec(Dest) {
if (ERTS_UNLIKELY(ERTS_SIG_IS_EXTERNAL_MSG(msgp))) {
FCALLS -= 10; /* FIXME: bump appropriate amount... */
- SWAPOUT; /* erts_decode_dist_message() may write to heap... */
- if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) {
+ SWAPOUT; /* erts_proc_sig_decode_dist() may write to heap... */
+ if (!erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) {
/*
* A corrupt distribution message that we weren't able to decode;
* remove it...
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 8e730e42d6..da5364183c 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -74,23 +74,19 @@ trace_jump W
return
+# To ensure that a "move Src x(0)" instruction can be combined with
+# the following call instruction, we need to make sure that there is
+# no line/1 instruction between the move and the call.
#
-# To ensure that a "move Src x(0)" instruction can be combined
-# with the following call instruction, we need to make sure that
-# there is no line/1 instruction between the move and the call.
-#
-# A tail-recursive call to an external function (non-BIF) will
-# never be saved on the stack, so there is no reason to keep
-# the line instruction. (The compiler did not remove the line
-# instruction because it cannot tell the difference between
-# BIFs and ordinary Erlang functions.)
-#
+# A tail-recursive call to an external function (BIF or non-BIF) will
+# never be saved on the stack, so there is no reason to keep the line
+# instruction.
move S X0=x==0 | line Loc | call_ext Ar Func => \
line Loc | move S X0 | call_ext Ar Func
-move S X0=x==0 | line Loc | call_ext_last Ar Func=u$is_not_bif D => \
+move S X0=x==0 | line Loc | call_ext_last Ar Func D => \
move S X0 | call_ext_last Ar Func D
-move S X0=x==0 | line Loc | call_ext_only Ar Func=u$is_not_bif => \
+move S X0=x==0 | line Loc | call_ext_only Ar Func => \
move S X0 | call_ext_only Ar Func
move S X0=x==0 | line Loc | call Ar Func => \
line Loc | move S X0 | call Ar Func
@@ -102,9 +98,9 @@ line I
allocate t t?
allocate_heap t I t?
-%cold
+# This instruction when a BIF is called tail-recursively when
+# ther is stack frame.
deallocate Q
-%hot
init y
allocate_zero t t?
@@ -118,11 +114,21 @@ test_heap I t?
allocate_heap S u==0 R => allocate S R
allocate_heap_zero S u==0 R => allocate_zero S R
-init2 y y
-init3 y y y
+init Y1 | init Y2 | init Y3 | succ(Y1,Y2) | succ(Y2,Y3) => init_seq3 Y1
+init_seq3 Y1 | init Y4 | succ3(Y1,Y4) => init_seq4 Y1
+init_seq4 Y1 | init Y5 | succ4(Y1,Y5) => init_seq5 Y1
+
+init_seq3 y
+init_seq4 y
+init_seq5 y
+
init Y1 | init Y2 | init Y3 => init3 Y1 Y2 Y3
init Y1 | init Y2 => init2 Y1 Y2
+init2 y y
+init3 y y y
+
+
# Selecting values
select_val S=aiq Fail=f Size=u Rest=* => const_select_val(S, Fail, Size, Rest)
@@ -205,14 +211,11 @@ set_tuple_element s S P
# Get tuple element
-i_get_tuple_element xy P x
-
-%cold
-i_get_tuple_element xy P y
-%hot
+i_get_tuple_element xy P xy
i_get_tuple_element2 x P x
-i_get_tuple_element2y x P y y
+i_get_tuple_element2_dst x P x x
+i_get_tuple_element2_dst x P y y
i_get_tuple_element3 x P x
@@ -274,6 +277,9 @@ move_window/6
move X1=x Y1=y | move X2=x Y2=y | move X3=x Y3=y | succ(Y1,Y2) | succ(Y2,Y3) => \
move_window X1 X2 X3 Y1 Y3
+move X1=x Y1=y | move X2=x Y2=y | succ(Y1,Y2) => \
+ move_window2 X1 X2 Y1
+
move_window X1=x X2=x X3=x Y1=y Y3=y | move X4=x Y4=y | succ(Y3,Y4) => \
move_window X1 X2 X3 X4 Y1 Y4
@@ -283,12 +289,13 @@ move_window X1=x X2=x X3=x X4=x Y1=y Y4=y | move X5=x Y5=y | succ(Y4,Y5) => \
move_window X1=x X2=x X3=x Y1=y Y3=y => move_window3 X1 X2 X3 Y1
move_window X1=x X2=x X3=x X4=x Y1=y Y4=y => move_window4 X1 X2 X3 X4 Y1
+move_window2 x x y
move_window3 x x x y
move_window4 x x x x y
move_window5 x x x x x y
# Swap registers.
-move R1=x Tmp=x | move R2=xy R1 | move Tmp R2 => swap_temp R1 R2 Tmp
+move R1=x Tmp=x | move R2=x R1 | move Tmp R2 => swap_temp R1 R2 Tmp
swap_temp R1 R2 Tmp | line Loc | apply Live | is_killed_apply(Tmp, Live) => \
swap R1 R2 | line Loc | apply Live
@@ -307,84 +314,84 @@ swap_temp R1 R2 Tmp | line Loc | call_ext_only Live Addr | \
swap_temp R1 R2 Tmp | line Loc | call_ext_last Live Addr D | \
is_killed(Tmp, Live) => swap R1 R2 | line Loc | call_ext_last Live Addr D
-swap_temp x xy x
-
-swap x xy
-
-move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2
-move Src=x SD=x | move SD=x D=x => move_dup Src SD D
-move Src=x D1=x | move Src=x D2=y => move_dup Src D1 D2
-move Src=y SD=x | move SD=x D=y => move_dup Src SD D
-move Src=x SD=x | move SD=x D=y => move_dup Src SD D
-move Src=y SD=x | move SD=x D=x => move_dup Src SD D
-
-move SD=x D=x | move Src=xy SD=x => move_shift Src SD D
-move SD=y D=x | move Src=x SD=y => move_shift Src SD D
-move SD=x D=y | move Src=x SD=x => move_shift Src SD D
-
-# The transformations above guarantee that the source for
-# the second move is not the same as the destination for
-# the first move. That means that we can do the moves in
-# parallel (fetch both values, then store them) which could
-# be faster.
-
-move X1=x Y1=y | move X2=x Y2=y => move2_par X1 Y1 X2 Y2
-move Y1=y X1=x | move Y2=y X2=x => move2_par Y1 X1 Y2 X2
-
-move X1=x X2=x | move X3=x X4=x => move2_par X1 X2 X3 X4
-
-move X1=x X2=x | move X3=x Y1=y => move2_par X1 X2 X3 Y1
+swap_temp x x x
-move S1=x S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1
+swap x x
-move S1=y S2=x | move X1=x Y1=y => move2_par S1 S2 X1 Y1
+# move_dup
-move Y1=y X1=x | move S1=x D1=x => move2_par Y1 X1 S1 D1
-move S1=x D1=x | move Y1=y X1=x => move2_par S1 D1 Y1 X1
+move Src=x D1=x | move Src=x D2=x => move_dup Src D1 D2
+move Src=x SD=x | move SD=x D=x => move_dup Src SD D
-move2_par X1=x Y1=y X2=x Y2=y | move X3=x Y3=y => move3 X1 Y1 X2 Y2 X3 Y3
-move2_par Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3
-move2_par X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6
+move_dup x x x
-move C=aiq X=x==1 => move_x1 C
-move C=aiq X=x==2 => move_x2 C
+# move_shift
-move_x1 c
-move_x2 c
+move SD=x D=x | move Src=xy SD=x | distinct(D, Src) => move_shift Src SD D
+move SD=y D=x | move Src=x SD=y | distinct(D, Src) => move_shift Src SD D
+move SD=x D=y | move Src=x SD=x | distinct(D, Src) => move_shift Src SD D
move_shift x x x
move_shift y x x
move_shift x y x
move_shift x x y
-move_dup xy x xy
+# move2_par x x x x
-move2_par x y x y
-move2_par y x y x
+move X1=x X2=x | move X3=x X4=x | independent_moves(X1, X2, X3, X4) => \
+ move2_par X1 X2 X3 X4
move2_par x x x x
+# move2_par x x x y
+
+move X1=x X2=x | move X3=x Y1=y | independent_moves(X1, X2, X3, Y1) => \
+ move2_par X1 X2 X3 Y1
+move X3=x Y1=y | move X1=x X2=x | independent_moves(X3, Y1, X1, X2) => \
+ move2_par X1 X2 X3 Y1
move2_par x x x y
+# move2_par y x y x
+
+move Y1=y X1=x | move Y2=y X2=x => move2_par Y1 X1 Y2 X2
+move2_par y x y x
+
+# move2_par y x x y
+
+move S1=y S2=x | move X1=x Y1=y | independent_moves(S1, S2, X1, Y1) => \
+ move2_par S1 S2 X1 Y1
+move X1=x Y1=y | move S1=y S2=x | independent_moves(S1, S2, X1, Y1) => \
+ move2_par S1 S2 X1 Y1
move2_par y x x y
-move2_par x x y x
+# move2_par y x x x
+
+move Y1=y X1=x | move S1=x D1=x | independent_moves(Y1, X1, S1, D1) => \
+ move2_par Y1 X1 S1 D1
+move S1=x D1=x | move Y1=y X1=x | independent_moves(Y1, X1, S1, D1) => \
+ move2_par Y1 X1 S1 D1
move2_par y x x x
-move3 x y x y x y
+# move3
+
+move2_par Y1=y X1=x Y2=y X2=x | move Y3=y X3=x => move3 Y1 X1 Y2 X2 Y3 X3
+move2_par X1=x X2=x X3=x X4=x | move X5=x X6=x => move3 X1 X2 X3 X4 X5 X6
+
move3 y x y x y x
move3 x x x x x x
-# The compiler almost never generates a "move Literal y(Y)" instruction,
-# so let's cheat if we encounter one.
-move S=n D=y => init D
-move S=c D=y => move S x | move x D
+# move_x1, move_x2
+
+move C=aiq X=x==1 => move_x1 C
+move C=aiq X=x==2 => move_x2 C
+
+move n D=y => init D
+
+move_x1 c
+move_x2 c
-move x x
-move x y
-move y x
-move c x
+move xy xy
+move c xy
move n x
-move y y
# The following move instructions using x(0) are frequently used.
@@ -478,9 +485,13 @@ is_ge f? c x
is_ge f? s s
%hot
-is_eq f? s s
+is_eq Fail=f Const=c Reg=xy => is_eq Fail Reg Const
+is_eq Fail=f C1=c C2=c => move C1 x | is_eq Fail x C2
+is_eq f? S s
-is_ne f? s s
+is_ne Fail=f Const=c Reg=xy => is_ne Fail Reg Const
+is_ne Fail=f C1=c C2=c => move C1 x | is_ne Fail x C2
+is_ne f? S s
#
# Putting tuples.
@@ -611,9 +622,13 @@ is_tuple f? rxy
test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity
test_arity Fail=f c Arity => jump Fail
+test_arity Fail Tuple=x Arity | get_tuple_element Tuple Pos Dst=x => \
+ test_arity_get_tuple_element Fail Tuple Arity Pos Dst
test_arity f? xy A
+test_arity_get_tuple_element f? x A P x
+
get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
get_tuple_element Reg=x P3 D3=x | \
succ(P1, P2) | succ(P2, P3) | \
@@ -622,8 +637,11 @@ get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
succ(P1, P2) | succ(D1, D2) => i_get_tuple_element2 Reg P1 D1
+get_tuple_element Reg=x P1 D1=x | get_tuple_element Reg=x P2 D2=x | \
+ succ(P1, P2) | distinct(D1, Reg) => i_get_tuple_element2_dst Reg P1 D1 D2
+
get_tuple_element Reg=x P1 D1=y | get_tuple_element Reg=x P2 D2=y | \
- succ(P1, P2) => i_get_tuple_element2y Reg P1 D1 D2
+ succ(P1, P2) => i_get_tuple_element2_dst Reg P1 D1 D2
get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst
@@ -647,14 +665,21 @@ is_list f? y
is_nonempty_list Fail=f S=x | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs
-is_nonempty_list F=f x==0 | test_heap I1 I2 => is_nonempty_list_test_heap F I1 I2
-
is_nonempty_list Fail=f S=x | get_list S D1=x D2=x => \
is_nonempty_list_get_list Fail S D1 D2
+is_nonempty_list Fail=f S=x | get_hd S Dst=x => \
+ is_nonempty_list_get_hd Fail S Dst
+
+is_nonempty_list Fail=f S=x | get_tl S Dst=x => \
+ is_nonempty_list_get_tl Fail S Dst
+
is_nonempty_list_allocate f? rx t t
-is_nonempty_list_test_heap f? I t
+
is_nonempty_list_get_list f? rx x x
+is_nonempty_list_get_hd f? x x
+is_nonempty_list_get_tl f? x x
+
is_nonempty_list f? xy
is_atom f? x
@@ -956,10 +981,9 @@ call_ext_only u==0 u$func:os:perf_counter/0 => \
call_ext u Bif=u$is_bif => call_bif Bif
-call_ext_last u Bif=u$is_bif D => call_bif Bif | deallocate_return D
+call_ext_last u Bif=u$is_bif D => deallocate D | call_bif_only Bif
-call_ext_only Ar=u Bif=u$is_bif => \
- allocate u Ar | call_bif Bif | deallocate_return u
+call_ext_only Ar=u Bif=u$is_bif => call_bif_only Bif
#
# Any remaining calls are calls to Erlang functions, not BIFs.
@@ -991,6 +1015,7 @@ i_perf_counter
%hot
call_bif e
+call_bif_only e
#
# Calls to non-building and guard BIFs.
@@ -999,6 +1024,9 @@ call_bif e
bif0 u$bif:erlang:self/0 Dst=d => self Dst
bif0 u$bif:erlang:node/0 Dst=d => node Dst
+bif1 Fail=f Bif=u$bif:erlang:hd/1 Src=x Dst=x => is_nonempty_list_get_hd Fail Src Dst
+bif1 Fail=f Bif=u$bif:erlang:tl/1 Src=x Dst=x => is_nonempty_list_get_tl Fail Src Dst
+
bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => gen_get(Src, Dst)
bif2 Jump=j u$bif:erlang:element/2 S1=s S2=xy Dst=d => gen_element(Jump, S1, S2, Dst)
@@ -1087,19 +1115,33 @@ is_function Fail=f c => jump Fail
func_info M F A => i_func_info u M F A
# ================================================================
-# New bit syntax matching (R11B).
+# Bit syntax matching obsoleted in OTP 22.
# ================================================================
-%warm
+%cold
bs_start_match2 Fail=f ica X Y D => jump Fail
bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D
i_bs_start_match2 xy f t t d
+bs_save2 Y=y Index => move Y x | bs_save2 x Index
bs_save2 Reg Index => gen_bs_save(Reg, Index)
-i_bs_save2 xy t
+i_bs_save2 x t
+bs_restore2 Y=y Index => move Y x | bs_restore2 x Index
bs_restore2 Reg Index => gen_bs_restore(Reg, Index)
-i_bs_restore2 xy t
+i_bs_restore2 x t
+
+bs_context_to_binary Y=y | line L | badmatch Y => \
+ move Y x | bs_context_to_binary x | line L | badmatch x
+bs_context_to_binary Y=y => move Y x | bs_context_to_binary x
+bs_context_to_binary x
+%warm
+
+# ================================================================
+# New bit syntax matching (R11B).
+# ================================================================
+
+%warm
# Matching integers
bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val
@@ -1118,7 +1160,7 @@ i_bs_get_integer_imm Ms Bits Live Fail Flags Y=y => \
i_bs_get_integer_small_imm xy W f? t x
i_bs_get_integer_imm xy W t f? t x
-i_bs_get_integer f? t t xy s d
+i_bs_get_integer xy f? t t s d
i_bs_get_integer_8 xy f? d
i_bs_get_integer_16 xy f? d
@@ -1130,9 +1172,9 @@ i_bs_get_integer_32 xy f? d
bs_get_binary2 Fail=f Ms=xy Live=u Sz=sq Unit=u Flags=u Dst=d => \
gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst)
-i_bs_get_binary_imm2 f? xy t W t d
-i_bs_get_binary2 f xy t? s t d
-i_bs_get_binary_all2 f? xy t t d
+i_bs_get_binary_imm2 xy f? t W t d
+i_bs_get_binary2 xy f t? s t d
+i_bs_get_binary_all2 xy f? t t d
i_bs_get_binary_all_reuse xy f? t
# Fetching float from binaries.
@@ -1141,7 +1183,7 @@ bs_get_float2 Fail=f Ms=xy Live=u Sz=s Unit=u Flags=u Dst=d => \
bs_get_float2 Fail=f Ms=x Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail
-i_bs_get_float2 f? xy t s t d
+i_bs_get_float2 xy f? t s t d
# Miscellanous
@@ -1149,8 +1191,7 @@ bs_skip_bits2 Fail=f Ms=xy Sz=sq Unit=u Flags=u => \
gen_skip_bits2(Fail, Ms, Sz, Unit, Flags)
i_bs_skip_bits_imm2 f? xy W
-i_bs_skip_bits2 f? xy xy t
-i_bs_skip_bits_all2 f? xy t
+i_bs_skip_bits2 xy xy f? t
bs_test_tail2 Fail=f Ms=xy Bits=u==0 => bs_test_zero_tail2 Fail Ms
bs_test_tail2 Fail=f Ms=xy Bits=u => bs_test_tail_imm2 Fail Ms Bits
@@ -1161,16 +1202,6 @@ bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms
bs_test_unit f? xy t
bs_test_unit8 f? xy
-# An y register operand for bs_context_to_binary is rare,
-# but can happen because of inlining.
-
-bs_context_to_binary Y=y | line L | badmatch Y => \
- move Y x | bs_context_to_binary x | line L | badmatch x
-
-bs_context_to_binary Y=y => move Y x | bs_context_to_binary x
-
-bs_context_to_binary x
-
# Gets a bitstring from the tail of a context.
bs_get_tail xy d t
@@ -1296,31 +1327,35 @@ i_bs_private_append j? t s S x
bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \
gen_put_integer(Fail, Sz, Unit, Flags, Src)
-i_new_bs_put_integer j? s t s
-i_new_bs_put_integer_imm j? W t s
+i_new_bs_put_integer j? S t s
+i_new_bs_put_integer_imm xyc j? W t
#
# Utf8/utf16/utf32 support. (R12B-5)
#
-bs_utf8_size j Src=s Dst=d => i_bs_utf8_size Src Dst
-
-i_bs_utf8_size s x
+bs_utf8_size j Src Dst=d => i_bs_utf8_size Src Dst
+bs_utf16_size j Src Dst=d => i_bs_utf16_size Src Dst
-bs_utf16_size j Src=s Dst=d => i_bs_utf16_size Src Dst
+bs_put_utf8 Fail u Src => i_bs_put_utf8 Fail Src
-i_bs_utf16_size s x
-
-bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src
+bs_put_utf32 Fail=j Flags=u Src=s => \
+ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src
-i_bs_put_utf8 j? s
+i_bs_utf8_size S x
+i_bs_utf16_size S x
-bs_put_utf16 j? t s
+i_bs_put_utf8 j? S
+bs_put_utf16 j? t S
-bs_put_utf32 Fail=j Flags=u Src=s => \
- i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src
+i_bs_validate_unicode j? S
-i_bs_validate_unicode j? s
+# Handle unoptimized code.
+i_bs_utf8_size Src=c Dst => move Src x | i_bs_utf8_size x Dst
+i_bs_utf16_size Src=c Dst => move Src x | i_bs_utf16_size x Dst
+i_bs_put_utf8 Fail Src=c => move Src x | i_bs_put_utf8 Fail x
+bs_put_utf16 Fail Flags Src=c => move Src x | bs_put_utf16 Fail Flags x
+i_bs_validate_unicode Fail Src=c => move Src x | i_bs_validate_unicode Fail x
#
# Storing floats into binaries.
@@ -1330,7 +1365,7 @@ bs_put_float Fail Sz=q Unit Flags Val => badarg Fail
bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_float(Fail, Sz, Unit, Flags, Src)
-i_new_bs_put_float j? s t s
+i_new_bs_put_float j? S t s
i_new_bs_put_float_imm j? W t s
#
@@ -1340,9 +1375,18 @@ i_new_bs_put_float_imm j? W t s
bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \
gen_put_binary(Fail, Sz, Unit, Flags, Src)
-i_new_bs_put_binary j? s t s
-i_new_bs_put_binary_imm j? W s
-i_new_bs_put_binary_all j? s t
+# In unoptimized code, the binary argument could be a literal. (In optimized code,
+# there would be a bs_put_string instruction.)
+i_new_bs_put_binary Fail Size Unit Lit=c => \
+ move Lit x | i_new_bs_put_binary Fail Size Unit x
+i_new_bs_put_binary_imm Fail Size Lit=c => \
+ move Lit x | i_new_bs_put_binary_imm Fail Size x
+i_new_bs_put_binary_all Lit=c Fail Unit => \
+ move Lit x | i_new_bs_put_binary_all x Fail Unit
+
+i_new_bs_put_binary j? S t S
+i_new_bs_put_binary_imm j? W S
+i_new_bs_put_binary_all xy j? t
#
# Warning: The i_bs_put_string and i_new_bs_put_string instructions
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 869a575cb4..a6312293cc 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -111,6 +111,23 @@
#endif
#endif
+/*
+ * Test for clang's convenient __has_builtin feature checking macro.
+ */
+#ifndef __has_builtin
+ #define __has_builtin(x) 0
+#endif
+
+/*
+ * Define HAVE_OVERFLOW_CHECK_BUILTINS if the overflow checking arithmetic
+ * builtins are available.
+ */
+#if ERTS_AT_LEAST_GCC_VSN__(5, 1, 0)
+# define HAVE_OVERFLOW_CHECK_BUILTINS 1
+#elif __has_builtin(__builtin_mul_overflow)
+# define HAVE_OVERFLOW_CHECK_BUILTINS 1
+#endif
+
#include "erl_misc_utils.h"
/*
@@ -1291,4 +1308,13 @@ erts_raw_env_next_char(byte *p, int encoding)
#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */
+/*
+ * Magic numbers for our driver port_control callbacks.
+ * Kept them below 1<<27 to not inflict extra bignum garbage on 32-bit.
+ */
+#define ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER 0x018b0900U
+#define ERTS_INET_DRV_CONTROL_MAGIC_NUMBER 0x03f1a300U
+#define ERTS_SPAWN_DRV_CONTROL_MAGIC_NUMBER 0x04c76a00U
+#define ERTS_FORKER_DRV_CONTROL_MAGIC_NUMBER 0x050a7800U
+
#endif
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 1e7b494a91..36cfe0548e 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -1946,7 +1946,7 @@ do_allocate_logger_message(Eterm gleader, ErtsMonotonicTime *ts, Eterm *pid,
else
sz += MAP4_SZ /* metadata map w gl w pid*/;
- *ts = ERTS_MONOTONIC_TO_USEC(erts_get_monotonic_time(NULL) + erts_get_time_offset());
+ *ts = ERTS_MONOTONIC_TO_USEC(erts_os_system_time());
erts_bld_sint64(NULL, &sz, *ts);
*bp = new_message_buffer(sz);
@@ -2701,7 +2701,8 @@ Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
if((AN)->sysname != (BN)->sysname) \
RETURN_NEQ(erts_cmp_atoms((AN)->sysname, (BN)->sysname)); \
ASSERT((AN)->creation != (BN)->creation); \
- RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \
+ if ((AN)->creation != 0 && (BN)->creation != 0) \
+ RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \
} \
} while (0)
@@ -3486,7 +3487,7 @@ store_external_or_ref_(Uint **hpp, ErlOffHeap* oh, Eterm ns)
if (is_external_header(*from_hp)) {
ExternalThing *etp = (ExternalThing *) from_hp;
ASSERT(is_external(ns));
- erts_refc_inc(&etp->node->refc, 2);
+ erts_ref_node_entry(etp->node, 2, make_boxed(to_hp));
}
else if (is_ordinary_ref_thing(from_hp))
return make_internal_ref(to_hp);
diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c
index 1c7aa56199..c93966d24f 100644
--- a/erts/emulator/drivers/common/inet_drv.c
+++ b/erts/emulator/drivers/common/inet_drv.c
@@ -574,7 +574,7 @@ static int my_strncasecmp(const char *s1, const char *s2, size_t n)
driver_select(port, e, mode | (on?ERL_DRV_USE:0), on)
#define sock_select(d, flags, onoff) do { \
- ASSERT(!(d)->is_ignored); \
+ ASSERT(!INET_IGNORED(d)); \
(d)->event_mask = (onoff) ? \
((d)->event_mask | (flags)) : \
((d)->event_mask & ~(flags)); \
@@ -898,6 +898,15 @@ static size_t my_strnlen(const char *s, size_t maxlen)
#define INET_CMSG_RECVTCLASS (1 << 1) /* am_recvtclass, am_tclass */
#define INET_CMSG_RECVTTL (1 << 2) /* am_recvttl, am_ttl */
+/* Inet flags */
+#define INET_FLG_BUFFER_SET (1 << 0) /* am_buffer has been set by user */
+#define INET_FLG_IS_IGNORED (1 << 1) /* If a fd is ignored by the inet_drv.
+ This flag should be set to true when
+ the fd is used outside of inet_drv. */
+#define INET_FLG_IS_IGNORED_RD (1 << 2)
+#define INET_FLG_IS_IGNORED_WR (1 << 3)
+#define INET_FLG_IS_IGNORED_PASS (1 << 4)
+
/*
** End of interface constants.
**--------------------------------------------------------------------------*/
@@ -943,10 +952,11 @@ static size_t my_strnlen(const char *s, size_t maxlen)
#define INET_IFNAMSIZ 16
/* INET Ignore states */
-#define INET_IGNORE_NONE 0
-#define INET_IGNORE_READ (1 << 0)
-#define INET_IGNORE_WRITE (1 << 1)
-#define INET_IGNORE_PASSIVE (1 << 2)
+#define INET_IGNORE_CLEAR(desc) ((desc)->flags & ~(INET_IGNORE_READ|INET_IGNORE_WRITE|INET_IGNORE_PASSIVE))
+#define INET_IGNORED(desc) ((desc)->flags & INET_FLG_IS_IGNORED)
+#define INET_IGNORE_READ (INET_FLG_IS_IGNORED|INET_FLG_IS_IGNORED_RD)
+#define INET_IGNORE_WRITE (INET_FLG_IS_IGNORED|INET_FLG_IS_IGNORED_WR)
+#define INET_IGNORE_PASSIVE (INET_FLG_IS_IGNORED|INET_FLG_IS_IGNORED_PASS)
/* Max length of Erlang Term Buffer (for outputting structured terms): */
#ifdef HAVE_SCTP
@@ -1128,9 +1138,7 @@ typedef struct {
double send_avg; /* average packet size sent */
subs_list empty_out_q_subs; /* Empty out queue subscribers */
- int is_ignored; /* if a fd is ignored by the inet_drv.
- This flag should be set to true when
- the fd is used outside of inet_drv. */
+ int flags;
#ifdef HAVE_SETNS
char *netns; /* Socket network namespace name
as full file path */
@@ -4551,7 +4559,7 @@ static void desc_close(inet_descriptor* desc)
* We should close the fd here, but the other driver might still
* be selecting on it.
*/
- if (!desc->is_ignored)
+ if (!INET_IGNORED(desc))
driver_select(desc->port,(ErlDrvEvent)(long)desc->event,
ERL_DRV_USE, 0);
else
@@ -6312,6 +6320,7 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
(long)desc->port, desc->s, ival));
if (ival < INET_MIN_BUFFER) ival = INET_MIN_BUFFER;
desc->bufsz = ival;
+ desc->flags |= INET_FLG_BUFFER_SET;
continue;
case INET_LOPT_ACTIVE:
@@ -6507,6 +6516,16 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
case INET_OPT_RCVBUF: type = SO_RCVBUF;
DEBUGF(("inet_set_opts(%ld): s=%d, SO_RCVBUF=%d\r\n",
(long)desc->port, desc->s, ival));
+ if (!(desc->flags & INET_FLG_BUFFER_SET)) {
+ /* make sure we have desc->bufsz >= SO_RCVBUF */
+ if (ival > (1 << 16) && desc->stype == SOCK_DGRAM && !IS_SCTP(desc))
+ /* For UDP we don't want to automatically
+ set the buffer size to be larger than
+ the theoretical max MTU */
+ desc->bufsz = 1 << 16;
+ else if (ival > desc->bufsz)
+ desc->bufsz = ival;
+ }
break;
case INET_OPT_LINGER: type = SO_LINGER;
if (len < 4)
@@ -6752,23 +6771,17 @@ static int inet_set_opts(inet_descriptor* desc, char* ptr, int len)
}
DEBUGF(("inet_set_opts(%ld): s=%d returned %d\r\n",
(long)desc->port, desc->s, res));
- if (type == SO_RCVBUF) {
- /* make sure we have desc->bufsz >= SO_RCVBUF */
- if (ival > (1 << 16) && desc->stype == SOCK_DGRAM && !IS_SCTP(desc))
- /* For UDP we don't want to automatically
- set the buffer size to be larger than
- the theoretical max MTU */
- desc->bufsz = 1 << 16;
- else if (ival > desc->bufsz)
- desc->bufsz = ival;
- }
}
if ( ((desc->stype == SOCK_STREAM) && IS_CONNECTED(desc)) ||
((desc->stype == SOCK_DGRAM) && IS_OPEN(desc))) {
- if (desc->active != old_active)
+ if (desc->active != old_active) {
+ /* Need to cancel the read_packet timer if we go from active to passive. */
+ if (desc->active == INET_PASSIVE && desc->stype == SOCK_DGRAM)
+ driver_cancel_timer(desc->port);
sock_select(desc, (FD_READ|FD_CLOSE), (desc->active>0));
+ }
/* XXX: UDP sockets could also trigger immediate read here NIY */
if ((desc->stype==SOCK_STREAM) && desc->active) {
@@ -6910,6 +6923,7 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
if (desc->bufsz < INET_MIN_BUFFER)
desc->bufsz = INET_MIN_BUFFER;
+ desc->flags |= INET_FLG_BUFFER_SET;
res = 0; /* This does not affect the kernel buffer size */
continue;
@@ -7031,6 +7045,7 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
smaller than the kernel one: */
if (desc->bufsz <= arg.ival)
desc->bufsz = arg.ival;
+ desc->flags |= INET_FLG_BUFFER_SET;
break;
}
case INET_OPT_SNDBUF:
@@ -7041,10 +7056,6 @@ static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len)
arg_ptr = (char*) (&arg.ival);
arg_sz = sizeof ( arg.ival);
- /* Adjust the size of the user-level recv buffer, so it's not
- smaller than the kernel one: */
- if (desc->bufsz <= arg.ival)
- desc->bufsz = arg.ival;
break;
}
case INET_OPT_REUSEADDR:
@@ -9101,7 +9112,7 @@ static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol)
sys_memzero((char *)&desc->remote,sizeof(desc->remote));
- desc->is_ignored = 0;
+ desc->flags = 0;
#ifdef HAVE_SETNS
desc->netns = NULL;
@@ -9503,19 +9514,19 @@ static ErlDrvSSizeT inet_ctl(inet_descriptor* desc, int cmd, char* buf,
if (desc->stype != SOCK_STREAM)
return ctl_error(EINVAL, rbuf, rsize);
- if (*buf == 1 && !desc->is_ignored) {
+ if (*buf == 1 && !INET_IGNORED(desc)) {
sock_select(desc, (FD_READ|FD_WRITE|FD_CLOSE|ERL_DRV_USE_NO_CALLBACK), 0);
if (desc->active)
- desc->is_ignored = INET_IGNORE_READ;
+ desc->flags |= INET_IGNORE_READ;
else
- desc->is_ignored = INET_IGNORE_PASSIVE;
- } else if (*buf == 0 && desc->is_ignored) {
+ desc->flags |= INET_IGNORE_PASSIVE;
+ } else if (*buf == 0 && INET_IGNORED(desc)) {
int flags = FD_CLOSE;
- if (desc->is_ignored & INET_IGNORE_READ)
+ if (desc->flags & INET_IGNORE_READ)
flags |= FD_READ;
- if (desc->is_ignored & INET_IGNORE_WRITE)
+ if (desc->flags & INET_IGNORE_WRITE)
flags |= FD_WRITE;
- desc->is_ignored = INET_IGNORE_NONE;
+ desc->flags = INET_IGNORE_CLEAR(desc);
if (flags != FD_CLOSE)
sock_select(desc, flags, 1);
} else
@@ -9955,6 +9966,7 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
{
tcp_descriptor* desc = (tcp_descriptor*)e;
+ cmd -= ERTS_INET_DRV_CONTROL_MAGIC_NUMBER;
switch(cmd) {
case INET_REQ_OPEN: { /* open socket and return internal index */
int domain;
@@ -10230,17 +10242,17 @@ static ErlDrvSSizeT tcp_inet_ctl(ErlDrvData e, unsigned int cmd,
if (enq_async(INETP(desc), tbuf, TCP_REQ_RECV) < 0)
return ctl_error(EALREADY, rbuf, rsize);
- if (INETP(desc)->is_ignored || tcp_recv(desc, n) == 0) {
+ if (INET_IGNORED(INETP(desc)) || tcp_recv(desc, n) == 0) {
if (timeout == 0)
async_error_am(INETP(desc), am_timeout);
else {
if (timeout != INET_INFINITY)
add_multi_timer(desc, INETP(desc)->port, 0,
timeout, &tcp_inet_recv_timeout);
- if (!INETP(desc)->is_ignored)
+ if (!INET_IGNORED(INETP(desc)))
sock_select(INETP(desc),(FD_READ|FD_CLOSE),1);
else
- INETP(desc)->is_ignored |= INET_IGNORE_READ;
+ INETP(desc)->flags |= INET_IGNORE_READ;
}
}
return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize);
@@ -11107,7 +11119,7 @@ static int tcp_inet_input(tcp_descriptor* desc, HANDLE event)
#ifdef DEBUG
long port = (long) desc->inet.port; /* Used after driver_exit() */
#endif
- ASSERT(!INETP(desc)->is_ignored);
+ ASSERT(!INET_IGNORED(INETP(desc)));
DEBUGF(("tcp_inet_input(%ld) {s=%d\r\n", port, desc->inet.s));
/* XXX fprintf(stderr,"tcp_inet_input(%ld) {s=%d}\r\n",(long) desc->inet.port, desc->inet.s); */
if (desc->inet.state == INET_STATE_ACCEPTING) {
@@ -11442,8 +11454,8 @@ static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev)
DEBUGF(("tcp_sendv(%ld): s=%d, about to send "LLU","LLU" bytes\r\n",
(long)desc->inet.port, desc->inet.s, (llu_t)h_len, (llu_t)len));
- if (INETP(desc)->is_ignored) {
- INETP(desc)->is_ignored |= INET_IGNORE_WRITE;
+ if (INET_IGNORED(INETP(desc))) {
+ INETP(desc)->flags |= INET_IGNORE_WRITE;
n = 0;
} else if (desc->tcp_add_flags & TCP_ADDF_DELAY_SEND) {
driver_enqv(ix, ev, 0);
@@ -11478,7 +11490,7 @@ static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev)
DEBUGF(("tcp_sendv(%ld): s=%d, Send failed, queuing\r\n",
(long)desc->inet.port, desc->inet.s));
driver_enqv(ix, ev, n);
- if (!INETP(desc)->is_ignored)
+ if (!INET_IGNORED(INETP(desc)))
sock_select(INETP(desc),(FD_WRITE|FD_CLOSE), 1);
}
return 0;
@@ -11547,8 +11559,8 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, ErlDrvSizeT len)
DEBUGF(("tcp_send(%ld): s=%d, about to send "LLU","LLU" bytes\r\n",
(long)desc->inet.port, desc->inet.s, (llu_t)h_len, (llu_t)len));
- if (INETP(desc)->is_ignored) {
- INETP(desc)->is_ignored |= INET_IGNORE_WRITE;
+ if (INET_IGNORED(INETP(desc))) {
+ INETP(desc)->flags |= INET_IGNORE_WRITE;
n = 0;
} else if (desc->tcp_add_flags & TCP_ADDF_DELAY_SEND) {
sock_send(desc->inet.s, buf, 0, 0);
@@ -11581,7 +11593,7 @@ static int tcp_send(tcp_descriptor* desc, char* ptr, ErlDrvSizeT len)
n -= h_len;
driver_enq(ix, ptr+n, len-n);
}
- if (!INETP(desc)->is_ignored)
+ if (!INET_IGNORED(INETP(desc)))
sock_select(INETP(desc),(FD_WRITE|FD_CLOSE), 1);
}
return 0;
@@ -11862,7 +11874,7 @@ static int tcp_inet_output(tcp_descriptor* desc, HANDLE event)
int ret = 0;
ErlDrvPort ix = desc->inet.port;
- ASSERT(!INETP(desc)->is_ignored);
+ ASSERT(!INET_IGNORED(INETP(desc)));
DEBUGF(("tcp_inet_output(%ld) {s=%d\r\n",
(long)desc->inet.port, desc->inet.s));
if (desc->inet.state == INET_STATE_CONNECTING) {
@@ -12184,6 +12196,7 @@ static ErlDrvSSizeT packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf,
int type = SOCK_DGRAM;
int af = AF_INET;
+ cmd -= ERTS_INET_DRV_CONTROL_MAGIC_NUMBER;
switch(cmd) {
case INET_REQ_OPEN: /* open socket and return internal index */
DEBUGF(("packet_inet_ctl(%ld): OPEN\r\n", (long)desc->port));
@@ -12536,9 +12549,12 @@ static void packet_inet_timeout(ErlDrvData e)
{
udp_descriptor * udesc = (udp_descriptor*) e;
inet_descriptor * desc = INETP(udesc);
- if (!(desc->active))
+ if (!(desc->active)) {
sock_select(desc, FD_READ, 0);
- async_error_am (desc, am_timeout);
+ async_error_am (desc, am_timeout);
+ } else {
+ (void)packet_inet_input(udesc, desc->s);
+ }
}
@@ -12894,6 +12910,15 @@ static int packet_inet_input(udp_descriptor* udesc, HANDLE event)
sock_select(desc, FD_READ, 1);
}
#endif
+
+ /* We set a timer on the port to trigger now.
+ This emulates a "yield" operation as that is
+ what we want to do here. We do *NOT* do a deselect
+ as that is expensive, instead we check if the
+ socket it still active when the timeout triggers
+ and if it is not, then we just ignore the timeout */
+ driver_set_timer(desc->port, 0);
+
return count;
}
diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c
index 11bb4373d8..f6864f96da 100644
--- a/erts/emulator/drivers/unix/ttsl_drv.c
+++ b/erts/emulator/drivers/unix/ttsl_drv.c
@@ -394,6 +394,8 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data,
{
char resbuff[2*sizeof(Uint32)];
ErlDrvSizeT res_size;
+
+ command -= ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER;
switch (command) {
case CTRL_OP_GET_WINSIZE:
{
@@ -419,7 +421,7 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data,
}
break;
default:
- return 0;
+ return -1;
}
if (rlen < res_size) {
*rbuf = driver_alloc(res_size);
diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c
index 99e7fb25a4..d19bfa3079 100644
--- a/erts/emulator/drivers/win32/ttsl_drv.c
+++ b/erts/emulator/drivers/win32/ttsl_drv.c
@@ -176,6 +176,8 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data,
{
char resbuff[2*sizeof(Uint32)];
ErlDrvSizeT res_size;
+
+ command -= ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER;
switch (command) {
case CTRL_OP_GET_WINSIZE:
{
@@ -201,7 +203,7 @@ static ErlDrvSSizeT ttysl_control(ErlDrvData drv_data,
}
break;
default:
- return 0;
+ return -1;
}
if (rlen < res_size) {
*rbuf = driver_alloc(res_size);
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index 211ce0492a..80e5d81023 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -579,7 +579,7 @@ Eterm hipe_check_get_msg(Process *c_p)
if (ERTS_SIG_IS_EXTERNAL_MSG(msgp)) {
/* FIXME: bump appropriate amount... */
- if (!erts_decode_dist_message(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) {
+ if (!erts_proc_sig_decode_dist(c_p, ERTS_PROC_LOCK_MAIN, msgp, 0)) {
/*
* A corrupt distribution message that we weren't able to decode;
* remove it...
diff --git a/erts/emulator/internal_doc/CountingInstructions.md b/erts/emulator/internal_doc/CountingInstructions.md
new file mode 100644
index 0000000000..d4b1213d00
--- /dev/null
+++ b/erts/emulator/internal_doc/CountingInstructions.md
@@ -0,0 +1,53 @@
+Counting Instructions
+=====================
+
+Here is an example that shows how to count how many times each
+instruction is executed:
+
+ $ (cd erts/emulator && make icount)
+ MAKE icount
+ make[1]: Entering directory `/home/uabbgus/otp/erts/emulator'
+ .
+ .
+ .
+ make[1]: Leaving directory `/home/uabbgus/otp/erts/emulator'
+ $ cat t.erl
+ -module(t).
+ -compile([export_all,nowarn_export_all]).
+
+ count() ->
+ erts_debug:ic(fun benchmark/0).
+
+ benchmark() ->
+ %% Run dialyzer.
+ Root = code:root_dir(),
+ Wc1 = filename:join(Root, "lib/{kernel,stdlib}/ebin/*.beam"),
+ Wc2 = filename:join(Root, "erts/preloaded/ebin/*.beam"),
+ Files = filelib:wildcard(Wc1) ++ filelib:wildcard(Wc2),
+ Opts = [{analysis_type,plt_build},{files,Files},{get_warnings,true}],
+ dialyzer:run(Opts).
+ $ $ERL_TOP/bin/cerl -icount
+ Erlang/OTP 22 [RELEASE CANDIDATE 1] [erts-10.2.4] [source-ac0d451] [64-bit] [smp:4:4] [ds:4:4:10] [async-threads:1] [hipe] [instruction-counting]
+
+ Eshell V10.2.4 (abort with ^G)
+ 1> c(t).
+ {ok,t}
+ 2> t:count().
+ 0 badarg_j
+ 0 badmatch_x
+ 0 bs_add_jsstx
+ 0 bs_context_to_binary_x
+ .
+ .
+ .
+ 536461394 move_call_last_yfQ
+ 552405176 allocate_tt
+ 619920327 i_is_eq_exact_immed_frc
+ 636419163 is_nonempty_list_allocate_frtt
+ 641859278 i_get_tuple_element_xPx
+ 678196718 move_return_c
+ 786289914 is_tagged_tuple_frAa
+ 865826424 i_call_f
+ Total: 20728870321
+ []
+ 3>
diff --git a/erts/emulator/nifs/common/net_nif.c b/erts/emulator/nifs/common/net_nif.c
new file mode 100644
index 0000000000..252aa3c835
--- /dev/null
+++ b/erts/emulator/nifs/common/net_nif.c
@@ -0,0 +1,1656 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2019. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : The NIF (C) part of the net interface
+ * This is a module of miscellaneous functions.
+ * ----------------------------------------------------------------------
+ *
+ */
+
+#define STATIC_ERLANG_NIF 1
+
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+/* If we HAVE_SCTP_H and Solaris, we need to define the following in
+ * order to get SCTP working:
+ */
+#if (defined(HAVE_SCTP_H) && defined(__sun) && defined(__SVR4))
+#define SOLARIS10 1
+/* WARNING: This is not quite correct, it may also be Solaris 11! */
+#define _XPG4_2
+#define __EXTENSIONS__
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <ctype.h>
+#include <sys/types.h>
+#include <errno.h>
+#include <time.h>
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#ifdef HAVE_SYS_UIO_H
+#include <sys/uio.h>
+#endif
+
+#ifdef HAVE_NET_IF_DL_H
+#include <net/if_dl.h>
+#endif
+
+#ifdef HAVE_IFADDRS_H
+#include <ifaddrs.h>
+#endif
+
+#ifdef HAVE_NETPACKET_PACKET_H
+#include <netpacket/packet.h>
+#endif
+
+#ifdef HAVE_SYS_UN_H
+#include <sys/un.h>
+#endif
+
+/* SENDFILE STUFF HERE IF WE NEED IT... */
+
+#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
+#define __DARWIN__ 1
+#endif
+
+
+#ifdef __WIN32__
+#define STRNCASECMP strncasecmp
+#define INCL_WINSOCK_API_TYPEDEFS 1
+
+#ifndef WINDOWS_H_INCLUDES_WINSOCK2_H
+#include <winsock2.h>
+#endif
+#include <windows.h>
+#include <Ws2tcpip.h> /* NEED VC 6.0 or higher */
+
+/* Visual studio 2008+: NTDDI_VERSION needs to be set for iphlpapi.h
+ * to define the right structures. It needs to be set to WINXP (or LONGHORN)
+ * for IPV6 to work and it's set lower by default, so we need to change it.
+ */
+#ifdef HAVE_SDKDDKVER_H
+# include <sdkddkver.h>
+# ifdef NTDDI_VERSION
+# undef NTDDI_VERSION
+# endif
+# define NTDDI_VERSION NTDDI_WINXP
+#endif
+#include <iphlpapi.h>
+
+#undef WANT_NONBLOCKING
+#include "sys.h"
+
+#else /* !__WIN32__ */
+
+#include <sys/time.h>
+#ifdef NETDB_H_NEEDS_IN_H
+#include <netinet/in.h>
+#endif
+#include <netdb.h>
+
+#include <sys/socket.h>
+#include <netinet/in.h>
+
+#ifdef DEF_INADDR_LOOPBACK_IN_RPC_TYPES_H
+#include <rpc/types.h>
+#endif
+
+#include <netinet/ip.h>
+#include <netinet/tcp.h>
+#include <netinet/udp.h>
+#include <arpa/inet.h>
+
+#include <sys/param.h>
+#ifdef HAVE_ARPA_NAMESER_H
+#include <arpa/nameser.h>
+#endif
+
+#ifdef HAVE_SYS_SOCKIO_H
+#include <sys/sockio.h>
+#endif
+
+#ifdef HAVE_SYS_IOCTL_H
+#include <sys/ioctl.h>
+#endif
+
+#include <net/if.h>
+
+#ifdef HAVE_SCHED_H
+#include <sched.h>
+#endif
+
+#ifdef HAVE_SETNS_H
+#include <setns.h>
+#endif
+
+#define HAVE_UDP
+
+#ifndef WANT_NONBLOCKING
+#define WANT_NONBLOCKING
+#endif
+#include "sys.h"
+
+#endif
+
+#include <erl_nif.h>
+
+#include "socket_dbg.h"
+#include "socket_int.h"
+#include "socket_util.h"
+
+
+/* All platforms fail on malloc errors. */
+#define FATAL_MALLOC
+
+
+#ifdef __WIN32__
+#define net_gethostname(__buf__, __bufSz__) gethostname((__buf__), (__bufSz__))
+#else
+#define net_gethostname(__buf__, __bufSz__) gethostname((__buf__), (__bufSz__))
+#endif // __WIN32__
+
+
+
+/* *** Misc macros and defines *** */
+
+#ifdef __WIN32__
+#define get_errno() WSAGetLastError()
+#else
+#define get_errno() errno
+#endif
+
+
+#define HOSTNAME_LEN 256
+#define SERVICE_LEN 256
+
+
+/* MAXHOSTNAMELEN could be 64 or 255 depending
+ * on the platform. Instead, use INET_MAXHOSTNAMELEN
+ * which is always 255 across all platforms
+ */
+#define NET_MAXHOSTNAMELEN 255
+
+
+/* =================================================================== *
+ * *
+ * Various enif macros *
+ * *
+ * =================================================================== */
+
+
+#ifdef HAVE_SOCKLEN_T
+# define SOCKLEN_T socklen_t
+#else
+# define SOCKLEN_T size_t
+#endif
+
+/* Debug stuff... */
+#define NET_NIF_DEBUG_DEFAULT FALSE
+
+#define NDBG( proto ) ESOCK_DBG_PRINTF( data.debug , proto )
+
+
+typedef struct {
+ BOOLEAN_T debug;
+} NetData;
+
+
+
+/* =================================================================== *
+ * *
+ * Static data *
+ * *
+ * =================================================================== */
+
+
+static NetData data;
+
+
+
+/* ----------------------------------------------------------------------
+ * F o r w a r d s
+ * ----------------------------------------------------------------------
+ */
+
+/* THIS IS JUST TEMPORARY */
+extern char* erl_errno_id(int error);
+
+/* All the nif "callback" functions for the net API has
+ * the exact same API:
+ *
+ * nif_<funcname>(ErlNifEnv* env,
+ * int argc,
+ * const ERL_NIF_TERM argv[]);
+ *
+ * So, to simplify, use some macro magic to define those.
+ *
+ * These are the functions making up the "official" API.
+ */
+
+#define ENET_NIF_FUNCS \
+ ENET_NIF_FUNC_DEF(info); \
+ ENET_NIF_FUNC_DEF(command); \
+ ENET_NIF_FUNC_DEF(gethostname); \
+ ENET_NIF_FUNC_DEF(getnameinfo); \
+ ENET_NIF_FUNC_DEF(getaddrinfo); \
+ ENET_NIF_FUNC_DEF(if_name2index); \
+ ENET_NIF_FUNC_DEF(if_index2name); \
+ ENET_NIF_FUNC_DEF(if_names);
+
+#define ENET_NIF_FUNC_DEF(F) \
+ static ERL_NIF_TERM nif_##F(ErlNifEnv* env, \
+ int argc, \
+ const ERL_NIF_TERM argv[]);
+ENET_NIF_FUNCS
+#undef ENET_NIF_FUNC_DEF
+
+
+/* And here comes the functions that does the actual work (for the most part) */
+static ERL_NIF_TERM ncommand(ErlNifEnv* env,
+ ERL_NIF_TERM cmd);
+static ERL_NIF_TERM ngethostname(ErlNifEnv* env);
+static ERL_NIF_TERM ngetnameinfo(ErlNifEnv* env,
+ const SocketAddress* saP,
+ SOCKLEN_T saLen,
+ int flags);
+static ERL_NIF_TERM ngetaddrinfo(ErlNifEnv* env,
+ char* host,
+ char* serv);
+static ERL_NIF_TERM nif_name2index(ErlNifEnv* env,
+ char* ifn);
+static ERL_NIF_TERM nif_index2name(ErlNifEnv* env,
+ unsigned int id);
+static ERL_NIF_TERM nif_names(ErlNifEnv* env);
+static unsigned int nif_names_length(struct if_nameindex* p);
+
+/*
+static void net_dtor(ErlNifEnv* env, void* obj);
+static void net_stop(ErlNifEnv* env,
+ void* obj,
+ int fd,
+ int is_direct_call);
+static void net_down(ErlNifEnv* env,
+ void* obj,
+ const ErlNifPid* pid,
+ const ErlNifMonitor* mon);
+*/
+
+static BOOLEAN_T decode_nameinfo_flags(ErlNifEnv* env,
+ const ERL_NIF_TERM eflags,
+ int* flags);
+static BOOLEAN_T decode_nameinfo_flags_list(ErlNifEnv* env,
+ const ERL_NIF_TERM eflags,
+ int* flags);
+static
+BOOLEAN_T decode_addrinfo_string(ErlNifEnv* env,
+ const ERL_NIF_TERM eString,
+ char** stringP);
+static ERL_NIF_TERM decode_bool(ErlNifEnv* env,
+ ERL_NIF_TERM eBool,
+ BOOLEAN_T* bool);
+static ERL_NIF_TERM encode_address_infos(ErlNifEnv* env,
+ struct addrinfo* addrInfo);
+static ERL_NIF_TERM encode_address_info(ErlNifEnv* env,
+ struct addrinfo* addrInfoP);
+static unsigned int address_info_length(struct addrinfo* addrInfoP);
+
+static ERL_NIF_TERM encode_address_info_family(ErlNifEnv* env,
+ int family);
+static ERL_NIF_TERM encode_address_info_type(ErlNifEnv* env,
+ int socktype);
+static ERL_NIF_TERM encode_address_info_proto(ErlNifEnv* env,
+ int proto);
+
+static char* make_address_info(ErlNifEnv* env,
+ ERL_NIF_TERM fam,
+ ERL_NIF_TERM sockType,
+ ERL_NIF_TERM proto,
+ ERL_NIF_TERM addr,
+ ERL_NIF_TERM* ai);
+
+static BOOLEAN_T extract_debug(ErlNifEnv* env,
+ ERL_NIF_TERM map);
+static int on_load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info);
+
+
+#if HAVE_IN6
+# if ! defined(HAVE_IN6ADDR_ANY) || ! HAVE_IN6ADDR_ANY
+# if HAVE_DECL_IN6ADDR_ANY_INIT
+static const struct in6_addr in6addr_any = { { IN6ADDR_ANY_INIT } };
+# else
+static const struct in6_addr in6addr_any =
+ { { { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 } } };
+# endif /* HAVE_IN6ADDR_ANY_INIT */
+# endif /* ! HAVE_DECL_IN6ADDR_ANY */
+
+# if ! defined(HAVE_IN6ADDR_LOOPBACK) || ! HAVE_IN6ADDR_LOOPBACK
+# if HAVE_DECL_IN6ADDR_LOOPBACK_INIT
+static const struct in6_addr in6addr_loopback =
+ { { IN6ADDR_LOOPBACK_INIT } };
+# else
+static const struct in6_addr in6addr_loopback =
+ { { { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 } } };
+# endif /* HAVE_IN6ADDR_LOOPBACk_INIT */
+# endif /* ! HAVE_DECL_IN6ADDR_LOOPBACK */
+#endif /* HAVE_IN6 */
+
+
+
+/* *** Local atoms *** */
+
+#define LOCAL_ATOMS \
+ LOCAL_ATOM_DECL(address_info); \
+ LOCAL_ATOM_DECL(debug); \
+ LOCAL_ATOM_DECL(host); \
+ LOCAL_ATOM_DECL(idn); \
+ LOCAL_ATOM_DECL(idna_allow_unassigned); \
+ LOCAL_ATOM_DECL(idna_use_std3_ascii_rules); \
+ LOCAL_ATOM_DECL(namereqd); \
+ LOCAL_ATOM_DECL(name_info); \
+ LOCAL_ATOM_DECL(nofqdn); \
+ LOCAL_ATOM_DECL(numerichost); \
+ LOCAL_ATOM_DECL(numericserv); \
+ LOCAL_ATOM_DECL(service);
+
+#define LOCAL_ERROR_REASON_ATOMS \
+ LOCAL_ATOM_DECL(eaddrfamily); \
+ LOCAL_ATOM_DECL(ebadflags); \
+ LOCAL_ATOM_DECL(efail); \
+ LOCAL_ATOM_DECL(efamily); \
+ LOCAL_ATOM_DECL(efault); \
+ LOCAL_ATOM_DECL(emem); \
+ LOCAL_ATOM_DECL(enametoolong); \
+ LOCAL_ATOM_DECL(enodata); \
+ LOCAL_ATOM_DECL(enoname); \
+ LOCAL_ATOM_DECL(enxio); \
+ LOCAL_ATOM_DECL(eoverflow); \
+ LOCAL_ATOM_DECL(eservice); \
+ LOCAL_ATOM_DECL(esocktype); \
+ LOCAL_ATOM_DECL(esystem);
+
+#define LOCAL_ATOM_DECL(A) static ERL_NIF_TERM atom_##A
+LOCAL_ATOMS
+LOCAL_ERROR_REASON_ATOMS
+#undef LOCAL_ATOM_DECL
+
+
+/* *** net *** */
+static ErlNifResourceType* net;
+static ErlNifResourceTypeInit netInit = {
+ NULL, // net_dtor,
+ NULL, // net_stop,
+ NULL // (ErlNifResourceDown*) net_down
+};
+
+
+
+/* ----------------------------------------------------------------------
+ * N I F F u n c t i o n s
+ * ----------------------------------------------------------------------
+ *
+ * Utility and admin functions:
+ * ----------------------------
+ * nif_info/0
+ * nif_command/1
+ *
+ * The "proper" net functions:
+ * ------------------------------
+ * nif_gethostname/0
+ * nif_getnameinfo/2
+ * nif_getaddrinfo/3
+ * nif_if_name2index/1
+ * nif_if_index2name/1
+ * nif_if_names/0
+ *
+ */
+
+
+/* ----------------------------------------------------------------------
+ * nif_info
+ *
+ * Description:
+ * This is currently just a placeholder...
+ */
+static
+ERL_NIF_TERM nif_info(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM info, tmp;
+
+ NDBG( ("NET", "info -> entry\r\n") );
+
+ tmp = enif_make_new_map(env);
+ if (!enif_make_map_put(env, tmp, atom_debug, BOOL2ATOM(data.debug), &info))
+ info = tmp;
+
+ NDBG( ("NET", "info -> done: %T\r\n", info) );
+
+ return info;
+#endif
+}
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_command
+ *
+ * Description:
+ * This is a general purpose utility function.
+ *
+ * Arguments:
+ * Command - This is a general purpose command, of any type.
+ * Currently, the only supported command is:
+ *
+ * {debug, boolean()}
+ */
+static
+ERL_NIF_TERM nif_command(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM ecmd, result;
+
+ NDBG( ("NET", "command -> entry (%d)\r\n", argc) );
+
+ if (argc != 1)
+ return enif_make_badarg(env);
+
+ ecmd = argv[0];
+
+ NDBG( ("NET", "command -> ecmd: %T\r\n", ecmd) );
+
+ result = ncommand(env, ecmd);
+
+ NDBG( ("NET", "command -> result: %T\r\n", result) );
+
+ return result;
+#endif
+}
+
+
+
+/*
+ * The command can, in principle, be anything, though currently we only
+ * support a debug command.
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM ncommand(ErlNifEnv* env,
+ ERL_NIF_TERM cmd)
+{
+ const ERL_NIF_TERM* t;
+ int tsz;
+
+ if (IS_TUPLE(env, cmd)) {
+ /* Could be the debug tuple */
+ if (!GET_TUPLE(env, cmd, &tsz, &t))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (tsz != 2)
+ return esock_make_error(env, esock_atom_einval);
+
+ /* First element should be the atom 'debug' */
+ if (COMPARE(t[0], atom_debug) != 0)
+ return esock_make_error(env, esock_atom_einval);
+
+ return decode_bool(env, t[1], &data.debug);
+
+ } else {
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+}
+#endif
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_gethostname
+ *
+ * Description:
+ * Access the hostname of the current processor.
+ *
+ */
+static
+ERL_NIF_TERM nif_gethostname(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM result;
+
+ NDBG( ("NET", "nif_gethostname -> entry (%d)\r\n", argc) );
+
+ if (argc != 0)
+ return enif_make_badarg(env);
+
+ result = ngethostname(env);
+
+ NDBG( ("NET", "nif_gethostname -> done when result: %T\r\n", result) );
+
+ return result;
+#endif
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM ngethostname(ErlNifEnv* env)
+{
+ ERL_NIF_TERM result;
+ char buf[NET_MAXHOSTNAMELEN + 1];
+ int res;
+
+ res = net_gethostname(buf, sizeof(buf));
+
+ NDBG( ("NET", "ngethostname -> gethostname res: %d\r\n", res) );
+
+ switch (res) {
+ case 0:
+ result = esock_make_ok2(env, MKS(env, buf));
+ break;
+
+ case EFAULT:
+ result = esock_make_error(env, atom_efault);
+ break;
+
+ case EINVAL:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+
+ case ENAMETOOLONG:
+ result = esock_make_error(env, atom_enametoolong);
+ break;
+
+ default:
+ result = esock_make_error(env, MKI(env, res));
+ break;
+ }
+
+ return result;
+}
+#endif
+
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_getnameinfo
+ *
+ * Description:
+ * Address-to-name translation in protocol-independent manner.
+ *
+ * Arguments:
+ * SockAddr - Socket Address (address and port)
+ * Flags - The flags argument modifies the behavior of getnameinfo().
+ */
+
+static
+ERL_NIF_TERM nif_getnameinfo(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM result;
+ ERL_NIF_TERM eSockAddr, eFlags;
+ int flags = 0; // Just in case...
+ SocketAddress sa;
+ SOCKLEN_T saLen = 0; // Just in case...
+ char* xres;
+
+ NDBG( ("NET", "nif_getnameinfo -> entry (%d)\r\n", argc) );
+
+ if (argc != 2)
+ return enif_make_badarg(env);
+ eSockAddr = argv[0];
+ eFlags = argv[1];
+
+ NDBG( ("NET",
+ "nif_getnameinfo -> "
+ "\r\n SockAddr: %T"
+ "\r\n Flags: %T"
+ "\r\n", eSockAddr, eFlags) );
+
+ if ((xres = esock_decode_sockaddr(env, eSockAddr, &sa, &saLen)) != NULL) {
+ NDBG( ("NET", "nif_getnameinfo -> failed decode sockaddr: %s\r\n", xres) );
+ return esock_make_error_str(env, xres);
+ }
+
+ NDBG( ("NET", "nif_getnameinfo -> (try) decode flags\r\n") );
+
+ if (!decode_nameinfo_flags(env, eFlags, &flags))
+ return enif_make_badarg(env);
+
+ result = ngetnameinfo(env, &sa, saLen, flags);
+
+ NDBG( ("NET",
+ "nif_getnameinfo -> done when result: "
+ "\r\n %T\r\n", result) );
+
+ return result;
+#endif
+}
+
+
+
+/* Given the provided sock(et) address (and flags), retreive the host and
+ * service info.
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM ngetnameinfo(ErlNifEnv* env,
+ const SocketAddress* saP,
+ SOCKLEN_T saLen,
+ int flags)
+{
+ ERL_NIF_TERM result;
+ char host[HOSTNAME_LEN];
+ SOCKLEN_T hostLen = sizeof(host);
+ char serv[SERVICE_LEN];
+ SOCKLEN_T servLen = sizeof(serv);
+
+ int res = getnameinfo((struct sockaddr*) saP, saLen,
+ host, hostLen,
+ serv, servLen,
+ flags);
+
+ NDBG( ("NET", "ngetnameinfo -> res: %d\r\n", res) );
+
+ switch (res) {
+ case 0:
+ {
+ ERL_NIF_TERM keys[] = {atom_host, atom_service};
+ ERL_NIF_TERM vals[] = {MKS(env, host), MKS(env, serv)};
+ ERL_NIF_TERM info;
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, &info))
+ return enif_make_badarg(env);
+
+ result = esock_make_ok2(env, info);
+ }
+ break;
+
+#if defined(EAI_AGAIN)
+ case EAI_AGAIN:
+ result = esock_make_error(env, esock_atom_eagain);
+ break;
+#endif
+
+#if defined(EAI_BADFLAGS)
+ case EAI_BADFLAGS:
+ result = esock_make_error(env, atom_ebadflags);
+ break;
+#endif
+
+#if defined(EAI_FAIL)
+ case EAI_FAIL:
+ result = esock_make_error(env, atom_efail);
+ break;
+#endif
+
+#if defined(EAI_FAMILY)
+ case EAI_FAMILY:
+ result = esock_make_error(env, atom_efamily);
+ break;
+#endif
+
+#if defined(EAI_MEMORY)
+ case EAI_MEMORY:
+ result = esock_make_error(env, atom_emem);
+ break;
+#endif
+
+#if defined(EAI_NONAME)
+ case EAI_NONAME:
+ result = esock_make_error(env, atom_enoname);
+ break;
+#endif
+
+#if defined(EAI_OVERFLOW)
+ case EAI_OVERFLOW:
+ result = esock_make_error(env, atom_eoverflow);
+ break;
+#endif
+
+#if defined(EAI_SYSTEM)
+ case EAI_SYSTEM:
+ result = esock_make_error_errno(env, get_errno());
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return result;
+}
+#endif
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_getaddrinfo
+ *
+ * Description:
+ * Network address and service translation.
+ *
+ * Arguments:
+ * Host - Host name (either a string or the atom undefined)
+ * Service - Service name (either a string or the atom undefined)
+ * Hints - Hints for the lookup (address info record) (currently *ignored*)
+ */
+
+static
+ERL_NIF_TERM nif_getaddrinfo(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM result, eHostName, eServName; //, eHints;
+ char* hostName;
+ char* servName;
+ // struct addrinfo* hints;
+
+ NDBG( ("NET", "nif_getaddrinfo -> entry (%d)\r\n", argc) );
+
+ if (argc != 3) {
+ return enif_make_badarg(env);
+ }
+ eHostName = argv[0];
+ eServName = argv[1];
+ // eHints = argv[2];
+
+ NDBG( ("NET",
+ "nif_getaddrinfo -> "
+ "\r\n ehost: %T"
+ "\r\n eservice: %T"
+ "\r\n ehints: %T"
+ "\r\n", argv[0], argv[1], argv[2]) );
+
+ if (!decode_addrinfo_string(env, eHostName, &hostName))
+ return enif_make_badarg(env);
+
+ if (!decode_addrinfo_string(env, eServName, &servName))
+ return enif_make_badarg(env);
+
+ /*
+ if (decode_addrinfo_hints(env, eHints, &hints))
+ return enif_make_badarg(env);
+ */
+
+ if ((hostName == NULL) && (servName == NULL))
+ return enif_make_badarg(env);
+
+ result = ngetaddrinfo(env, hostName, servName);
+
+ if (hostName != NULL)
+ FREE(hostName);
+
+ if (servName != NULL)
+ FREE(servName);
+
+ /*
+ if (hints != NULL)
+ FREE(hints);
+ */
+
+ NDBG( ("NET",
+ "nif_getaddrinfo -> done when result: "
+ "\r\n %T\r\n", result) );
+
+ return result;
+#endif
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM ngetaddrinfo(ErlNifEnv* env,
+ char* host,
+ char* serv)
+{
+ ERL_NIF_TERM result;
+ struct addrinfo* addrInfoP;
+ int res;
+
+ NDBG( ("NET", "ngetaddrinfo -> entry with"
+ "\r\n host: %s"
+ "\r\n serv: %s"
+ "\r\n",
+ ((host == NULL) ? "NULL" : host),
+ ((serv == NULL) ? "NULL" : serv)) );
+
+ res = getaddrinfo(host, serv, NULL, &addrInfoP);
+
+ NDBG( ("NET", "ngetaddrinfo -> res: %d\r\n", res) );
+
+ switch (res) {
+ case 0:
+ {
+ ERL_NIF_TERM addrInfo = encode_address_infos(env, addrInfoP);
+ freeaddrinfo(addrInfoP);
+ result = esock_make_ok2(env, addrInfo);
+ }
+ break;
+
+#if defined(EAI_ADDRFAMILY)
+ case EAI_ADDRFAMILY:
+ result = esock_make_error(env, atom_eaddrfamily);
+ break;
+#endif
+
+#if defined(EAI_AGAIN)
+ case EAI_AGAIN:
+ result = esock_make_error(env, esock_atom_eagain);
+ break;
+#endif
+
+#if defined(EAI_BADFLAGS)
+ case EAI_BADFLAGS:
+ result = esock_make_error(env, atom_ebadflags);
+ break;
+#endif
+
+#if defined(EAI_FAIL)
+ case EAI_FAIL:
+ result = esock_make_error(env, atom_efail);
+ break;
+#endif
+
+#if defined(EAI_FAMILY)
+ case EAI_FAMILY:
+ result = esock_make_error(env, atom_efamily);
+ break;
+#endif
+
+#if defined(EAI_MEMORY)
+ case EAI_MEMORY:
+ result = esock_make_error(env, atom_emem);
+ break;
+#endif
+
+#if defined(EAI_NODATA)
+ case EAI_NODATA:
+ result = esock_make_error(env, atom_enodata);
+ break;
+#endif
+
+#if defined(EAI_NONAME)
+ case EAI_NONAME:
+ result = esock_make_error(env, atom_enoname);
+ break;
+#endif
+
+#if defined(EAI_SERVICE)
+ case EAI_SERVICE:
+ result = esock_make_error(env, atom_eservice);
+ break;
+#endif
+
+#if defined(EAI_SOCKTYPE)
+ case EAI_SOCKTYPE:
+ result = esock_make_error(env, atom_esocktype);
+ break;
+#endif
+
+#if defined(EAI_SYSTEM)
+ case EAI_SYSTEM:
+ result = esock_make_error(env, atom_esystem);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return result;
+}
+#endif
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_if_name2index
+ *
+ * Description:
+ * Perform a Interface Name to Interface Index translation.
+ *
+ * Arguments:
+ * Ifn - Interface name to be translated.
+ */
+
+static
+ERL_NIF_TERM nif_if_name2index(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM eifn, result;
+ char ifn[IF_NAMESIZE+1];
+
+ NDBG( ("NET", "nif_if_name2index -> entry (%d)\r\n", argc) );
+
+ if (argc != 1) {
+ return enif_make_badarg(env);
+ }
+ eifn = argv[0];
+
+ NDBG( ("NET",
+ "nif_if_name2index -> "
+ "\r\n Ifn: %T"
+ "\r\n", argv[0]) );
+
+ if (0 >= GET_STR(env, eifn, ifn, sizeof(ifn)))
+ return esock_make_error(env, esock_atom_einval);
+
+ result = nif_name2index(env, ifn);
+
+ NDBG( ("NET", "nif_if_name2index -> done when result: %T\r\n", result) );
+
+ return result;
+#endif
+}
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nif_name2index(ErlNifEnv* env,
+ char* ifn)
+{
+ unsigned int idx;
+
+ NDBG( ("NET", "nif_name2index -> entry with ifn: %s\r\n", ifn) );
+
+ idx = if_nametoindex(ifn);
+
+ NDBG( ("NET", "nif_name2index -> idx: %d\r\n", idx) );
+
+ if (idx == 0) {
+ int save_errno = get_errno();
+ NDBG( ("NET", "nif_name2index -> failed: %d\r\n", save_errno) );
+ return esock_make_error_errno(env, save_errno);
+ } else {
+ return esock_make_ok2(env, MKI(env, idx));
+ }
+
+}
+#endif
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_if_index2name
+ *
+ * Description:
+ * Perform a Interface Index to Interface Name translation.
+ *
+ * Arguments:
+ * Idx - Interface index to be translated.
+ */
+
+static
+ERL_NIF_TERM nif_if_index2name(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM result;
+ unsigned int idx;
+
+ NDBG( ("NET", "nif_if_index2name -> entry (%d)\r\n", argc) );
+
+ if ((argc != 1) ||
+ !GET_UINT(env, argv[0], &idx)) {
+ return enif_make_badarg(env);
+ }
+
+ NDBG( ("NET", "nif_index2name -> "
+ "\r\n Idx: %T"
+ "\r\n", argv[0]) );
+
+ result = nif_index2name(env, idx);
+
+ NDBG( ("NET", "nif_if_index2name -> done when result: %T\r\n", result) );
+
+ return result;
+#endif
+}
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nif_index2name(ErlNifEnv* env,
+ unsigned int idx)
+{
+ ERL_NIF_TERM result;
+ char* ifn = MALLOC(IF_NAMESIZE+1);
+
+ if (ifn == NULL)
+ return enif_make_badarg(env); // PLACEHOLDER
+
+ if (NULL != if_indextoname(idx, ifn)) {
+ result = esock_make_ok2(env, MKS(env, ifn));
+ } else {
+ result = esock_make_error(env, atom_enxio);
+ }
+
+ FREE(ifn);
+
+ return result;
+}
+#endif
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_if_names
+ *
+ * Description:
+ * Get network interface names and indexes.
+ *
+ */
+
+static
+ERL_NIF_TERM nif_if_names(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM result;
+
+ NDBG( ("NET", "nif_if_names -> entry (%d)\r\n", argc) );
+
+ if (argc != 0) {
+ return enif_make_badarg(env);
+ }
+
+ result = nif_names(env);
+
+ NDBG( ("NET", "nif_if_names -> done when result: %T\r\n", result) );
+
+ return result;
+#endif
+}
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nif_names(ErlNifEnv* env)
+{
+ ERL_NIF_TERM result;
+ struct if_nameindex* ifs = if_nameindex();
+
+ NDBG( ("NET", "nif_names -> ifs: 0x%lX\r\n", ifs) );
+
+ if (ifs == NULL) {
+ result = esock_make_error_errno(env, get_errno());
+ } else {
+ /*
+ * We got some interfaces:
+ * 1) Calculate how many - the only way is to iterate through the list
+ * until its end (which is indicated by an entry with index = zero
+ * and if_name = NULL).
+ * 2) Allocate an ERL_NIF_TERM array of the calculated length.
+ * 3) Iterate through the array of interfaces and for each create
+ * a two tuple: {Idx, If}
+ *
+ * Or shall we instead build a list in reverse order and then when
+ * its done, reverse that? Check
+ */
+ unsigned int len = nif_names_length(ifs);
+
+ NDBG( ("NET", "nif_names -> len: %d\r\n", len) );
+
+ if (len > 0) {
+ ERL_NIF_TERM* array = MALLOC(len * sizeof(ERL_NIF_TERM));
+ unsigned int i;
+
+ for (i = 0; i < len; i++) {
+ array[i] = MKT2(env,
+ MKI(env, ifs[i].if_index),
+ MKS(env, ifs[i].if_name));
+ }
+
+ result = esock_make_ok2(env, MKLA(env, array, len));
+ FREE(array);
+ } else {
+ result = esock_make_ok2(env, enif_make_list(env, 0));
+ }
+ }
+
+ if (ifs != NULL)
+ if_freenameindex(ifs);
+
+ return result;
+}
+
+
+static
+unsigned int nif_names_length(struct if_nameindex* p)
+{
+ unsigned int len = 0;
+ BOOLEAN_T done = FALSE;
+
+ while (!done) {
+
+ NDBG( ("NET", "nif_names_length -> %d: "
+ "\r\n if_index: %d"
+ "\r\n if_name: 0x%lX"
+ "\r\n", len, p[len].if_index, p[len].if_name) );
+
+ if ((p[len].if_index == 0) && (p[len].if_name == NULL))
+ done = TRUE;
+ else
+ len++;
+ }
+
+ return len;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * U t i l i t y F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+/* The erlang format for a set of flags is a list of atoms.
+ * A special case is when there is no flags, which is
+ * represented by the atom undefined.
+ */
+#if !defined(__WIN32__)
+static
+BOOLEAN_T decode_nameinfo_flags(ErlNifEnv* env,
+ const ERL_NIF_TERM eflags,
+ int* flags)
+{
+ BOOLEAN_T result;
+
+ if (IS_ATOM(env, eflags)) {
+ NDBG( ("NET", "decode_nameinfo_flags -> is atom (%T)\r\n", eflags) );
+ if (COMPARE(eflags, esock_atom_undefined) == 0) {
+ *flags = 0;
+ result = TRUE;
+ } else {
+ result = FALSE;
+ }
+ } else if (IS_LIST(env, eflags)) {
+ NDBG( ("NET", "decode_nameinfo_flags -> is list\r\n") );
+ result = decode_nameinfo_flags_list(env, eflags, flags);
+ } else {
+ result = FALSE;
+ }
+
+ NDBG( ("NET", "decode_nameinfo_flags -> result: %s\r\n", B2S(result)) );
+
+ return result;
+}
+
+
+
+static
+BOOLEAN_T decode_nameinfo_flags_list(ErlNifEnv* env,
+ const ERL_NIF_TERM eflags,
+ int* flags)
+{
+ ERL_NIF_TERM elem, tail, list = eflags;
+ int tmp = 0;
+ BOOLEAN_T done = FALSE;
+
+ while (!done) {
+ if (GET_LIST_ELEM(env, list, &elem, &tail)) {
+ if (COMPARE(elem, atom_namereqd) == 0) {
+ tmp |= NI_NAMEREQD;
+ } else if (COMPARE(elem, esock_atom_dgram) == 0) {
+ tmp |= NI_DGRAM;
+ } else if (COMPARE(elem, atom_nofqdn) == 0) {
+ tmp |= NI_NOFQDN;
+ } else if (COMPARE(elem, atom_numerichost) == 0) {
+ tmp |= NI_NUMERICHOST;
+ } else if (COMPARE(elem, atom_numericserv) == 0) {
+ tmp |= NI_NUMERICSERV;
+
+ /* Starting with glibc 2.3.4: */
+
+#if defined(NI_IDN)
+ } else if (COMPARE(elem, atom_idn) == 0) {
+ tmp |= NI_IDN;
+#endif
+
+#if defined(NI_IDN_ALLOW_UNASSIGNED)
+ } else if (COMPARE(elem, atom_idna_allow_unassigned) == 0) {
+ tmp |= NI_IDN_ALLOW_UNASSIGNED;
+#endif
+
+#if defined(NI_IDN_USE_STD3_ASCII_RULES)
+ } else if (COMPARE(elem, atom_idna_use_std3_ascii_rules) == 0) {
+ tmp |= NI_IDN_USE_STD3_ASCII_RULES;
+#endif
+
+ } else {
+ return FALSE;
+ }
+
+ list = tail;
+
+ } else {
+ done = TRUE;
+ }
+ }
+
+ *flags = tmp;
+
+ return TRUE;
+}
+
+
+
+/* Decode the address info string (hostname or service name)
+ * The string is either the atom undefined or an actual string.
+ */
+static
+BOOLEAN_T decode_addrinfo_string(ErlNifEnv* env,
+ const ERL_NIF_TERM eString,
+ char** stringP)
+{
+ BOOLEAN_T result;
+
+ if (IS_ATOM(env, eString)) {
+
+ if (COMPARE(eString, esock_atom_undefined) == 0) {
+ *stringP = NULL;
+ result = TRUE;
+ } else {
+ *stringP = NULL;
+ result = FALSE;
+ }
+
+ } else {
+
+ result = esock_decode_string(env, eString, stringP);
+
+ }
+
+ return result;
+
+}
+
+
+
+static
+ERL_NIF_TERM decode_bool(ErlNifEnv* env,
+ ERL_NIF_TERM eBool,
+ BOOLEAN_T* bool)
+{
+ if (COMPARE(eBool, esock_atom_true) == 0) {
+ *bool = TRUE;
+ return esock_atom_ok;
+ } else if (COMPARE(eBool, esock_atom_false) == 0) {
+ *bool = FALSE;
+ return esock_atom_ok;
+ } else {
+ return esock_make_error(env, esock_atom_einval);
+ }
+}
+
+
+
+/* Encode the address info
+ * The address info is a linked list och address info, which
+ * will result in the result being a list of zero or more length.
+ */
+static
+ERL_NIF_TERM encode_address_infos(ErlNifEnv* env,
+ struct addrinfo* addrInfo)
+{
+ ERL_NIF_TERM result;
+ unsigned int len = address_info_length(addrInfo);
+
+ NDBG( ("NET", "encode_address_infos -> len: %d\r\n", len) );
+
+ if (len > 0) {
+ ERL_NIF_TERM* array = MALLOC(len * sizeof(ERL_NIF_TERM));
+ unsigned int i = 0;
+ struct addrinfo* p = addrInfo;
+
+ while (i < len) {
+ array[i] = encode_address_info(env, p);
+ p = p->ai_next;
+ i++;
+ }
+
+ result = MKLA(env, array, len);
+ FREE(array);
+ } else {
+ result = MKEL(env);
+ }
+
+ NDBG( ("NET", "encode_address_infos -> result: "
+ "\r\n %T\r\n", result) );
+
+ return result;
+}
+
+
+
+/* Calculate the length of the adress info linked list
+ * The list is NULL-terminated, so the only way is to
+ * iterate through the list until we find next = NULL.
+ */
+static
+unsigned int address_info_length(struct addrinfo* addrInfoP)
+{
+ unsigned int len = 1;
+ struct addrinfo* tmp;
+ BOOLEAN_T done = FALSE;
+
+ tmp = addrInfoP;
+
+ while (!done) {
+ if (tmp->ai_next != NULL) {
+ len++;
+ tmp = tmp->ai_next;
+ } else {
+ done = TRUE;
+ }
+ }
+
+ return len;
+}
+
+
+
+/* Create one (erlang) instance of the address info record
+ * Should we have address info as a record or as a map?
+ *
+ * {address_info, Fam, Type, Proto, Addr}
+ */
+static
+ERL_NIF_TERM encode_address_info(ErlNifEnv* env,
+ struct addrinfo* addrInfoP)
+{
+ ERL_NIF_TERM fam, type, proto, addr, addrInfo;
+
+ fam = encode_address_info_family(env, addrInfoP->ai_family);
+ type = encode_address_info_type(env, addrInfoP->ai_socktype);
+ proto = encode_address_info_proto(env, addrInfoP->ai_protocol);
+ esock_encode_sockaddr(env,
+ (SocketAddress*) addrInfoP->ai_addr,
+ addrInfoP->ai_addrlen,
+ &addr);
+
+ if (make_address_info(env, fam, type, proto, addr, &addrInfo) == NULL)
+ return addrInfo;
+ else
+ return esock_atom_undefined; // We should to better...
+
+}
+
+
+/* Convert an "native" family to an erlang family (=domain).
+ * Note that this is not currently exhaustive, but only supports
+ * inet and inet6. Other values will be returned as is, that is
+ * in the form of an integer.
+ */
+static
+ERL_NIF_TERM encode_address_info_family(ErlNifEnv* env,
+ int family)
+{
+ ERL_NIF_TERM efam;
+
+ if (NULL != esock_encode_domain(env, family, &efam))
+ efam = MKI(env, family);
+
+ return efam;
+}
+
+
+
+/* Convert an "native" socket type to an erlang socket type.
+ * Note that this is not currently exhaustive, but only supports
+ * stream and dgram. Other values will be returned as is, that is
+ * in the form of an integer.
+ */
+static
+ERL_NIF_TERM encode_address_info_type(ErlNifEnv* env,
+ int socktype)
+{
+ ERL_NIF_TERM etype;
+
+ if (NULL != esock_encode_type(env, socktype, &etype))
+ etype = MKI(env, socktype);
+
+ return etype;
+}
+
+
+
+/* Convert an "native" protocol to an erlang protocol.
+ * Note that this is not currently exhaustive, but only supports
+ * tcp and udp. Other values will be returned as is, that is
+ * in the form of an integer.
+ */
+static
+ERL_NIF_TERM encode_address_info_proto(ErlNifEnv* env,
+ int proto)
+{
+ ERL_NIF_TERM eproto;
+
+ if (NULL != esock_encode_protocol(env, proto, &eproto))
+ eproto = MKI(env, proto);
+
+ return eproto;
+}
+
+
+
+static
+char* make_address_info(ErlNifEnv* env,
+ ERL_NIF_TERM fam,
+ ERL_NIF_TERM sockType,
+ ERL_NIF_TERM proto,
+ ERL_NIF_TERM addr,
+ ERL_NIF_TERM* ai)
+{
+ ERL_NIF_TERM keys[] = {esock_atom_family,
+ esock_atom_type,
+ esock_atom_protocol,
+ esock_atom_addr};
+ ERL_NIF_TERM vals[] = {fam, sockType, proto, addr};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, ai)) {
+ *ai = esock_atom_undefined;
+ return ESOCK_STR_EINVAL;
+ } else {
+ return NULL;
+ }
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * C a l l b a c k F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+/* =========================================================================
+ * net_dtor - Callback function for resource destructor
+ *
+ */
+/*
+static
+void net_dtor(ErlNifEnv* env, void* obj)
+{
+}
+*/
+
+
+/* =========================================================================
+ * net_stop - Callback function for resource stop
+ *
+ */
+/*
+static
+void net_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call)
+{
+}
+*/
+
+
+
+
+/* =========================================================================
+ * net_down - Callback function for resource down (monitored processes)
+ *
+ */
+/*
+static
+void net_down(ErlNifEnv* env,
+ void* obj,
+ const ErlNifPid* pid,
+ const ErlNifMonitor* mon)
+{
+}
+*/
+
+
+
+/* ----------------------------------------------------------------------
+ * L o a d / u n l o a d / u p g r a d e F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+static
+ErlNifFunc net_funcs[] =
+{
+ // Some utility functions
+ {"nif_info", 0, nif_info, 0},
+ {"nif_command", 1, nif_command, 0}, // Shall we let this be dirty?
+
+ /* get/set hostname */
+ {"nif_gethostname", 0, nif_gethostname, 0},
+
+ /* address and name translation in protocol-independent manner */
+ {"nif_getnameinfo", 2, nif_getnameinfo, 0},
+ {"nif_getaddrinfo", 3, nif_getaddrinfo, 0},
+
+ /* Network interface (name and/or index) functions */
+ {"nif_if_name2index", 1, nif_if_name2index, 0},
+ {"nif_if_index2name", 1, nif_if_index2name, 0},
+ {"nif_if_names", 0, nif_if_names, 0}
+};
+
+
+#if !defined(__WIN32__)
+static
+BOOLEAN_T extract_debug(ErlNifEnv* env,
+ ERL_NIF_TERM map)
+{
+ /*
+ * We need to do this here since the "proper" atom has not been
+ * created when this function is called.
+ */
+ ERL_NIF_TERM debug = MKA(env, "debug");
+
+ return esock_extract_bool_from_map(env, map, debug, NET_NIF_DEBUG_DEFAULT);
+}
+#endif
+
+
+/* =======================================================================
+ * load_info - A map of misc info (e.g global debug)
+ */
+
+static
+int on_load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+{
+#if !defined(__WIN32__)
+ // We should make it possible to use load_info to get default values
+ data.debug = extract_debug(env, load_info);
+
+ NDBG( ("NET", "on_load -> entry\r\n") );
+#endif
+
+#define LOCAL_ATOM_DECL(A) atom_##A = MKA(env, #A)
+LOCAL_ATOMS
+LOCAL_ERROR_REASON_ATOMS
+#undef LOCAL_ATOM_DECL
+
+ // For storing "global" things...
+ // data.env = enif_alloc_env(); // We should really check
+ // data.version = MKA(env, ERTS_VERSION);
+ // data.buildDate = MKA(env, ERTS_BUILD_DATE);
+
+ net = enif_open_resource_type_x(env,
+ "net",
+ &netInit,
+ ERL_NIF_RT_CREATE,
+ NULL);
+
+#if !defined(__WIN32__)
+ NDBG( ("NET", "on_load -> done\r\n") );
+#endif
+
+ return !net;
+}
+
+ERL_NIF_INIT(net, net_funcs, on_load, NULL, NULL, NULL)
diff --git a/erts/emulator/nifs/common/socket_dbg.c b/erts/emulator/nifs/common/socket_dbg.c
new file mode 100644
index 0000000000..fe9135e5a0
--- /dev/null
+++ b/erts/emulator/nifs/common/socket_dbg.c
@@ -0,0 +1,138 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2018. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : Debug functions for the socket and net NIF(s).
+ * ----------------------------------------------------------------------
+ *
+ */
+
+#include <stdarg.h>
+#include <string.h>
+#include <stdio.h>
+#include <ctype.h>
+#include <time.h>
+
+#include <erl_nif.h>
+#include "socket_dbg.h"
+
+#define TSELF() enif_thread_self()
+#define TNAME(__T__) enif_thread_name( __T__ )
+#define TSNAME() TNAME(TSELF())
+
+static FILE* dbgout = NULL;
+
+static int realtime(struct timespec* tsP);
+static int timespec2str(char *buf, unsigned int len, struct timespec *ts);
+
+
+extern
+void esock_dbg_init(char* filename)
+{
+ if (filename != NULL) {
+ if (strcmp(filename, ESOCK_DBGOUT_DEFAULT) == 0) {
+ dbgout = stdout;
+ } else if (strcmp(filename, ESOCK_DBGOUT_UNIQUE) == 0) {
+ char template[] = "/tmp/esock-dbg-XXXXXX";
+ dbgout = fdopen(mkstemp(template), "w+");
+ } else {
+ dbgout = fopen(filename, "w+");
+ }
+ } else {
+ char template[] = "/tmp/esock-dbg-XXXXXX";
+ dbgout = fdopen(mkstemp(template), "w+");
+ }
+}
+
+
+
+/*
+ * Print a debug format string *with* both a timestamp and the
+ * the name of the *current* thread.
+ */
+extern
+void esock_dbg_printf( const char* prefix, const char* format, ... )
+{
+ va_list args;
+ char f[512 + sizeof(format)]; // This has to suffice...
+ char stamp[30];
+ struct timespec ts;
+ int res;
+
+ /*
+ * We should really include self in the printout, so we can se which process
+ * are executing the code. But then I must change the API....
+ * ....something for later.
+ */
+
+ if (!realtime(&ts)) {
+ if (timespec2str(stamp, sizeof(stamp), &ts) != 0) {
+ res = enif_snprintf(f, sizeof(f), "%s [%s] %s", prefix, TSNAME(), format);
+ // res = enif_snprintf(f, sizeof(f), "%s [%s]", prefix, format);
+ } else {
+ res = enif_snprintf(f, sizeof(f), "%s [%s] [%s] %s", prefix, stamp, TSNAME(), format);
+ // res = enif_snprintf(f, sizeof(f), "%s [%s] %s", prefix, stamp, format);
+ }
+
+ if (res > 0) {
+ va_start (args, format);
+ enif_vfprintf (dbgout, f, args);
+ va_end (args);
+ fflush(stdout);
+ }
+ }
+
+ return;
+}
+
+
+static
+int realtime(struct timespec* tsP)
+{
+ return clock_gettime(CLOCK_REALTIME, tsP);
+}
+
+
+
+
+/*
+ * Convert a timespec struct into a readable/printable string
+ */
+static
+int timespec2str(char *buf, unsigned int len, struct timespec *ts)
+{
+ int ret, buflen;
+ struct tm t;
+
+ tzset();
+ if (localtime_r(&(ts->tv_sec), &t) == NULL)
+ return 1;
+
+ ret = strftime(buf, len, "%F %T", &t);
+ if (ret == 0)
+ return 2;
+ len -= ret - 1;
+ buflen = strlen(buf);
+
+ ret = snprintf(&buf[buflen], len, ".%06ld", ts->tv_nsec/1000);
+ if (ret >= len)
+ return 3;
+
+ return 0;
+}
diff --git a/erts/emulator/nifs/common/socket_dbg.h b/erts/emulator/nifs/common/socket_dbg.h
new file mode 100644
index 0000000000..47739b46da
--- /dev/null
+++ b/erts/emulator/nifs/common/socket_dbg.h
@@ -0,0 +1,55 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2018. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : Defines and macros for the debug util of the socket and
+ * net NIF(s).
+ * ----------------------------------------------------------------------
+ *
+ */
+
+#ifndef SOCKET_DBG_H__
+#define SOCKET_DBG_H__
+
+/* Used when calling the init function */
+#define ESOCK_DBGOUT_DEFAULT "stdout"
+#define ESOCK_DBGOUT_UNIQUE "unique"
+
+
+/* Used in debug printouts */
+#ifdef __WIN32__
+#define LLU "%I64u"
+#else
+#define LLU "%llu"
+#endif
+typedef unsigned long long llu_t;
+
+
+
+#define ESOCK_DBG_PRINTF( ___COND___ , proto ) \
+ if ( ___COND___ ) { \
+ esock_dbg_printf proto; \
+ fflush(stdout); \
+ }
+
+
+extern void esock_dbg_init(char* filename);
+extern void esock_dbg_printf( const char* prefix, const char* format, ... );
+
+#endif // SOCKET_DBG_H__
diff --git a/erts/emulator/nifs/common/socket_int.h b/erts/emulator/nifs/common/socket_int.h
new file mode 100644
index 0000000000..043303a60d
--- /dev/null
+++ b/erts/emulator/nifs/common/socket_int.h
@@ -0,0 +1,392 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2018. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : Utility "stuff" for socket and net.
+ * ----------------------------------------------------------------------
+ *
+ */
+
+#ifndef SOCKET_INT_H__
+#define SOCKET_INT_H__
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+#ifdef __WIN32__
+
+/* All this just to replace sys/socket.h, netinet/in.h and sys/un.h??? */
+#define INCL_WINSOCK_API_TYPEDEFS 1
+#ifndef WINDOWS_H_INCLUDES_WINSOCK2_H
+#include <winsock2.h>
+#endif
+#include <windows.h>
+#include <Ws2tcpip.h> /* NEED VC 6.0 or higher */
+/* Visual studio 2008+: NTDDI_VERSION needs to be set for iphlpapi.h
+ * to define the right structures. It needs to be set to WINXP (or LONGHORN)
+ * for IPV6 to work and it's set lower by default, so we need to change it.
+ */
+#ifdef HAVE_SDKDDKVER_H
+# include <sdkddkver.h>
+# ifdef NTDDI_VERSION
+# undef NTDDI_VERSION
+# endif
+# define NTDDI_VERSION NTDDI_WINXP
+#endif
+#include <iphlpapi.h>
+
+#else /* !__WIN32__ */
+
+#include <sys/socket.h>
+#include <netinet/in.h>
+#ifdef HAVE_SYS_UN_H
+#include <sys/un.h>
+#endif
+
+#endif
+
+#include <erl_nif.h>
+
+/* The general purpose sockaddr */
+typedef union {
+ /* General sockaddr */
+ struct sockaddr sa;
+
+ /* IPv4 sockaddr */
+ struct sockaddr_in in4;
+
+ /* IPv6 sockaddr */
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ struct sockaddr_in6 in6;
+#endif
+
+ /* Unix Domain Socket sockaddr */
+#if defined(HAVE_SYS_UN_H)
+ struct sockaddr_un un;
+#endif
+
+} SocketAddress;
+
+
+/* *** Boolean *type* stuff... *** */
+typedef unsigned int BOOLEAN_T;
+#define TRUE 1
+#define FALSE 0
+
+#define BOOL2ATOM(__B__) ((__B__) ? esock_atom_true : esock_atom_false)
+
+#define B2S(__B__) ((__B__) ? "true" : "false")
+
+/* Misc error strings */
+#define ESOCK_STR_EAFNOSUPPORT "eafnosupport"
+#define ESOCK_STR_EAGAIN "eagain"
+#define ESOCK_STR_EINVAL "einval"
+
+
+/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ * "Global" atoms
+ */
+
+#define GLOBAL_ATOM_DEFS \
+ GLOBAL_ATOM_DEF(abort); \
+ GLOBAL_ATOM_DEF(accept); \
+ GLOBAL_ATOM_DEF(acceptconn); \
+ GLOBAL_ATOM_DEF(acceptfilter); \
+ GLOBAL_ATOM_DEF(adaption_layer); \
+ GLOBAL_ATOM_DEF(addr); \
+ GLOBAL_ATOM_DEF(addrform); \
+ GLOBAL_ATOM_DEF(add_membership); \
+ GLOBAL_ATOM_DEF(add_source_membership); \
+ GLOBAL_ATOM_DEF(any); \
+ GLOBAL_ATOM_DEF(associnfo); \
+ GLOBAL_ATOM_DEF(authhdr); \
+ GLOBAL_ATOM_DEF(auth_active_key); \
+ GLOBAL_ATOM_DEF(auth_asconf); \
+ GLOBAL_ATOM_DEF(auth_chunk); \
+ GLOBAL_ATOM_DEF(auth_delete_key); \
+ GLOBAL_ATOM_DEF(auth_key); \
+ GLOBAL_ATOM_DEF(auth_level); \
+ GLOBAL_ATOM_DEF(autoclose); \
+ GLOBAL_ATOM_DEF(bindtodevice); \
+ GLOBAL_ATOM_DEF(block_source); \
+ GLOBAL_ATOM_DEF(broadcast); \
+ GLOBAL_ATOM_DEF(busy_poll); \
+ GLOBAL_ATOM_DEF(checksum); \
+ GLOBAL_ATOM_DEF(close); \
+ GLOBAL_ATOM_DEF(connect); \
+ GLOBAL_ATOM_DEF(congestion); \
+ GLOBAL_ATOM_DEF(context); \
+ GLOBAL_ATOM_DEF(cork); \
+ GLOBAL_ATOM_DEF(credentials); \
+ GLOBAL_ATOM_DEF(ctrl); \
+ GLOBAL_ATOM_DEF(ctrunc); \
+ GLOBAL_ATOM_DEF(data); \
+ GLOBAL_ATOM_DEF(debug); \
+ GLOBAL_ATOM_DEF(default_send_params); \
+ GLOBAL_ATOM_DEF(delayed_ack_time); \
+ GLOBAL_ATOM_DEF(dgram); \
+ GLOBAL_ATOM_DEF(disable_fragments); \
+ GLOBAL_ATOM_DEF(domain); \
+ GLOBAL_ATOM_DEF(dontfrag); \
+ GLOBAL_ATOM_DEF(dontroute); \
+ GLOBAL_ATOM_DEF(drop_membership); \
+ GLOBAL_ATOM_DEF(drop_source_membership); \
+ GLOBAL_ATOM_DEF(dstopts); \
+ GLOBAL_ATOM_DEF(eor); \
+ GLOBAL_ATOM_DEF(error); \
+ GLOBAL_ATOM_DEF(errqueue); \
+ GLOBAL_ATOM_DEF(esp_network_level); \
+ GLOBAL_ATOM_DEF(esp_trans_level); \
+ GLOBAL_ATOM_DEF(events); \
+ GLOBAL_ATOM_DEF(explicit_eor); \
+ GLOBAL_ATOM_DEF(faith); \
+ GLOBAL_ATOM_DEF(false); \
+ GLOBAL_ATOM_DEF(family); \
+ GLOBAL_ATOM_DEF(flags); \
+ GLOBAL_ATOM_DEF(flowinfo); \
+ GLOBAL_ATOM_DEF(fragment_interleave); \
+ GLOBAL_ATOM_DEF(freebind); \
+ GLOBAL_ATOM_DEF(get_peer_addr_info); \
+ GLOBAL_ATOM_DEF(hdrincl); \
+ GLOBAL_ATOM_DEF(hmac_ident); \
+ GLOBAL_ATOM_DEF(hoplimit); \
+ GLOBAL_ATOM_DEF(hopopts); \
+ GLOBAL_ATOM_DEF(ifindex); \
+ GLOBAL_ATOM_DEF(inet); \
+ GLOBAL_ATOM_DEF(inet6); \
+ GLOBAL_ATOM_DEF(info); \
+ GLOBAL_ATOM_DEF(initmsg); \
+ GLOBAL_ATOM_DEF(iov); \
+ GLOBAL_ATOM_DEF(ip); \
+ GLOBAL_ATOM_DEF(ipcomp_level); \
+ GLOBAL_ATOM_DEF(ipv6); \
+ GLOBAL_ATOM_DEF(i_want_mapped_v4_addr); \
+ GLOBAL_ATOM_DEF(join_group); \
+ GLOBAL_ATOM_DEF(keepalive); \
+ GLOBAL_ATOM_DEF(keepcnt); \
+ GLOBAL_ATOM_DEF(keepidle); \
+ GLOBAL_ATOM_DEF(keepintvl); \
+ GLOBAL_ATOM_DEF(leave_group); \
+ GLOBAL_ATOM_DEF(level); \
+ GLOBAL_ATOM_DEF(linger); \
+ GLOBAL_ATOM_DEF(local); \
+ GLOBAL_ATOM_DEF(local_auth_chunks); \
+ GLOBAL_ATOM_DEF(loopback); \
+ GLOBAL_ATOM_DEF(lowdelay); \
+ GLOBAL_ATOM_DEF(mark); \
+ GLOBAL_ATOM_DEF(maxburst); \
+ GLOBAL_ATOM_DEF(maxseg); \
+ GLOBAL_ATOM_DEF(md5sig); \
+ GLOBAL_ATOM_DEF(mincost); \
+ GLOBAL_ATOM_DEF(minttl); \
+ GLOBAL_ATOM_DEF(msfilter); \
+ GLOBAL_ATOM_DEF(mtu); \
+ GLOBAL_ATOM_DEF(mtu_discover); \
+ GLOBAL_ATOM_DEF(multicast_all); \
+ GLOBAL_ATOM_DEF(multicast_hops); \
+ GLOBAL_ATOM_DEF(multicast_if); \
+ GLOBAL_ATOM_DEF(multicast_loop); \
+ GLOBAL_ATOM_DEF(multicast_ttl); \
+ GLOBAL_ATOM_DEF(nodelay); \
+ GLOBAL_ATOM_DEF(nodefrag); \
+ GLOBAL_ATOM_DEF(noopt); \
+ GLOBAL_ATOM_DEF(nopush); \
+ GLOBAL_ATOM_DEF(not_found); \
+ GLOBAL_ATOM_DEF(not_owner); \
+ GLOBAL_ATOM_DEF(ok); \
+ GLOBAL_ATOM_DEF(oob); \
+ GLOBAL_ATOM_DEF(oobinline); \
+ GLOBAL_ATOM_DEF(options); \
+ GLOBAL_ATOM_DEF(origdstaddr); \
+ GLOBAL_ATOM_DEF(partial_delivery_point); \
+ GLOBAL_ATOM_DEF(passcred); \
+ GLOBAL_ATOM_DEF(path); \
+ GLOBAL_ATOM_DEF(peekcred); \
+ GLOBAL_ATOM_DEF(peek_off); \
+ GLOBAL_ATOM_DEF(peer_addr_params); \
+ GLOBAL_ATOM_DEF(peer_auth_chunks); \
+ GLOBAL_ATOM_DEF(pktinfo); \
+ GLOBAL_ATOM_DEF(pktoptions); \
+ GLOBAL_ATOM_DEF(port); \
+ GLOBAL_ATOM_DEF(portrange); \
+ GLOBAL_ATOM_DEF(primary_addr); \
+ GLOBAL_ATOM_DEF(priority); \
+ GLOBAL_ATOM_DEF(protocol); \
+ GLOBAL_ATOM_DEF(raw); \
+ GLOBAL_ATOM_DEF(rcvbuf); \
+ GLOBAL_ATOM_DEF(rcvbufforce); \
+ GLOBAL_ATOM_DEF(rcvlowat); \
+ GLOBAL_ATOM_DEF(rcvtimeo); \
+ GLOBAL_ATOM_DEF(rdm); \
+ GLOBAL_ATOM_DEF(recv); \
+ GLOBAL_ATOM_DEF(recvdstaddr); \
+ GLOBAL_ATOM_DEF(recverr); \
+ GLOBAL_ATOM_DEF(recvfrom); \
+ GLOBAL_ATOM_DEF(recvif); \
+ GLOBAL_ATOM_DEF(recvmsg); \
+ GLOBAL_ATOM_DEF(recvopts); \
+ GLOBAL_ATOM_DEF(recvorigdstaddr); \
+ GLOBAL_ATOM_DEF(recvpktinfo); \
+ GLOBAL_ATOM_DEF(recvtclass); \
+ GLOBAL_ATOM_DEF(recvtos); \
+ GLOBAL_ATOM_DEF(recvttl); \
+ GLOBAL_ATOM_DEF(reliability); \
+ GLOBAL_ATOM_DEF(reset_streams); \
+ GLOBAL_ATOM_DEF(retopts); \
+ GLOBAL_ATOM_DEF(reuseaddr); \
+ GLOBAL_ATOM_DEF(reuseport); \
+ GLOBAL_ATOM_DEF(rights); \
+ GLOBAL_ATOM_DEF(router_alert); \
+ GLOBAL_ATOM_DEF(rthdr); \
+ GLOBAL_ATOM_DEF(rtoinfo); \
+ GLOBAL_ATOM_DEF(rxq_ovfl); \
+ GLOBAL_ATOM_DEF(scope_id); \
+ GLOBAL_ATOM_DEF(sctp); \
+ GLOBAL_ATOM_DEF(sec); \
+ GLOBAL_ATOM_DEF(select_failed); \
+ GLOBAL_ATOM_DEF(select_sent); \
+ GLOBAL_ATOM_DEF(send); \
+ GLOBAL_ATOM_DEF(sendmsg); \
+ GLOBAL_ATOM_DEF(sendsrcaddr); \
+ GLOBAL_ATOM_DEF(sendto); \
+ GLOBAL_ATOM_DEF(seqpacket); \
+ GLOBAL_ATOM_DEF(setfib); \
+ GLOBAL_ATOM_DEF(set_peer_primary_addr); \
+ GLOBAL_ATOM_DEF(sndbuf); \
+ GLOBAL_ATOM_DEF(sndbufforce); \
+ GLOBAL_ATOM_DEF(sndlowat); \
+ GLOBAL_ATOM_DEF(sndtimeo); \
+ GLOBAL_ATOM_DEF(socket); \
+ GLOBAL_ATOM_DEF(socket_tag); \
+ GLOBAL_ATOM_DEF(spec_dst); \
+ GLOBAL_ATOM_DEF(status); \
+ GLOBAL_ATOM_DEF(stream); \
+ GLOBAL_ATOM_DEF(syncnt); \
+ GLOBAL_ATOM_DEF(tclass); \
+ GLOBAL_ATOM_DEF(tcp); \
+ GLOBAL_ATOM_DEF(throughput); \
+ GLOBAL_ATOM_DEF(timestamp); \
+ GLOBAL_ATOM_DEF(tos); \
+ GLOBAL_ATOM_DEF(transparent); \
+ GLOBAL_ATOM_DEF(true); \
+ GLOBAL_ATOM_DEF(trunc); \
+ GLOBAL_ATOM_DEF(ttl); \
+ GLOBAL_ATOM_DEF(type); \
+ GLOBAL_ATOM_DEF(udp); \
+ GLOBAL_ATOM_DEF(unblock_source); \
+ GLOBAL_ATOM_DEF(undefined); \
+ GLOBAL_ATOM_DEF(unicast_hops); \
+ GLOBAL_ATOM_DEF(unknown); \
+ GLOBAL_ATOM_DEF(usec); \
+ GLOBAL_ATOM_DEF(user_timeout); \
+ GLOBAL_ATOM_DEF(use_ext_recvinfo); \
+ GLOBAL_ATOM_DEF(use_min_mtu); \
+ GLOBAL_ATOM_DEF(v6only);
+
+
+/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ * Error reason atoms
+ */
+
+#define GLOBAL_ERROR_REASON_ATOM_DEFS \
+ GLOBAL_ATOM_DEF(eafnosupport); \
+ GLOBAL_ATOM_DEF(eagain); \
+ GLOBAL_ATOM_DEF(einval);
+
+
+#define GLOBAL_ATOM_DEF(A) extern ERL_NIF_TERM esock_atom_##A
+GLOBAL_ATOM_DEFS
+GLOBAL_ERROR_REASON_ATOM_DEFS
+#undef GLOBAL_ATOM_DEF
+
+
+/* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ * Various wrapper macros for enif functions
+ */
+#define MALLOC(SZ) enif_alloc((SZ))
+#define REALLOC(P, SZ) enif_realloc((P), (SZ))
+#define FREE(P) enif_free((P))
+
+#define MKA(E,S) enif_make_atom((E), (S))
+#define MKBIN(E,B) enif_make_binary((E), (B))
+#define MKI(E,I) enif_make_int((E), (I))
+#define MKL(E,L) enif_make_long((E), (L))
+#define MKLA(E,A,L) enif_make_list_from_array((E), (A), (L))
+#define MKEL(E) enif_make_list((E), 0)
+#define MKMA(E,KA,VA,L,M) enif_make_map_from_arrays((E), (KA), (VA), (L), (M))
+#define MKPID(E, P) enif_make_pid((E), (P))
+#define MKREF(E) enif_make_ref((E))
+#define MKS(E,S) enif_make_string((E), (S), ERL_NIF_LATIN1)
+#define MKSL(E,S,L) enif_make_string_len((E), (S), (L), ERL_NIF_LATIN1)
+#define MKSBIN(E,B,ST,SZ) enif_make_sub_binary((E), (B), (ST), (SZ))
+#define MKT2(E,E1,E2) enif_make_tuple2((E), (E1), (E2))
+#define MKT3(E,E1,E2,E3) enif_make_tuple3((E), (E1), (E2), (E3))
+#define MKT4(E,E1,E2,E3,E4) enif_make_tuple4((E), (E1), (E2), (E3), (E4))
+#define MKT5(E,E1,E2,E3,E4,E5) \
+ enif_make_tuple5((E), (E1), (E2), (E3), (E4), (E5))
+#define MKT8(E,E1,E2,E3,E4,E5,E6,E7,E8) \
+ enif_make_tuple8((E), (E1), (E2), (E3), (E4), (E5), (E6), (E7), (E8))
+#define MKTA(E, A, AL) enif_make_tuple_from_array((E), (A), (AL))
+#define MKUI(E,UI) enif_make_uint((E), (UI))
+#define MKUL(E,UL) enif_make_ulong((E), (UL))
+
+#define MCREATE(N) enif_mutex_create((N))
+#define MDESTROY(M) enif_mutex_destroy((M))
+#define MLOCK(M) enif_mutex_lock((M))
+#define MUNLOCK(M) enif_mutex_unlock((M))
+
+#define MONP(S,E,D,P,M) esock_monitor((S), (E), (D), (P), (M))
+#define DEMONP(S,E,D,M) esock_demonitor((S), (E), (D), (M))
+#define MON_INIT(M) esock_monitor_init((M))
+#define MON2T(E, M) enif_make_monitor_term((E), (M))
+
+#define COMPARE(A, B) enif_compare((A), (B))
+#define COMPARE_PIDS(P1, P2) enif_compare_pids((P1), (P2))
+
+#define IS_ATOM(E, TE) enif_is_atom((E), (TE))
+#define IS_BIN(E, TE) enif_is_binary((E), (TE))
+#define IS_LIST(E, TE) enif_is_list((E), (TE))
+#define IS_MAP(E, TE) enif_is_map((E), (TE))
+#define IS_NUM(E, TE) enif_is_number((E), (TE))
+#define IS_TUPLE(E, TE) enif_is_tuple((E), (TE))
+
+#define GET_ATOM_LEN(E, TE, LP) \
+ enif_get_atom_length((E), (TE), (LP), ERL_NIF_LATIN1)
+#define GET_ATOM(E, TE, BP, MAX) \
+ enif_get_atom((E), (TE), (BP), (MAX), ERL_NIF_LATIN1)
+#define GET_BIN(E, TE, BP) enif_inspect_iolist_as_binary((E), (TE), (BP))
+#define GET_INT(E, TE, IP) enif_get_int((E), (TE), (IP))
+#define GET_LIST_ELEM(E, L, HP, TP) enif_get_list_cell((E), (L), (HP), (TP))
+#define GET_LIST_LEN(E, L, LP) enif_get_list_length((E), (L), (LP))
+#define GET_LONG(E, TE, LP) enif_get_long((E), (TE), (LP))
+#define GET_LPID(E, T, P) enif_get_local_pid((E), (T), (P))
+#define GET_STR(E, L, B, SZ) \
+ enif_get_string((E), (L), (B), (SZ), ERL_NIF_LATIN1)
+#define GET_UINT(E, TE, UIP) enif_get_uint((E), (TE), (UIP))
+#define GET_ULONG(E, TE, ULP) enif_get_long((E), (TE), (ULP))
+#define GET_TUPLE(E, TE, TSZ, TA) enif_get_tuple((E), (TE), (TSZ), (TA))
+#define GET_MAP_VAL(E, M, K, V) enif_get_map_value((E), (M), (K), (V))
+
+#define ALLOC_BIN(SZ, BP) enif_alloc_binary((SZ), (BP))
+#define REALLOC_BIN(SZ, BP) enif_realloc_binary((SZ), (BP))
+#define FREE_BIN(BP) enif_release_binary((BP))
+
+
+#endif // SOCKET_INT_H__
diff --git a/erts/emulator/nifs/common/socket_nif.c b/erts/emulator/nifs/common/socket_nif.c
new file mode 100644
index 0000000000..052c585032
--- /dev/null
+++ b/erts/emulator/nifs/common/socket_nif.c
@@ -0,0 +1,18278 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2019. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : The NIF (C) part of the socket interface
+ *
+ * All of the nif-functions which are part of the API has two parts.
+ * The first function is called 'nif_<something>', e.g. nif_open.
+ * This does the initial validation and argument processing and then
+ * calls the function that does the actual work. This is called
+ * 'n<something>'.
+ * ----------------------------------------------------------------------
+ *
+ *
+ * This is just a code snippet in case there is need of extra debugging
+ *
+ * esock_dbg_printf("DEMONP", "[%d] %s: %T\r\n",
+ * descP->sock, slogan,
+ * MON2T(env, &monP->mon));
+ *
+ */
+
+#define STATIC_ERLANG_NIF 1
+
+
+#ifdef HAVE_CONFIG_H
+#include "config.h"
+#endif
+
+/* If we HAVE_SCTP_H and Solaris, we need to define the following in
+ * order to get SCTP working:
+ */
+#if (defined(HAVE_SCTP_H) && defined(__sun) && defined(__SVR4))
+#define SOLARIS10 1
+/* WARNING: This is not quite correct, it may also be Solaris 11! */
+#define _XPG4_2
+#define __EXTENSIONS__
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stddef.h>
+#include <ctype.h>
+#include <sys/types.h>
+#include <errno.h>
+#include <time.h>
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#ifdef HAVE_SYS_UIO_H
+#include <sys/uio.h>
+#endif
+
+#ifdef HAVE_NET_IF_DL_H
+#include <net/if_dl.h>
+#endif
+
+#ifdef HAVE_IFADDRS_H
+#include <ifaddrs.h>
+#endif
+
+#ifdef HAVE_NETPACKET_PACKET_H
+#include <netpacket/packet.h>
+#endif
+
+#ifdef HAVE_SYS_UN_H
+#include <sys/un.h>
+#endif
+
+/* SENDFILE STUFF HERE IF WE NEED IT... */
+
+#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
+#define __DARWIN__ 1
+#endif
+
+
+#ifdef __WIN32__
+#define STRNCASECMP strncasecmp
+#define INCL_WINSOCK_API_TYPEDEFS 1
+
+#ifndef WINDOWS_H_INCLUDES_WINSOCK2_H
+#include <winsock2.h>
+#endif
+#include <windows.h>
+#include <Ws2tcpip.h> /* NEED VC 6.0 or higher */
+
+/* Visual studio 2008+: NTDDI_VERSION needs to be set for iphlpapi.h
+ * to define the right structures. It needs to be set to WINXP (or LONGHORN)
+ * for IPV6 to work and it's set lower by default, so we need to change it.
+ */
+#ifdef HAVE_SDKDDKVER_H
+# include <sdkddkver.h>
+# ifdef NTDDI_VERSION
+# undef NTDDI_VERSION
+# endif
+# define NTDDI_VERSION NTDDI_WINXP
+#endif
+#include <iphlpapi.h>
+
+#undef WANT_NONBLOCKING
+#include "sys.h"
+
+
+
+
+/* AND HERE WE MAY HAVE A BUNCH OF DEFINES....SEE INET DRIVER.... */
+
+
+
+
+#else /* ifdef __WIN32__ */
+
+#include <sys/time.h>
+#ifdef NETDB_H_NEEDS_IN_H
+#include <netinet/in.h>
+#endif
+#include <netdb.h>
+
+#include <sys/socket.h>
+#include <netinet/in.h>
+
+#ifdef DEF_INADDR_LOOPBACK_IN_RPC_TYPES_H
+#include <rpc/types.h>
+#endif
+
+#include <netinet/ip.h>
+#include <netinet/tcp.h>
+#include <netinet/udp.h>
+#include <arpa/inet.h>
+
+#include <sys/param.h>
+#ifdef HAVE_ARPA_NAMESER_H
+#include <arpa/nameser.h>
+#endif
+
+#ifdef HAVE_SYS_SOCKIO_H
+#include <sys/sockio.h>
+#endif
+
+#ifdef HAVE_SYS_IOCTL_H
+#include <sys/ioctl.h>
+#endif
+
+#include <net/if.h>
+
+#ifdef HAVE_SCHED_H
+#include <sched.h>
+#endif
+
+#ifdef HAVE_SETNS_H
+#include <setns.h>
+#endif
+
+#define HAVE_UDP
+
+/* SCTP support -- currently for UNIX platforms only: */
+#undef HAVE_SCTP
+#if defined(HAVE_SCTP_H)
+
+#include <netinet/sctp.h>
+
+/* SCTP Socket API Draft from version 11 on specifies that netinet/sctp.h must
+ explicitly define HAVE_SCTP in case when SCTP is supported, but Solaris 10
+ still apparently uses Draft 10, and does not define that symbol, so we have
+ to define it explicitly:
+*/
+#ifndef HAVE_SCTP
+# define HAVE_SCTP
+#endif
+
+/* These changed in draft 11, so SOLARIS10 uses the old MSG_* */
+#if ! HAVE_DECL_SCTP_UNORDERED
+# define SCTP_UNORDERED MSG_UNORDERED
+#endif
+#if ! HAVE_DECL_SCTP_ADDR_OVER
+# define SCTP_ADDR_OVER MSG_ADDR_OVER
+#endif
+#if ! HAVE_DECL_SCTP_ABORT
+# define SCTP_ABORT MSG_ABORT
+#endif
+#if ! HAVE_DECL_SCTP_EOF
+# define SCTP_EOF MSG_EOF
+#endif
+
+/* More Solaris 10 fixes: */
+#if ! HAVE_DECL_SCTP_CLOSED && HAVE_DECL_SCTPS_IDLE
+# define SCTP_CLOSED SCTPS_IDLE
+# undef HAVE_DECL_SCTP_CLOSED
+# define HAVE_DECL_SCTP_CLOSED 1
+#endif
+#if ! HAVE_DECL_SCTP_BOUND && HAVE_DECL_SCTPS_BOUND
+# define SCTP_BOUND SCTPS_BOUND
+# undef HAVE_DECL_SCTP_BOUND
+# define HAVE_DECL_SCTP_BOUND 1
+#endif
+#if ! HAVE_DECL_SCTP_LISTEN && HAVE_DECL_SCTPS_LISTEN
+# define SCTP_LISTEN SCTPS_LISTEN
+# undef HAVE_DECL_SCTP_LISTEN
+# define HAVE_DECL_SCTP_LISTEN 1
+#endif
+#if ! HAVE_DECL_SCTP_COOKIE_WAIT && HAVE_DECL_SCTPS_COOKIE_WAIT
+# define SCTP_COOKIE_WAIT SCTPS_COOKIE_WAIT
+# undef HAVE_DECL_SCTP_COOKIE_WAIT
+# define HAVE_DECL_SCTP_COOKIE_WAIT 1
+#endif
+#if ! HAVE_DECL_SCTP_COOKIE_ECHOED && HAVE_DECL_SCTPS_COOKIE_ECHOED
+# define SCTP_COOKIE_ECHOED SCTPS_COOKIE_ECHOED
+# undef HAVE_DECL_SCTP_COOKIE_ECHOED
+# define HAVE_DECL_SCTP_COOKIE_ECHOED 1
+#endif
+#if ! HAVE_DECL_SCTP_ESTABLISHED && HAVE_DECL_SCTPS_ESTABLISHED
+# define SCTP_ESTABLISHED SCTPS_ESTABLISHED
+# undef HAVE_DECL_SCTP_ESTABLISHED
+# define HAVE_DECL_SCTP_ESTABLISHED 1
+#endif
+#if ! HAVE_DECL_SCTP_SHUTDOWN_PENDING && HAVE_DECL_SCTPS_SHUTDOWN_PENDING
+# define SCTP_SHUTDOWN_PENDING SCTPS_SHUTDOWN_PENDING
+# undef HAVE_DECL_SCTP_SHUTDOWN_PENDING
+# define HAVE_DECL_SCTP_SHUTDOWN_PENDING 1
+#endif
+#if ! HAVE_DECL_SCTP_SHUTDOWN_SENT && HAVE_DECL_SCTPS_SHUTDOWN_SENT
+# define SCTP_SHUTDOWN_SENT SCTPS_SHUTDOWN_SENT
+# undef HAVE_DECL_SCTP_SHUTDOWN_SENT
+# define HAVE_DECL_SCTP_SHUTDOWN_SENT 1
+#endif
+#if ! HAVE_DECL_SCTP_SHUTDOWN_RECEIVED && HAVE_DECL_SCTPS_SHUTDOWN_RECEIVED
+# define SCTP_SHUTDOWN_RECEIVED SCTPS_SHUTDOWN_RECEIVED
+# undef HAVE_DECL_SCTP_SHUTDOWN_RECEIVED
+# define HAVE_DECL_SCTP_SHUTDOWN_RECEIVED 1
+#endif
+#if ! HAVE_DECL_SCTP_SHUTDOWN_ACK_SENT && HAVE_DECL_SCTPS_SHUTDOWN_ACK_SENT
+# define SCTP_SHUTDOWN_ACK_SENT SCTPS_SHUTDOWN_ACK_SENT
+# undef HAVE_DECL_SCTP_SHUTDOWN_ACK_SENT
+# define HAVE_DECL_SCTP_SHUTDOWN_ACK_SENT 1
+#endif
+/* New spelling in lksctp 2.6.22 or maybe even earlier:
+ * adaption -> adaptation
+ */
+#if !defined(SCTP_ADAPTATION_LAYER) && defined (SCTP_ADAPTION_LAYER)
+# define SCTP_ADAPTATION_LAYER SCTP_ADAPTION_LAYER
+# define SCTP_ADAPTATION_INDICATION SCTP_ADAPTION_INDICATION
+# define sctp_adaptation_event sctp_adaption_event
+# define sctp_setadaptation sctp_setadaption
+# define sn_adaptation_event sn_adaption_event
+# define sai_adaptation_ind sai_adaption_ind
+# define ssb_adaptation_ind ssb_adaption_ind
+# define sctp_adaptation_layer_event sctp_adaption_layer_event
+#endif
+
+/*
+ * We *may* need this stuff later when we *fully* implement support for SCTP
+ *
+
+#if defined(__GNUC__) && defined(HAVE_SCTP_BINDX)
+static typeof(sctp_bindx) *esock_sctp_bindx = NULL;
+#else
+static int (*esock_sctp_bindx)
+ (int sd, struct sockaddr *addrs, int addrcnt, int flags) = NULL;
+#endif
+
+#if defined(__GNUC__) && defined(HAVE_SCTP_PEELOFF)
+static typeof(sctp_peeloff) *esock_sctp_peeloff = NULL;
+#else
+static int (*esock_sctp_peeloff)
+ (int sd, sctp_assoc_t assoc_id) = NULL;
+#endif
+
+#if defined(__GNUC__) && defined(HAVE_SCTP_GETLADDRS)
+static typeof(sctp_getladdrs) *esock_sctp_getladdrs = NULL;
+#else
+static int (*esock_sctp_getladdrs)
+ (int sd, sctp_assoc_t assoc_id, struct sockaddr **ss) = NULL;
+#endif
+
+#if defined(__GNUC__) && defined(HAVE_SCTP_FREELADDRS)
+static typeof(sctp_freeladdrs) *esock_sctp_freeladdrs = NULL;
+#else
+static void (*esock_sctp_freeladdrs)(struct sockaddr *addrs) = NULL;
+#endif
+
+#if defined(__GNUC__) && defined(HAVE_SCTP_GETPADDRS)
+static typeof(sctp_getpaddrs) *esock_sctp_getpaddrs = NULL;
+#else
+static int (*esock_sctp_getpaddrs)
+ (int sd, sctp_assoc_t assoc_id, struct sockaddr **ss) = NULL;
+#endif
+
+#if defined(__GNUC__) && defined(HAVE_SCTP_FREEPADDRS)
+static typeof(sctp_freepaddrs) *esock_sctp_freepaddrs = NULL;
+#else
+static void (*esock_sctp_freepaddrs)(struct sockaddr *addrs) = NULL;
+#endif
+
+*/
+
+#endif /* #if defined(HAVE_SCTP_H) */
+
+
+#ifndef WANT_NONBLOCKING
+#define WANT_NONBLOCKING
+#endif
+#include "sys.h"
+
+/* Socket stuff */
+#define INVALID_SOCKET -1
+// #define INVALID_EVENT -1
+#define SOCKET_ERROR -1
+
+#endif /* ifdef __WIN32__ */
+
+#include <erl_nif.h>
+
+#include "socket_dbg.h"
+#include "socket_tarray.h"
+#include "socket_int.h"
+#include "socket_util.h"
+
+#if defined(SOL_IPV6) || defined(IPPROTO_IPV6)
+#define HAVE_IPV6
+#endif
+
+/* All platforms fail on malloc errors. */
+#define FATAL_MALLOC
+
+
+/* Debug stuff... */
+#define SOCKET_GLOBAL_DEBUG_DEFAULT FALSE
+#define SOCKET_DEBUG_DEFAULT FALSE
+
+/* Counters and stuff (Don't know where to sent this stuff anyway) */
+#define SOCKET_NIF_IOW_DEFAULT FALSE
+
+
+
+/* Socket stuff */
+#define INVALID_EVENT -1
+
+#define SOCKET int
+#define HANDLE long int
+
+
+/* ==============================================================================
+ * The IS_SOCKET_ERROR macro below is used for portability reasons.
+ * While POSIX specifies that errors from socket-related system calls
+ * should be indicated with a -1 return value, some users have experienced
+ * non-Windows OS kernels that return negative values other than -1.
+ * While one can argue that such kernels are technically broken, comparing
+ * against values less than 0 covers their out-of-spec return values without
+ * imposing incorrect semantics on systems that manage to correctly return -1
+ * for errors, thus increasing Erlang's portability.
+ */
+#ifdef __WIN32__
+#define IS_SOCKET_ERROR(val) ((val) == SOCKET_ERROR)
+#else
+#define IS_SOCKET_ERROR(val) ((val) < 0)
+#endif
+
+
+/* *** Misc macros and defines *** */
+
+/* This macro exist on some (linux) platforms */
+#if !defined(IPTOS_TOS_MASK)
+#define IPTOS_TOS_MASK 0x1E
+#endif
+#if !defined(IPTOS_TOS)
+#define IPTOS_TOS(tos) ((tos)&IPTOS_TOS_MASK)
+#endif
+
+
+#if defined(TCP_CA_NAME_MAX)
+#define SOCKET_OPT_TCP_CONGESTION_NAME_MAX TCP_CA_NAME_MAX
+#else
+/* This is really excessive, but just in case... */
+#define SOCKET_OPT_TCP_CONGESTION_NAME_MAX 256
+#endif
+
+
+#if defined(TCP_CONGESTION) || defined(SO_BINDTODEVICE)
+#define USE_GETOPT_STR_OPT
+#define USE_SETOPT_STR_OPT
+#endif
+
+
+
+/* *** Socket state defs *** */
+
+#define SOCKET_FLAG_OPEN 0x0001
+#define SOCKET_FLAG_ACTIVE 0x0004
+#define SOCKET_FLAG_LISTEN 0x0008
+#define SOCKET_FLAG_CON 0x0010
+#define SOCKET_FLAG_ACC 0x0020
+#define SOCKET_FLAG_BUSY 0x0040
+#define SOCKET_FLAG_CLOSE 0x0080
+
+#define SOCKET_STATE_CLOSED (0)
+#define SOCKET_STATE_OPEN (SOCKET_FLAG_OPEN)
+#define SOCKET_STATE_CONNECTED (SOCKET_STATE_OPEN | SOCKET_FLAG_ACTIVE)
+#define SOCKET_STATE_LISTENING (SOCKET_STATE_OPEN | SOCKET_FLAG_LISTEN)
+#define SOCKET_STATE_CONNECTING (SOCKET_STATE_OPEN | SOCKET_FLAG_CON)
+#define SOCKET_STATE_ACCEPTING (SOCKET_STATE_LISTENING | SOCKET_FLAG_ACC)
+#define SOCKET_STATE_CLOSING (SOCKET_FLAG_CLOSE)
+
+#define IS_CLOSED(d) \
+ ((d)->state == SOCKET_STATE_CLOSED)
+
+/*
+#define IS_STATE(d, f) \
+ (((d)->state & (f)) == (f))
+*/
+
+#define IS_CLOSING(d) \
+ (((d)->state & SOCKET_STATE_CLOSING) == SOCKET_STATE_CLOSING)
+
+#define IS_OPEN(d) \
+ (((d)->state & SOCKET_FLAG_OPEN) == SOCKET_FLAG_OPEN)
+
+#define IS_CONNECTED(d) \
+ (((d)->state & SOCKET_STATE_CONNECTED) == SOCKET_STATE_CONNECTED)
+
+#define IS_CONNECTING(d) \
+ (((d)->state & SOCKET_FLAG_CON) == SOCKET_FLAG_CON)
+
+/*
+#define IS_BUSY(d) \
+ (((d)->state & SOCKET_FLAG_BUSY) == SOCKET_FLAG_BUSY)
+*/
+
+#define SOCKET_SEND_FLAG_CONFIRM 0
+#define SOCKET_SEND_FLAG_DONTROUTE 1
+#define SOCKET_SEND_FLAG_EOR 2
+#define SOCKET_SEND_FLAG_MORE 3
+#define SOCKET_SEND_FLAG_NOSIGNAL 4
+#define SOCKET_SEND_FLAG_OOB 5
+#define SOCKET_SEND_FLAG_LOW SOCKET_SEND_FLAG_CONFIRM
+#define SOCKET_SEND_FLAG_HIGH SOCKET_SEND_FLAG_OOB
+
+#define SOCKET_RECV_FLAG_CMSG_CLOEXEC 0
+#define SOCKET_RECV_FLAG_ERRQUEUE 1
+#define SOCKET_RECV_FLAG_OOB 2
+#define SOCKET_RECV_FLAG_PEEK 3
+#define SOCKET_RECV_FLAG_TRUNC 4
+#define SOCKET_RECV_FLAG_LOW SOCKET_RECV_FLAG_CMSG_CLOEXEC
+#define SOCKET_RECV_FLAG_HIGH SOCKET_RECV_FLAG_TRUNC
+
+#define SOCKET_RECV_BUFFER_SIZE_DEFAULT 8192
+#define SOCKET_RECV_CTRL_BUFFER_SIZE_DEFAULT 1024
+#define SOCKET_SEND_CTRL_BUFFER_SIZE_DEFAULT 1024
+
+#define VT2S(__VT__) (((__VT__) == SOCKET_OPT_VALUE_TYPE_UNSPEC) ? "unspec" : \
+ (((__VT__) == SOCKET_OPT_VALUE_TYPE_INT) ? "int" : \
+ ((__VT__) == SOCKET_OPT_VALUE_TYPE_BOOL) ? "bool" : \
+ "undef"))
+
+#define SOCKET_OPT_VALUE_TYPE_UNSPEC 0
+#define SOCKET_OPT_VALUE_TYPE_INT 1
+#define SOCKET_OPT_VALUE_TYPE_BOOL 2
+
+typedef union {
+ struct {
+ // 0 = not open, 1 = open
+ unsigned int open:1;
+ // 0 = not conn, 1 = connecting, 2 = connected
+ unsigned int connect:2;
+ // unsigned int connecting:1;
+ // unsigned int connected:1;
+ // 0 = not listen, 1 = listening, 2 = accepting
+ unsigned int listen:2;
+ // unsigned int listening:1;
+ // unsigned int accepting:1;
+ /* Room for more... */
+ } flags;
+ unsigned int field; // Make it easy to reset all flags...
+} SocketState;
+
+/*
+#define IS_OPEN(d) ((d)->state.flags.open)
+#define IS_CONNECTED(d) ((d)->state.flags.connect == SOCKET_STATE_CONNECTED)
+#define IS_CONNECTING(d) ((d)->state.flags.connect == SOCKET_STATE_CONNECTING)
+*/
+
+
+/*----------------------------------------------------------------------------
+ * Interface constants.
+ *
+ * This section must be "identical" to the corresponding socket.hrl
+ */
+
+/* domain */
+#define SOCKET_DOMAIN_LOCAL 1
+#define SOCKET_DOMAIN_INET 2
+#define SOCKET_DOMAIN_INET6 3
+
+/* type */
+#define SOCKET_TYPE_STREAM 1
+#define SOCKET_TYPE_DGRAM 2
+#define SOCKET_TYPE_RAW 3
+// #define SOCKET_TYPE_RDM 4
+#define SOCKET_TYPE_SEQPACKET 5
+
+/* protocol */
+#define SOCKET_PROTOCOL_IP 1
+#define SOCKET_PROTOCOL_TCP 2
+#define SOCKET_PROTOCOL_UDP 3
+#define SOCKET_PROTOCOL_SCTP 4
+#define SOCKET_PROTOCOL_ICMP 5
+#define SOCKET_PROTOCOL_IGMP 6
+
+/* shutdown how */
+#define SOCKET_SHUTDOWN_HOW_RD 0
+#define SOCKET_SHUTDOWN_HOW_WR 1
+#define SOCKET_SHUTDOWN_HOW_RDWR 2
+
+
+#define SOCKET_OPT_LEVEL_OTP 0
+#define SOCKET_OPT_LEVEL_SOCKET 1
+#define SOCKET_OPT_LEVEL_IP 2
+#define SOCKET_OPT_LEVEL_IPV6 3
+#define SOCKET_OPT_LEVEL_TCP 4
+#define SOCKET_OPT_LEVEL_UDP 5
+#define SOCKET_OPT_LEVEL_SCTP 6
+
+#define SOCKET_OPT_OTP_DEBUG 1
+#define SOCKET_OPT_OTP_IOW 2
+#define SOCKET_OPT_OTP_CTRL_PROC 3
+#define SOCKET_OPT_OTP_RCVBUF 4
+#define SOCKET_OPT_OTP_RCVCTRLBUF 6
+#define SOCKET_OPT_OTP_SNDCTRLBUF 7
+#define SOCKET_OPT_OTP_FD 8
+#define SOCKET_OPT_OTP_DOMAIN 0xFF01 // INTERNAL AND ONLY GET
+#define SOCKET_OPT_OTP_TYPE 0xFF02 // INTERNAL AND ONLY GET
+#define SOCKET_OPT_OTP_PROTOCOL 0xFF03 // INTERNAL AND ONLY GET
+
+#define SOCKET_OPT_SOCK_ACCEPTCONN 1
+#define SOCKET_OPT_SOCK_BINDTODEVICE 3
+#define SOCKET_OPT_SOCK_BROADCAST 4
+#define SOCKET_OPT_SOCK_DEBUG 6
+#define SOCKET_OPT_SOCK_DOMAIN 7
+#define SOCKET_OPT_SOCK_DONTROUTE 8
+#define SOCKET_OPT_SOCK_KEEPALIVE 10
+#define SOCKET_OPT_SOCK_LINGER 11
+#define SOCKET_OPT_SOCK_OOBINLINE 13
+#define SOCKET_OPT_SOCK_PEEK_OFF 15
+#define SOCKET_OPT_SOCK_PRIORITY 17
+#define SOCKET_OPT_SOCK_PROTOCOL 18
+#define SOCKET_OPT_SOCK_RCVBUF 19
+#define SOCKET_OPT_SOCK_RCVLOWAT 21
+#define SOCKET_OPT_SOCK_RCVTIMEO 22
+#define SOCKET_OPT_SOCK_REUSEADDR 23
+#define SOCKET_OPT_SOCK_REUSEPORT 24
+#define SOCKET_OPT_SOCK_SNDBUF 27
+#define SOCKET_OPT_SOCK_SNDLOWAT 29
+#define SOCKET_OPT_SOCK_SNDTIMEO 30
+#define SOCKET_OPT_SOCK_TIMESTAMP 31
+#define SOCKET_OPT_SOCK_TYPE 32
+
+#define SOCKET_OPT_IP_ADD_MEMBERSHIP 1
+#define SOCKET_OPT_IP_ADD_SOURCE_MEMBERSHIP 2
+#define SOCKET_OPT_IP_BLOCK_SOURCE 3
+#define SOCKET_OPT_IP_DROP_MEMBERSHIP 5
+#define SOCKET_OPT_IP_DROP_SOURCE_MEMBERSHIP 6
+#define SOCKET_OPT_IP_FREEBIND 7
+#define SOCKET_OPT_IP_HDRINCL 8
+#define SOCKET_OPT_IP_MINTTL 9
+#define SOCKET_OPT_IP_MSFILTER 10
+#define SOCKET_OPT_IP_MTU 11
+#define SOCKET_OPT_IP_MTU_DISCOVER 12
+#define SOCKET_OPT_IP_MULTICAST_ALL 13
+#define SOCKET_OPT_IP_MULTICAST_IF 14
+#define SOCKET_OPT_IP_MULTICAST_LOOP 15
+#define SOCKET_OPT_IP_MULTICAST_TTL 16
+#define SOCKET_OPT_IP_NODEFRAG 17
+#define SOCKET_OPT_IP_PKTINFO 19
+#define SOCKET_OPT_IP_RECVDSTADDR 20
+#define SOCKET_OPT_IP_RECVERR 21
+#define SOCKET_OPT_IP_RECVIF 22
+#define SOCKET_OPT_IP_RECVOPTS 23
+#define SOCKET_OPT_IP_RECVORIGDSTADDR 24
+#define SOCKET_OPT_IP_RECVTOS 25
+#define SOCKET_OPT_IP_RECVTTL 26
+#define SOCKET_OPT_IP_RETOPTS 27
+#define SOCKET_OPT_IP_ROUTER_ALERT 28
+#define SOCKET_OPT_IP_SENDSRCADDR 29 // Same as IP_RECVDSTADDR?
+#define SOCKET_OPT_IP_TOS 30
+#define SOCKET_OPT_IP_TRANSPARENT 31
+#define SOCKET_OPT_IP_TTL 32
+#define SOCKET_OPT_IP_UNBLOCK_SOURCE 33
+
+#define SOCKET_OPT_IPV6_ADDRFORM 1
+#define SOCKET_OPT_IPV6_ADD_MEMBERSHIP 2
+#define SOCKET_OPT_IPV6_AUTHHDR 3
+#define SOCKET_OPT_IPV6_DROP_MEMBERSHIP 6
+#define SOCKET_OPT_IPV6_DSTOPTS 7
+#define SOCKET_OPT_IPV6_FLOWINFO 11
+#define SOCKET_OPT_IPV6_HOPLIMIT 12
+#define SOCKET_OPT_IPV6_HOPOPTS 13
+#define SOCKET_OPT_IPV6_MTU 17
+#define SOCKET_OPT_IPV6_MTU_DISCOVER 18
+#define SOCKET_OPT_IPV6_MULTICAST_HOPS 19
+#define SOCKET_OPT_IPV6_MULTICAST_IF 20
+#define SOCKET_OPT_IPV6_MULTICAST_LOOP 21
+#define SOCKET_OPT_IPV6_RECVERR 24
+#define SOCKET_OPT_IPV6_RECVPKTINFO 25 // PKTINFO on FreeBSD
+#define SOCKET_OPT_IPV6_ROUTER_ALERT 27
+#define SOCKET_OPT_IPV6_RTHDR 28
+#define SOCKET_OPT_IPV6_UNICAST_HOPS 30
+#define SOCKET_OPT_IPV6_V6ONLY 32
+
+#define SOCKET_OPT_TCP_CONGESTION 1
+#define SOCKET_OPT_TCP_CORK 2
+#define SOCKET_OPT_TCP_MAXSEG 7
+#define SOCKET_OPT_TCP_NODELAY 9
+
+#define SOCKET_OPT_UDP_CORK 1
+
+#define SOCKET_OPT_SCTP_ASSOCINFO 2
+#define SOCKET_OPT_SCTP_AUTOCLOSE 8
+#define SOCKET_OPT_SCTP_DISABLE_FRAGMENTS 12
+#define SOCKET_OPT_SCTP_EVENTS 14
+#define SOCKET_OPT_SCTP_INITMSG 18
+#define SOCKET_OPT_SCTP_MAXSEG 21
+#define SOCKET_OPT_SCTP_NODELAY 23
+#define SOCKET_OPT_SCTP_RTOINFO 29
+
+/* We should *eventually* use this instead of hard-coding the size (to 1) */
+#define ESOCK_RECVMSG_IOVEC_SZ 1
+
+
+#define SOCKET_SUPPORTS_OPTIONS 0x0001
+#define SOCKET_SUPPORTS_SCTP 0x0002
+#define SOCKET_SUPPORTS_IPV6 0x0003
+
+
+
+/* =================================================================== *
+ * *
+ * Various enif macros *
+ * *
+ * =================================================================== */
+
+#define SGDBG( proto ) ESOCK_DBG_PRINTF( data.dbg , proto )
+#define SSDBG( __D__ , proto ) ESOCK_DBG_PRINTF( (__D__)->dbg , proto )
+
+
+
+/* =================================================================== *
+ * *
+ * Basic socket operations *
+ * *
+ * =================================================================== */
+
+#ifdef __WIN32__
+
+/* *** Windows macros *** */
+
+#define sock_accept(s, addr, len) \
+ make_noninheritable_handle(accept((s), (addr), (len)))
+#define sock_bind(s, addr, len) bind((s), (addr), (len))
+#define sock_close(s) closesocket((s))
+#define sock_close_event(e) WSACloseEvent(e)
+#define sock_connect(s, addr, len) connect((s), (addr), (len))
+#define sock_create_event(s) WSACreateEvent()
+#define sock_errno() WSAGetLastError()
+#define sock_getopt(s,l,o,v,ln) getsockopt((s),(l),(o),(v),(ln))
+#define sock_htons(x) htons((x))
+#define sock_htonl(x) htonl((x))
+#define sock_listen(s, b) listen((s), (b))
+#define sock_name(s, addr, len) getsockname((s), (addr), (len))
+#define sock_ntohs(x) ntohs((x))
+#define sock_open(domain, type, proto) \
+ make_noninheritable_handle(socket((domain), (type), (proto)))
+#define sock_peer(s, addr, len) getpeername((s), (addr), (len))
+#define sock_recv(s,buf,len,flag) recv((s),(buf),(len),(flag))
+#define sock_recvfrom(s,buf,blen,flag,addr,alen) \
+ recvfrom((s),(buf),(blen),(flag),(addr),(alen))
+#define sock_send(s,buf,len,flag) send((s),(buf),(len),(flag))
+#define sock_sendto(s,buf,blen,flag,addr,alen) \
+ sendto((s),(buf),(blen),(flag),(addr),(alen))
+#define sock_setopt(s,l,o,v,ln) setsockopt((s),(l),(o),(v),(ln))
+#define sock_shutdown(s, how) shutdown((s), (how))
+
+
+#define SET_BLOCKING(s) ioctlsocket(s, FIONBIO, &zero_value)
+#define SET_NONBLOCKING(s) ioctlsocket(s, FIONBIO, &one_value)
+static unsigned long zero_value = 0;
+static unsigned long one_value = 1;
+
+
+#else /* !__WIN32__ */
+
+
+#ifdef HAS_ACCEPT4
+// We have to figure out what the flags are...
+#define sock_accept(s, addr, len) accept4((s), (addr), (len), (SOCK_CLOEXEC))
+#else
+#define sock_accept(s, addr, len) accept((s), (addr), (len))
+#endif
+#define sock_bind(s, addr, len) bind((s), (addr), (len))
+#define sock_close(s) close((s))
+#define sock_close_event(e) /* do nothing */
+#define sock_connect(s, addr, len) connect((s), (addr), (len))
+#define sock_create_event(s) (s) /* return file descriptor */
+#define sock_errno() errno
+#define sock_getopt(s,t,n,v,l) getsockopt((s),(t),(n),(v),(l))
+#define sock_htons(x) htons((x))
+#define sock_htonl(x) htonl((x))
+#define sock_listen(s, b) listen((s), (b))
+#define sock_name(s, addr, len) getsockname((s), (addr), (len))
+#define sock_ntohs(x) ntohs((x))
+#define sock_open(domain, type, proto) socket((domain), (type), (proto))
+#define sock_peer(s, addr, len) getpeername((s), (addr), (len))
+#define sock_recv(s,buf,len,flag) recv((s),(buf),(len),(flag))
+#define sock_recvfrom(s,buf,blen,flag,addr,alen) \
+ recvfrom((s),(buf),(blen),(flag),(addr),(alen))
+#define sock_recvmsg(s,msghdr,flag) recvmsg((s),(msghdr),(flag))
+#define sock_send(s,buf,len,flag) send((s), (buf), (len), (flag))
+#define sock_sendmsg(s,msghdr,flag) sendmsg((s),(msghdr),(flag))
+#define sock_sendto(s,buf,blen,flag,addr,alen) \
+ sendto((s),(buf),(blen),(flag),(addr),(alen))
+#define sock_setopt(s,l,o,v,ln) setsockopt((s),(l),(o),(v),(ln))
+#define sock_shutdown(s, how) shutdown((s), (how))
+
+#endif /* !__WIN32__ */
+
+#ifdef HAVE_SOCKLEN_T
+# define SOCKLEN_T socklen_t
+#else
+# define SOCKLEN_T size_t
+#endif
+
+#ifdef __WIN32__
+#define SOCKOPTLEN_T int
+#else
+#define SOCKOPTLEN_T SOCKLEN_T
+#endif
+
+/* We can use the IPv4 def for this since the beginning
+ * is the same for INET and INET6 */
+#define which_address_port(sap) \
+ ((((sap)->in4.sin_family == AF_INET) || \
+ ((sap)->in4.sin_family == AF_INET6)) ? \
+ ((sap)->in4.sin_port) : -1)
+
+
+typedef struct {
+ int is_active;
+ ErlNifMonitor mon;
+} ESockMonitor;
+
+typedef struct {
+ ErlNifPid pid; // PID of the requesting process
+ ESockMonitor mon; // Monitor to the requesting process
+ ERL_NIF_TERM ref; // The (unique) reference (ID) of the request
+} SocketRequestor;
+
+typedef struct socket_request_queue_element {
+ struct socket_request_queue_element* nextP;
+ SocketRequestor data;
+} SocketRequestQueueElement;
+
+typedef struct {
+ SocketRequestQueueElement* first;
+ SocketRequestQueueElement* last;
+} SocketRequestQueue;
+
+
+typedef struct {
+ /* +++ The actual socket +++ */
+ SOCKET sock;
+ HANDLE event;
+
+ /* +++ Stuff "about" the socket +++ */
+ int domain;
+ int type;
+ int protocol;
+
+ unsigned int state;
+ SocketAddress remote;
+ unsigned int addrLen;
+
+ ErlNifEnv* env;
+
+ /* +++ Controller (owner) process +++ */
+ ErlNifPid ctrlPid;
+ // ErlNifMonitor ctrlMon;
+ ESockMonitor ctrlMon;
+
+ /* +++ Write stuff +++ */
+ ErlNifMutex* writeMtx;
+ SocketRequestor currentWriter;
+ SocketRequestor* currentWriterP; // NULL or points to currentWriter
+ SocketRequestQueue writersQ;
+ BOOLEAN_T isWritable;
+ Uint32 writePkgCnt;
+ Uint32 writeByteCnt;
+ Uint32 writeTries;
+ Uint32 writeWaits;
+ Uint32 writeFails;
+
+ /* +++ Read stuff +++ */
+ ErlNifMutex* readMtx;
+ SocketRequestor currentReader;
+ SocketRequestor* currentReaderP; // NULL or points to currentReader
+ SocketRequestQueue readersQ;
+ BOOLEAN_T isReadable;
+ ErlNifBinary rbuffer; // DO WE NEED THIS
+ Uint32 readCapacity; // DO WE NEED THIS
+ Uint32 readPkgCnt;
+ Uint32 readByteCnt;
+ Uint32 readTries;
+ Uint32 readWaits;
+
+ /* +++ Accept stuff +++ */
+ ErlNifMutex* accMtx;
+ SocketRequestor currentAcceptor;
+ SocketRequestor* currentAcceptorP; // NULL or points to currentAcceptor
+ SocketRequestQueue acceptorsQ;
+
+ /* +++ Config & Misc stuff +++ */
+ size_t rBufSz; // Read buffer size (when data length = 0)
+ /* rNum and rNumCnt are used (together with rBufSz) when calling the recv
+ * function with the Length argument set to 0 (zero).
+ * If rNum is 0 (zero), then rNumCnt is not used and only *one* read will
+ * be done. Also, when get'ing the value of the option (rcvbuf) with
+ * getopt, the value will be reported as an integer. If the rNum has a
+ * value greater then 0 (zero), then it will instead be reported as {N, BufSz}.
+ */
+ unsigned int rNum; // recv: Number of reads using rBufSz
+ unsigned int rNumCnt; // recv: Current number of reads (so far)
+ size_t rCtrlSz; // Read control buffer size
+ size_t wCtrlSz; // Write control buffer size
+ BOOLEAN_T iow; // Inform On (counter) Wrap
+ BOOLEAN_T dbg;
+
+ /* +++ Close stuff +++ */
+ ErlNifMutex* closeMtx;
+ ErlNifPid closerPid;
+ ESockMonitor closerMon;
+ ErlNifEnv* closeEnv;
+ ERL_NIF_TERM closeRef;
+ BOOLEAN_T closeLocal;
+
+} SocketDescriptor;
+
+
+/* Global stuff.
+ */
+typedef struct {
+ /* These are for debugging, testing and the like */
+ // ERL_NIF_TERM version;
+ // ERL_NIF_TERM buildDate;
+ BOOLEAN_T dbg;
+
+ BOOLEAN_T iow; // Where do we send this? Subscription?
+ ErlNifMutex* cntMtx;
+ Uint32 numSockets;
+ Uint32 numTypeStreams;
+ Uint32 numTypeDGrams;
+ Uint32 numTypeSeqPkgs;
+ Uint32 numDomainInet;
+ Uint32 numDomainInet6;
+ Uint32 numDomainLocal;
+ Uint32 numProtoIP;
+ Uint32 numProtoTCP;
+ Uint32 numProtoUDP;
+ Uint32 numProtoSCTP;
+} SocketData;
+
+
+/* ----------------------------------------------------------------------
+ * F o r w a r d s
+ * ----------------------------------------------------------------------
+ */
+
+
+extern char* erl_errno_id(int error); /* THIS IS JUST TEMPORARY??? */
+
+
+/* All the nif "callback" functions for the socket API has
+ * the exact same API:
+ *
+ * nif_<funcname>(ErlNifEnv* env,
+ * int argc,
+ * const ERL_NIF_TERM argv[]);
+ *
+ * So, to simplify, use some macro magic to define those.
+ *
+ * These are the functions making up the "official" API.
+ * Basically, these functions does some preliminary checks and argument
+ * extractions and then call the functions called 'n<funcname>', which
+ * does the actual work. Except for the info function.
+ *
+ * nif_info
+ * nif_supports
+ * nif_open
+ * nif_bind
+ * nif_connect
+ * nif_listen
+ * nif_accept
+ * nif_send
+ * nif_sendto
+ * nif_sendmsg
+ * nif_recv
+ * nif_recvfrom
+ * nif_recvmsg
+ * nif_close
+ * nif_shutdown
+ * nif_setopt
+ * nif_getopt
+ * nif_sockname
+ * nif_peername
+ * nif_finalize_connection
+ * nif_finalize_close
+ * nif_cancel
+ */
+
+#define ESOCK_NIF_FUNCS \
+ ESOCK_NIF_FUNC_DEF(info); \
+ ESOCK_NIF_FUNC_DEF(supports); \
+ ESOCK_NIF_FUNC_DEF(open); \
+ ESOCK_NIF_FUNC_DEF(bind); \
+ ESOCK_NIF_FUNC_DEF(connect); \
+ ESOCK_NIF_FUNC_DEF(listen); \
+ ESOCK_NIF_FUNC_DEF(accept); \
+ ESOCK_NIF_FUNC_DEF(send); \
+ ESOCK_NIF_FUNC_DEF(sendto); \
+ ESOCK_NIF_FUNC_DEF(sendmsg); \
+ ESOCK_NIF_FUNC_DEF(recv); \
+ ESOCK_NIF_FUNC_DEF(recvfrom); \
+ ESOCK_NIF_FUNC_DEF(recvmsg); \
+ ESOCK_NIF_FUNC_DEF(close); \
+ ESOCK_NIF_FUNC_DEF(shutdown); \
+ ESOCK_NIF_FUNC_DEF(setopt); \
+ ESOCK_NIF_FUNC_DEF(getopt); \
+ ESOCK_NIF_FUNC_DEF(sockname); \
+ ESOCK_NIF_FUNC_DEF(peername); \
+ ESOCK_NIF_FUNC_DEF(finalize_connection); \
+ ESOCK_NIF_FUNC_DEF(finalize_close); \
+ ESOCK_NIF_FUNC_DEF(cancel);
+
+#define ESOCK_NIF_FUNC_DEF(F) \
+ static ERL_NIF_TERM nif_##F(ErlNifEnv* env, \
+ int argc, \
+ const ERL_NIF_TERM argv[]);
+ESOCK_NIF_FUNCS
+#undef ESOCK_NIF_FUNC_DEF
+
+
+#if !defined(__WIN32__)
+/* And here comes the functions that does the actual work (for the most part) */
+static ERL_NIF_TERM nsupports(ErlNifEnv* env, int key);
+static ERL_NIF_TERM nsupports_options(ErlNifEnv* env);
+static ERL_NIF_TERM nsupports_options_socket(ErlNifEnv* env);
+static ERL_NIF_TERM nsupports_options_ip(ErlNifEnv* env);
+static ERL_NIF_TERM nsupports_options_ipv6(ErlNifEnv* env);
+static ERL_NIF_TERM nsupports_options_tcp(ErlNifEnv* env);
+static ERL_NIF_TERM nsupports_options_udp(ErlNifEnv* env);
+static ERL_NIF_TERM nsupports_options_sctp(ErlNifEnv* env);
+static ERL_NIF_TERM nsupports_sctp(ErlNifEnv* env);
+static ERL_NIF_TERM nsupports_ipv6(ErlNifEnv* env);
+
+static ERL_NIF_TERM nopen(ErlNifEnv* env,
+ int domain,
+ int type,
+ int protocol,
+ char* netns);
+static ERL_NIF_TERM nbind(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ SocketAddress* sockAddrP,
+ unsigned int addrLen);
+static ERL_NIF_TERM nconnect(ErlNifEnv* env,
+ SocketDescriptor* descP);
+static ERL_NIF_TERM nlisten(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int backlog);
+static ERL_NIF_TERM naccept(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM ref);
+static ERL_NIF_TERM naccept_listening(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref);
+static ERL_NIF_TERM naccept_listening_error(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ErlNifPid caller,
+ int save_errno);
+static ERL_NIF_TERM naccept_listening_accept(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ SOCKET accSock,
+ ErlNifPid caller,
+ SocketAddress* remote);
+static ERL_NIF_TERM naccept_accepting(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM ref);
+static ERL_NIF_TERM naccept_accepting_current(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM ref);
+static ERL_NIF_TERM naccept_accepting_current_accept(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ SOCKET accSock,
+ SocketAddress* remote);
+static ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef,
+ int save_errno);
+static ERL_NIF_TERM naccept_accepting_other(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ErlNifPid caller);
+static ERL_NIF_TERM naccept_busy_retry(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ErlNifPid* pid,
+ unsigned int nextState);
+static BOOLEAN_T naccept_accepted(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ SOCKET accSock,
+ ErlNifPid pid,
+ SocketAddress* remote,
+ ERL_NIF_TERM* result);
+static ERL_NIF_TERM nsend(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM sendRef,
+ ErlNifBinary* dataP,
+ int flags);
+static ERL_NIF_TERM nsendto(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM sendRef,
+ ErlNifBinary* dataP,
+ int flags,
+ SocketAddress* toAddrP,
+ unsigned int toAddrLen);
+static ERL_NIF_TERM nsendmsg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM sendRef,
+ ERL_NIF_TERM eMsgHdr,
+ int flags);
+static ERL_NIF_TERM nrecv(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sendRef,
+ ERL_NIF_TERM recvRef,
+ int len,
+ int flags);
+static ERL_NIF_TERM nrecvfrom(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef,
+ Uint16 bufSz,
+ int flags);
+static ERL_NIF_TERM nrecvmsg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef,
+ Uint16 bufLen,
+ Uint16 ctrlLen,
+ int flags);
+static ERL_NIF_TERM nclose(ErlNifEnv* env,
+ SocketDescriptor* descP);
+static ERL_NIF_TERM nshutdown(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int how);
+static ERL_NIF_TERM nsetopt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ BOOLEAN_T isEncoded,
+ BOOLEAN_T isOTP,
+ int level,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+
+/* Set OTP level options */
+static ERL_NIF_TERM nsetopt_otp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+/* *** nsetopt_otp_debug ***
+ * *** nsetopt_otp_iow ***
+ * *** nsetopt_otp_ctrl_proc ***
+ * *** nsetopt_otp_rcvbuf ***
+ * *** nsetopt_otp_rcvctrlbuf ***
+ * *** nsetopt_otp_sndctrlbuf ***
+ */
+#define NSETOPT_OTP_FUNCS \
+ NSETOPT_OTP_FUNC_DEF(debug); \
+ NSETOPT_OTP_FUNC_DEF(iow); \
+ NSETOPT_OTP_FUNC_DEF(ctrl_proc); \
+ NSETOPT_OTP_FUNC_DEF(rcvbuf); \
+ NSETOPT_OTP_FUNC_DEF(rcvctrlbuf); \
+ NSETOPT_OTP_FUNC_DEF(sndctrlbuf);
+#define NSETOPT_OTP_FUNC_DEF(F) \
+ static ERL_NIF_TERM nsetopt_otp_##F(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ ERL_NIF_TERM eVal)
+NSETOPT_OTP_FUNCS
+#undef NSETOPT_OTP_FUNC_DEF
+
+/* Set native options */
+static ERL_NIF_TERM nsetopt_native(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+static ERL_NIF_TERM nsetopt_level(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+static ERL_NIF_TERM nsetopt_lvl_socket(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+
+
+/* *** Handling set of socket options for level = socket *** */
+
+#if defined(SO_BINDTODEVICE)
+static ERL_NIF_TERM nsetopt_lvl_sock_bindtodevice(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_BROADCAST)
+static ERL_NIF_TERM nsetopt_lvl_sock_broadcast(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_DEBUG)
+static ERL_NIF_TERM nsetopt_lvl_sock_debug(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_DONTROUTE)
+static ERL_NIF_TERM nsetopt_lvl_sock_dontroute(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_KEEPALIVE)
+static ERL_NIF_TERM nsetopt_lvl_sock_keepalive(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_LINGER)
+static ERL_NIF_TERM nsetopt_lvl_sock_linger(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_OOBINLINE)
+static ERL_NIF_TERM nsetopt_lvl_sock_oobinline(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_PEEK_OFF)
+static ERL_NIF_TERM nsetopt_lvl_sock_peek_off(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_PRIORITY)
+static ERL_NIF_TERM nsetopt_lvl_sock_priority(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_RCVBUF)
+static ERL_NIF_TERM nsetopt_lvl_sock_rcvbuf(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_RCVLOWAT)
+static ERL_NIF_TERM nsetopt_lvl_sock_rcvlowat(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_RCVTIMEO)
+static ERL_NIF_TERM nsetopt_lvl_sock_rcvtimeo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_REUSEADDR)
+static ERL_NIF_TERM nsetopt_lvl_sock_reuseaddr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_REUSEPORT)
+static ERL_NIF_TERM nsetopt_lvl_sock_reuseport(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_SNDBUF)
+static ERL_NIF_TERM nsetopt_lvl_sock_sndbuf(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_SNDLOWAT)
+static ERL_NIF_TERM nsetopt_lvl_sock_sndlowat(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_SNDTIMEO)
+static ERL_NIF_TERM nsetopt_lvl_sock_sndtimeo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SO_TIMESTAMP)
+static ERL_NIF_TERM nsetopt_lvl_sock_timestamp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+static ERL_NIF_TERM nsetopt_lvl_ip(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+
+/* *** Handling set of socket options for level = ip *** */
+#if defined(IP_ADD_MEMBERSHIP)
+static ERL_NIF_TERM nsetopt_lvl_ip_add_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_ADD_SOURCE_MEMBERSHIP)
+static ERL_NIF_TERM nsetopt_lvl_ip_add_source_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_BLOCK_SOURCE)
+static ERL_NIF_TERM nsetopt_lvl_ip_block_source(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_DROP_MEMBERSHIP)
+static ERL_NIF_TERM nsetopt_lvl_ip_drop_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_DROP_SOURCE_MEMBERSHIP)
+static ERL_NIF_TERM nsetopt_lvl_ip_drop_source_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_FREEBIND)
+static ERL_NIF_TERM nsetopt_lvl_ip_freebind(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_HDRINCL)
+static ERL_NIF_TERM nsetopt_lvl_ip_hdrincl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_MINTTL)
+static ERL_NIF_TERM nsetopt_lvl_ip_minttl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_MSFILTER) && defined(IP_MSFILTER_SIZE)
+static ERL_NIF_TERM nsetopt_lvl_ip_msfilter(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+static BOOLEAN_T decode_ip_msfilter_mode(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ Uint32* mode);
+static ERL_NIF_TERM nsetopt_lvl_ip_msfilter_set(ErlNifEnv* env,
+ SOCKET sock,
+ struct ip_msfilter* msfP,
+ SOCKLEN_T optLen);
+#endif
+#if defined(IP_MTU_DISCOVER)
+static ERL_NIF_TERM nsetopt_lvl_ip_mtu_discover(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_MULTICAST_ALL)
+static ERL_NIF_TERM nsetopt_lvl_ip_multicast_all(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_MULTICAST_IF)
+static ERL_NIF_TERM nsetopt_lvl_ip_multicast_if(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_MULTICAST_LOOP)
+static ERL_NIF_TERM nsetopt_lvl_ip_multicast_loop(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_MULTICAST_TTL)
+static ERL_NIF_TERM nsetopt_lvl_ip_multicast_ttl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_NODEFRAG)
+static ERL_NIF_TERM nsetopt_lvl_ip_nodefrag(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_PKTINFO)
+static ERL_NIF_TERM nsetopt_lvl_ip_pktinfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_RECVDSTADDR)
+static ERL_NIF_TERM nsetopt_lvl_ip_recvdstaddr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_RECVERR)
+static ERL_NIF_TERM nsetopt_lvl_ip_recverr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_RECVIF)
+static ERL_NIF_TERM nsetopt_lvl_ip_recvif(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_RECVOPTS)
+static ERL_NIF_TERM nsetopt_lvl_ip_recvopts(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_RECVORIGDSTADDR)
+static ERL_NIF_TERM nsetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_RECVTOS)
+static ERL_NIF_TERM nsetopt_lvl_ip_recvtos(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_RECVTTL)
+static ERL_NIF_TERM nsetopt_lvl_ip_recvttl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_RETOPTS)
+static ERL_NIF_TERM nsetopt_lvl_ip_retopts(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_ROUTER_ALERT)
+static ERL_NIF_TERM nsetopt_lvl_ip_router_alert(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_SENDSRCADDR)
+static ERL_NIF_TERM nsetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_TOS)
+static ERL_NIF_TERM nsetopt_lvl_ip_tos(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_TRANSPARENT)
+static ERL_NIF_TERM nsetopt_lvl_ip_transparent(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_TTL)
+static ERL_NIF_TERM nsetopt_lvl_ip_ttl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IP_UNBLOCK_SOURCE)
+static ERL_NIF_TERM nsetopt_lvl_ip_unblock_source(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+
+#if defined(IP_DROP_MEMBERSHIP) || defined(IP_ADD_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_update_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal,
+ int opt);
+#endif
+#if defined(IP_ADD_SOURCE_MEMBERSHIP) || defined(IP_DROP_SOURCE_MEMBERSHIP) || defined(IP_BLOCK_SOURCE) || defined(IP_UNBLOCK_SOURCE)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_update_source(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal,
+ int opt);
+#endif
+
+
+/* *** Handling set of socket options for level = ipv6 *** */
+#if defined(HAVE_IPV6)
+static ERL_NIF_TERM nsetopt_lvl_ipv6(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+#if defined(IPV6_ADDRFORM)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_addrform(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_ADD_MEMBERSHIP)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_add_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_AUTHHDR)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_authhdr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_DROP_MEMBERSHIP)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_drop_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_DSTOPTS)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_dstopts(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_FLOWINFO)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_flowinfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_HOPLIMIT)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_hoplimit(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_HOPOPTS)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_hopopts(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_MTU)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_mtu(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_MTU_DISCOVER)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_MULTICAST_HOPS)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_MULTICAST_IF)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_if(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_MULTICAST_LOOP)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_RECVERR)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_recverr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_ROUTER_ALERT)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_router_alert(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_RTHDR)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_rthdr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_UNICAST_HOPS)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(IPV6_V6ONLY)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_v6only(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+
+#if defined(IPV6_ADD_MEMBERSHIP) || defined(IPV6_DROP_MEMBERSHIP)
+static ERL_NIF_TERM nsetopt_lvl_ipv6_update_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal,
+ int opt);
+#endif
+
+#endif // defined(HAVE_IPV6)
+static ERL_NIF_TERM nsetopt_lvl_tcp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+#if defined(TCP_CONGESTION)
+static ERL_NIF_TERM nsetopt_lvl_tcp_congestion(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(TCP_MAXSEG)
+static ERL_NIF_TERM nsetopt_lvl_tcp_maxseg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(TCP_NODELAY)
+static ERL_NIF_TERM nsetopt_lvl_tcp_nodelay(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+static ERL_NIF_TERM nsetopt_lvl_udp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+#if defined(UDP_CORK)
+static ERL_NIF_TERM nsetopt_lvl_udp_cork(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(HAVE_SCTP)
+static ERL_NIF_TERM nsetopt_lvl_sctp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal);
+#if defined(SCTP_ASSOCINFO)
+static ERL_NIF_TERM nsetopt_lvl_sctp_associnfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SCTP_AUTOCLOSE)
+static ERL_NIF_TERM nsetopt_lvl_sctp_autoclose(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SCTP_DISABLE_FRAGMENTS)
+static ERL_NIF_TERM nsetopt_lvl_sctp_disable_fragments(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SCTP_EVENTS)
+static ERL_NIF_TERM nsetopt_lvl_sctp_events(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SCTP_INITMSG)
+static ERL_NIF_TERM nsetopt_lvl_sctp_initmsg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SCTP_MAXSEG)
+static ERL_NIF_TERM nsetopt_lvl_sctp_maxseg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SCTP_NODELAY)
+static ERL_NIF_TERM nsetopt_lvl_sctp_nodelay(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#if defined(SCTP_RTOINFO)
+static ERL_NIF_TERM nsetopt_lvl_sctp_rtoinfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal);
+#endif
+#endif // defined(HAVE_SCTP)
+
+static ERL_NIF_TERM ngetopt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ BOOLEAN_T isEncoded,
+ BOOLEAN_T isOTP,
+ int level,
+ ERL_NIF_TERM eOpt);
+
+static ERL_NIF_TERM ngetopt_otp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt);
+/* *** ngetopt_otp_debug ***
+ * *** ngetopt_otp_iow ***
+ * *** ngetopt_otp_ctrl_proc ***
+ * *** ngetopt_otp_rcvbuf ***
+ * *** ngetopt_otp_rcvctrlbuf ***
+ * *** ngetopt_otp_sndctrlbuf ***
+ * *** ngetopt_otp_fd ***
+ * *** ngetopt_otp_domain ***
+ * *** ngetopt_otp_type ***
+ * *** ngetopt_otp_protocol ***
+ */
+#define NGETOPT_OTP_FUNCS \
+ NGETOPT_OTP_FUNC_DEF(debug); \
+ NGETOPT_OTP_FUNC_DEF(iow); \
+ NGETOPT_OTP_FUNC_DEF(ctrl_proc); \
+ NGETOPT_OTP_FUNC_DEF(rcvbuf); \
+ NGETOPT_OTP_FUNC_DEF(rcvctrlbuf); \
+ NGETOPT_OTP_FUNC_DEF(sndctrlbuf); \
+ NGETOPT_OTP_FUNC_DEF(fd); \
+ NGETOPT_OTP_FUNC_DEF(domain); \
+ NGETOPT_OTP_FUNC_DEF(type); \
+ NGETOPT_OTP_FUNC_DEF(protocol);
+#define NGETOPT_OTP_FUNC_DEF(F) \
+ static ERL_NIF_TERM ngetopt_otp_##F(ErlNifEnv* env, \
+ SocketDescriptor* descP)
+NGETOPT_OTP_FUNCS
+#undef NGETOPT_OTP_FUNC_DEF
+
+static ERL_NIF_TERM ngetopt_native(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ ERL_NIF_TERM eOpt);
+static ERL_NIF_TERM ngetopt_native_unspec(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ SOCKOPTLEN_T valueSz);
+static ERL_NIF_TERM ngetopt_level(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int eOpt);
+static ERL_NIF_TERM ngetopt_lvl_socket(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt);
+#if defined(SO_ACCEPTCONN)
+static ERL_NIF_TERM ngetopt_lvl_sock_acceptconn(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_BINDTODEVICE)
+static ERL_NIF_TERM ngetopt_lvl_sock_bindtodevice(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_BROADCAST)
+static ERL_NIF_TERM ngetopt_lvl_sock_broadcast(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_DEBUG)
+static ERL_NIF_TERM ngetopt_lvl_sock_debug(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_DOMAIN)
+static ERL_NIF_TERM ngetopt_lvl_sock_domain(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_DONTROUTE)
+static ERL_NIF_TERM ngetopt_lvl_sock_dontroute(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_KEEPALIVE)
+static ERL_NIF_TERM ngetopt_lvl_sock_keepalive(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_LINGER)
+static ERL_NIF_TERM ngetopt_lvl_sock_linger(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_OOBINLINE)
+static ERL_NIF_TERM ngetopt_lvl_sock_oobinline(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_PEEK_OFF)
+static ERL_NIF_TERM ngetopt_lvl_sock_peek_off(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_PRIORITY)
+static ERL_NIF_TERM ngetopt_lvl_sock_priority(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_PROTOCOL)
+static ERL_NIF_TERM ngetopt_lvl_sock_protocol(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_RCVBUF)
+static ERL_NIF_TERM ngetopt_lvl_sock_rcvbuf(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_RCVLOWAT)
+static ERL_NIF_TERM ngetopt_lvl_sock_rcvlowat(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_RCVTIMEO)
+static ERL_NIF_TERM ngetopt_lvl_sock_rcvtimeo(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_REUSEADDR)
+static ERL_NIF_TERM ngetopt_lvl_sock_reuseaddr(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_REUSEPORT)
+static ERL_NIF_TERM ngetopt_lvl_sock_reuseport(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_SNDBUF)
+static ERL_NIF_TERM ngetopt_lvl_sock_sndbuf(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_SNDLOWAT)
+static ERL_NIF_TERM ngetopt_lvl_sock_sndlowat(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_SNDTIMEO)
+static ERL_NIF_TERM ngetopt_lvl_sock_sndtimeo(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_TIMESTAMP)
+static ERL_NIF_TERM ngetopt_lvl_sock_timestamp(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SO_TYPE)
+static ERL_NIF_TERM ngetopt_lvl_sock_type(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+static ERL_NIF_TERM ngetopt_lvl_ip(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt);
+#if defined(IP_FREEBIND)
+static ERL_NIF_TERM ngetopt_lvl_ip_freebind(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_HDRINCL)
+static ERL_NIF_TERM ngetopt_lvl_ip_hdrincl(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_MINTTL)
+static ERL_NIF_TERM ngetopt_lvl_ip_minttl(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_MTU)
+static ERL_NIF_TERM ngetopt_lvl_ip_mtu(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_MTU_DISCOVER)
+static ERL_NIF_TERM ngetopt_lvl_ip_mtu_discover(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_MULTICAST_ALL)
+static ERL_NIF_TERM ngetopt_lvl_ip_multicast_all(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_MULTICAST_IF)
+static ERL_NIF_TERM ngetopt_lvl_ip_multicast_if(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_MULTICAST_LOOP)
+static ERL_NIF_TERM ngetopt_lvl_ip_multicast_loop(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_MULTICAST_TTL)
+static ERL_NIF_TERM ngetopt_lvl_ip_multicast_ttl(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_NODEFRAG)
+static ERL_NIF_TERM ngetopt_lvl_ip_nodefrag(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_PKTINFO)
+static ERL_NIF_TERM ngetopt_lvl_ip_pktinfo(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_RECVDSTADDR)
+static ERL_NIF_TERM ngetopt_lvl_ip_recvdstaddr(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_RECVERR)
+static ERL_NIF_TERM ngetopt_lvl_ip_recverr(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_RECVIF)
+static ERL_NIF_TERM ngetopt_lvl_ip_recvif(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_RECVOPTS)
+static ERL_NIF_TERM ngetopt_lvl_ip_recvopts(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_RECVORIGDSTADDR)
+static ERL_NIF_TERM ngetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_RECVTOS)
+static ERL_NIF_TERM ngetopt_lvl_ip_recvtos(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_RECVTTL)
+static ERL_NIF_TERM ngetopt_lvl_ip_recvttl(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_RETOPTS)
+static ERL_NIF_TERM ngetopt_lvl_ip_retopts(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_ROUTER_ALERT)
+static ERL_NIF_TERM ngetopt_lvl_ip_router_alert(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_SENDSRCADDR)
+static ERL_NIF_TERM ngetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_TOS)
+static ERL_NIF_TERM ngetopt_lvl_ip_tos(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_TRANSPARENT)
+static ERL_NIF_TERM ngetopt_lvl_ip_transparent(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IP_TTL)
+static ERL_NIF_TERM ngetopt_lvl_ip_ttl(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(HAVE_IPV6)
+static ERL_NIF_TERM ngetopt_lvl_ipv6(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt);
+#if defined(IPV6_AUTHHDR)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_authhdr(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_DSTOPTS)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_dstopts(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_FLOWINFO)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_flowinfo(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_HOPLIMIT)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_hoplimit(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_HOPOPTS)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_hopopts(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_MTU)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_mtu(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_MTU_DISCOVER)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_MULTICAST_HOPS)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_MULTICAST_IF)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_if(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_MULTICAST_LOOP)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_RECVERR)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_recverr(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_ROUTER_ALERT)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_router_alert(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_RTHDR)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_rthdr(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_UNICAST_HOPS)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(IPV6_V6ONLY)
+static ERL_NIF_TERM ngetopt_lvl_ipv6_v6only(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+
+#endif // defined(HAVE_IPV6)
+
+static ERL_NIF_TERM ngetopt_lvl_tcp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt);
+#if defined(TCP_CONGESTION)
+static ERL_NIF_TERM ngetopt_lvl_tcp_congestion(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(TCP_MAXSEG)
+static ERL_NIF_TERM ngetopt_lvl_tcp_maxseg(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(TCP_NODELAY)
+static ERL_NIF_TERM ngetopt_lvl_tcp_nodelay(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+static ERL_NIF_TERM ngetopt_lvl_udp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt);
+#if defined(UDP_CORK)
+static ERL_NIF_TERM ngetopt_lvl_udp_cork(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(HAVE_SCTP)
+static ERL_NIF_TERM ngetopt_lvl_sctp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt);
+#if defined(SCTP_ASSOCINFO)
+static ERL_NIF_TERM ngetopt_lvl_sctp_associnfo(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SCTP_AUTOCLOSE)
+static ERL_NIF_TERM ngetopt_lvl_sctp_autoclose(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SCTP_DISABLE_FRAGMENTS)
+static ERL_NIF_TERM ngetopt_lvl_sctp_disable_fragments(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SCTP_MAXSEG)
+static ERL_NIF_TERM ngetopt_lvl_sctp_maxseg(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SCTP_INITMSG)
+static ERL_NIF_TERM ngetopt_lvl_sctp_initmsg(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SCTP_NODELAY)
+static ERL_NIF_TERM ngetopt_lvl_sctp_nodelay(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#if defined(SCTP_RTOINFO)
+static ERL_NIF_TERM ngetopt_lvl_sctp_rtoinfo(ErlNifEnv* env,
+ SocketDescriptor* descP);
+#endif
+#endif // defined(HAVE_SCTP)
+static ERL_NIF_TERM nsockname(ErlNifEnv* env,
+ SocketDescriptor* descP);
+static ERL_NIF_TERM npeername(ErlNifEnv* env,
+ SocketDescriptor* descP);
+static ERL_NIF_TERM ncancel(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM op,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_connect(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_accept(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_accept_current(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef);
+static ERL_NIF_TERM ncancel_accept_waiting(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_send(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_send_current(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef);
+static ERL_NIF_TERM ncancel_send_waiting(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_recv(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_recv_current(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef);
+static ERL_NIF_TERM ncancel_recv_waiting(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_read_select(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_write_select(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef);
+static ERL_NIF_TERM ncancel_mode_select(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef,
+ int smode,
+ int rmode);
+
+#if defined(USE_SETOPT_STR_OPT)
+static ERL_NIF_TERM nsetopt_str_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ int max,
+ ERL_NIF_TERM eVal);
+#endif
+static ERL_NIF_TERM nsetopt_bool_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ ERL_NIF_TERM eVal);
+static ERL_NIF_TERM nsetopt_int_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ ERL_NIF_TERM eVal);
+static ERL_NIF_TERM nsetopt_timeval_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ ERL_NIF_TERM eVal);
+
+#if defined(USE_GETOPT_STR_OPT)
+static ERL_NIF_TERM ngetopt_str_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ int max);
+#endif
+static ERL_NIF_TERM ngetopt_bool_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt);
+static ERL_NIF_TERM ngetopt_int_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt);
+static ERL_NIF_TERM ngetopt_timeval_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt);
+
+static BOOLEAN_T send_check_writer(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ERL_NIF_TERM* checkResult);
+static ERL_NIF_TERM send_check_result(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ssize_t written,
+ ssize_t dataSize,
+ int saveErrno,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM sendRef);
+static BOOLEAN_T recv_check_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ERL_NIF_TERM* checkResult);
+static char* recv_init_current_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref);
+static ERL_NIF_TERM recv_update_current_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef);
+static void recv_error_current_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM reason);
+static ERL_NIF_TERM recv_check_result(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int read,
+ int toRead,
+ int saveErrno,
+ ErlNifBinary* bufP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef);
+static ERL_NIF_TERM recvfrom_check_result(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int read,
+ int saveErrno,
+ ErlNifBinary* bufP,
+ SocketAddress* fromAddrP,
+ unsigned int fromAddrLen,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef);
+static ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int read,
+ int saveErrno,
+ struct msghdr* msgHdrP,
+ ErlNifBinary* dataBufP,
+ ErlNifBinary* ctrlBufP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef);
+
+static ERL_NIF_TERM nfinalize_connection(ErlNifEnv* env,
+ SocketDescriptor* descP);
+static ERL_NIF_TERM nfinalize_close(ErlNifEnv* env,
+ SocketDescriptor* descP);
+
+extern char* encode_msghdr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int read,
+ struct msghdr* msgHdrP,
+ ErlNifBinary* dataBufP,
+ ErlNifBinary* ctrlBufP,
+ ERL_NIF_TERM* eSockAddr);
+extern char* encode_cmsghdrs(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ErlNifBinary* cmsgBinP,
+ struct msghdr* msgHdrP,
+ ERL_NIF_TERM* eCMsgHdr);
+extern char* decode_cmsghdrs(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eCMsgHdr,
+ char* cmsgHdrBufP,
+ size_t cmsgHdrBufLen,
+ size_t* cmsgHdrBufUsed);
+extern char* decode_cmsghdr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eCMsgHdr,
+ char* bufP,
+ size_t rem,
+ size_t* used);
+static char* encode_cmsghdr_level(ErlNifEnv* env,
+ int level,
+ ERL_NIF_TERM* eLevel);
+static char* decode_cmsghdr_level(ErlNifEnv* env,
+ ERL_NIF_TERM eLevel,
+ int* level);
+static char* encode_cmsghdr_type(ErlNifEnv* env,
+ int level,
+ int type,
+ ERL_NIF_TERM* eType);
+static char* decode_cmsghdr_type(ErlNifEnv* env,
+ int level,
+ ERL_NIF_TERM eType,
+ int* type);
+static char* encode_cmsghdr_data(ErlNifEnv* env,
+ ERL_NIF_TERM ctrlBuf,
+ int level,
+ int type,
+ unsigned char* dataP,
+ size_t dataPos,
+ size_t dataLen,
+ ERL_NIF_TERM* eCMsgHdrData);
+static char* encode_cmsghdr_data_socket(ErlNifEnv* env,
+ ERL_NIF_TERM ctrlBuf,
+ int type,
+ unsigned char* dataP,
+ size_t dataPos,
+ size_t dataLen,
+ ERL_NIF_TERM* eCMsgHdrData);
+static char* encode_cmsghdr_data_ip(ErlNifEnv* env,
+ ERL_NIF_TERM ctrlBuf,
+ int type,
+ unsigned char* dataP,
+ size_t dataPos,
+ size_t dataLen,
+ ERL_NIF_TERM* eCMsgHdrData);
+#if defined(HAVE_IPV6)
+static char* encode_cmsghdr_data_ipv6(ErlNifEnv* env,
+ ERL_NIF_TERM ctrlBuf,
+ int type,
+ unsigned char* dataP,
+ size_t dataPos,
+ size_t dataLen,
+ ERL_NIF_TERM* eCMsgHdrData);
+#endif
+extern char* encode_msghdr_flags(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int msgFlags,
+ ERL_NIF_TERM* flags);
+static char* decode_cmsghdr_data(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ char* bufP,
+ size_t rem,
+ int level,
+ int type,
+ ERL_NIF_TERM eData,
+ size_t* used);
+static char* decode_cmsghdr_final(SocketDescriptor* descP,
+ char* bufP,
+ size_t rem,
+ int level,
+ int type,
+ char* data,
+ int sz,
+ size_t* used);
+static BOOLEAN_T decode_sock_linger(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ struct linger* valP);
+#if defined(IP_TOS)
+static BOOLEAN_T decode_ip_tos(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ int* val);
+#endif
+#if defined(IP_MTU_DISCOVER)
+static char* decode_ip_pmtudisc(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ int* val);
+#endif
+#if defined(IP_MTU_DISCOVER)
+static void encode_ip_pmtudisc(ErlNifEnv* env,
+ int val,
+ ERL_NIF_TERM* eVal);
+#endif
+#if defined(IPV6_MTU_DISCOVER)
+static char* decode_ipv6_pmtudisc(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ int* val);
+#endif
+#if defined(IPV6_MTU_DISCOVER)
+static void encode_ipv6_pmtudisc(ErlNifEnv* env,
+ int val,
+ ERL_NIF_TERM* eVal);
+#endif
+
+/*
+static BOOLEAN_T decode_bool(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ BOOLEAN_T* val);
+*/
+static BOOLEAN_T decode_native_get_opt(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ int* opt,
+ Uint16* valueType,
+ int* valueSz);
+// static void encode_bool(BOOLEAN_T val, ERL_NIF_TERM* eVal);
+static ERL_NIF_TERM encode_ip_tos(ErlNifEnv* env, int val);
+
+static void inform_waiting_procs(ErlNifEnv* env,
+ char* role,
+ SocketDescriptor* descP,
+ SocketRequestQueue* q,
+ BOOLEAN_T free,
+ ERL_NIF_TERM reason);
+
+static int socket_setopt(int sock,
+ int level,
+ int opt,
+ const void* optVal,
+ const socklen_t optLen);
+
+static BOOLEAN_T verify_is_connected(SocketDescriptor* descP, int* err);
+
+static SocketDescriptor* alloc_descriptor(SOCKET sock, HANDLE event);
+
+
+static BOOLEAN_T edomain2domain(int edomain, int* domain);
+static BOOLEAN_T etype2type(int etype, int* type);
+static BOOLEAN_T eproto2proto(ErlNifEnv* env,
+ const ERL_NIF_TERM eproto,
+ int* proto);
+static BOOLEAN_T ehow2how(unsigned int ehow, int* how);
+static BOOLEAN_T esendflags2sendflags(unsigned int esendflags, int* sendflags);
+static BOOLEAN_T erecvflags2recvflags(unsigned int erecvflags, int* recvflags);
+static BOOLEAN_T elevel2level(BOOLEAN_T isEncoded,
+ int eLevel,
+ BOOLEAN_T* isOTP,
+ int* level);
+#ifdef HAVE_SETNS
+static BOOLEAN_T emap2netns(ErlNifEnv* env, ERL_NIF_TERM map, char** netns);
+static BOOLEAN_T change_network_namespace(char* netns, int* cns, int* err);
+static BOOLEAN_T restore_network_namespace(int ns, SOCKET sock, int* err);
+#endif
+
+static BOOLEAN_T cnt_inc(Uint32* cnt, Uint32 inc);
+static void cnt_dec(Uint32* cnt, Uint32 dec);
+
+static void inc_socket(int domain, int type, int protocol);
+static void dec_socket(int domain, int type, int protocol);
+
+
+
+/* *** activate_next_acceptor ***
+ * *** activate_next_writer ***
+ * *** activate_next_reader ***
+ *
+ * All the activate-next functions for acceptor, writer and reader
+ * have exactly the same API, so we apply some macro magic to simplify.
+ * They simply operates on dufferent data structures.
+ *
+ */
+
+#define ACTIVATE_NEXT_FUNCS_DEFS \
+ ACTIVATE_NEXT_FUNC_DEF(acceptor) \
+ ACTIVATE_NEXT_FUNC_DEF(writer) \
+ ACTIVATE_NEXT_FUNC_DEF(reader)
+
+#define ACTIVATE_NEXT_FUNC_DEF(F) \
+ static BOOLEAN_T activate_next_##F(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ ERL_NIF_TERM sockRef);
+ACTIVATE_NEXT_FUNCS_DEFS
+#undef ACTIVATE_NEXT_FUNC_DEF
+
+/*
+static BOOLEAN_T activate_next(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ SocketRequestor* reqP,
+ SocketRequestQueue* q,
+ ERL_NIF_TERM sockRef);
+*/
+
+/* *** acceptor_search4pid | writer_search4pid | reader_search4pid ***
+ * *** acceptor_push | writer_push | reader_push ***
+ * *** acceptor_pop | writer_pop | reader_pop ***
+ * *** acceptor_unqueue | writer_unqueue | reader_unqueue ***
+ *
+ * All the queue operator functions (search4pid, push, pop
+ * and unqueue) for acceptor, writer and reader has exactly
+ * the same API, so we apply some macro magic to simplify.
+ */
+
+#define ESOCK_OPERATOR_FUNCS_DEFS \
+ ESOCK_OPERATOR_FUNCS_DEF(acceptor) \
+ ESOCK_OPERATOR_FUNCS_DEF(writer) \
+ ESOCK_OPERATOR_FUNCS_DEF(reader)
+
+#define ESOCK_OPERATOR_FUNCS_DEF(O) \
+ static BOOLEAN_T O##_search4pid(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ ErlNifPid* pid); \
+ static ERL_NIF_TERM O##_push(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ ErlNifPid pid, \
+ ERL_NIF_TERM ref); \
+ static BOOLEAN_T O##_pop(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ SocketRequestor* reqP); \
+ static BOOLEAN_T O##_unqueue(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ const ErlNifPid* pid);
+ESOCK_OPERATOR_FUNCS_DEFS
+#undef ESOCK_OPERATOR_FUNCS_DEF
+
+static BOOLEAN_T requestor_pop(SocketRequestQueue* q,
+ SocketRequestor* reqP);
+
+static BOOLEAN_T qsearch4pid(ErlNifEnv* env,
+ SocketRequestQueue* q,
+ ErlNifPid* pid);
+static void qpush(SocketRequestQueue* q,
+ SocketRequestQueueElement* e);
+static SocketRequestQueueElement* qpop(SocketRequestQueue* q);
+static BOOLEAN_T qunqueue(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ const char* slogan,
+ SocketRequestQueue* q,
+ const ErlNifPid* pid);
+
+static int esock_monitor(const char* slogan,
+ ErlNifEnv* env,
+ SocketDescriptor* descP,
+ const ErlNifPid* pid,
+ ESockMonitor* mon);
+static int esock_demonitor(const char* slogan,
+ ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ESockMonitor* monP);
+static void esock_monitor_init(ESockMonitor* mon);
+
+#endif // if defined(__WIN32__)
+
+/*
+#if defined(HAVE_SYS_UN_H) || defined(SO_BINDTODEVICE)
+static size_t my_strnlen(const char *s, size_t maxlen);
+#endif
+*/
+
+static void socket_dtor(ErlNifEnv* env, void* obj);
+static void socket_stop(ErlNifEnv* env,
+ void* obj,
+ int fd,
+ int is_direct_call);
+static void socket_down(ErlNifEnv* env,
+ void* obj,
+ const ErlNifPid* pid,
+ const ErlNifMonitor* mon);
+
+#if !defined(__WIN32__)
+
+static void socket_down_acceptor(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ const ErlNifPid* pid);
+static void socket_down_writer(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ const ErlNifPid* pid);
+static void socket_down_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ const ErlNifPid* pid);
+
+static char* esock_send_close_msg(ErlNifEnv* env,
+ SocketDescriptor* descP);
+static char* esock_send_abort_msg(ErlNifEnv* env,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef,
+ ERL_NIF_TERM reason,
+ ErlNifPid* pid);
+static char* esock_send_socket_msg(ErlNifEnv* env,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM tag,
+ ERL_NIF_TERM info,
+ ErlNifPid* pid,
+ ErlNifEnv* msg_env);
+static char* esock_send_msg(ErlNifEnv* env,
+ ERL_NIF_TERM msg,
+ ErlNifPid* pid,
+ ErlNifEnv* msg_env);
+
+static int esock_select_read(ErlNifEnv* env,
+ ErlNifEvent event,
+ void* obj,
+ const ErlNifPid* pid,
+ ERL_NIF_TERM ref);
+static int esock_select_write(ErlNifEnv* env,
+ ErlNifEvent event,
+ void* obj,
+ const ErlNifPid* pid,
+ ERL_NIF_TERM ref);
+static int esock_select_stop(ErlNifEnv* env,
+ ErlNifEvent event,
+ void* obj);
+static int esock_select_cancel(ErlNifEnv* env,
+ ErlNifEvent event,
+ enum ErlNifSelectFlags mode,
+ void* obj);
+
+static BOOLEAN_T extract_debug(ErlNifEnv* env,
+ ERL_NIF_TERM map);
+static BOOLEAN_T extract_iow(ErlNifEnv* env,
+ ERL_NIF_TERM map);
+
+#endif // if defined(__WIN32__)
+
+static int on_load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info);
+
+
+
+#if HAVE_IN6
+# if ! defined(HAVE_IN6ADDR_ANY) || ! HAVE_IN6ADDR_ANY
+# if HAVE_DECL_IN6ADDR_ANY_INIT
+static const struct in6_addr in6addr_any = { { IN6ADDR_ANY_INIT } };
+# else
+static const struct in6_addr in6addr_any =
+ { { { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 } } };
+# endif /* HAVE_IN6ADDR_ANY_INIT */
+# endif /* ! HAVE_DECL_IN6ADDR_ANY */
+
+# if ! defined(HAVE_IN6ADDR_LOOPBACK) || ! HAVE_IN6ADDR_LOOPBACK
+# if HAVE_DECL_IN6ADDR_LOOPBACK_INIT
+static const struct in6_addr in6addr_loopback =
+ { { IN6ADDR_LOOPBACK_INIT } };
+# else
+static const struct in6_addr in6addr_loopback =
+ { { { 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1 } } };
+# endif /* HAVE_IN6ADDR_LOOPBACk_INIT */
+# endif /* ! HAVE_DECL_IN6ADDR_LOOPBACK */
+#endif /* HAVE_IN6 */
+
+
+
+/* (special) error string constants */
+static char str_exmon[] = "exmonitor"; // failed monitor
+static char str_exself[] = "exself"; // failed self
+static char str_exsend[] = "exsend"; // failed send
+
+
+
+/* *** Global atoms *** */
+#define GLOBAL_ATOMS \
+ GLOBAL_ATOM_DECL(abort); \
+ GLOBAL_ATOM_DECL(accept); \
+ GLOBAL_ATOM_DECL(acceptconn); \
+ GLOBAL_ATOM_DECL(acceptfilter); \
+ GLOBAL_ATOM_DECL(adaption_layer); \
+ GLOBAL_ATOM_DECL(addr); \
+ GLOBAL_ATOM_DECL(addrform); \
+ GLOBAL_ATOM_DECL(add_membership); \
+ GLOBAL_ATOM_DECL(add_source_membership); \
+ GLOBAL_ATOM_DECL(any); \
+ GLOBAL_ATOM_DECL(associnfo); \
+ GLOBAL_ATOM_DECL(authhdr); \
+ GLOBAL_ATOM_DECL(auth_active_key); \
+ GLOBAL_ATOM_DECL(auth_asconf); \
+ GLOBAL_ATOM_DECL(auth_chunk); \
+ GLOBAL_ATOM_DECL(auth_delete_key); \
+ GLOBAL_ATOM_DECL(auth_key); \
+ GLOBAL_ATOM_DECL(auth_level); \
+ GLOBAL_ATOM_DECL(autoclose); \
+ GLOBAL_ATOM_DECL(bindtodevice); \
+ GLOBAL_ATOM_DECL(block_source); \
+ GLOBAL_ATOM_DECL(broadcast); \
+ GLOBAL_ATOM_DECL(busy_poll); \
+ GLOBAL_ATOM_DECL(checksum); \
+ GLOBAL_ATOM_DECL(close); \
+ GLOBAL_ATOM_DECL(connect); \
+ GLOBAL_ATOM_DECL(congestion); \
+ GLOBAL_ATOM_DECL(context); \
+ GLOBAL_ATOM_DECL(cork); \
+ GLOBAL_ATOM_DECL(credentials); \
+ GLOBAL_ATOM_DECL(ctrl); \
+ GLOBAL_ATOM_DECL(ctrunc); \
+ GLOBAL_ATOM_DECL(data); \
+ GLOBAL_ATOM_DECL(debug); \
+ GLOBAL_ATOM_DECL(default_send_params); \
+ GLOBAL_ATOM_DECL(delayed_ack_time); \
+ GLOBAL_ATOM_DECL(dgram); \
+ GLOBAL_ATOM_DECL(disable_fragments); \
+ GLOBAL_ATOM_DECL(domain); \
+ GLOBAL_ATOM_DECL(dontfrag); \
+ GLOBAL_ATOM_DECL(dontroute); \
+ GLOBAL_ATOM_DECL(drop_membership); \
+ GLOBAL_ATOM_DECL(drop_source_membership); \
+ GLOBAL_ATOM_DECL(dstopts); \
+ GLOBAL_ATOM_DECL(eor); \
+ GLOBAL_ATOM_DECL(error); \
+ GLOBAL_ATOM_DECL(errqueue); \
+ GLOBAL_ATOM_DECL(esp_network_level); \
+ GLOBAL_ATOM_DECL(esp_trans_level); \
+ GLOBAL_ATOM_DECL(events); \
+ GLOBAL_ATOM_DECL(explicit_eor); \
+ GLOBAL_ATOM_DECL(faith); \
+ GLOBAL_ATOM_DECL(false); \
+ GLOBAL_ATOM_DECL(family); \
+ GLOBAL_ATOM_DECL(flags); \
+ GLOBAL_ATOM_DECL(flowinfo); \
+ GLOBAL_ATOM_DECL(fragment_interleave); \
+ GLOBAL_ATOM_DECL(freebind); \
+ GLOBAL_ATOM_DECL(get_peer_addr_info); \
+ GLOBAL_ATOM_DECL(hdrincl); \
+ GLOBAL_ATOM_DECL(hmac_ident); \
+ GLOBAL_ATOM_DECL(hoplimit); \
+ GLOBAL_ATOM_DECL(hopopts); \
+ GLOBAL_ATOM_DECL(ifindex); \
+ GLOBAL_ATOM_DECL(inet); \
+ GLOBAL_ATOM_DECL(inet6); \
+ GLOBAL_ATOM_DECL(info); \
+ GLOBAL_ATOM_DECL(initmsg); \
+ GLOBAL_ATOM_DECL(iov); \
+ GLOBAL_ATOM_DECL(ip); \
+ GLOBAL_ATOM_DECL(ipcomp_level); \
+ GLOBAL_ATOM_DECL(ipv6); \
+ GLOBAL_ATOM_DECL(i_want_mapped_v4_addr); \
+ GLOBAL_ATOM_DECL(join_group); \
+ GLOBAL_ATOM_DECL(keepalive); \
+ GLOBAL_ATOM_DECL(keepcnt); \
+ GLOBAL_ATOM_DECL(keepidle); \
+ GLOBAL_ATOM_DECL(keepintvl); \
+ GLOBAL_ATOM_DECL(leave_group); \
+ GLOBAL_ATOM_DECL(level); \
+ GLOBAL_ATOM_DECL(linger); \
+ GLOBAL_ATOM_DECL(local); \
+ GLOBAL_ATOM_DECL(local_auth_chunks); \
+ GLOBAL_ATOM_DECL(loopback); \
+ GLOBAL_ATOM_DECL(lowdelay); \
+ GLOBAL_ATOM_DECL(mark); \
+ GLOBAL_ATOM_DECL(maxburst); \
+ GLOBAL_ATOM_DECL(maxseg); \
+ GLOBAL_ATOM_DECL(md5sig); \
+ GLOBAL_ATOM_DECL(mincost); \
+ GLOBAL_ATOM_DECL(minttl); \
+ GLOBAL_ATOM_DECL(msfilter); \
+ GLOBAL_ATOM_DECL(mtu); \
+ GLOBAL_ATOM_DECL(mtu_discover); \
+ GLOBAL_ATOM_DECL(multicast_all); \
+ GLOBAL_ATOM_DECL(multicast_hops); \
+ GLOBAL_ATOM_DECL(multicast_if); \
+ GLOBAL_ATOM_DECL(multicast_loop); \
+ GLOBAL_ATOM_DECL(multicast_ttl); \
+ GLOBAL_ATOM_DECL(nodelay); \
+ GLOBAL_ATOM_DECL(nodefrag); \
+ GLOBAL_ATOM_DECL(noopt); \
+ GLOBAL_ATOM_DECL(nopush); \
+ GLOBAL_ATOM_DECL(not_found); \
+ GLOBAL_ATOM_DECL(not_owner); \
+ GLOBAL_ATOM_DECL(ok); \
+ GLOBAL_ATOM_DECL(oob); \
+ GLOBAL_ATOM_DECL(oobinline); \
+ GLOBAL_ATOM_DECL(options); \
+ GLOBAL_ATOM_DECL(origdstaddr); \
+ GLOBAL_ATOM_DECL(partial_delivery_point); \
+ GLOBAL_ATOM_DECL(passcred); \
+ GLOBAL_ATOM_DECL(path); \
+ GLOBAL_ATOM_DECL(peekcred); \
+ GLOBAL_ATOM_DECL(peek_off); \
+ GLOBAL_ATOM_DECL(peer_addr_params); \
+ GLOBAL_ATOM_DECL(peer_auth_chunks); \
+ GLOBAL_ATOM_DECL(pktinfo); \
+ GLOBAL_ATOM_DECL(pktoptions); \
+ GLOBAL_ATOM_DECL(port); \
+ GLOBAL_ATOM_DECL(portrange); \
+ GLOBAL_ATOM_DECL(primary_addr); \
+ GLOBAL_ATOM_DECL(priority); \
+ GLOBAL_ATOM_DECL(protocol); \
+ GLOBAL_ATOM_DECL(raw); \
+ GLOBAL_ATOM_DECL(rcvbuf); \
+ GLOBAL_ATOM_DECL(rcvbufforce); \
+ GLOBAL_ATOM_DECL(rcvlowat); \
+ GLOBAL_ATOM_DECL(rcvtimeo); \
+ GLOBAL_ATOM_DECL(rdm); \
+ GLOBAL_ATOM_DECL(recv); \
+ GLOBAL_ATOM_DECL(recvdstaddr); \
+ GLOBAL_ATOM_DECL(recverr); \
+ GLOBAL_ATOM_DECL(recvfrom); \
+ GLOBAL_ATOM_DECL(recvif); \
+ GLOBAL_ATOM_DECL(recvmsg); \
+ GLOBAL_ATOM_DECL(recvopts); \
+ GLOBAL_ATOM_DECL(recvorigdstaddr); \
+ GLOBAL_ATOM_DECL(recvpktinfo); \
+ GLOBAL_ATOM_DECL(recvtclass); \
+ GLOBAL_ATOM_DECL(recvtos); \
+ GLOBAL_ATOM_DECL(recvttl); \
+ GLOBAL_ATOM_DECL(reliability); \
+ GLOBAL_ATOM_DECL(reset_streams); \
+ GLOBAL_ATOM_DECL(retopts); \
+ GLOBAL_ATOM_DECL(reuseaddr); \
+ GLOBAL_ATOM_DECL(reuseport); \
+ GLOBAL_ATOM_DECL(rights); \
+ GLOBAL_ATOM_DECL(router_alert); \
+ GLOBAL_ATOM_DECL(rthdr); \
+ GLOBAL_ATOM_DECL(rtoinfo); \
+ GLOBAL_ATOM_DECL(rxq_ovfl); \
+ GLOBAL_ATOM_DECL(scope_id); \
+ GLOBAL_ATOM_DECL(sctp); \
+ GLOBAL_ATOM_DECL(sec); \
+ GLOBAL_ATOM_DECL(select_failed); \
+ GLOBAL_ATOM_DECL(select_sent); \
+ GLOBAL_ATOM_DECL(send); \
+ GLOBAL_ATOM_DECL(sendmsg); \
+ GLOBAL_ATOM_DECL(sendsrcaddr); \
+ GLOBAL_ATOM_DECL(sendto); \
+ GLOBAL_ATOM_DECL(seqpacket); \
+ GLOBAL_ATOM_DECL(setfib); \
+ GLOBAL_ATOM_DECL(set_peer_primary_addr); \
+ GLOBAL_ATOM_DECL(socket); \
+ GLOBAL_ATOM_DECL(sndbuf); \
+ GLOBAL_ATOM_DECL(sndbufforce); \
+ GLOBAL_ATOM_DECL(sndlowat); \
+ GLOBAL_ATOM_DECL(sndtimeo); \
+ GLOBAL_ATOM_DECL(spec_dst); \
+ GLOBAL_ATOM_DECL(status); \
+ GLOBAL_ATOM_DECL(stream); \
+ GLOBAL_ATOM_DECL(syncnt); \
+ GLOBAL_ATOM_DECL(tclass); \
+ GLOBAL_ATOM_DECL(tcp); \
+ GLOBAL_ATOM_DECL(throughput); \
+ GLOBAL_ATOM_DECL(timestamp); \
+ GLOBAL_ATOM_DECL(tos); \
+ GLOBAL_ATOM_DECL(transparent); \
+ GLOBAL_ATOM_DECL(true); \
+ GLOBAL_ATOM_DECL(trunc); \
+ GLOBAL_ATOM_DECL(ttl); \
+ GLOBAL_ATOM_DECL(type); \
+ GLOBAL_ATOM_DECL(udp); \
+ GLOBAL_ATOM_DECL(unblock_source); \
+ GLOBAL_ATOM_DECL(undefined); \
+ GLOBAL_ATOM_DECL(unicast_hops); \
+ GLOBAL_ATOM_DECL(unknown); \
+ GLOBAL_ATOM_DECL(usec); \
+ GLOBAL_ATOM_DECL(user_timeout); \
+ GLOBAL_ATOM_DECL(use_ext_recvinfo); \
+ GLOBAL_ATOM_DECL(use_min_mtu); \
+ GLOBAL_ATOM_DECL(v6only);
+
+
+/* *** Global error reason atoms *** */
+#define GLOBAL_ERROR_REASON_ATOMS \
+ GLOBAL_ATOM_DECL(eagain); \
+ GLOBAL_ATOM_DECL(eafnosupport); \
+ GLOBAL_ATOM_DECL(einval);
+
+
+#define GLOBAL_ATOM_DECL(A) ERL_NIF_TERM esock_atom_##A
+GLOBAL_ATOMS
+GLOBAL_ERROR_REASON_ATOMS
+#undef GLOBAL_ATOM_DECL
+ERL_NIF_TERM esock_atom_socket_tag; // This has a "special" name ('$socket')
+
+/* *** Local atoms *** */
+#define LOCAL_ATOMS \
+ LOCAL_ATOM_DECL(adaptation_layer); \
+ LOCAL_ATOM_DECL(address); \
+ LOCAL_ATOM_DECL(association); \
+ LOCAL_ATOM_DECL(assoc_id); \
+ LOCAL_ATOM_DECL(authentication); \
+ LOCAL_ATOM_DECL(bool); \
+ LOCAL_ATOM_DECL(close); \
+ LOCAL_ATOM_DECL(closed); \
+ LOCAL_ATOM_DECL(closing); \
+ LOCAL_ATOM_DECL(cookie_life); \
+ LOCAL_ATOM_DECL(data_in); \
+ LOCAL_ATOM_DECL(do); \
+ LOCAL_ATOM_DECL(dont); \
+ LOCAL_ATOM_DECL(exclude); \
+ LOCAL_ATOM_DECL(false); \
+ LOCAL_ATOM_DECL(global_counters); \
+ LOCAL_ATOM_DECL(in4_sockaddr); \
+ LOCAL_ATOM_DECL(in6_sockaddr); \
+ LOCAL_ATOM_DECL(include); \
+ LOCAL_ATOM_DECL(initial); \
+ LOCAL_ATOM_DECL(int); \
+ LOCAL_ATOM_DECL(interface); \
+ LOCAL_ATOM_DECL(iow); \
+ LOCAL_ATOM_DECL(local_rwnd); \
+ LOCAL_ATOM_DECL(max); \
+ LOCAL_ATOM_DECL(max_attempts); \
+ LOCAL_ATOM_DECL(max_init_timeo); \
+ LOCAL_ATOM_DECL(max_instreams); \
+ LOCAL_ATOM_DECL(max_rxt); \
+ LOCAL_ATOM_DECL(min); \
+ LOCAL_ATOM_DECL(mode); \
+ LOCAL_ATOM_DECL(multiaddr); \
+ LOCAL_ATOM_DECL(null); \
+ LOCAL_ATOM_DECL(num_dinet); \
+ LOCAL_ATOM_DECL(num_dinet6); \
+ LOCAL_ATOM_DECL(num_dlocal); \
+ LOCAL_ATOM_DECL(num_outstreams); \
+ LOCAL_ATOM_DECL(num_peer_dests); \
+ LOCAL_ATOM_DECL(num_pip); \
+ LOCAL_ATOM_DECL(num_psctp); \
+ LOCAL_ATOM_DECL(num_ptcp); \
+ LOCAL_ATOM_DECL(num_pudp); \
+ LOCAL_ATOM_DECL(num_sockets); \
+ LOCAL_ATOM_DECL(num_tdgrams); \
+ LOCAL_ATOM_DECL(num_tseqpkgs); \
+ LOCAL_ATOM_DECL(num_tstreams); \
+ LOCAL_ATOM_DECL(partial_delivery); \
+ LOCAL_ATOM_DECL(peer_error); \
+ LOCAL_ATOM_DECL(peer_rwnd); \
+ LOCAL_ATOM_DECL(probe); \
+ LOCAL_ATOM_DECL(select); \
+ LOCAL_ATOM_DECL(sender_dry); \
+ LOCAL_ATOM_DECL(send_failure); \
+ LOCAL_ATOM_DECL(shutdown); \
+ LOCAL_ATOM_DECL(slist); \
+ LOCAL_ATOM_DECL(sourceaddr); \
+ LOCAL_ATOM_DECL(timeout); \
+ LOCAL_ATOM_DECL(true); \
+ LOCAL_ATOM_DECL(want);
+
+/* Local error reason atoms */
+#define LOCAL_ERROR_REASON_ATOMS \
+ LOCAL_ATOM_DECL(eisconn); \
+ LOCAL_ATOM_DECL(enotclosing); \
+ LOCAL_ATOM_DECL(enotconn); \
+ LOCAL_ATOM_DECL(exalloc); \
+ LOCAL_ATOM_DECL(exbadstate); \
+ LOCAL_ATOM_DECL(exbusy); \
+ LOCAL_ATOM_DECL(exmon); \
+ LOCAL_ATOM_DECL(exself); \
+ LOCAL_ATOM_DECL(exsend);
+
+#define LOCAL_ATOM_DECL(LA) static ERL_NIF_TERM atom_##LA
+LOCAL_ATOMS
+LOCAL_ERROR_REASON_ATOMS
+#undef LOCAL_ATOM_DECL
+
+
+/* *** Sockets *** */
+static ErlNifResourceType* sockets;
+static ErlNifResourceTypeInit socketInit = {
+ socket_dtor,
+ socket_stop,
+ (ErlNifResourceDown*) socket_down
+};
+
+// Initiated when the nif is loaded
+static SocketData data;
+
+
+/* ----------------------------------------------------------------------
+ * N I F F u n c t i o n s
+ * ----------------------------------------------------------------------
+ *
+ * Utility and admin functions:
+ * ----------------------------
+ * nif_info/0
+ * nif_supports/1
+ * (nif_debug/1)
+ *
+ * The "proper" socket functions:
+ * ------------------------------
+ * nif_open(Domain, Type, Protocol, Extra)
+ * nif_bind(Sock, LocalAddr)
+ * nif_connect(Sock, SockAddr)
+ * nif_listen(Sock, Backlog)
+ * nif_accept(LSock, Ref)
+ * nif_send(Sock, SendRef, Data, Flags)
+ * nif_sendto(Sock, SendRef, Data, Dest, Flags)
+ * nif_sendmsg(Sock, SendRef, MsgHdr, Flags)
+ * nif_recv(Sock, RecvRef, Length, Flags)
+ * nif_recvfrom(Sock, RecvRef, BufSz, Flags)
+ * nif_recvmsg(Sock, RecvRef, BufSz, CtrlSz, Flags)
+ * nif_close(Sock)
+ * nif_shutdown(Sock, How)
+ * nif_sockname(Sock)
+ * nif_peername(Sock)
+ *
+ * And some functions to manipulate and retrieve socket options:
+ * -------------------------------------------------------------
+ * nif_setopt/5
+ * nif_getopt/4
+ *
+ * And some utility functions:
+ * -------------------------------------------------------------
+ *
+ * And some socket admin functions:
+ * -------------------------------------------------------------
+ * nif_cancel(Sock, Ref)
+ */
+
+
+/* ----------------------------------------------------------------------
+ * nif_info
+ *
+ * Description:
+ * This is currently just a placeholder...
+ */
+#define MKCT(E, T, C) MKT2((E), (T), MKI((E), (C)))
+
+static
+ERL_NIF_TERM nif_info(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ if (argc != 0) {
+ return enif_make_badarg(env);
+ } else {
+ ERL_NIF_TERM numSockets = MKCT(env, atom_num_sockets, data.numSockets);
+ ERL_NIF_TERM numTypeDGrams = MKCT(env, atom_num_tdgrams, data.numTypeDGrams);
+ ERL_NIF_TERM numTypeStreams = MKCT(env, atom_num_tstreams, data.numTypeStreams);
+ ERL_NIF_TERM numTypeSeqPkgs = MKCT(env, atom_num_tseqpkgs, data.numTypeSeqPkgs);
+ ERL_NIF_TERM numDomLocal = MKCT(env, atom_num_dlocal, data.numDomainLocal);
+ ERL_NIF_TERM numDomInet = MKCT(env, atom_num_dinet, data.numDomainInet);
+ ERL_NIF_TERM numDomInet6 = MKCT(env, atom_num_dinet6, data.numDomainInet6);
+ ERL_NIF_TERM numProtoIP = MKCT(env, atom_num_pip, data.numProtoIP);
+ ERL_NIF_TERM numProtoTCP = MKCT(env, atom_num_ptcp, data.numProtoTCP);
+ ERL_NIF_TERM numProtoUDP = MKCT(env, atom_num_pudp, data.numProtoUDP);
+ ERL_NIF_TERM numProtoSCTP = MKCT(env, atom_num_psctp, data.numProtoSCTP);
+ ERL_NIF_TERM gcnt[] = {numSockets,
+ numTypeDGrams, numTypeStreams, numTypeSeqPkgs,
+ numDomLocal, numDomInet, numDomInet6,
+ numProtoIP, numProtoTCP, numProtoUDP, numProtoSCTP};
+ unsigned int lenGCnt = sizeof(gcnt) / sizeof(ERL_NIF_TERM);
+ ERL_NIF_TERM lgcnt = MKLA(env, gcnt, lenGCnt);
+ ERL_NIF_TERM keys[] = {esock_atom_debug, atom_iow, atom_global_counters};
+ ERL_NIF_TERM vals[] = {BOOL2ATOM(data.dbg), BOOL2ATOM(data.iow), lgcnt};
+ ERL_NIF_TERM info;
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, &info))
+ return enif_make_badarg(env);
+
+ return info;
+ }
+#endif
+}
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_supports
+ *
+ * Description:
+ * This function is intended to answer the question: "Is X supported?"
+ * Currently three keys are "supported": options | sctp | ipv6
+ * That results in a list of all *known options* (known by us) and if
+ * the platform supports (OS) it or not.
+ *
+ * Key
+ * ---
+ * options [{socket, [{Opt, boolean()}]},
+ * {ip, [{Opt, boolean()}]},
+ * {ipv6, [{Opt, boolean()}]},
+ * {tcp, [{Opt, boolean()}]},
+ * {udp, [{Opt, boolean()}]},
+ * {sctp, [{Opt, boolean()}]}]
+ */
+
+static
+ERL_NIF_TERM nif_supports(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ int key;
+
+ SGDBG( ("SOCKET", "nif_supports -> entry with %d args\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 1) ||
+ !GET_INT(env, argv[0], &key)) {
+ return enif_make_badarg(env);
+ }
+
+ return nsupports(env, key);
+#endif
+}
+
+
+
+/* nopen - create an endpoint for communication
+ *
+ * Assumes the input has been validated.
+ *
+ * Normally we want debugging on (individual) sockets to be controlled
+ * by the sockets own debug flag. But since we don't even have a socket
+ * yet, we must use the global debug flag.
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports(ErlNifEnv* env, int key)
+{
+ ERL_NIF_TERM result;
+
+ SGDBG( ("SOCKET", "nsupports -> entry with 0x%lX\r\n", key) );
+
+ switch (key) {
+ case SOCKET_SUPPORTS_OPTIONS:
+ result = nsupports_options(env);
+ break;
+
+ case SOCKET_SUPPORTS_SCTP:
+ result = nsupports_sctp(env);
+ break;
+
+ case SOCKET_SUPPORTS_IPV6:
+ result = nsupports_ipv6(env);
+ break;
+
+ default:
+ result = esock_atom_false;
+ break;
+ }
+
+ return result;
+}
+#endif
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_options(ErlNifEnv* env)
+{
+ ERL_NIF_TERM sockOpts = nsupports_options_socket(env);
+ ERL_NIF_TERM sockOptsT = MKT2(env, esock_atom_socket, sockOpts);
+ ERL_NIF_TERM ipOpts = nsupports_options_ip(env);
+ ERL_NIF_TERM ipOptsT = MKT2(env, esock_atom_ip, ipOpts);
+ ERL_NIF_TERM ipv6Opts = nsupports_options_ipv6(env);
+ ERL_NIF_TERM ipv6OptsT = MKT2(env, esock_atom_ipv6, ipv6Opts);
+ ERL_NIF_TERM tcpOpts = nsupports_options_tcp(env);
+ ERL_NIF_TERM tcpOptsT = MKT2(env, esock_atom_tcp, tcpOpts);
+ ERL_NIF_TERM udpOpts = nsupports_options_udp(env);
+ ERL_NIF_TERM udpOptsT = MKT2(env, esock_atom_udp, udpOpts);
+ ERL_NIF_TERM sctpOpts = nsupports_options_sctp(env);
+ ERL_NIF_TERM sctpOptsT = MKT2(env, esock_atom_sctp, sctpOpts);
+ ERL_NIF_TERM optsA[] = {sockOptsT,
+ ipOptsT, ipv6OptsT,
+ tcpOptsT, udpOptsT, sctpOptsT};
+ unsigned int lenOptsA = sizeof(optsA) / sizeof(ERL_NIF_TERM);
+ ERL_NIF_TERM optsL = MKLA(env, optsA, lenOptsA);
+
+ return optsL;
+}
+#endif
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_options_socket(ErlNifEnv* env)
+{
+ SocketTArray opts = TARRAY_CREATE(128);
+ ERL_NIF_TERM tmp, optsL;
+
+
+ /* *** SOCKET_OPT_SOCK_ACCEPTCONN => SO_ACCEPTCONN *** */
+#if defined(SO_ACCEPTCONN)
+ tmp = MKT2(env, esock_atom_acceptconn, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_acceptconn, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_ACCEPTFILTER => SO_ACCEPTFILTER *** */
+ tmp = MKT2(env, esock_atom_acceptfilter, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_BINDTODEVICE => SO_BINDTODEVICE *** */
+#if defined(SO_BINDTODEVICE)
+ tmp = MKT2(env, esock_atom_bindtodevice, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_bindtodevice, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_BROADCAST => SO_BROADCAST *** */
+#if defined(SO_BROADCAST)
+ tmp = MKT2(env, esock_atom_broadcast, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_broadcast, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_BUSY_POLL => SO_BUSY_POLL *** */
+ tmp = MKT2(env, esock_atom_busy_poll, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_DEBUG => SO_DEBUG *** */
+#if defined(SO_DEBUG)
+ tmp = MKT2(env, esock_atom_debug, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_debug, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_DOMAIN => SO_DOMAIN *** */
+#if defined(SO_DOMAIN)
+ tmp = MKT2(env, esock_atom_domain, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_domain, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_DONTROUTE => SO_DONTROUTE *** */
+#if defined(SO_DONTROUTE)
+ tmp = MKT2(env, esock_atom_dontroute, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_dontroute, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_ERROR => SO_ERROR *** */
+ tmp = MKT2(env, esock_atom_error, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_KEEPALIVE => SO_KEEPALIVE *** */
+#if defined(SO_KEEPALIVE)
+ tmp = MKT2(env, esock_atom_keepalive, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_keepalive, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_LINGER => SO_LINGER *** */
+#if defined(SO_LINGER)
+ tmp = MKT2(env, esock_atom_linger, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_linger, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_MARK => SO_MARK *** */
+ tmp = MKT2(env, esock_atom_mark, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_OOBINLINE => SO_OOBINLINE *** */
+#if defined(SO_OOBINLINE)
+ tmp = MKT2(env, esock_atom_oobinline, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_oobinline, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_PASSCRED => SO_PASSCRED *** */
+ tmp = MKT2(env, esock_atom_passcred, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_PEEK_OFF => SO_PEEK_OFF *** */
+#if defined(SO_PEEK_OFF)
+ tmp = MKT2(env, esock_atom_peek_off, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_peek_off, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_PEEKCRED => SO_PEEKCRED *** */
+ tmp = MKT2(env, esock_atom_peekcred, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_PRIORITY => SO_PRIORITY *** */
+#if defined(SO_PRIORITY)
+ tmp = MKT2(env, esock_atom_priority, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_priority, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_PROTOCOL => SO_PROTOCOL *** */
+#if defined(SO_PROTOCOL)
+ tmp = MKT2(env, esock_atom_protocol, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_protocol, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_RCVBUF => SO_RCVBUF *** */
+#if defined(SO_RCVBUF)
+ tmp = MKT2(env, esock_atom_rcvbuf, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_rcvbuf, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_RCVBUFFORCE => SO_RCVBUFFORCE *** */
+ tmp = MKT2(env, esock_atom_rcvbufforce, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_RCVLOWAT => SO_RCVLOWAT *** */
+#if defined(SO_RCVLOWAT)
+ tmp = MKT2(env, esock_atom_rcvlowat, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_rcvlowat, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_RCVTIMEO => SO_RCVTIMEO *** */
+#if defined(SO_RCVTIMEO)
+ tmp = MKT2(env, esock_atom_rcvtimeo, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_rcvtimeo, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_REUSEADDR => SO_REUSEADDR *** */
+#if defined(SO_REUSEADDR)
+ tmp = MKT2(env, esock_atom_reuseaddr, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_reuseaddr, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_REUSEPORT => SO_REUSEPORT *** */
+#if defined(SO_REUSEPORT)
+ tmp = MKT2(env, esock_atom_reuseport, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_reuseport, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_RXQ_OVFL => SO_RXQ_OVFL *** */
+ tmp = MKT2(env, esock_atom_rxq_ovfl, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_SETFIB => SO_SETFIB *** */
+ tmp = MKT2(env, esock_atom_setfib, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_SNDBUF => SO_SNDBUF *** */
+#if defined(SO_SNDBUF)
+ tmp = MKT2(env, esock_atom_sndbuf, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_sndbuf, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_SNDBUFFORCE => SO_SNDBUFFORCE *** */
+ tmp = MKT2(env, esock_atom_sndbufforce, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_SNDLOWAT => SO_SNDLOWAT *** */
+#if defined(SO_SNDLOWAT)
+ tmp = MKT2(env, esock_atom_sndlowat, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_sndlowat, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_SNDTIMEO => SO_SNDTIMEO *** */
+#if defined(SO_SNDTIMEO)
+ tmp = MKT2(env, esock_atom_sndtimeo, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_sndtimeo, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_TIMESTAMP => SO_TIMESTAMP *** */
+#if defined(SO_TIMESTAMP)
+ tmp = MKT2(env, esock_atom_timestamp, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_timestamp, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SOCK_TYPE => SO_TYPE *** */
+#if defined(SO_TYPE)
+ tmp = MKT2(env, esock_atom_type, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_type, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ TARRAY_TOLIST(opts, env, &optsL);
+
+ return optsL;
+}
+#endif
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_options_ip(ErlNifEnv* env)
+{
+ SocketTArray opts = TARRAY_CREATE(128);
+ ERL_NIF_TERM tmp, optsL;
+
+
+ /* *** SOCKET_OPT_IP_ADD_MEMBERSHIP => IP_ADD_MEMBERSHIP *** */
+#if defined(IP_ADD_MEMBERSHIP)
+ tmp = MKT2(env, esock_atom_add_membership, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_add_membership, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_ADD_SOURCE_MEMBERSHIP => IP_ADD_SOURCE_MEMBERSHIP *** */
+#if defined(IP_ADD_SOURCE_MEMBERSHIP)
+ tmp = MKT2(env, esock_atom_add_source_membership, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_add_source_membership, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_BLOCK_SOURCE => IP_BLOCK_SOURCE *** */
+#if defined(IP_BLOCK_SOURCE)
+ tmp = MKT2(env, esock_atom_block_source, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_block_source, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_DONTFRAG => IP_DONTFRAG *** */
+ tmp = MKT2(env, esock_atom_dontfrag, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_DROP_MEMBERSHIP => IP_DROP_MEMBERSHIP *** */
+#if defined(IP_DROP_MEMBERSHIP)
+ tmp = MKT2(env, esock_atom_drop_membership, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_drop_membership, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_DROP_SOURCE_MEMBERSHIP => IP_DROP_SOURCE_MEMBERSHIP *** */
+#if defined(IP_DROP_SOURCE_MEMBERSHIP)
+ tmp = MKT2(env, esock_atom_drop_source_membership, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_drop_source_membership, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_FREEBIND => IP_FREEBIND *** */
+#if defined(IP_FREEBIND)
+ tmp = MKT2(env, esock_atom_freebind, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_freebind, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_HDRINCL => IP_HDRINCL *** */
+#if defined(IP_HDRINCL)
+ tmp = MKT2(env, esock_atom_hdrincl, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_hdrincl, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_MINTTL => IP_MINTTL *** */
+#if defined(IP_MINTTL)
+ tmp = MKT2(env, esock_atom_minttl, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_minttl, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_MSFILTER => IP_MSFILTER / IP_MSFILTER_SIZE *** */
+#if defined(IP_MSFILTER) && defined(IP_MSFILTER_SIZE)
+ tmp = MKT2(env, esock_atom_msfilter, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_msfilter, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_MTU => IP_MTU *** */
+ tmp = MKT2(env, esock_atom_mtu, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_MTU_DISCOVER => IP_MTU_DISCOVER *** */
+#if defined(IP_MTU_DISCOVER)
+ tmp = MKT2(env, esock_atom_mtu_discover, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_mtu_discover, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_MULTICAST_ALL => IP_MULTICAST_ALL *** */
+#if defined(IP_MULTICAST_ALL)
+ tmp = MKT2(env, esock_atom_multicast_all, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_multicast_all, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_MULTICAST_IF => IP_MULTICAST_IF *** */
+#if defined(IP_MULTICAST_IF)
+ tmp = MKT2(env, esock_atom_multicast_if, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_multicast_if, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_MULTICAST_LOOP => IP_MULTICAST_LOOP *** */
+#if defined(IP_MULTICAST_LOOP)
+ tmp = MKT2(env, esock_atom_multicast_loop, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_multicast_loop, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_MULTICAST_TTL => IP_MULTICAST_TTL *** */
+#if defined(IP_MULTICAST_TTL)
+ tmp = MKT2(env, esock_atom_multicast_ttl, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_multicast_ttl, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_NODEFRAG => IP_NODEFRAG *** */
+#if defined(IP_NODEFRAG)
+ tmp = MKT2(env, esock_atom_nodefrag, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_nodefrag, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_OPTIONS => IP_OPTIONS *** */
+ tmp = MKT2(env, esock_atom_options, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_PKTINFO => IP_PKTINFO *** */
+#if defined(IP_PKTINFO)
+ tmp = MKT2(env, esock_atom_pktinfo, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_pktinfo, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_RECVDSTADDR => IP_RECVDSTADDR *** */
+#if defined(IP_RECVDSTADDR)
+ tmp = MKT2(env, esock_atom_recvdstaddr, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recvdstaddr, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_RECVERR => IP_RECVERR *** */
+#if defined(IP_RECVERR)
+ tmp = MKT2(env, esock_atom_recverr, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recverr, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_RECVIF => IP_RECVIF *** */
+#if defined(IP_RECVIF)
+ tmp = MKT2(env, esock_atom_recvif, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recvif, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_RECVOPTS => IP_RECVOPTS *** */
+#if defined(IP_RECVOPTS)
+ tmp = MKT2(env, esock_atom_recvopts, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recvopts, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_RECVORIGDSTADDR => IP_RECVORIGDSTADDR *** */
+#if defined(IP_RECVORIGDSTADDR)
+ tmp = MKT2(env, esock_atom_recvorigdstaddr, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recvorigdstaddr, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_RECVTOS => IP_RECVTOS *** */
+#if defined(IP_RECVTOS)
+ tmp = MKT2(env, esock_atom_recvtos, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recvtos, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_RECVTTL => IP_RECVTTL *** */
+#if defined(IP_RECVTTL)
+ tmp = MKT2(env, esock_atom_recvttl, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recvttl, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_RETOPTS => IP_RETOPTS *** */
+#if defined(IP_RETOPTS)
+ tmp = MKT2(env, esock_atom_retopts, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_retopts, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_ROUTER_ALERT => IP_ROUTER_ALERT *** */
+#if defined(IP_ROUTER_ALERT)
+ tmp = MKT2(env, esock_atom_router_alert, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_router_alert, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_SENDSRCADDR => IP_SENDSRCADDR *** */
+#if defined(IP_SENDSRCADDR)
+ tmp = MKT2(env, esock_atom_sendsrcaddr, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_sendsrcaddr, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_TOS => IP_TOS *** */
+#if defined(IP_TOS)
+ tmp = MKT2(env, esock_atom_tos, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_tos, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_TRANSPARENT => IP_TRANSPARENT *** */
+#if defined(IP_TRANSPARENT)
+ tmp = MKT2(env, esock_atom_transparent, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_transparent, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_TTL => IP_TTL *** */
+#if defined(IP_TTL)
+ tmp = MKT2(env, esock_atom_ttl, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_ttl, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IP_UNBLOCK_SOURCE => IP_UNBLOCK_SOURCE *** */
+#if defined(IP_UNBLOCK_SOURCE)
+ tmp = MKT2(env, esock_atom_unblock_source, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_unblock_source, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ TARRAY_TOLIST(opts, env, &optsL);
+
+ return optsL;
+}
+#endif
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_options_ipv6(ErlNifEnv* env)
+{
+ SocketTArray opts = TARRAY_CREATE(128);
+ ERL_NIF_TERM tmp, optsL;
+
+
+ /* *** SOCKET_OPT_IPV6_ADDRFORM => IPV6_ADDRFORM *** */
+#if defined(IPV6_ADDRFORM)
+ tmp = MKT2(env, esock_atom_addrform, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_addrform, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_ADD_MEMBERSHIP => IPV6_ADD_MEMBERSHIP *** */
+#if defined(IPV6_ADD_MEMBERSHIP)
+ tmp = MKT2(env, esock_atom_add_membership, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_add_membership, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_AUTHHDR => IPV6_AUTHHDR *** */
+#if defined(IPV6_AUTHHDR)
+ tmp = MKT2(env, esock_atom_authhdr, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_authhdr, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_AUTH_LEVEL => IPV6_AUTH_LEVEL *** */
+ tmp = MKT2(env, esock_atom_auth_level, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_CHECKSUM => IPV6_CHECKSUM *** */
+ tmp = MKT2(env, esock_atom_checksum, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_DROP_MEMBERSHIP => IPV6_DROP_MEMBERSHIP *** */
+#if defined(IPV6_DROP_MEMBERSHIP)
+ tmp = MKT2(env, esock_atom_drop_membership, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_drop_membership, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_DSTOPTS => IPV6_DSTOPTS *** */
+#if defined(IPV6_DSTOPTS)
+ tmp = MKT2(env, esock_atom_dstopts, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_dstopts, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_ESP_NETWORK_LEVEL => IPV6_ESP_NETWORK_LEVEL *** */
+ tmp = MKT2(env, esock_atom_esp_network_level, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_ESP_TRANS_LEVEL => IPV6_ESP_TRANS_LEVEL *** */
+ tmp = MKT2(env, esock_atom_esp_trans_level, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_FAITH => IPV6_FAITH *** */
+ tmp = MKT2(env, esock_atom_faith, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_FLOWINFO => IPV6_FLOWINFO *** */
+#if defined(IPV6_FLOWINFO)
+ tmp = MKT2(env, esock_atom_flowinfo, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_flowinfo, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_HOPLIMIT => IPV6_HOPLIMIT *** */
+#if defined(IPV6_HOPLIMIT)
+ tmp = MKT2(env, esock_atom_hoplimit, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_hoplimit, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_HOPOPTS => IPV6_HOPOPTS *** */
+#if defined(IPV6_HOPOPTS)
+ tmp = MKT2(env, esock_atom_hopopts, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_hopopts, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_IPCOMP_LEVEL => IPV6_IPCOMP_LEVEL *** */
+ tmp = MKT2(env, esock_atom_ipcomp_level, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_JOIN_GROUP => IPV6_JOIN_GROUP *** */
+ tmp = MKT2(env, esock_atom_join_group, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_LEAVE_GROUP => IPV6_LEAVE_GROUP *** */
+ tmp = MKT2(env, esock_atom_leave_group, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_MTU => IPV6_MTU *** */
+#if defined(IPV6_MTU)
+ tmp = MKT2(env, esock_atom_mtu, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_mtu, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_MTU_DISCOVER => IPV6_MTU_DISCOVER *** */
+#if defined(IPV6_MTU_DISCOVER)
+ tmp = MKT2(env, esock_atom_mtu_discover, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_mtu_discover, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_MULTICAST_HOPS => IPV6_MULTICAST_HOPS *** */
+#if defined(IPV6_MULTICAST_HOPS)
+ tmp = MKT2(env, esock_atom_multicast_hops, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_multicast_hops, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_MULTICAST_IF => IPV6_MULTICAST_IF *** */
+#if defined(IPV6_MULTICAST_IF)
+ tmp = MKT2(env, esock_atom_multicast_if, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_multicast_if, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_MULTICAST_LOOP => IPV6_MULTICAST_LOOP *** */
+#if defined(IPV6_MULTICAST_LOOP)
+ tmp = MKT2(env, esock_atom_multicast_loop, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_multicast_loop, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_PORTRANGE => IPV6_PORTRANGE *** */
+ tmp = MKT2(env, esock_atom_portrange, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_PKTOPTIONS => IPV6_PKTOPTIONS *** */
+ tmp = MKT2(env, esock_atom_pktoptions, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_RECVERR => IPV6_RECVERR *** */
+#if defined(IPV6_RECVERR)
+ tmp = MKT2(env, esock_atom_recverr, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recverr, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_RECVPKTINFO => IPV6_RECVPKTINFO *** */
+#if defined(IPV6_RECVPKTINFO)
+ tmp = MKT2(env, esock_atom_recvpktinfo, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_recvpktinfo, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_RECVTCLASS => IPV6_RECVTCLASS *** */
+ tmp = MKT2(env, esock_atom_recvtclass, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_ROUTER_ALERT => IPV6_ROUTER_ALERT *** */
+#if defined(IPV6_ROUTER_ALERT)
+ tmp = MKT2(env, esock_atom_router_alert, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_router_alert, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_RTHDR => IPV6_RTHDR *** */
+#if defined(IPV6_RTHDR)
+ tmp = MKT2(env, esock_atom_rthdr, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_rthdr, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_TCLASS => IPV6_TCLASS *** */
+ tmp = MKT2(env, esock_atom_tclass, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_UNICAST_HOPS => IPV6_UNICAST_HOPS *** */
+#if defined(IPV6_UNICAST_HOPS)
+ tmp = MKT2(env, esock_atom_unicast_hops, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_unicast_hops, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_USE_MIN_MTU => IPV6_USE_MIN_MTU *** */
+ tmp = MKT2(env, esock_atom_use_min_mtu, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_IPV6_V6ONLY => IPV6_V6ONLY *** */
+#if defined(IPV6_V6ONLY)
+ tmp = MKT2(env, esock_atom_v6only, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_v6only, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ TARRAY_TOLIST(opts, env, &optsL);
+
+ return optsL;
+}
+#endif
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_options_tcp(ErlNifEnv* env)
+{
+ SocketTArray opts = TARRAY_CREATE(32);
+ ERL_NIF_TERM tmp, optsL;
+
+
+ /* *** SOCKET_OPT_TCP_CONGESTION => TCP_CONGESTION *** */
+#if defined(TCP_CONGESTION)
+ tmp = MKT2(env, esock_atom_congestion, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_congestion, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_CORK => TCP_CORK *** */
+#if defined(TCP_CORK)
+ tmp = MKT2(env, esock_atom_cork, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_cork, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_INFO => TCP_INFO *** */
+ tmp = MKT2(env, esock_atom_info, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_KEEPCNT => TCP_KEEPCNT *** */
+ tmp = MKT2(env, esock_atom_keepcnt, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_KEEPIDLE => TCP_KEEPIDLE *** */
+ tmp = MKT2(env, esock_atom_keepidle, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_KEEPINTVL => TCP_KEEPINTVL *** */
+ tmp = MKT2(env, esock_atom_keepintvl, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_MAXSEG => TCP_MAXSEG *** */
+#if defined(TCP_)
+ tmp = MKT2(env, esock_atom_maxseg, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_maxseg, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_MD5SIG => TCP_MD5SIG *** */
+ tmp = MKT2(env, esock_atom_md5sig, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_NODELAY => TCP_NODELAY *** */
+#if defined(TCP_)
+ tmp = MKT2(env, esock_atom_nodelay, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_nodelay, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_NOOPT => TCP_NOOPT *** */
+ tmp = MKT2(env, esock_atom_noopt, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_NOPUSH => TCP_NOPUSH *** */
+ tmp = MKT2(env, esock_atom_nopush, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_SYNCNT => TCP_SYNCNT *** */
+ tmp = MKT2(env, esock_atom_syncnt, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_TCP_USER_TIMEOUT => TCP_USER_TIMEOUT *** */
+ tmp = MKT2(env, esock_atom_user_timeout, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ TARRAY_TOLIST(opts, env, &optsL);
+
+ return optsL;
+}
+#endif
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_options_udp(ErlNifEnv* env)
+{
+ SocketTArray opts = TARRAY_CREATE(8);
+ ERL_NIF_TERM tmp, optsL;
+
+
+ /* *** SOCKET_OPT_UDP_CORK => UDP_CORK *** */
+#if defined(UDP_CORK)
+ tmp = MKT2(env, esock_atom_cork, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_cork, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ TARRAY_TOLIST(opts, env, &optsL);
+
+ return optsL;
+}
+#endif
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_options_sctp(ErlNifEnv* env)
+{
+ SocketTArray opts = TARRAY_CREATE(64);
+ ERL_NIF_TERM tmp, optsL;
+
+
+ /* *** SOCKET_OPT_SCTP_ADAPTION_LAYER => SCTP_ADAPTION_LAYER *** */
+ tmp = MKT2(env, esock_atom_adaption_layer, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_ASSOCINFO => SCTP_ASSOCINFO *** */
+#if defined(SCTP_ASSOCINFO)
+ tmp = MKT2(env, esock_atom_associnfo, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_associnfo, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_AUTH_ACTIVE_KEY => SCTP_AUTH_ACTIVE_KEY *** */
+ tmp = MKT2(env, esock_atom_auth_active_key, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_AUTH_ASCONF => SCTP_AUTH_ASCONF *** */
+ tmp = MKT2(env, esock_atom_auth_asconf, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_AUTH_CHUNK => SCTP_AUTH_CHUNK *** */
+ tmp = MKT2(env, esock_atom_auth_chunk, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_AUTH_DELETE_KEY => SCTP_AUTH_DELETE_KEY *** */
+ tmp = MKT2(env, esock_atom_auth_delete_key, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_AUTH_KEY => SCTP_AUTH_KEY *** */
+ tmp = MKT2(env, esock_atom_auth_key, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_AUTOCLOSE => SCTP_AUTOCLOSE *** */
+#if defined(SCTP_AUTOCLOSE)
+ tmp = MKT2(env, esock_atom_autoclose, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_autoclose, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_CONTEXT => SCTP_CONTEXT *** */
+ tmp = MKT2(env, esock_atom_context, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_DEFAULT_SEND_PARAMS => SCTP_DEFAULT_SEND_PARAMS *** */
+ tmp = MKT2(env, esock_atom_default_send_params, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_DELAYED_ACK_TIME => SCTP_DELAYED_ACK_TIME *** */
+ tmp = MKT2(env, esock_atom_delayed_ack_time, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_DISABLE_FRAGMENTS => SCTP_DISABLE_FRAGMENTS *** */
+#if defined(SCTP_DISABLE_FRAGMENTS)
+ tmp = MKT2(env, esock_atom_disable_fragments, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_disable_fragments, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_HMAC_IDENT => SCTP_HMAC_IDENT *** */
+ tmp = MKT2(env, esock_atom_hmac_ident, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_EVENTS => SCTP_EVENTS *** */
+#if defined(SCTP_EVENTS)
+ tmp = MKT2(env, esock_atom_events, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_events, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_EXPLICIT_EOR => SCTP_EXPLICIT_EOR *** */
+ tmp = MKT2(env, esock_atom_explicit_eor, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_FRAGMENT_INTERLEAVE => SCTP_FRAGMENT_INTERLEAVE *** */
+ tmp = MKT2(env, esock_atom_fragment_interleave, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_GET_PEER_ADDR_INFO => SCTP_GET_PEER_ADDR_INFO *** */
+ tmp = MKT2(env, esock_atom_get_peer_addr_info, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_INITMSG => SCTP_INITMSG *** */
+#if defined(SCTP_INITMSG)
+ tmp = MKT2(env, esock_atom_initmsg, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_initmsg, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_I_WANT_MAPPED_V4_ADDR => SCTP_I_WANT_MAPPED_V4_ADDR *** */
+ tmp = MKT2(env, esock_atom_i_want_mapped_v4_addr, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_LOCAL_AUTH_CHUNKS => SCTP_LOCAL_AUTH_CHUNKS *** */
+ tmp = MKT2(env, esock_atom_local_auth_chunks, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_MAXSEG => SCTP_MAXSEG *** */
+#if defined(SCTP_MAXSEG)
+ tmp = MKT2(env, esock_atom_maxseg, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_maxseg, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_MAXBURST => SCTP_MAXBURST *** */
+ tmp = MKT2(env, esock_atom_maxburst, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_NODELAY => SCTP_NODELAY *** */
+#if defined(SCTP_NODELAY)
+ tmp = MKT2(env, esock_atom_nodelay, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_nodelay, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_PARTIAL_DELIVERY_POINT => SCTP_PARTIAL_DELIVERY_POINT *** */
+ tmp = MKT2(env, esock_atom_partial_delivery_point, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_PEER_ADDR_PARAMS => SCTP_PEER_ADDR_PARAMS *** */
+ tmp = MKT2(env, esock_atom_peer_addr_params, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_PEER_AUTH_CHUNKS => SCTP_PEER_AUTH_CHUNKS *** */
+ tmp = MKT2(env, esock_atom_peer_auth_chunks, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_PRIMARY_ADDR => SCTP_PRIMARY_ADDR *** */
+ tmp = MKT2(env, esock_atom_primary_addr, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_RESET_STREAMS => SCTP_RESET_STREAMS *** */
+ tmp = MKT2(env, esock_atom_reset_streams, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_RTOINFO => SCTP_RTOINFO *** */
+#if defined(SCTP_RTOINFO)
+ tmp = MKT2(env, esock_atom_rtoinfo, esock_atom_true);
+#else
+ tmp = MKT2(env, esock_atom_rtoinfo, esock_atom_false);
+#endif
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_SET_PEER_PRIMARY_ADDR => SCTP_SET_PEER_PRIMARY_ADDR *** */
+ tmp = MKT2(env, esock_atom_set_peer_primary_addr, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_STATUS => SCTP_STATUS *** */
+ tmp = MKT2(env, esock_atom_status, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ /* *** SOCKET_OPT_SCTP_USE_EXT_RECVINFO => SCTP_USE_EXT_RECVINFO *** */
+ tmp = MKT2(env, esock_atom_use_ext_recvinfo, esock_atom_false);
+ TARRAY_ADD(opts, tmp);
+
+
+ TARRAY_TOLIST(opts, env, &optsL);
+
+ return optsL;
+}
+#endif
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_sctp(ErlNifEnv* env)
+{
+ ERL_NIF_TERM supports;
+
+#if defined(HAVE_SCTP)
+ supports = esock_atom_true;
+#else
+ supports = esock_atom_false;
+#endif
+
+ return supports;
+}
+#endif
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsupports_ipv6(ErlNifEnv* env)
+{
+ ERL_NIF_TERM supports;
+
+ /* Is this (test) really sufficient for testing if we support IPv6? */
+#if defined(HAVE_IPV6)
+ supports = esock_atom_true;
+#else
+ supports = esock_atom_false;
+#endif
+
+ return supports;
+}
+#endif
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_open
+ *
+ * Description:
+ * Create an endpoint for communication.
+ *
+ * Arguments:
+ * Domain - The domain, for example 'inet'
+ * Type - Type of socket, for example 'stream'
+ * Protocol - The protocol, for example 'tcp'
+ * Extra - A map with "obscure" options.
+ * Currently the only allowed option is netns (network namespace).
+ * This is *only* allowed on linux!
+ * We sould also use this for the fd value, in case we should use
+ * an already existing (file) descriptor.
+ */
+static
+ERL_NIF_TERM nif_open(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ int edomain, etype, eproto;
+ int domain, type, proto;
+ char* netns;
+ ERL_NIF_TERM emap;
+ ERL_NIF_TERM result;
+
+ SGDBG( ("SOCKET", "nif_open -> entry with %d args\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 4) ||
+ !GET_INT(env, argv[0], &edomain) ||
+ !GET_INT(env, argv[1], &etype) ||
+ !IS_MAP(env, argv[3])) {
+ return enif_make_badarg(env);
+ }
+ eproto = argv[2];
+ emap = argv[3];
+
+ SGDBG( ("SOCKET", "nif_open -> "
+ "\r\n edomain: %T"
+ "\r\n etype: %T"
+ "\r\n eproto: %T"
+ "\r\n extra: %T"
+ "\r\n", argv[0], argv[1], eproto, emap) );
+
+ if (!edomain2domain(edomain, &domain)) {
+ SGDBG( ("SOCKET", "nif_open -> invalid domain: %d\r\n", edomain) );
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ if (!etype2type(etype, &type)) {
+ SGDBG( ("SOCKET", "nif_open -> invalid type: %d\r\n", etype) );
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ if (!eproto2proto(env, eproto, &proto)) {
+ SGDBG( ("SOCKET", "nif_open -> invalid protocol: %d\r\n", eproto) );
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+#ifdef HAVE_SETNS
+ /* We *currently* only support one extra option: netns */
+ if (!emap2netns(env, emap, &netns)) {
+ SGDBG( ("SOCKET", "nif_open -> namespace: %s\r\n", netns) );
+ return enif_make_badarg(env);
+ }
+#else
+ netns = NULL;
+#endif
+
+
+ result = nopen(env, domain, type, proto, netns);
+
+ SGDBG( ("SOCKET", "nif_open -> done with result: "
+ "\r\n %T"
+ "\r\n", result) );
+
+ return result;
+
+#endif // if defined(__WIN32__)
+}
+
+
+/* nopen - create an endpoint for communication
+ *
+ * Assumes the input has been validated.
+ *
+ * Normally we want debugging on (individual) sockets to be controlled
+ * by the sockets own debug flag. But since we don't even have a socket
+ * yet, we must use the global debug flag.
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nopen(ErlNifEnv* env,
+ int domain, int type, int protocol,
+ char* netns)
+{
+ SocketDescriptor* descP;
+ ERL_NIF_TERM res;
+ int save_errno = 0;
+ SOCKET sock;
+ HANDLE event;
+#ifdef HAVE_SETNS
+ int current_ns = 0;
+#endif
+
+ SGDBG( ("SOCKET", "nopen -> entry with"
+ "\r\n domain: %d"
+ "\r\n type: %d"
+ "\r\n protocol: %d"
+ "\r\n netns: %s"
+ "\r\n", domain, type, protocol, ((netns == NULL) ? "NULL" : netns)) );
+
+#ifdef HAVE_SETNS
+ if ((netns != NULL) &&
+ !change_network_namespace(netns, &current_ns, &save_errno))
+ return esock_make_error_errno(env, save_errno);
+#endif
+
+ if ((sock = sock_open(domain, type, protocol)) == INVALID_SOCKET)
+ return esock_make_error_errno(env, sock_errno());
+
+ SGDBG( ("SOCKET", "nopen -> open success: %d\r\n", sock) );
+
+#ifdef HAVE_SETNS
+ if ((netns != NULL) &&
+ !restore_network_namespace(current_ns, sock, &save_errno))
+ return esock_make_error_errno(env, save_errno);
+
+ if (netns != NULL)
+ FREE(netns);
+#endif
+
+
+ if ((event = sock_create_event(sock)) == INVALID_EVENT) {
+ save_errno = sock_errno();
+ while ((sock_close(sock) == INVALID_SOCKET) && (sock_errno() == EINTR));
+ return esock_make_error_errno(env, save_errno);
+ }
+
+ SGDBG( ("SOCKET", "nopen -> event success: %d\r\n", event) );
+
+ SET_NONBLOCKING(sock);
+
+
+ /* Create and initiate the socket "descriptor" */
+ if ((descP = alloc_descriptor(sock, event)) == NULL) {
+ sock_close(sock);
+ // Not sure if this is really the proper error, but...
+ return enif_make_badarg(env);
+ }
+
+ descP->state = SOCKET_STATE_OPEN;
+ descP->domain = domain;
+ descP->type = type;
+ descP->protocol = protocol;
+
+ /* Does this apply to other types? Such as RAW?
+ * Also, is this really correct? Should we not wait for bind?
+ */
+ if (type == SOCK_DGRAM) {
+ descP->isReadable = TRUE;
+ descP->isWritable = TRUE;
+ }
+
+ /*
+ * Should we keep track of sockets (resources) in some way?
+ * Doing it here will require mutex to ensure data integrity,
+ * which will be costly. Send it somewhere?
+ */
+ res = enif_make_resource(env, descP);
+ enif_release_resource(descP);
+
+ /* Keep track of the creator
+ * This should not be a problem, but just in case
+ * the *open* function is used with the wrong kind
+ * of environment...
+ */
+ if (enif_self(env, &descP->ctrlPid) == NULL)
+ return esock_make_error(env, atom_exself);
+
+ if (MONP("nopen -> ctrl",
+ env, descP,
+ &descP->ctrlPid,
+ &descP->ctrlMon) != 0)
+ return esock_make_error(env, atom_exmon);
+
+
+ inc_socket(domain, type, protocol);
+
+ return esock_make_ok2(env, res);
+}
+#endif // if !defined(__WIN32__)
+
+
+
+#ifdef HAVE_SETNS
+/* We should really have another API, so that we can return errno... */
+
+/* *** change network namespace ***
+ * Retreive the current namespace and set the new.
+ * Return result and previous namespace if successfull.
+ */
+#if !defined(__WIN32__)
+static
+BOOLEAN_T change_network_namespace(char* netns, int* cns, int* err)
+{
+ int save_errno;
+ int current_ns = 0;
+ int new_ns = 0;
+
+ SGDBG( ("SOCKET", "change_network_namespace -> entry with"
+ "\r\n new ns: %s", netns) );
+
+ if (netns != NULL) {
+ current_ns = open("/proc/self/ns/net", O_RDONLY);
+ if (current_ns == INVALID_SOCKET) {
+ *cns = current_ns;
+ *err = sock_errno();
+ return FALSE;
+ }
+ new_ns = open(netns, O_RDONLY);
+ if (new_ns == INVALID_SOCKET) {
+ save_errno = sock_errno();
+ while (close(current_ns) == INVALID_SOCKET &&
+ sock_errno() == EINTR);
+ *cns = -1;
+ *err = save_errno;
+ return FALSE;
+ }
+ if (setns(new_ns, CLONE_NEWNET) != 0) {
+ save_errno = sock_errno();
+ while ((close(new_ns) == INVALID_SOCKET) &&
+ (sock_errno() == EINTR));
+ while ((close(current_ns) == INVALID_SOCKET) &&
+ (sock_errno() == EINTR));
+ *cns = -1;
+ *err = save_errno;
+ return FALSE;
+ } else {
+ while ((close(new_ns) == INVALID_SOCKET) &&
+ (sock_errno() == EINTR));
+ *cns = current_ns;
+ *err = 0;
+ return TRUE;
+ }
+ } else {
+ *cns = INVALID_SOCKET;
+ *err = 0;
+ return TRUE;
+ }
+}
+#endif // if !defined(__WIN32__)
+
+
+/* *** restore network namespace ***
+ * Restore the previous namespace (see above).
+ */
+#if !defined(__WIN32__)
+static
+BOOLEAN_T restore_network_namespace(int ns, SOCKET sock, int* err)
+{
+ int save_errno;
+
+ SGDBG( ("SOCKET", "restore_network_namespace -> entry with"
+ "\r\n ns: %d", ns) );
+
+ if (ns != INVALID_SOCKET) {
+ if (setns(ns, CLONE_NEWNET) != 0) {
+ /* XXX Failed to restore network namespace.
+ * What to do? Tidy up and return an error...
+ * Note that the thread now might still be in the namespace.
+ * Can this even happen? Should the emulator be aborted?
+ */
+ if (sock != INVALID_SOCKET)
+ save_errno = sock_errno();
+ while (close(sock) == INVALID_SOCKET &&
+ sock_errno() == EINTR);
+ sock = INVALID_SOCKET;
+ while (close(ns) == INVALID_SOCKET &&
+ sock_errno() == EINTR);
+ *err = save_errno;
+ return FALSE;
+ } else {
+ while (close(ns) == INVALID_SOCKET &&
+ sock_errno() == EINTR);
+ *err = 0;
+ return TRUE;
+ }
+ }
+
+ *err = 0;
+ return TRUE;
+}
+#endif // if !defined(__WIN32__)
+#endif // ifdef HAVE_SETNS
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_bind
+ *
+ * Description:
+ * Bind a name to a socket.
+ *
+ * Arguments:
+ * [0] Socket (ref) - Points to the socket descriptor.
+ * [1] LocalAddr - Local address is a sockaddr map ( socket:sockaddr() ).
+ */
+static
+ERL_NIF_TERM nif_bind(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM eSockAddr;
+ SocketAddress sockAddr;
+ unsigned int addrLen;
+ char* xres;
+
+ SGDBG( ("SOCKET", "nif_bind -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 2) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+ eSockAddr = argv[1];
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ SSDBG( descP,
+ ("SOCKET", "nif_bind -> args when sock = %d (0x%lX)"
+ "\r\n Socket: %T"
+ "\r\n SockAddr: %T"
+ "\r\n", descP->sock, descP->state, argv[0], eSockAddr) );
+
+ /* Make sure we are ready
+ * Not sure how this would even happen, but...
+ */
+ if (descP->state != SOCKET_STATE_OPEN)
+ return esock_make_error(env, atom_exbadstate);
+
+ if ((xres = esock_decode_sockaddr(env, eSockAddr, &sockAddr, &addrLen)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ return nbind(env, descP, &sockAddr, addrLen);
+
+#endif // if defined(__WIN32__)
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nbind(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ SocketAddress* sockAddrP,
+ unsigned int addrLen)
+{
+ int port, ntohs_port;
+
+ SSDBG( descP, ("SOCKET", "nbind -> try bind\r\n") );
+
+ if (IS_SOCKET_ERROR(sock_bind(descP->sock,
+ (struct sockaddr*) sockAddrP, addrLen))) {
+ return esock_make_error_errno(env, sock_errno());
+ }
+
+ SSDBG( descP, ("SOCKET", "nbind -> bound - get port\r\n") );
+
+ port = which_address_port(sockAddrP);
+ SSDBG( descP, ("SOCKET", "nbind -> port: %d\r\n", port) );
+ if (port == 0) {
+ SOCKLEN_T len = sizeof(SocketAddress);
+ sys_memzero((char *) sockAddrP, len);
+ sock_name(descP->sock, &sockAddrP->sa, &len);
+ port = which_address_port(sockAddrP);
+ } else if (port == -1) {
+ port = 0;
+ }
+
+ ntohs_port = sock_ntohs(port);
+
+ SSDBG( descP, ("SOCKET", "nbind -> done with port = %d\r\n", ntohs_port) );
+
+ return esock_make_ok2(env, MKI(env, ntohs_port));
+
+}
+#endif // if !defined(__WIN32__)
+
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_connect
+ *
+ * Description:
+ * Initiate a connection on a socket
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * SockAddr - Socket Address of "remote" host.
+ * This is sockaddr(), which is either
+ * sockaddr_in4 or sockaddr_in6.
+ */
+static
+ERL_NIF_TERM nif_connect(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM res, eSockAddr;
+ char* xres;
+
+ SGDBG( ("SOCKET", "nif_connect -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 2) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+ eSockAddr = argv[1];
+
+ SSDBG( descP,
+ ("SOCKET", "nif_connect -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n SockAddr: %T"
+ "\r\n", descP->sock, argv[0], eSockAddr) );
+
+ if ((xres = esock_decode_sockaddr(env, eSockAddr,
+ &descP->remote, &descP->addrLen)) != NULL) {
+ return esock_make_error_str(env, xres);
+ }
+
+
+ MLOCK(descP->readMtx);
+ MLOCK(descP->writeMtx);
+
+ res = nconnect(env, descP);
+
+ MUNLOCK(descP->writeMtx);
+ MUNLOCK(descP->readMtx);
+
+ return res;
+
+#endif // if !defined(__WIN32__)
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nconnect(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM res, ref;
+ int code, sres, save_errno = 0;
+
+ /*
+ * Verify that we are where in the proper state
+ */
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ if (!IS_OPEN(descP)) {
+ SSDBG( descP, ("SOCKET", "nif_connect -> not open\r\n") );
+ return esock_make_error(env, atom_exbadstate);
+ }
+
+ if (IS_CONNECTED(descP)) {
+ SSDBG( descP, ("SOCKET", "nif_connect -> already connected\r\n") );
+ return esock_make_error(env, atom_eisconn);
+ }
+
+ if (IS_CONNECTING(descP)) {
+ SSDBG( descP, ("SOCKET", "nif_connect -> already connecting\r\n") );
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+
+ /*
+ * And attempt to connect
+ */
+
+ code = sock_connect(descP->sock,
+ (struct sockaddr*) &descP->remote,
+ descP->addrLen);
+ save_errno = sock_errno();
+
+ SSDBG( descP, ("SOCKET", "nif_connect -> connect result: %d, %d\r\n",
+ code, save_errno) );
+
+ if (IS_SOCKET_ERROR(code) &&
+ ((save_errno == ERRNO_BLOCK) || /* Winsock2 */
+ (save_errno == EINPROGRESS))) { /* Unix & OSE!! */
+ ref = MKREF(env);
+ descP->state = SOCKET_STATE_CONNECTING;
+ if ((sres = esock_select_write(env, descP->sock, descP, NULL, ref)) < 0) {
+ res = esock_make_error(env,
+ MKT2(env,
+ esock_atom_select_failed,
+ MKI(env, sres)));
+ } else {
+ res = esock_make_ok2(env, ref);
+ }
+ } else if (code == 0) { /* ok we are connected */
+
+ descP->state = SOCKET_STATE_CONNECTED;
+ descP->isReadable = TRUE;
+ descP->isWritable = TRUE;
+
+ res = esock_atom_ok;
+ } else {
+ res = esock_make_error_errno(env, save_errno);
+ }
+
+ return res;
+
+}
+#endif // if !defined(__WIN32__)
+
+
+/* ----------------------------------------------------------------------
+ * nif_finalize_connection
+ *
+ * Description:
+ * Make socket ready for input and output.
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ */
+static
+ERL_NIF_TERM nif_finalize_connection(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 1) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ return nfinalize_connection(env, descP);
+
+#endif
+}
+
+
+/* *** nfinalize_connection ***
+ * Perform the final check to verify a connection.
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nfinalize_connection(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ int error;
+
+ if (descP->state != SOCKET_STATE_CONNECTING)
+ return esock_make_error(env, atom_enotconn);
+
+ if (!verify_is_connected(descP, &error)) {
+ descP->state = SOCKET_STATE_OPEN; /* restore state */
+ return esock_make_error_errno(env, error);
+ }
+
+ descP->state = SOCKET_STATE_CONNECTED;
+ descP->isReadable = TRUE;
+ descP->isWritable = TRUE;
+
+ return esock_atom_ok;
+}
+#endif
+
+
+/* *** verify_is_connected ***
+ * Check if a connection has been established.
+ */
+#if !defined(__WIN32__)
+static
+BOOLEAN_T verify_is_connected(SocketDescriptor* descP, int* err)
+{
+ /*
+ * *** This is strange ***
+ *
+ * This *should* work on Windows NT too, but doesn't.
+ * An bug in Winsock 2.0 for Windows NT?
+ *
+ * See "Unix Netwok Programming", W.R.Stevens, p 412 for a
+ * discussion about Unix portability and non blocking connect.
+ */
+
+#ifndef SO_ERROR
+
+ int sz, code;
+
+ sz = sizeof(descP->remote);
+ sys_memzero((char *) &descP->remote, sz);
+ code = sock_peer(desc->sock,
+ (struct sockaddr*) &descP->remote, &sz);
+
+ if (IS_SOCKET_ERROR(code)) {
+ *err = sock_errno();
+ return FALSE;
+ }
+
+#else
+
+ int error = 0; /* Has to be initiated, we check it */
+ unsigned int sz = sizeof(error); /* even if we get -1 */
+ int code = sock_getopt(descP->sock,
+ SOL_SOCKET, SO_ERROR,
+ (void *)&error, &sz);
+
+ if ((code < 0) || error) {
+ *err = error;
+ return FALSE;
+ }
+
+#endif /* SO_ERROR */
+
+ *err = 0;
+
+ return TRUE;
+}
+#endif
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_listen
+ *
+ * Description:
+ * Listen for connections on a socket.
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * Backlog - The maximum length to which the queue of pending
+ * connections for socket may grow.
+ */
+static
+ERL_NIF_TERM nif_listen(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ int backlog;
+
+ SGDBG( ("SOCKET", "nif_listen -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 2) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP) ||
+ !GET_INT(env, argv[1], &backlog)) {
+ return enif_make_badarg(env);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nif_listen -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n backlog: %d"
+ "\r\n", descP->sock, argv[0], backlog) );
+
+ return nlisten(env, descP, backlog);
+
+#endif // if defined(__WIN32__)
+}
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nlisten(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int backlog)
+{
+
+ /*
+ * Verify that we are where in the proper state
+ */
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ if (descP->state == SOCKET_STATE_CLOSED)
+ return esock_make_error(env, atom_exbadstate);
+
+ if (!IS_OPEN(descP))
+ return esock_make_error(env, atom_exbadstate);
+
+
+ /*
+ * And attempt to make socket listening
+ */
+
+ if (IS_SOCKET_ERROR(sock_listen(descP->sock, backlog)))
+ return esock_make_error_errno(env, sock_errno());
+
+ descP->state = SOCKET_STATE_LISTENING;
+
+ return esock_atom_ok;
+
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_accept
+ *
+ * Description:
+ * Accept a connection on a socket.
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * Request ref - Unique "id" of this request
+ * (used for the select, if none is in queue).
+ */
+static
+ERL_NIF_TERM nif_accept(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM sockRef, ref, res;
+
+ SGDBG( ("SOCKET", "nif_accept -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ sockRef = argv[0];
+ if ((argc != 2) ||
+ !enif_get_resource(env, sockRef, sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+ ref = argv[1];
+
+ SSDBG( descP,
+ ("SOCKET", "nif_accept -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n ReqRef: %T"
+ "\r\n", descP->sock, argv[0], ref) );
+
+ MLOCK(descP->accMtx);
+
+ res = naccept(env, descP, sockRef, ref);
+
+ MUNLOCK(descP->accMtx);
+
+ return res;
+
+#endif // if defined(__WIN32__)
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM naccept(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM ref)
+{
+ ERL_NIF_TERM res;
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ switch (descP->state) {
+ case SOCKET_STATE_LISTENING:
+ res = naccept_listening(env, descP, ref);
+ break;
+
+ case SOCKET_STATE_ACCEPTING:
+ res = naccept_accepting(env, descP, sockRef, ref);
+ break;
+
+ default:
+ res = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return res;
+}
+#endif // if !defined(__WIN32__)
+
+
+/* *** naccept_listening ***
+ * We have no active acceptor (and no acceptors in queue).
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM naccept_listening(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref)
+{
+ SocketAddress remote;
+ unsigned int n;
+ SOCKET accSock;
+ int save_errno;
+ ErlNifPid caller;
+ ERL_NIF_TERM res;
+
+ SSDBG( descP, ("SOCKET", "naccept_listening -> get caller\r\n") );
+
+ if (enif_self(env, &caller) == NULL)
+ return esock_make_error(env, atom_exself);
+
+ n = sizeof(remote);
+ sys_memzero((char *) &remote, n);
+ SSDBG( descP, ("SOCKET", "naccept_listening -> try accept\r\n") );
+ accSock = sock_accept(descP->sock, (struct sockaddr*) &remote, &n);
+ if (accSock == INVALID_SOCKET) {
+
+ save_errno = sock_errno();
+
+ SSDBG( descP,
+ ("SOCKET",
+ "naccept_listening -> accept failed (%d)\r\n", save_errno) );
+
+ res = naccept_listening_error(env, descP, ref, caller, save_errno);
+
+ } else {
+
+ /*
+ * We got one
+ */
+
+ SSDBG( descP, ("SOCKET", "naccept_listening -> success\r\n") );
+
+ res = naccept_listening_accept(env, descP, accSock, caller, &remote);
+
+ }
+
+ return res;
+}
+
+
+/* *** naccept_listening_error ***
+ * The accept call resultet in an error - handle it.
+ * There are only two cases:
+ * 1) BLOCK => Attempt a "retry"
+ * 2) Other => Return the value (converted to an atom)
+ */
+static
+ERL_NIF_TERM naccept_listening_error(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ErlNifPid caller,
+ int save_errno)
+{
+ ERL_NIF_TERM res;
+
+ if (save_errno == ERRNO_BLOCK) {
+
+ /* *** Try again later *** */
+ SSDBG( descP, ("SOCKET", "naccept_listening_error -> would block\r\n") );
+
+ descP->currentAcceptor.pid = caller;
+ if (MONP("naccept_listening -> current acceptor",
+ env, descP,
+ &descP->currentAcceptor.pid,
+ &descP->currentAcceptor.mon) != 0)
+ return esock_make_error(env, atom_exmon);
+
+ descP->currentAcceptor.ref = enif_make_copy(descP->env, ref);
+ descP->currentAcceptorP = &descP->currentAcceptor;
+
+ res = naccept_busy_retry(env, descP, ref, NULL, SOCKET_STATE_ACCEPTING);
+
+
+ } else {
+ SSDBG( descP,
+ ("SOCKET",
+ "naccept_listening -> errno: %d\r\n", save_errno) );
+ res = esock_make_error_errno(env, save_errno);
+ }
+
+ return res;
+}
+
+
+/* *** naccept_listening_accept ***
+ * The accept call was successful (accepted) - handle the new connection.
+ */
+static
+ERL_NIF_TERM naccept_listening_accept(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ SOCKET accSock,
+ ErlNifPid caller,
+ SocketAddress* remote)
+{
+ ERL_NIF_TERM res;
+
+ naccept_accepted(env, descP, accSock, caller, remote, &res);
+
+ return res;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* *** naccept_accepting ***
+ * We have an active acceptor and possibly acceptors waiting in queue.
+ * If the pid of the calling process is not the pid of the "current process",
+ * push the requester onto the (acceptor) queue.
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM naccept_accepting(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM ref)
+{
+ ErlNifPid caller;
+ ERL_NIF_TERM res;
+
+ SSDBG( descP, ("SOCKET", "naccept_accepting -> get caller\r\n") );
+
+ if (enif_self(env, &caller) == NULL)
+ return esock_make_error(env, atom_exself);
+
+ SSDBG( descP, ("SOCKET", "naccept_accepting -> check: "
+ "are caller current acceptor:"
+ "\r\n Caller: %T"
+ "\r\n Current: %T"
+ "\r\n", caller, descP->currentAcceptor.pid) );
+
+ if (COMPARE_PIDS(&descP->currentAcceptor.pid, &caller) == 0) {
+
+ SSDBG( descP,
+ ("SOCKET", "naccept_accepting -> current acceptor\r\n") );
+
+ res = naccept_accepting_current(env, descP, sockRef, ref);
+
+ } else {
+
+ /* Not the "current acceptor", so (maybe) push onto queue */
+
+ SSDBG( descP,
+ ("SOCKET", "naccept_accepting -> *not* current acceptor\r\n") );
+
+ res = naccept_accepting_other(env, descP, ref, caller);
+
+ }
+
+ return res;
+
+}
+
+
+
+/* *** naccept_accepting_current ***
+ * Handles when the current acceptor makes another attempt.
+ */
+static
+ERL_NIF_TERM naccept_accepting_current(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM accRef)
+{
+ SocketAddress remote;
+ unsigned int n;
+ SOCKET accSock;
+ int save_errno;
+ ERL_NIF_TERM res;
+
+ SSDBG( descP, ("SOCKET", "naccept_accepting_current -> try accept\r\n") );
+ n = sizeof(descP->remote);
+ sys_memzero((char *) &remote, n);
+ accSock = sock_accept(descP->sock, (struct sockaddr*) &remote, &n);
+ if (accSock == INVALID_SOCKET) {
+
+ save_errno = sock_errno();
+
+ SSDBG( descP,
+ ("SOCKET",
+ "naccept_accepting_current -> accept failed: %d\r\n",
+ save_errno) );
+
+ res = naccept_accepting_current_error(env, descP, sockRef,
+ accRef, save_errno);
+
+ } else {
+
+ SSDBG( descP, ("SOCKET", "naccept_accepting_current -> accepted\r\n") );
+
+ res = naccept_accepting_current_accept(env, descP, sockRef,
+ accSock, &remote);
+
+ }
+
+ return res;
+}
+
+
+/* *** naccept_accepting_current_accept ***
+ * Handles when the current acceptor succeeded in its accept call -
+ * handle the new connection.
+ */
+static
+ERL_NIF_TERM naccept_accepting_current_accept(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ SOCKET accSock,
+ SocketAddress* remote)
+{
+ ERL_NIF_TERM res;
+
+ if (naccept_accepted(env, descP, accSock,
+ descP->currentAcceptor.pid, remote, &res)) {
+
+ /* We should really go through the queue until we succeed to activate
+ * a waiting acceptor. For now we just pop once and hope for the best...
+ * This will leave any remaining acceptors *hanging*...
+ *
+ * We need a "activate-next" function.
+ *
+ */
+
+ if (!activate_next_acceptor(env, descP, sockRef)) {
+
+ SSDBG( descP,
+ ("SOCKET",
+ "naccept_accepting_current_accept -> "
+ "no more writers\r\n") );
+
+ descP->state = SOCKET_STATE_LISTENING;
+
+ descP->currentAcceptorP = NULL;
+ descP->currentAcceptor.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentAcceptor.pid);
+ esock_monitor_init(&descP->currentAcceptor.mon);
+ }
+
+ }
+
+ return res;
+}
+
+
+/* *** naccept_accepting_current_error ***
+ * The accept call of current acceptor resultet in an error - handle it.
+ * There are only two cases:
+ * 1) BLOCK => Attempt a "retry"
+ * 2) Other => Return the value (converted to an atom)
+ */
+static
+ERL_NIF_TERM naccept_accepting_current_error(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef,
+ int save_errno)
+{
+ SocketRequestor req;
+ ERL_NIF_TERM res, reason;
+
+ if (save_errno == ERRNO_BLOCK) {
+
+ /*
+ * Just try again, no real error, just a ghost trigger from poll,
+ */
+
+ SSDBG( descP,
+ ("SOCKET",
+ "naccept_accepting_current_error -> "
+ "would block: try again\r\n") );
+
+ res = naccept_busy_retry(env, descP, opRef, &descP->currentAcceptor.pid,
+ /* No state change */
+ descP->state);
+
+ } else {
+
+ reason = MKA(env, erl_errno_id(save_errno));
+ res = esock_make_error(env, reason);
+
+ while (acceptor_pop(env, descP, &req)) {
+ SSDBG( descP,
+ ("SOCKET", "naccept_accepting_current_error -> abort %T\r\n",
+ req.pid) );
+ esock_send_abort_msg(env, sockRef, req.ref, reason, &req.pid);
+ DEMONP("naccept_accepting_current_error -> pop'ed writer",
+ env, descP, &req.mon);
+ }
+
+ }
+
+ return res;
+}
+
+
+/* *** naccept_accepting_other ***
+ * Handles when the another acceptor makes an attempt, which
+ * results (maybe) in the request beeing pushed onto the
+ * acceptor queue.
+ */
+static
+ERL_NIF_TERM naccept_accepting_other(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ErlNifPid caller)
+{
+ ERL_NIF_TERM result;
+
+ if (!acceptor_search4pid(env, descP, &caller)) // Ugh! (&caller)
+ result = acceptor_push(env, descP, caller, ref);
+ else
+ result = esock_make_error(env, esock_atom_eagain);
+
+ return result;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* *** naccept_busy_retry ***
+ * Perform a retry select. If successful, set nextState.
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM naccept_busy_retry(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ErlNifPid* pid,
+ unsigned int nextState)
+{
+ int sres;
+ ERL_NIF_TERM res, reason;
+
+ if ((sres = esock_select_read(env, descP->sock, descP, pid, ref)) < 0) {
+ reason = MKT2(env, esock_atom_select_failed, MKI(env, sres));
+ res = esock_make_error(env, reason);
+ } else {
+ descP->state = nextState;
+ res = esock_make_error(env, esock_atom_eagain);
+ }
+
+ return res;
+}
+
+
+
+/* *** naccept_accepted ***
+ * Generic function handling a successful accept.
+ */
+static
+BOOLEAN_T naccept_accepted(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ SOCKET accSock,
+ ErlNifPid pid,
+ SocketAddress* remote,
+ ERL_NIF_TERM* result)
+{
+ SocketDescriptor* accDescP;
+ HANDLE accEvent;
+ ERL_NIF_TERM accRef;
+ int save_errno;
+
+ /*
+ * We got one
+ */
+
+ if ((accEvent = sock_create_event(accSock)) == INVALID_EVENT) {
+ save_errno = sock_errno();
+ while ((sock_close(accSock) == INVALID_SOCKET) &&
+ (sock_errno() == EINTR));
+ *result = esock_make_error_errno(env, save_errno);
+ return FALSE;
+ }
+
+ if ((accDescP = alloc_descriptor(accSock, accEvent)) == NULL) {
+ sock_close(accSock);
+ *result = enif_make_badarg(env);
+ return FALSE;
+ }
+
+ accDescP->domain = descP->domain;
+ accDescP->type = descP->type;
+ accDescP->protocol = descP->protocol;
+ accDescP->rBufSz = descP->rBufSz; // Inherit buffer size
+ accDescP->rNum = descP->rNum; // Inherit buffer uses
+ accDescP->rNumCnt = 0;
+ accDescP->rCtrlSz = descP->rCtrlSz; // Inherit buffer siez
+ accDescP->wCtrlSz = descP->wCtrlSz; // Inherit buffer size
+
+ accRef = enif_make_resource(env, accDescP);
+ enif_release_resource(accDescP);
+
+ accDescP->ctrlPid = pid;
+ if (MONP("naccept_accepted -> ctrl",
+ env, accDescP,
+ &accDescP->ctrlPid,
+ &accDescP->ctrlMon) != 0) {
+ sock_close(accSock);
+ *result = esock_make_error(env, atom_exmon);
+ return FALSE;
+ }
+
+ accDescP->remote = *remote;
+ SET_NONBLOCKING(accDescP->sock);
+
+ accDescP->state = SOCKET_STATE_CONNECTED;
+ accDescP->isReadable = TRUE;
+ accDescP->isWritable = TRUE;
+
+ *result = esock_make_ok2(env, accRef);
+
+ return TRUE;
+
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_send
+ *
+ * Description:
+ * Send a message on a socket
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * SendRef - A unique id for this (send) request.
+ * Data - The data to send in the form of a IOVec.
+ * Flags - Send flags.
+ */
+
+static
+ERL_NIF_TERM nif_send(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM sockRef, sendRef;
+ ErlNifBinary sndData;
+ unsigned int eflags;
+ int flags;
+ ERL_NIF_TERM res;
+
+ SGDBG( ("SOCKET", "nif_send -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 4) ||
+ !GET_BIN(env, argv[2], &sndData) ||
+ !GET_UINT(env, argv[3], &eflags)) {
+ return enif_make_badarg(env);
+ }
+ sockRef = argv[0]; // We need this in case we send in case we send abort
+ sendRef = argv[1];
+
+ if (!enif_get_resource(env, sockRef, sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nif_send -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n SendRef: %T"
+ "\r\n Size of data: %d"
+ "\r\n eFlags: %d"
+ "\r\n", descP->sock, sockRef, sendRef, sndData.size, eflags) );
+
+ if (!esendflags2sendflags(eflags, &flags))
+ return enif_make_badarg(env);
+
+ MLOCK(descP->writeMtx);
+
+ /* We need to handle the case when another process tries
+ * to write at the same time.
+ * If the current write could not write its entire package
+ * this time (resulting in an select). The write of the
+ * other process must be made to wait until current
+ * is done!
+ * Basically, we need a write queue!
+ *
+ * A 'writing' field (boolean), which is set if we did
+ * not manage to write the entire message and reset every
+ * time we do.
+ */
+
+ res = nsend(env, descP, sockRef, sendRef, &sndData, flags);
+
+ MUNLOCK(descP->writeMtx);
+
+ return res;
+#endif // if defined(__WIN32__)
+}
+
+
+
+/* *** nsend ***
+ *
+ * Do the actual send.
+ * Do some initial writer checks, do the actual send and then
+ * analyze the result. If we are done, another writer may be
+ * scheduled (if there is one in the writer queue).
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsend(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM sendRef,
+ ErlNifBinary* sndDataP,
+ int flags)
+{
+ int save_errno;
+ ssize_t written;
+ ERL_NIF_TERM writerCheck;
+
+ if (!descP->isWritable)
+ return enif_make_badarg(env);
+
+ /* Check if there is already a current writer and if its us */
+ if (!send_check_writer(env, descP, sendRef, &writerCheck))
+ return writerCheck;
+
+ /* We ignore the wrap for the moment.
+ * Maybe we should issue a wrap-message to controlling process...
+ */
+ cnt_inc(&descP->writeTries, 1);
+
+ written = sock_send(descP->sock, sndDataP->data, sndDataP->size, flags);
+ if (IS_SOCKET_ERROR(written))
+ save_errno = sock_errno();
+ else
+ save_errno = -1; // The value does not actually matter in this case
+
+ return send_check_result(env, descP,
+ written, sndDataP->size, save_errno,
+ sockRef, sendRef);
+
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_sendto
+ *
+ * Description:
+ * Send a message on a socket
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * SendRef - A unique id for this (send) request.
+ * Data - The data to send in the form of a IOVec.
+ * Dest - Destination (socket) address.
+ * Flags - Send flags.
+ */
+
+static
+ERL_NIF_TERM nif_sendto(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM sockRef, sendRef;
+ ErlNifBinary sndData;
+ unsigned int eflags;
+ int flags;
+ ERL_NIF_TERM eSockAddr;
+ SocketAddress remoteAddr;
+ unsigned int remoteAddrLen;
+ char* xres;
+ ERL_NIF_TERM res;
+
+ SGDBG( ("SOCKET", "nif_sendto -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 5) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP) ||
+ !GET_BIN(env, argv[2], &sndData) ||
+ !GET_UINT(env, argv[4], &eflags)) {
+ return enif_make_badarg(env);
+ }
+ sockRef = argv[0]; // We need this in case we send in case we send abort
+ sendRef = argv[1];
+ eSockAddr = argv[3];
+
+ if (!enif_get_resource(env, sockRef, sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nif_sendto -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n sendRef: %T"
+ "\r\n size of data: %d"
+ "\r\n eSockAddr: %T"
+ "\r\n eflags: %d"
+ "\r\n",
+ descP->sock, sockRef, sendRef, sndData.size, eSockAddr, eflags) );
+
+ if (!esendflags2sendflags(eflags, &flags)) {
+ SSDBG( descP, ("SOCKET", "nif_sendto -> sendflags decode failed\r\n") );
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ if ((xres = esock_decode_sockaddr(env, eSockAddr,
+ &remoteAddr,
+ &remoteAddrLen)) != NULL) {
+ SSDBG( descP, ("SOCKET", "nif_sendto -> sockaddr decode: %s\r\n", xres) );
+ return esock_make_error_str(env, xres);
+ }
+
+ MLOCK(descP->writeMtx);
+
+ res = nsendto(env, descP, sockRef, sendRef, &sndData, flags,
+ &remoteAddr, remoteAddrLen);
+
+ MUNLOCK(descP->writeMtx);
+
+ SGDBG( ("SOCKET", "nif_sendto -> done with result: "
+ "\r\n %T"
+ "\r\n", res) );
+
+ return res;
+#endif // if defined(__WIN32__)
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsendto(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM sendRef,
+ ErlNifBinary* dataP,
+ int flags,
+ SocketAddress* toAddrP,
+ unsigned int toAddrLen)
+{
+ int save_errno;
+ ssize_t written;
+ ERL_NIF_TERM writerCheck;
+
+ if (!descP->isWritable)
+ return enif_make_badarg(env);
+
+ /* Check if there is already a current writer and if its us */
+ if (!send_check_writer(env, descP, sendRef, &writerCheck))
+ return writerCheck;
+
+ /* We ignore the wrap for the moment.
+ * Maybe we should issue a wrap-message to controlling process...
+ */
+ cnt_inc(&descP->writeTries, 1);
+
+ if (toAddrP != NULL) {
+ written = sock_sendto(descP->sock,
+ dataP->data, dataP->size, flags,
+ &toAddrP->sa, toAddrLen);
+ } else {
+ written = sock_sendto(descP->sock,
+ dataP->data, dataP->size, flags,
+ NULL, 0);
+ }
+ if (IS_SOCKET_ERROR(written))
+ save_errno = sock_errno();
+ else
+ save_errno = -1; // The value does not actually matter in this case
+
+ return send_check_result(env, descP, written, dataP->size, save_errno,
+ sockRef, sendRef);
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_sendmsg
+ *
+ * Description:
+ * Send a message on a socket
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * SendRef - A unique id for this (send) request.
+ * MsgHdr - Message Header - data and (maybe) control and dest
+ * Flags - Send flags.
+ */
+
+static
+ERL_NIF_TERM nif_sendmsg(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ ERL_NIF_TERM res, sockRef, sendRef, eMsgHdr;
+ SocketDescriptor* descP;
+ unsigned int eflags;
+ int flags;
+
+ SGDBG( ("SOCKET", "nif_sendmsg -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 4) ||
+ !IS_MAP(env, argv[2]) ||
+ !GET_UINT(env, argv[3], &eflags)) {
+ return enif_make_badarg(env);
+ }
+ sockRef = argv[0]; // We need this in case we send in case we send abort
+ sendRef = argv[1];
+ eMsgHdr = argv[2];
+
+ if (!enif_get_resource(env, sockRef, sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nif_sendmsg -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n sendRef: %T"
+ "\r\n eflags: %d"
+ "\r\n",
+ descP->sock, argv[0], sendRef, eflags) );
+
+ if (!esendflags2sendflags(eflags, &flags))
+ return esock_make_error(env, esock_atom_einval);
+
+ MLOCK(descP->writeMtx);
+
+ res = nsendmsg(env, descP, sockRef, sendRef, eMsgHdr, flags);
+
+ MUNLOCK(descP->writeMtx);
+
+ SSDBG( descP,
+ ("SOCKET", "nif_sendmsg -> done with result: "
+ "\r\n %T"
+ "\r\n", res) );
+
+ return res;
+#endif // if defined(__WIN32__)
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsendmsg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM sendRef,
+ ERL_NIF_TERM eMsgHdr,
+ int flags)
+{
+ ERL_NIF_TERM res, eAddr, eIOV, eCtrl;
+ SocketAddress addr;
+ struct msghdr msgHdr;
+ ErlNifBinary* iovBins;
+ struct iovec* iov;
+ unsigned int iovLen;
+ char* ctrlBuf;
+ size_t ctrlBufLen, ctrlBufUsed;
+ int save_errno;
+ ssize_t written, dataSize;
+ ERL_NIF_TERM writerCheck;
+ char* xres;
+
+ if (!descP->isWritable)
+ return enif_make_badarg(env);
+
+ /* Check if there is already a current writer and if its us */
+ if (!send_check_writer(env, descP, sendRef, &writerCheck))
+ return writerCheck;
+
+ /* Depending on if we are *connected* or not, we require
+ * different things in the msghdr map.
+ */
+ if (IS_CONNECTED(descP)) {
+
+ /* We don't need the address */
+
+ SSDBG( descP, ("SOCKET", "nsendmsg -> connected: no address\r\n") );
+
+ msgHdr.msg_name = NULL;
+ msgHdr.msg_namelen = 0;
+
+ } else {
+
+ /* We need the address */
+
+ msgHdr.msg_name = (void*) &addr;
+ msgHdr.msg_namelen = sizeof(addr);
+ sys_memzero((char *) msgHdr.msg_name, msgHdr.msg_namelen);
+ if (!GET_MAP_VAL(env, eMsgHdr, esock_atom_addr, &eAddr))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP, ("SOCKET", "nsendmsg -> not connected: "
+ "\r\n address: %T"
+ "\r\n", eAddr) );
+
+ if ((xres = esock_decode_sockaddr(env, eAddr,
+ msgHdr.msg_name,
+ &msgHdr.msg_namelen)) != NULL)
+ return esock_make_error_str(env, xres);
+ }
+
+
+ /* Extract the (other) attributes of the msghdr map: iov and maybe ctrl */
+
+ /* The *mandatory* iov, which must be a list */
+ if (!GET_MAP_VAL(env, eMsgHdr, esock_atom_iov, &eIOV))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_LIST_LEN(env, eIOV, &iovLen) && (iovLen > 0))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP, ("SOCKET", "nsendmsg -> iov length: %d\r\n", iovLen) );
+
+ iovBins = MALLOC(iovLen * sizeof(ErlNifBinary));
+ ESOCK_ASSERT( (iovBins != NULL) );
+
+ iov = MALLOC(iovLen * sizeof(struct iovec));
+ ESOCK_ASSERT( (iov != NULL) );
+
+ /* The *opional* ctrl */
+ if (GET_MAP_VAL(env, eMsgHdr, esock_atom_ctrl, &eCtrl)) {
+ ctrlBufLen = descP->wCtrlSz;
+ ctrlBuf = (char*) MALLOC(ctrlBufLen);
+ ESOCK_ASSERT( (ctrlBuf != NULL) );
+ } else {
+ eCtrl = esock_atom_undefined;
+ ctrlBufLen = 0;
+ ctrlBuf = NULL;
+ }
+ SSDBG( descP, ("SOCKET", "nsendmsg -> optional ctrl: "
+ "\r\n ctrlBuf: 0x%lX"
+ "\r\n ctrlBufLen: %d"
+ "\r\n eCtrl: %T\r\n", ctrlBuf, ctrlBufLen, eCtrl) );
+
+ /* Decode the iov and initiate that part of the msghdr */
+ if ((xres = esock_decode_iov(env, eIOV,
+ iovBins, iov, iovLen, &dataSize)) != NULL) {
+ FREE(iovBins);
+ FREE(iov);
+ if (ctrlBuf != NULL) FREE(ctrlBuf);
+ return esock_make_error_str(env, xres);
+ }
+ msgHdr.msg_iov = iov;
+ msgHdr.msg_iovlen = iovLen;
+
+
+ SSDBG( descP, ("SOCKET",
+ "nsendmsg -> total (iov) data size: %d\r\n", dataSize) );
+
+
+ /* Decode the ctrl and initiate that part of the msghdr.
+ */
+ if (ctrlBuf != NULL) {
+ if ((xres = decode_cmsghdrs(env, descP,
+ eCtrl,
+ ctrlBuf, ctrlBufLen, &ctrlBufUsed)) != NULL) {
+ FREE(iovBins);
+ FREE(iov);
+ if (ctrlBuf != NULL) FREE(ctrlBuf);
+ return esock_make_error_str(env, xres);
+ }
+ } else {
+ ctrlBufUsed = 0;
+ }
+ msgHdr.msg_control = ctrlBuf;
+ msgHdr.msg_controllen = ctrlBufUsed;
+
+
+ /* The msg-flags field is not used when sending, but zero it just in case */
+ msgHdr.msg_flags = 0;
+
+
+ /* We ignore the wrap for the moment.
+ * Maybe we should issue a wrap-message to controlling process...
+ */
+ cnt_inc(&descP->writeTries, 1);
+
+ /* And now, finally, try to send the message */
+ written = sock_sendmsg(descP->sock, &msgHdr, flags);
+
+ if (IS_SOCKET_ERROR(written))
+ save_errno = sock_errno();
+ else
+ save_errno = -1; // OK or not complete: this value should not matter in this case
+
+ res = send_check_result(env, descP, written, dataSize, save_errno,
+ sockRef, sendRef);
+
+ FREE(iovBins);
+ FREE(iov);
+ if (ctrlBuf != NULL) FREE(ctrlBuf);
+
+ return res;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_writev / nif_sendv
+ *
+ * Description:
+ * Send a message (vector) on a socket
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * SendRef - A unique id for this (send) request.
+ * Data - A vector of binaries
+ * Flags - Send flags.
+ */
+
+#ifdef FOBAR
+static
+ERL_NIF_TERM nwritev(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sendRef,
+ ERL_NIF_TERM data)
+{
+ ERL_NIF_TERM tail;
+ ErlNifIOVec vec;
+ ErlNifIOVec* iovec = &vec;
+ SysIOVec* sysiovec;
+ int save_errno;
+ int iovcnt, n;
+
+ if (!enif_inspect_iovec(env, MAX_VSZ, data, &tail, &iovec))
+ return enif_make_badarg(env);
+
+ if (enif_ioq_size(descP->outQ) > 0) {
+ /* If the I/O queue contains data we enqueue the iovec
+ * and then peek the data to write out of the queue.
+ */
+ if (!enif_ioq_enqv(q, iovec, 0))
+ return -3;
+
+ sysiovec = enif_ioq_peek(descP->outQ, &iovcnt);
+
+ } else {
+ /* If the I/O queue is empty we skip the trip through it. */
+ iovcnt = iovec->iovcnt;
+ sysiovec = iovec->iov;
+ }
+
+ /* Attempt to write the data */
+ n = writev(fd, sysiovec, iovcnt);
+ saved_errno = errno;
+
+ if (enif_ioq_size(descP->outQ) == 0) {
+ /* If the I/O queue was initially empty we enqueue any
+ remaining data into the queue for writing later. */
+ if (n >= 0 && !enif_ioq_enqv(descP->outQ, iovec, n))
+ return -3;
+ } else {
+ /* Dequeue any data that was written from the queue. */
+ if (n > 0 && !enif_ioq_deq(descP->outQ, n, NULL))
+ return -4;
+ }
+ /* return n, which is either number of bytes written or -1 if
+ some error happened */
+ errno = saved_errno;
+ return n;
+}
+#endif
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_recv
+ *
+ * Description:
+ * Receive a message on a socket.
+ * Normally used only on a connected socket!
+ * If we are trying to read > 0 bytes, then that is what we do.
+ * But if we have specified 0 bytes, then we want to read
+ * whatever is in the buffers (everything it got).
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * RecvRef - A unique id for this (send) request.
+ * Length - The number of bytes to receive.
+ * Flags - Receive flags.
+ */
+
+static
+ERL_NIF_TERM nif_recv(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM sockRef, recvRef;
+ int len;
+ unsigned int eflags;
+ int flags;
+ ERL_NIF_TERM res;
+
+ if ((argc != 4) ||
+ !GET_INT(env, argv[2], &len) ||
+ !GET_UINT(env, argv[3], &eflags)) {
+ return enif_make_badarg(env);
+ }
+ sockRef = argv[0]; // We need this in case we case we send abort
+ recvRef = argv[1];
+
+ if (!enif_get_resource(env, sockRef, sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ if (!erecvflags2recvflags(eflags, &flags))
+ return enif_make_badarg(env);
+
+ MLOCK(descP->readMtx);
+
+ /* We need to handle the case when another process tries
+ * to receive at the same time.
+ * If the current recv could not read its entire package
+ * this time (resulting in an select). The read of the
+ * other process must be made to wait until current
+ * is done!
+ * Basically, we need a read queue!
+ *
+ * A 'reading' field (boolean), which is set if we did
+ * not manage to read the entire message and reset every
+ * time we do.
+ */
+
+ res = nrecv(env, descP, sockRef, recvRef, len, flags);
+
+ MUNLOCK(descP->readMtx);
+
+ return res;
+#endif // if defined(__WIN32__)
+}
+
+
+/* The (read) buffer handling *must* be optimized!
+ * But for now we make it easy for ourselves by
+ * allocating a binary (of the specified or default
+ * size) and then throwing it away...
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nrecv(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef,
+ int len,
+ int flags)
+{
+ ssize_t read;
+ ErlNifBinary buf;
+ ERL_NIF_TERM readerCheck;
+ int save_errno;
+ int bufSz = (len ? len : descP->rBufSz);
+
+ SSDBG( descP, ("SOCKET", "nrecv -> entry with"
+ "\r\n len: %d (%d:%d)"
+ "\r\n flags: %d"
+ "\r\n", len, descP->rNumCnt, bufSz, flags) );
+
+ if (!descP->isReadable)
+ return enif_make_badarg(env);
+
+ /* Check if there is already a current reader and if its us */
+ if (!recv_check_reader(env, descP, recvRef, &readerCheck))
+ return readerCheck;
+
+ /* Allocate a buffer:
+ * Either as much as we want to read or (if zero (0)) use the "default"
+ * size (what has been configured).
+ */
+ if (!ALLOC_BIN(bufSz, &buf))
+ return esock_make_error(env, atom_exalloc);
+
+ /* We ignore the wrap for the moment.
+ * Maybe we should issue a wrap-message to controlling process...
+ */
+ cnt_inc(&descP->readTries, 1);
+
+ // If it fails (read = -1), we need errno...
+ SSDBG( descP, ("SOCKET", "nrecv -> try read (%d)\r\n", buf.size) );
+ read = sock_recv(descP->sock, buf.data, buf.size, flags);
+ if (IS_SOCKET_ERROR(read)) {
+ save_errno = sock_errno();
+ } else {
+ save_errno = -1; // The value does not actually matter in this case
+ }
+
+ SSDBG( descP, ("SOCKET", "nrecv -> read: %d (%d)\r\n", read, save_errno) );
+
+ return recv_check_result(env, descP,
+ read, len,
+ save_errno,
+ &buf,
+ sockRef,
+ recvRef);
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_recvfrom
+ *
+ * Description:
+ * Receive a message on a socket.
+ * Normally used only on a (un-) connected socket!
+ * If a buffer size = 0 is specified, then the we will use the default
+ * buffer size for this socket (whatever has been configured).
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * RecvRef - A unique id for this (send) request.
+ * BufSz - Size of the buffer into which we put the received message.
+ * Flags - Receive flags.
+ *
+ * <KOLLA>
+ *
+ * How do we handle if the peek flag is set? We need to basically keep
+ * track of if we expect any data from the read. Regardless of the
+ * number of bytes we try to read.
+ *
+ * </KOLLA>
+ */
+
+static
+ERL_NIF_TERM nif_recvfrom(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM sockRef, recvRef;
+ unsigned int bufSz;
+ unsigned int eflags;
+ int flags;
+ ERL_NIF_TERM res;
+
+ SGDBG( ("SOCKET", "nif_recvfrom -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 4) ||
+ !GET_UINT(env, argv[2], &bufSz) ||
+ !GET_UINT(env, argv[3], &eflags)) {
+ return enif_make_badarg(env);
+ }
+ sockRef = argv[0]; // We need this in case we send in case we send abort
+ recvRef = argv[1];
+
+ if (!enif_get_resource(env, sockRef, sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nif_recvfrom -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n recvRef: %T"
+ "\r\n bufSz: %d"
+ "\r\n eflags: %d"
+ "\r\n", descP->sock, argv[0], recvRef, bufSz, eflags) );
+
+ /* if (IS_OPEN(descP)) */
+ /* return esock_make_error(env, atom_enotconn); */
+
+ if (!erecvflags2recvflags(eflags, &flags)) {
+ SSDBG( descP, ("SOCKET", "nif_recvfrom -> recvflags decode failed\r\n") );
+ return enif_make_badarg(env);
+ }
+
+ MLOCK(descP->readMtx);
+
+ /* <KOLLA>
+ * We need to handle the case when another process tries
+ * to receive at the same time.
+ * If the current recv could not read its entire package
+ * this time (resulting in an select). The read of the
+ * other process must be made to wait until current
+ * is done!
+ * Basically, we need a read queue!
+ *
+ * A 'reading' field (boolean), which is set if we did
+ * not manage to read the entire message and reset every
+ * time we do.
+ * </KOLLA>
+ */
+
+ res = nrecvfrom(env, descP, sockRef, recvRef, bufSz, flags);
+
+ MUNLOCK(descP->readMtx);
+
+ return res;
+#endif // if defined(__WIN32__)
+}
+
+
+/* The (read) buffer handling *must* be optimized!
+ * But for now we make it easy for ourselves by
+ * allocating a binary (of the specified or default
+ * size) and then throwing it away...
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nrecvfrom(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef,
+ Uint16 len,
+ int flags)
+{
+ SocketAddress fromAddr;
+ unsigned int addrLen;
+ ssize_t read;
+ int save_errno;
+ ErlNifBinary buf;
+ ERL_NIF_TERM readerCheck;
+ int bufSz = (len ? len : descP->rBufSz);
+
+ SSDBG( descP, ("SOCKET", "nrecvfrom -> entry with"
+ "\r\n len: %d (%d)"
+ "\r\n flags: %d"
+ "\r\n", len, bufSz, flags) );
+
+ if (!descP->isReadable)
+ return enif_make_badarg(env);
+
+ /* Check if there is already a current reader and if its us */
+ if (!recv_check_reader(env, descP, recvRef, &readerCheck))
+ return readerCheck;
+
+ /* Allocate a buffer:
+ * Either as much as we want to read or (if zero (0)) use the "default"
+ * size (what has been configured).
+ */
+ if (!ALLOC_BIN(bufSz, &buf))
+ return esock_make_error(env, atom_exalloc);
+
+ /* We ignore the wrap for the moment.
+ * Maybe we should issue a wrap-message to controlling process...
+ */
+ cnt_inc(&descP->readTries, 1);
+
+ addrLen = sizeof(fromAddr);
+ sys_memzero((char*) &fromAddr, addrLen);
+
+ read = sock_recvfrom(descP->sock, buf.data, buf.size, flags,
+ &fromAddr.sa, &addrLen);
+ if (IS_SOCKET_ERROR(read))
+ save_errno = sock_errno();
+ else
+ save_errno = -1; // The value does not actually matter in this case
+
+ return recvfrom_check_result(env, descP,
+ read,
+ save_errno,
+ &buf,
+ &fromAddr, addrLen,
+ sockRef,
+ recvRef);
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_recvmsg
+ *
+ * Description:
+ * Receive a message on a socket.
+ * Normally used only on a (un-) connected socket!
+ * If a buffer size = 0 is specified, then we will use the default
+ * buffer size for this socket (whatever has been configured).
+ * If ctrl (buffer) size = 0 is specified, then the default ctrl
+ * (buffer) size is used (1024).
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * RecvRef - A unique id for this (send) request.
+ * BufSz - Size of the buffer into which we put the received message.
+ * CtrlSz - Size of the ctrl (buffer) into which we put the received
+ * ancillary data.
+ * Flags - Receive flags.
+ *
+ * <KOLLA>
+ *
+ * How do we handle if the peek flag is set? We need to basically keep
+ * track of if we expect any data from the read. Regardless of the
+ * number of bytes we try to read.
+ *
+ * </KOLLA>
+ */
+
+static
+ERL_NIF_TERM nif_recvmsg(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM sockRef, recvRef;
+ unsigned int bufSz;
+ unsigned int ctrlSz;
+ unsigned int eflags;
+ int flags;
+ ERL_NIF_TERM res;
+
+ SGDBG( ("SOCKET", "nif_recvmsg -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 5) ||
+ !GET_UINT(env, argv[2], &bufSz) ||
+ !GET_UINT(env, argv[3], &ctrlSz) ||
+ !GET_UINT(env, argv[4], &eflags)) {
+ return enif_make_badarg(env);
+ }
+ sockRef = argv[0]; // We need this in case we send in case we send abort
+ recvRef = argv[1];
+
+ if (!enif_get_resource(env, sockRef, sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nif_recvmsg -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n recvRef: %T"
+ "\r\n bufSz: %d"
+ "\r\n ctrlSz: %d"
+ "\r\n eflags: %d"
+ "\r\n", descP->sock, argv[0], recvRef, bufSz, ctrlSz, eflags) );
+
+ /* if (IS_OPEN(descP)) */
+ /* return esock_make_error(env, atom_enotconn); */
+
+ if (!erecvflags2recvflags(eflags, &flags))
+ return enif_make_badarg(env);
+
+ MLOCK(descP->readMtx);
+
+ /* <KOLLA>
+ *
+ * We need to handle the case when another process tries
+ * to receive at the same time.
+ * If the current recv could not read its entire package
+ * this time (resulting in an select). The read of the
+ * other process must be made to wait until current
+ * is done!
+ * Basically, we need a read queue!
+ *
+ * A 'reading' field (boolean), which is set if we did
+ * not manage to read the entire message and reset every
+ * time we do.
+ *
+ * </KOLLA>
+ */
+
+ res = nrecvmsg(env, descP, sockRef, recvRef, bufSz, ctrlSz, flags);
+
+ MUNLOCK(descP->readMtx);
+
+ return res;
+#endif // if defined(__WIN32__)
+}
+
+
+/* The (read) buffer handling *must* be optimized!
+ * But for now we make it easy for ourselves by
+ * allocating a binary (of the specified or default
+ * size) and then throwing it away...
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nrecvmsg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef,
+ Uint16 bufLen,
+ Uint16 ctrlLen,
+ int flags)
+{
+ unsigned int addrLen;
+ ssize_t read;
+ int save_errno;
+ int bufSz = (bufLen ? bufLen : descP->rBufSz);
+ int ctrlSz = (ctrlLen ? ctrlLen : descP->rCtrlSz);
+ struct msghdr msgHdr;
+ struct iovec iov[1]; // Shall we always use 1?
+ ErlNifBinary data[1]; // Shall we always use 1?
+ ErlNifBinary ctrl;
+ ERL_NIF_TERM readerCheck;
+ SocketAddress addr;
+
+ SSDBG( descP, ("SOCKET", "nrecvmsg -> entry with"
+ "\r\n bufSz: %d (%d)"
+ "\r\n ctrlSz: %d (%d)"
+ "\r\n flags: %d"
+ "\r\n", bufSz, bufLen, ctrlSz, ctrlLen, flags) );
+
+ if (!descP->isReadable)
+ return enif_make_badarg(env);
+
+ /* Check if there is already a current reader and if its us */
+ if (!recv_check_reader(env, descP, recvRef, &readerCheck))
+ return readerCheck;
+
+ /*
+ for (i = 0; i < sizeof(buf); i++) {
+ if (!ALLOC_BIN(bifSz, &buf[i]))
+ return esock_make_error(env, atom_exalloc);
+ iov[i].iov_base = buf[i].data;
+ iov[i].iov_len = buf[i].size;
+ }
+ */
+
+ /* Allocate the (msg) data buffer:
+ */
+ if (!ALLOC_BIN(bufSz, &data[0]))
+ return esock_make_error(env, atom_exalloc);
+
+ /* Allocate the ctrl (buffer):
+ */
+ if (!ALLOC_BIN(ctrlSz, &ctrl))
+ return esock_make_error(env, atom_exalloc);
+
+ /* We ignore the wrap for the moment.
+ * Maybe we should issue a wrap-message to controlling process...
+ */
+ cnt_inc(&descP->readTries, 1);
+
+ addrLen = sizeof(addr);
+ sys_memzero((char*) &addr, addrLen);
+ sys_memzero((char*) &msgHdr, sizeof(msgHdr));
+
+ iov[0].iov_base = data[0].data;
+ iov[0].iov_len = data[0].size;
+
+ msgHdr.msg_name = &addr;
+ msgHdr.msg_namelen = addrLen;
+ msgHdr.msg_iov = iov;
+ msgHdr.msg_iovlen = 1; // Should use a constant or calculate...
+ msgHdr.msg_control = ctrl.data;
+ msgHdr.msg_controllen = ctrl.size;
+
+ read = sock_recvmsg(descP->sock, &msgHdr, flags);
+ if (IS_SOCKET_ERROR(read))
+ save_errno = sock_errno();
+ else
+ save_errno = -1; // The value does not actually matter in this case
+
+ return recvmsg_check_result(env, descP,
+ read,
+ save_errno,
+ &msgHdr,
+ data, // Needed for iov encode
+ &ctrl, // Needed for ctrl header encode
+ sockRef,
+ recvRef);
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_close
+ *
+ * Description:
+ * Close a (socket) file descriptor.
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ */
+
+static
+ERL_NIF_TERM nif_close(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+
+ if ((argc != 1) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ return nclose(env, descP);
+#endif // if defined(__WIN32__)
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nclose(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM reply, reason;
+ BOOLEAN_T doClose;
+ int selectRes;
+ int domain = descP->domain;
+ int type = descP->type;
+ int protocol = descP->protocol;
+
+ SSDBG( descP, ("SOCKET",
+ "nclose -> [%d] entry (0x%lX, 0x%lX, 0x%lX, 0x%lX)\r\n",
+ descP->sock,
+ descP->state,
+ descP->currentWriterP,
+ descP->currentReaderP,
+ descP->currentAcceptorP) );
+
+ MLOCK(descP->closeMtx);
+
+ if (descP->state == SOCKET_STATE_CLOSED) {
+ reason = atom_closed;
+ doClose = FALSE;
+ } else if (descP->state == SOCKET_STATE_CLOSING) {
+ reason = atom_closing;
+ doClose = FALSE;
+ } else {
+
+ /* Store the PID of the caller,
+ * since we need to inform it when we
+ * (that is, the stop callback function)
+ * completes.
+ */
+
+ if (enif_self(env, &descP->closerPid) == NULL) {
+ MUNLOCK(descP->closeMtx);
+ return esock_make_error(env, atom_exself);
+ }
+
+ /* Monitor the caller, since we should complete this operation even if
+ * the caller dies (for whatever reason).
+ *
+ * <KOLLA>
+ *
+ * Can we actiually use this for anything?
+ *
+ * </KOLLA>
+ */
+
+ if (MONP("nclose -> closer",
+ env, descP,
+ &descP->closerPid,
+ &descP->closerMon) != 0) {
+ MUNLOCK(descP->closeMtx);
+ return esock_make_error(env, atom_exmon);
+ }
+
+ descP->closeLocal = TRUE;
+ descP->state = SOCKET_STATE_CLOSING;
+ descP->isReadable = FALSE;
+ descP->isWritable = FALSE;
+ doClose = TRUE;
+ }
+
+ if (doClose) {
+ descP->closeEnv = enif_alloc_env();
+ descP->closeRef = MKREF(descP->closeEnv);
+ selectRes = esock_select_stop(env, descP->sock, descP);
+ if (selectRes & ERL_NIF_SELECT_STOP_CALLED) {
+ /* Prep done - inform the caller it can finalize (close) directly */
+ SSDBG( descP,
+ ("SOCKET", "nclose -> [%d] stop was called\r\n", descP->sock) );
+ dec_socket(domain, type, protocol);
+ reply = esock_atom_ok;
+ } else if (selectRes & ERL_NIF_SELECT_STOP_SCHEDULED) {
+ /* The stop callback function has been *scheduled* which means that we
+ * have to wait for it to complete. */
+ SSDBG( descP,
+ ("SOCKET", "nclose -> [%d] stop was scheduled\r\n",
+ descP->sock) );
+ dec_socket(domain, type, protocol); // SHALL WE DO THIS AT finalize?
+ reply = esock_make_ok2(env, descP->closeRef);
+ } else {
+
+ SSDBG( descP,
+ ("SOCKET", "nclose -> [%d] stop failed: %d\r\n",
+ descP->sock, selectRes) );
+
+ /* <KOLLA>
+ *
+ * WE SHOULD REALLY HAVE A WAY TO CLOBBER THE SOCKET,
+ * SO WE DON'T LET STUFF LEAK.
+ * NOW, BECAUSE WE FAILED TO SELECT, WE CANNOT FINISH
+ * THE CLOSE, WHAT TO DO? ABORT?
+ *
+ * </KOLLA>
+ */
+
+ // No point in having this?
+ DEMONP("nclose -> closer", env, descP, &descP->closerMon);
+
+ reason = MKT2(env, atom_select, MKI(env, selectRes));
+ reply = esock_make_error(env, reason);
+ }
+
+ } else {
+ reply = esock_make_error(env, reason);
+ }
+
+ MUNLOCK(descP->closeMtx);
+
+ SSDBG( descP,
+ ("SOCKET", "nclose -> [%d] done when: "
+ "\r\n state: 0x%lX"
+ "\r\n reply: %T"
+ "\r\n", descP->sock, descP->state, reply) );
+
+ return reply;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_finalize_close
+ *
+ * Description:
+ * Perform the actual socket close!
+ * Note that this function is executed in a dirty scheduler.
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ */
+static
+ERL_NIF_TERM nif_finalize_close(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 1) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ return nfinalize_close(env, descP);
+#endif // if defined(__WIN32__)
+}
+
+
+/* *** nfinalize_close ***
+ * Perform the final step in the socket close.
+ */
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nfinalize_close(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM reply;
+
+ if (IS_CLOSED(descP))
+ return esock_atom_ok;
+
+ if (!IS_CLOSING(descP))
+ return esock_make_error(env, atom_enotclosing);
+
+ /* This nif is executed in a dirty scheduler just so that
+ * it can "hang" (whith minumum effect on the VM) while the
+ * kernel writes our buffers. IF we have set the linger option
+ * for this ({true, integer() > 0}). For this to work we must
+ * be blocking...
+ */
+ SET_BLOCKING(descP->sock);
+
+ if (sock_close(descP->sock) != 0) {
+ int save_errno = sock_errno();
+
+ if (save_errno != ERRNO_BLOCK) {
+ /* Not all data in the buffers where sent,
+ * make sure the caller gets this.
+ */
+ reply = esock_make_error(env, atom_timeout);
+ } else {
+ reply = esock_make_error_errno(env, save_errno);
+ }
+ } else {
+ reply = esock_atom_ok;
+ }
+ sock_close_event(descP->event);
+
+ descP->sock = INVALID_SOCKET;
+ descP->event = INVALID_EVENT;
+
+ descP->state = SOCKET_STATE_CLOSED;
+
+ return reply;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_shutdown
+ *
+ * Description:
+ * Disable sends and/or receives on a socket.
+ *
+ * Arguments:
+ * [0] Socket (ref) - Points to the socket descriptor.
+ * [1] How - What will be shutdown.
+ */
+
+static
+ERL_NIF_TERM nif_shutdown(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ unsigned int ehow;
+ int how;
+
+ if ((argc != 2) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP) ||
+ !GET_UINT(env, argv[1], &ehow)) {
+ return enif_make_badarg(env);
+ }
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ if (!ehow2how(ehow, &how))
+ return enif_make_badarg(env);
+
+ return nshutdown(env, descP, how);
+#endif // if defined(__WIN32__)
+}
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nshutdown(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int how)
+{
+ ERL_NIF_TERM reply;
+
+ if (sock_shutdown(descP->sock, how) == 0) {
+ switch (how) {
+ case SHUT_RD:
+ descP->isReadable = FALSE;
+ break;
+ case SHUT_WR:
+ descP->isWritable = FALSE;
+ break;
+ case SHUT_RDWR:
+ descP->isReadable = FALSE;
+ descP->isWritable = FALSE;
+ break;
+ }
+ reply = esock_atom_ok;
+ } else {
+ reply = esock_make_error_errno(env, sock_errno());
+ }
+
+ return reply;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_setopt
+ *
+ * Description:
+ * Set socket option.
+ * Its possible to use a "raw" mode (not encoded). That is, we do not
+ * interpret level, opt and value. They are passed "as is" to the
+ * setsockopt function call (the value arguments is assumed to be a
+ * binary, already encoded).
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * Encoded - Are the "arguments" encoded or not.
+ * Level - Level of the socket option.
+ * Opt - The socket option.
+ * Value - Value of the socket option (type depend on the option).
+ */
+
+static
+ERL_NIF_TERM nif_setopt(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP = NULL;
+ int eLevel, level = -1;
+ int eOpt;
+ ERL_NIF_TERM eIsEncoded;
+ ERL_NIF_TERM eVal;
+ BOOLEAN_T isEncoded, isOTP;
+ ERL_NIF_TERM result;
+
+ SGDBG( ("SOCKET", "nif_setopt -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 5) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP) ||
+ !GET_INT(env, argv[2], &eLevel) ||
+ !GET_INT(env, argv[3], &eOpt)) {
+ SGDBG( ("SOCKET", "nif_setopt -> failed initial arg check\r\n") );
+ return enif_make_badarg(env);
+ }
+ eIsEncoded = argv[1];
+ eVal = argv[4];
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ isEncoded = esock_decode_bool(eIsEncoded);
+
+ /* SGDBG( ("SOCKET", "nif_setopt -> eIsDecoded (%T) decoded: %d\r\n", */
+ /* eIsEncoded, isEncoded) ); */
+
+ if (!elevel2level(isEncoded, eLevel, &isOTP, &level)) {
+ SSDBG( descP, ("SOCKET", "nif_seopt -> failed decode level\r\n") );
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nif_setopt -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n Encoded: %d (%T)"
+ "\r\n Level: %d (%d)"
+ "\r\n Opt: %d"
+ "\r\n Value: %T"
+ "\r\n",
+ descP->sock, argv[0],
+ isEncoded, eIsEncoded,
+ level, eLevel,
+ eOpt, eVal) );
+
+ result = nsetopt(env, descP, isEncoded, isOTP, level, eOpt, eVal);
+
+ SSDBG( descP,
+ ("SOCKET", "nif_setopt -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+#endif // if defined(__WIN32__)
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsetopt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ BOOLEAN_T isEncoded,
+ BOOLEAN_T isOTP,
+ int level,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ if (isOTP) {
+ /* These are not actual socket options,
+ * but options for our implementation.
+ */
+ result = nsetopt_otp(env, descP, eOpt, eVal);
+ } else if (!isEncoded) {
+ result = nsetopt_native(env, descP, level, eOpt, eVal);
+ } else {
+ result = nsetopt_level(env, descP, level, eOpt, eVal);
+ }
+
+ return result;
+}
+
+
+
+/* nsetopt_otp - Handle OTP (level) options
+ */
+static
+ERL_NIF_TERM nsetopt_otp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_otp -> entry with"
+ "\r\n eOpt: %d"
+ "\r\n eVal: %T"
+ "\r\n", eOpt, eVal) );
+
+ switch (eOpt) {
+ case SOCKET_OPT_OTP_DEBUG:
+ result = nsetopt_otp_debug(env, descP, eVal);
+ break;
+
+ case SOCKET_OPT_OTP_IOW:
+ result = nsetopt_otp_iow(env, descP, eVal);
+ break;
+
+ case SOCKET_OPT_OTP_CTRL_PROC:
+ result = nsetopt_otp_ctrl_proc(env, descP, eVal);
+ break;
+
+ case SOCKET_OPT_OTP_RCVBUF:
+ result = nsetopt_otp_rcvbuf(env, descP, eVal);
+ break;
+
+ case SOCKET_OPT_OTP_RCVCTRLBUF:
+ result = nsetopt_otp_rcvctrlbuf(env, descP, eVal);
+ break;
+
+ case SOCKET_OPT_OTP_SNDCTRLBUF:
+ result = nsetopt_otp_sndctrlbuf(env, descP, eVal);
+ break;
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return result;
+}
+
+
+/* nsetopt_otp_debug - Handle the OTP (level) debug options
+ */
+static
+ERL_NIF_TERM nsetopt_otp_debug(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ descP->dbg = esock_decode_bool(eVal);
+
+ return esock_atom_ok;
+}
+
+
+/* nsetopt_otp_iow - Handle the OTP (level) iow options
+ */
+static
+ERL_NIF_TERM nsetopt_otp_iow(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ descP->iow = esock_decode_bool(eVal);
+
+ return esock_atom_ok;
+}
+
+
+
+/* nsetopt_otp_ctrl_proc - Handle the OTP (level) controlling_process options
+ */
+static
+ERL_NIF_TERM nsetopt_otp_ctrl_proc(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ErlNifPid caller, newCtrlPid;
+ // ErlNifMonitor newCtrlMon;
+ ESockMonitor newCtrlMon;
+ int xres;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_otp_ctrl_proc -> entry with"
+ "\r\n eVal: %T"
+ "\r\n", eVal) );
+
+ /* Before we begin, ensure that caller is (current) controlling-process */
+ if (enif_self(env, &caller) == NULL)
+ return esock_make_error(env, atom_exself);
+
+ if (COMPARE_PIDS(&descP->ctrlPid, &caller) != 0) {
+ SSDBG( descP, ("SOCKET", "nsetopt_otp_ctrl_proc -> not owner (%T)\r\n",
+ descP->ctrlPid) );
+ return esock_make_error(env, esock_atom_not_owner);
+ }
+
+ if (!GET_LPID(env, eVal, &newCtrlPid)) {
+ esock_warning_msg("Failed get pid of new controlling process\r\n");
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ if ((xres = MONP("nsetopt_otp_ctrl_proc -> (new) ctrl",
+ env, descP, &newCtrlPid, &newCtrlMon)) != 0) {
+ esock_warning_msg("Failed monitor %d) (new) controlling process\r\n", xres);
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ if ((xres = DEMONP("nsetopt_otp_ctrl_proc -> (old) ctrl",
+ env, descP, &descP->ctrlMon)) != 0) {
+ esock_warning_msg("Failed demonitor (%d) "
+ "old controlling process %T (%T)\r\n",
+ xres, descP->ctrlPid, descP->ctrlMon);
+ }
+
+ descP->ctrlPid = newCtrlPid;
+ descP->ctrlMon = newCtrlMon;
+
+ SSDBG( descP, ("SOCKET", "nsetopt_otp_ctrl_proc -> done\r\n") );
+
+ return esock_atom_ok;
+}
+
+
+
+/* nsetopt_otp_rcvbuf - Handle the OTP (level) rcvbuf option
+ * The (otp) rcvbuf option is provided as:
+ *
+ * BufSz :: integer() | {N :: pos_integer(), BufSz :: pod_integer()}
+ *
+ * Where N is the max number of reads.
+ */
+static
+ERL_NIF_TERM nsetopt_otp_rcvbuf(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ const ERL_NIF_TERM* t; // The array of the elements of the tuple
+ int tsz; // The size of the tuple - should be 2
+ unsigned int n;
+ size_t bufSz;
+ char* xres;
+
+ if (IS_NUM(env, eVal)) {
+
+ /* This will have the effect that the buffer size will be
+ * reported as an integer (getopt).
+ */
+ n = 0;
+
+ if ((xres = esock_decode_bufsz(env,
+ eVal,
+ SOCKET_RECV_BUFFER_SIZE_DEFAULT,
+ &bufSz)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ } else if (IS_TUPLE(env, eVal)) {
+
+ if (!GET_TUPLE(env, eVal, &tsz, &t))
+ return enif_make_badarg(env); // We should use a "proper" error value...
+
+ if (tsz != 2)
+ return enif_make_badarg(env); // We should use a "proper" error value...
+
+ if (!GET_UINT(env, t[0], &n))
+ return enif_make_badarg(env); // We should use a "proper" error value...
+
+ if ((xres = esock_decode_bufsz(env,
+ t[1],
+ SOCKET_RECV_BUFFER_SIZE_DEFAULT,
+ &bufSz)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ } else {
+ return enif_make_badarg(env); // We should use a "proper" error value...
+ }
+
+ descP->rNum = n;
+ descP->rBufSz = bufSz;
+
+ return esock_atom_ok;
+}
+
+
+
+/* nsetopt_otp_rcvctrlbuf - Handle the OTP (level) rcvctrlbuf option
+ */
+static
+ERL_NIF_TERM nsetopt_otp_rcvctrlbuf(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ size_t val;
+ char* xres;
+
+ if ((xres = esock_decode_bufsz(env,
+ eVal,
+ SOCKET_RECV_CTRL_BUFFER_SIZE_DEFAULT,
+ &val)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ descP->rCtrlSz = val;
+
+ return esock_atom_ok;
+}
+
+
+
+/* nsetopt_otp_sndctrlbuf - Handle the OTP (level) sndctrlbuf option
+ */
+static
+ERL_NIF_TERM nsetopt_otp_sndctrlbuf(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ size_t val;
+ char* xres;
+
+ if ((xres = esock_decode_bufsz(env,
+ eVal,
+ SOCKET_SEND_CTRL_BUFFER_SIZE_DEFAULT,
+ &val)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ descP->wCtrlSz = val;
+
+ return esock_atom_ok;
+}
+
+
+
+/* The option has *not* been encoded. Instead it has been provided
+ * in "native mode" (option is provided as is and value as a binary).
+ */
+static
+ERL_NIF_TERM nsetopt_native(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ ERL_NIF_TERM eVal)
+{
+ ErlNifBinary val;
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_native -> entry with"
+ "\r\n level: %d"
+ "\r\n opt: %d"
+ "\r\n eVal: %T"
+ "\r\n", level, opt, eVal) );
+
+ if (GET_BIN(env, eVal, &val)) {
+ int res = socket_setopt(descP->sock, level, opt,
+ val.data, val.size);
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+ } else {
+ result = esock_make_error(env, esock_atom_einval);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_native -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+
+/* nsetopt_level - A "proper" level (option) has been specified
+ */
+static
+ERL_NIF_TERM nsetopt_level(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_level -> entry with"
+ "\r\n level: %d"
+ "\r\n", level) );
+
+ switch (level) {
+ case SOL_SOCKET:
+ result = nsetopt_lvl_socket(env, descP, eOpt, eVal);
+ break;
+
+#if defined(SOL_IP)
+ case SOL_IP:
+#else
+ case IPPROTO_IP:
+#endif
+ result = nsetopt_lvl_ip(env, descP, eOpt, eVal);
+ break;
+
+#if defined(HAVE_IPV6)
+#if defined(SOL_IPV6)
+ case SOL_IPV6:
+#else
+ case IPPROTO_IPV6:
+#endif
+ result = nsetopt_lvl_ipv6(env, descP, eOpt, eVal);
+ break;
+#endif
+
+ case IPPROTO_TCP:
+ result = nsetopt_lvl_tcp(env, descP, eOpt, eVal);
+ break;
+
+ case IPPROTO_UDP:
+ result = nsetopt_lvl_udp(env, descP, eOpt, eVal);
+ break;
+
+#if defined(HAVE_SCTP)
+ case IPPROTO_SCTP:
+ result = nsetopt_lvl_sctp(env, descP, eOpt, eVal);
+ break;
+#endif
+
+ default:
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_level -> unknown level (%d)\r\n", level) );
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_level -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+
+/* nsetopt_lvl_socket - Level *SOCKET* option
+ */
+static
+ERL_NIF_TERM nsetopt_lvl_socket(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_socket -> entry with"
+ "\r\n opt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(SO_BINDTODEVICE)
+ case SOCKET_OPT_SOCK_BINDTODEVICE:
+ result = nsetopt_lvl_sock_bindtodevice(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_BROADCAST)
+ case SOCKET_OPT_SOCK_BROADCAST:
+ result = nsetopt_lvl_sock_broadcast(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_DEBUG)
+ case SOCKET_OPT_SOCK_DEBUG:
+ result = nsetopt_lvl_sock_debug(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_DONTROUTE)
+ case SOCKET_OPT_SOCK_DONTROUTE:
+ result = nsetopt_lvl_sock_dontroute(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_KEEPALIVE)
+ case SOCKET_OPT_SOCK_KEEPALIVE:
+ result = nsetopt_lvl_sock_keepalive(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_LINGER)
+ case SOCKET_OPT_SOCK_LINGER:
+ result = nsetopt_lvl_sock_linger(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_PEEK_OFF)
+ case SOCKET_OPT_SOCK_PEEK_OFF:
+ result = nsetopt_lvl_sock_peek_off(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_OOBINLINE)
+ case SOCKET_OPT_SOCK_OOBINLINE:
+ result = nsetopt_lvl_sock_oobinline(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_PRIORITY)
+ case SOCKET_OPT_SOCK_PRIORITY:
+ result = nsetopt_lvl_sock_priority(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_RCVBUF)
+ case SOCKET_OPT_SOCK_RCVBUF:
+ result = nsetopt_lvl_sock_rcvbuf(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_RCVLOWAT)
+ case SOCKET_OPT_SOCK_RCVLOWAT:
+ result = nsetopt_lvl_sock_rcvlowat(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_RCVTIMEO)
+ case SOCKET_OPT_SOCK_RCVTIMEO:
+ result = nsetopt_lvl_sock_rcvtimeo(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_REUSEADDR)
+ case SOCKET_OPT_SOCK_REUSEADDR:
+ result = nsetopt_lvl_sock_reuseaddr(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_REUSEPORT)
+ case SOCKET_OPT_SOCK_REUSEPORT:
+ result = nsetopt_lvl_sock_reuseport(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_SNDBUF)
+ case SOCKET_OPT_SOCK_SNDBUF:
+ result = nsetopt_lvl_sock_sndbuf(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_SNDLOWAT)
+ case SOCKET_OPT_SOCK_SNDLOWAT:
+ result = nsetopt_lvl_sock_sndlowat(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_SNDTIMEO)
+ case SOCKET_OPT_SOCK_SNDTIMEO:
+ result = nsetopt_lvl_sock_sndtimeo(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SO_TIMESTAMP)
+ case SOCKET_OPT_SOCK_TIMESTAMP:
+ result = nsetopt_lvl_sock_timestamp(env, descP, eVal);
+ break;
+#endif
+
+ default:
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_socket -> unknown opt (%d)\r\n", eOpt) );
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_socket -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+#if defined(SO_BINDTODEVICE)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_bindtodevice(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_str_opt(env, descP,
+ SOL_SOCKET, SO_BROADCAST,
+ IFNAMSIZ, eVal);
+}
+#endif
+
+
+#if defined(SO_BROADCAST)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_broadcast(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_BROADCAST, eVal);
+}
+#endif
+
+
+#if defined(SO_DEBUG)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_debug(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_DEBUG, eVal);
+}
+#endif
+
+
+#if defined(SO_DONTROUTE)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_dontroute(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_DONTROUTE, eVal);
+}
+#endif
+
+
+#if defined(SO_KEEPALIVE)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_keepalive(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_KEEPALIVE, eVal);
+}
+#endif
+
+
+#if defined(SO_LINGER)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_linger(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ struct linger val;
+
+ if (decode_sock_linger(env, eVal, &val)) {
+ int optLen = sizeof(val);
+ int res = socket_setopt(descP->sock, SOL_SOCKET, SO_LINGER,
+ (void*) &val, optLen);
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+ } else {
+ result = esock_make_error(env, esock_atom_einval);
+ }
+
+ return result;
+}
+#endif
+
+
+#if defined(SO_OOBINLINE)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_oobinline(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_OOBINLINE, eVal);
+}
+#endif
+
+
+#if defined(SO_PEEK_OFF)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_peek_off(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_PEEK_OFF, eVal);
+}
+#endif
+
+
+#if defined(SO_PRIORITY)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_priority(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_PRIORITY, eVal);
+}
+#endif
+
+
+#if defined(SO_RCVBUF)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_rcvbuf(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_RCVBUF, eVal);
+}
+#endif
+
+
+#if defined(SO_RCVLOWAT)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_rcvlowat(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_RCVLOWAT, eVal);
+}
+#endif
+
+
+#if defined(SO_RCVTIMEO)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_rcvtimeo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_timeval_opt(env, descP, SOL_SOCKET, SO_RCVTIMEO, eVal);
+}
+#endif
+
+
+#if defined(SO_REUSEADDR)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_reuseaddr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_REUSEADDR, eVal);
+}
+#endif
+
+
+#if defined(SO_REUSEPORT)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_reuseport(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_REUSEPORT, eVal);
+}
+#endif
+
+
+#if defined(SO_SNDBUF)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_sndbuf(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_SNDBUF, eVal);
+}
+#endif
+
+
+#if defined(SO_SNDLOWAT)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_sndlowat(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, SOL_SOCKET, SO_SNDLOWAT, eVal);
+}
+#endif
+
+
+#if defined(SO_SNDTIMEO)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_sndtimeo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sock_sndtimeo -> entry with"
+ "\r\n eVal: %T"
+ "\r\n", eVal) );
+
+ return nsetopt_timeval_opt(env, descP, SOL_SOCKET, SO_SNDTIMEO, eVal);
+}
+#endif
+
+
+#if defined(SO_TIMESTAMP)
+static
+ERL_NIF_TERM nsetopt_lvl_sock_timestamp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, SOL_SOCKET, SO_TIMESTAMP, eVal);
+}
+#endif
+
+
+
+/* nsetopt_lvl_ip - Level *IP* option(s)
+ */
+static
+ERL_NIF_TERM nsetopt_lvl_ip(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_ip -> entry with"
+ "\r\n opt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(IP_ADD_MEMBERSHIP)
+ case SOCKET_OPT_IP_ADD_MEMBERSHIP:
+ result = nsetopt_lvl_ip_add_membership(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_ADD_SOURCE_MEMBERSHIP)
+ case SOCKET_OPT_IP_ADD_SOURCE_MEMBERSHIP:
+ result = nsetopt_lvl_ip_add_source_membership(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_BLOCK_SOURCE)
+ case SOCKET_OPT_IP_BLOCK_SOURCE:
+ result = nsetopt_lvl_ip_block_source(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_DROP_MEMBERSHIP)
+ case SOCKET_OPT_IP_DROP_MEMBERSHIP:
+ result = nsetopt_lvl_ip_drop_membership(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_DROP_SOURCE_MEMBERSHIP)
+ case SOCKET_OPT_IP_DROP_SOURCE_MEMBERSHIP:
+ result = nsetopt_lvl_ip_drop_source_membership(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_FREEBIND)
+ case SOCKET_OPT_IP_FREEBIND:
+ result = nsetopt_lvl_ip_freebind(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_HDRINCL)
+ case SOCKET_OPT_IP_HDRINCL:
+ result = nsetopt_lvl_ip_hdrincl(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_MINTTL)
+ case SOCKET_OPT_IP_MINTTL:
+ result = nsetopt_lvl_ip_minttl(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_MSFILTER) && defined(IP_MSFILTER_SIZE)
+ case SOCKET_OPT_IP_MSFILTER:
+ result = nsetopt_lvl_ip_msfilter(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_MTU_DISCOVER)
+ case SOCKET_OPT_IP_MTU_DISCOVER:
+ result = nsetopt_lvl_ip_mtu_discover(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_MULTICAST_ALL)
+ case SOCKET_OPT_IP_MULTICAST_ALL:
+ result = nsetopt_lvl_ip_multicast_all(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_MULTICAST_IF)
+ case SOCKET_OPT_IP_MULTICAST_IF:
+ result = nsetopt_lvl_ip_multicast_if(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_MULTICAST_LOOP)
+ case SOCKET_OPT_IP_MULTICAST_LOOP:
+ result = nsetopt_lvl_ip_multicast_loop(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_MULTICAST_TTL)
+ case SOCKET_OPT_IP_MULTICAST_TTL:
+ result = nsetopt_lvl_ip_multicast_ttl(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_NODEFRAG)
+ case SOCKET_OPT_IP_NODEFRAG:
+ result = nsetopt_lvl_ip_nodefrag(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_PKTINFO)
+ case SOCKET_OPT_IP_PKTINFO:
+ result = nsetopt_lvl_ip_pktinfo(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_RECVDSTADDR)
+ case SOCKET_OPT_IP_RECVDSTADDR:
+ result = nsetopt_lvl_ip_recvdstaddr(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_RECVERR)
+ case SOCKET_OPT_IP_RECVERR:
+ result = nsetopt_lvl_ip_recverr(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_RECVIF)
+ case SOCKET_OPT_IP_RECVIF:
+ result = nsetopt_lvl_ip_recvif(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_RECVOPTS)
+ case SOCKET_OPT_IP_RECVOPTS:
+ result = nsetopt_lvl_ip_recvopts(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_RECVORIGDSTADDR)
+ case SOCKET_OPT_IP_RECVORIGDSTADDR:
+ result = nsetopt_lvl_ip_recvorigdstaddr(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_RECVTOS)
+ case SOCKET_OPT_IP_RECVTOS:
+ result = nsetopt_lvl_ip_recvtos(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_RECVTTL)
+ case SOCKET_OPT_IP_RECVTTL:
+ result = nsetopt_lvl_ip_recvttl(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_RETOPTS)
+ case SOCKET_OPT_IP_RETOPTS:
+ result = nsetopt_lvl_ip_retopts(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_ROUTER_ALERT)
+ case SOCKET_OPT_IP_ROUTER_ALERT:
+ result = nsetopt_lvl_ip_router_alert(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_SENDSRCADDR)
+ case SOCKET_OPT_IP_SENDSRCADDR:
+ result = nsetopt_lvl_ip_sendsrcaddr(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_TOS)
+ case SOCKET_OPT_IP_TOS:
+ result = nsetopt_lvl_ip_tos(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_TRANSPARENT)
+ case SOCKET_OPT_IP_TRANSPARENT:
+ result = nsetopt_lvl_ip_transparent(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_TTL)
+ case SOCKET_OPT_IP_TTL:
+ result = nsetopt_lvl_ip_ttl(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IP_UNBLOCK_SOURCE)
+ case SOCKET_OPT_IP_UNBLOCK_SOURCE:
+ result = nsetopt_lvl_ip_unblock_source(env, descP, eVal);
+ break;
+#endif
+
+ default:
+ SSDBG( descP, ("SOCKET", "nsetopt_lvl_ip -> unknown opt (%d)\r\n", eOpt) );
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_ip -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+/* nsetopt_lvl_ip_add_membership - Level IP ADD_MEMBERSHIP option
+ *
+ * The value is a map with two attributes: multiaddr and interface.
+ * The attribute 'multiaddr' is always a 4-tuple (IPv4 address).
+ * The attribute 'interface' is either the atom 'any' or a 4-tuple
+ * (IPv4 address).
+ */
+#if defined(IP_ADD_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_add_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_lvl_ip_update_membership(env, descP, eVal, IP_ADD_MEMBERSHIP);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_add_source_membership - Level IP ADD_SOURCE_MEMBERSHIP option
+ *
+ * The value is a map with three attributes: multiaddr, interface and
+ * sourceaddr.
+ * The attribute 'multiaddr' is always a 4-tuple (IPv4 address).
+ * The attribute 'interface' is always a 4-tuple (IPv4 address).
+ * The attribute 'sourceaddr' is always a 4-tuple (IPv4 address).
+ * (IPv4 address).
+ */
+#if defined(IP_ADD_SOURCE_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_add_source_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_lvl_ip_update_source(env, descP, eVal,
+ IP_ADD_SOURCE_MEMBERSHIP);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_block_source - Level IP BLOCK_SOURCE option
+ *
+ * The value is a map with three attributes: multiaddr, interface and
+ * sourceaddr.
+ * The attribute 'multiaddr' is always a 4-tuple (IPv4 address).
+ * The attribute 'interface' is always a 4-tuple (IPv4 address).
+ * The attribute 'sourceaddr' is always a 4-tuple (IPv4 address).
+ * (IPv4 address).
+ */
+#if defined(IP_BLOCK_SOURCE)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_block_source(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_lvl_ip_update_source(env, descP, eVal, IP_BLOCK_SOURCE);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_drop_membership - Level IP DROP_MEMBERSHIP option
+ *
+ * The value is a map with two attributes: multiaddr and interface.
+ * The attribute 'multiaddr' is always a 4-tuple (IPv4 address).
+ * The attribute 'interface' is either the atom 'any' or a 4-tuple
+ * (IPv4 address).
+ *
+ * We should really have a common function with add_membership,
+ * since the code is virtually identical (except for the option
+ * value).
+ */
+#if defined(IP_DROP_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_drop_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_lvl_ip_update_membership(env, descP, eVal,
+ IP_DROP_MEMBERSHIP);
+}
+#endif
+
+
+
+/* nsetopt_lvl_ip_drop_source_membership - Level IP DROP_SOURCE_MEMBERSHIP option
+ *
+ * The value is a map with three attributes: multiaddr, interface and
+ * sourceaddr.
+ * The attribute 'multiaddr' is always a 4-tuple (IPv4 address).
+ * The attribute 'interface' is always a 4-tuple (IPv4 address).
+ * The attribute 'sourceaddr' is always a 4-tuple (IPv4 address).
+ * (IPv4 address).
+ */
+#if defined(IP_DROP_SOURCE_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_drop_source_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_lvl_ip_update_source(env, descP, eVal,
+ IP_DROP_SOURCE_MEMBERSHIP);
+}
+#endif
+
+
+
+/* nsetopt_lvl_ip_freebind - Level IP FREEBIND option
+ */
+#if defined(IP_FREEBIND)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_freebind(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_FREEBIND, eVal);
+}
+#endif
+
+
+
+/* nsetopt_lvl_ip_hdrincl - Level IP HDRINCL option
+ */
+#if defined(IP_HDRINCL)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_hdrincl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_HDRINCL, eVal);
+}
+#endif
+
+
+
+/* nsetopt_lvl_ip_minttl - Level IP MINTTL option
+ */
+#if defined(IP_MINTTL)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_minttl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IP_MINTTL, eVal);
+}
+#endif
+
+
+
+/* nsetopt_lvl_ip_msfilter - Level IP MSFILTER option
+ *
+ * The value can be *either* the atom 'null' or a map of type ip_msfilter().
+ */
+#if defined(IP_MSFILTER) && defined(IP_MSFILTER_SIZE)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_msfilter(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ if (COMPARE(eVal, atom_null) == 0) {
+ return nsetopt_lvl_ip_msfilter_set(env, descP->sock, NULL, 0);
+ } else {
+ struct ip_msfilter* msfP;
+ Uint32 msfSz;
+ ERL_NIF_TERM eMultiAddr, eInterface, eFMode, eSList, elem, tail;
+ size_t sz;
+ unsigned int slistLen, idx;
+
+ if (!IS_MAP(env, eVal))
+ return esock_make_error(env, esock_atom_einval);
+
+ // It must have atleast four attributes
+ if (!enif_get_map_size(env, eVal, &sz) || (sz < 4))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_multiaddr, &eMultiAddr))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_interface, &eInterface))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_mode, &eFMode))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_slist, &eSList))
+ return esock_make_error(env, esock_atom_einval);
+
+ /* We start (decoding) with the slist, since without it we don't
+ * really know how much (memory) to allocate.
+ */
+ if (!GET_LIST_LEN(env, eSList, &slistLen))
+ return esock_make_error(env, esock_atom_einval);
+
+ msfSz = IP_MSFILTER_SIZE(slistLen);
+ msfP = MALLOC(msfSz);
+
+ if (!esock_decode_ip4_address(env, eMultiAddr, &msfP->imsf_multiaddr)) {
+ FREE(msfP);
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ if (!esock_decode_ip4_address(env, eInterface, &msfP->imsf_interface)) {
+ FREE(msfP);
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ if (!decode_ip_msfilter_mode(env, eFMode, &msfP->imsf_fmode)) {
+ FREE(msfP);
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+ /* And finally, extract the source addresses */
+ msfP->imsf_numsrc = slistLen;
+ for (idx = 0; idx < slistLen; idx++) {
+ if (GET_LIST_ELEM(env, eSList, &elem, &tail)) {
+ if (!esock_decode_ip4_address(env, elem, &msfP->imsf_slist[idx])) {
+ FREE(msfP);
+ return esock_make_error(env, esock_atom_einval);
+ } else {
+ eSList = tail;
+ }
+ }
+ }
+
+ /* And now, finally, set the option */
+ result = nsetopt_lvl_ip_msfilter_set(env, descP->sock, msfP, msfSz);
+ FREE(msfP);
+ return result;
+ }
+
+}
+
+
+static
+BOOLEAN_T decode_ip_msfilter_mode(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ Uint32* mode)
+{
+ BOOLEAN_T result;
+
+ if (COMPARE(eVal, atom_include) == 0) {
+ *mode = MCAST_INCLUDE;
+ result = TRUE;
+ } else if (COMPARE(eVal, atom_exclude) == 0) {
+ *mode = MCAST_EXCLUDE;
+ result = TRUE;
+ } else {
+ result = FALSE;
+ }
+
+ return result;
+}
+
+
+static
+ERL_NIF_TERM nsetopt_lvl_ip_msfilter_set(ErlNifEnv* env,
+ SOCKET sock,
+ struct ip_msfilter* msfP,
+ SOCKLEN_T optLen)
+{
+ ERL_NIF_TERM result;
+ int res;
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ res = socket_setopt(sock, level, IP_MSFILTER, (void*) msfP, optLen);
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ return result;
+}
+#endif // IP_MSFILTER
+
+
+
+/* nsetopt_lvl_ip_mtu_discover - Level IP MTU_DISCOVER option
+ *
+ * The value is an atom of the type ip_pmtudisc().
+ */
+#if defined(IP_MTU_DISCOVER)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_mtu_discover(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ int val;
+ char* xres;
+ int res;
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ if ((xres = decode_ip_pmtudisc(env, eVal, &val)) != NULL) {
+
+ result = esock_make_error_str(env, xres);
+
+ } else {
+
+ res = socket_setopt(descP->sock, level, IP_MTU_DISCOVER,
+ &val, sizeof(val));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ }
+
+ return result;
+}
+#endif
+
+
+/* nsetopt_lvl_ip_multicast_all - Level IP MULTICAST_ALL option
+ */
+#if defined(IP_MULTICAST_ALL)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_multicast_all(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_MULTICAST_ALL, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_multicast_if - Level IP MULTICAST_IF option
+ *
+ * The value is either the atom 'any' or a 4-tuple.
+ */
+#if defined(IP_MULTICAST_IF)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_multicast_if(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ struct in_addr ifAddr;
+ char* xres;
+ int res;
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ if ((xres = esock_decode_ip4_address(env, eVal, &ifAddr)) != NULL) {
+ result = esock_make_error_str(env, xres);
+ } else {
+
+ res = socket_setopt(descP->sock, level, IP_MULTICAST_LOOP,
+ &ifAddr, sizeof(ifAddr));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ }
+
+ return result;
+}
+#endif
+
+
+/* nsetopt_lvl_ip_multicast_loop - Level IP MULTICAST_LOOP option
+ */
+#if defined(IP_MULTICAST_LOOP)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_multicast_loop(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_MULTICAST_LOOP, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_multicast_ttl - Level IP MULTICAST_TTL option
+ */
+#if defined(IP_MULTICAST_TTL)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_multicast_ttl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IP_MULTICAST_TTL, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_nodefrag - Level IP NODEFRAG option
+ */
+#if defined(IP_NODEFRAG)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_nodefrag(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_NODEFRAG, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_pktinfo - Level IP PKTINFO option
+ */
+#if defined(IP_PKTINFO)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_pktinfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_PKTINFO, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_recvdstaddr - Level IP RECVDSTADDR option
+ */
+#if defined(IP_RECVDSTADDR)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_recvdstaddr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_RECVDSTADDR, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_recverr - Level IP RECVERR option
+ */
+#if defined(IP_RECVERR)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_recverr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_RECVERR, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_recvif - Level IP RECVIF option
+ */
+#if defined(IP_RECVIF)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_recvif(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_RECVIF, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_recvopts - Level IP RECVOPTS option
+ */
+#if defined(IP_RECVOPTS)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_recvopts(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_RECVOPTS, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_recvorigdstaddr - Level IP RECVORIGDSTADDR option
+ */
+#if defined(IP_RECVORIGDSTADDR)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_RECVORIGDSTADDR, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_recvtos - Level IP RECVTOS option
+ */
+#if defined(IP_RECVTOS)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_recvtos(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_RECVTOS, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_recvttl - Level IP RECVTTL option
+ */
+#if defined(IP_RECVTTL)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_recvttl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_RECVTTL, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_retopts - Level IP RETOPTS option
+ */
+#if defined(IP_RETOPTS)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_retopts(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_RETOPTS, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_router_alert - Level IP ROUTER_ALERT option
+ */
+#if defined(IP_ROUTER_ALERT)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_router_alert(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IP_ROUTER_ALERT, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_sendsrcaddr - Level IP SENDSRCADDR option
+ */
+#if defined(IP_SENDSRCADDR)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_SENDSRCADDR, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ip_tos - Level IP TOS option
+ */
+#if defined(IP_TOS)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_tos(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+ ERL_NIF_TERM result;
+ int val;
+
+ if (decode_ip_tos(env, eVal, &val)) {
+ int res = socket_setopt(descP->sock, level, IP_TOS, &val, sizeof(val));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ } else {
+ result = esock_make_error(env, esock_atom_einval);
+ }
+
+ return result;
+}
+#endif
+
+
+/* nsetopt_lvl_ip_transparent - Level IP TRANSPARENT option
+ */
+#if defined(IP_TRANSPARENT)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_transparent(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IP_TRANSPARENT, eVal);
+}
+#endif
+
+
+
+/* nsetopt_lvl_ip_ttl - Level IP TTL option
+ */
+#if defined(IP_TTL)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_ttl(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IP_TTL, eVal);
+}
+#endif
+
+
+
+/* nsetopt_lvl_ip_unblock_source - Level IP UNBLOCK_SOURCE option
+ *
+ * The value is a map with three attributes: multiaddr, interface and
+ * sourceaddr.
+ * The attribute 'multiaddr' is always a 4-tuple (IPv4 address).
+ * The attribute 'interface' is always a 4-tuple (IPv4 address).
+ * The attribute 'sourceaddr' is always a 4-tuple (IPv4 address).
+ * (IPv4 address).
+ */
+#if defined(IP_UNBLOCK_SOURCE)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_unblock_source(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_lvl_ip_update_source(env, descP, eVal, IP_UNBLOCK_SOURCE);
+}
+#endif
+
+
+
+#if defined(IP_ADD_MEMBERSHIP) || defined(IP_DROP_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_update_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal,
+ int opt)
+{
+ ERL_NIF_TERM result, eMultiAddr, eInterface;
+ struct ip_mreq mreq;
+ char* xres;
+ int res;
+ size_t sz;
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ // It must be a map
+ if (!IS_MAP(env, eVal))
+ return enif_make_badarg(env);
+
+ // It must have atleast two attributes
+ if (!enif_get_map_size(env, eVal, &sz) || (sz >= 2))
+ return enif_make_badarg(env);
+
+ if (!GET_MAP_VAL(env, eVal, atom_multiaddr, &eMultiAddr))
+ return enif_make_badarg(env);
+
+ if (!GET_MAP_VAL(env, eVal, atom_interface, &eInterface))
+ return enif_make_badarg(env);
+
+ if ((xres = esock_decode_ip4_address(env,
+ eMultiAddr,
+ &mreq.imr_multiaddr)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ if ((xres = esock_decode_ip4_address(env,
+ eInterface,
+ &mreq.imr_interface)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ res = socket_setopt(descP->sock, level, opt, &mreq, sizeof(mreq));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ return result;
+}
+#endif
+
+
+#if defined(IP_ADD_SOURCE_MEMBERSHIP) || defined(IP_DROP_SOURCE_MEMBERSHIP) || defined(IP_BLOCK_SOURCE) || defined(IP_UNBLOCK_SOURCE)
+static
+ERL_NIF_TERM nsetopt_lvl_ip_update_source(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal,
+ int opt)
+{
+ ERL_NIF_TERM result, eMultiAddr, eInterface, eSourceAddr;
+ struct ip_mreq_source mreq;
+ char* xres;
+ int res;
+ size_t sz;
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ // It must be a map
+ if (!IS_MAP(env, eVal))
+ return enif_make_badarg(env);
+
+ // It must have atleast three attributes
+ if (!enif_get_map_size(env, eVal, &sz) || (sz >= 3))
+ return enif_make_badarg(env);
+
+ if (!GET_MAP_VAL(env, eVal, atom_multiaddr, &eMultiAddr))
+ return enif_make_badarg(env);
+
+ if (!GET_MAP_VAL(env, eVal, atom_interface, &eInterface))
+ return enif_make_badarg(env);
+
+ if (!GET_MAP_VAL(env, eVal, atom_sourceaddr, &eSourceAddr))
+ return enif_make_badarg(env);
+
+ if ((xres = esock_decode_ip4_address(env,
+ eMultiAddr,
+ &mreq.imr_multiaddr)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ if ((xres = esock_decode_ip4_address(env,
+ eInterface,
+ &mreq.imr_interface)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ if ((xres = esock_decode_ip4_address(env,
+ eSourceAddr,
+ &mreq.imr_sourceaddr)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ res = socket_setopt(descP->sock, level, opt, &mreq, sizeof(mreq));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ return result;
+}
+#endif
+
+
+
+/* *** Handling set of socket options for level = ipv6 *** */
+
+/* nsetopt_lvl_ipv6 - Level *IPv6* option(s)
+ */
+#if defined(HAVE_IPV6)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_ipv6 -> entry with"
+ "\r\n opt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(IPV6_ADDRFORM)
+ case SOCKET_OPT_IPV6_ADDRFORM:
+ result = nsetopt_lvl_ipv6_addrform(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_ADD_MEMBERSHIP)
+ case SOCKET_OPT_IPV6_ADD_MEMBERSHIP:
+ result = nsetopt_lvl_ipv6_add_membership(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_AUTHHDR)
+ case SOCKET_OPT_IPV6_AUTHHDR:
+ result = nsetopt_lvl_ipv6_authhdr(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_DROP_MEMBERSHIP)
+ case SOCKET_OPT_IPV6_DROP_MEMBERSHIP:
+ result = nsetopt_lvl_ipv6_drop_membership(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_DSTOPTS)
+ case SOCKET_OPT_IPV6_DSTOPTS:
+ result = nsetopt_lvl_ipv6_dstopts(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_FLOWINFO)
+ case SOCKET_OPT_IPV6_FLOWINFO:
+ result = nsetopt_lvl_ipv6_flowinfo(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_HOPLIMIT)
+ case SOCKET_OPT_IPV6_HOPLIMIT:
+ result = nsetopt_lvl_ipv6_hoplimit(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_HOPOPTS)
+ case SOCKET_OPT_IPV6_HOPOPTS:
+ result = nsetopt_lvl_ipv6_hopopts(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_MTU)
+ case SOCKET_OPT_IPV6_MTU:
+ result = nsetopt_lvl_ipv6_mtu(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_MTU_DISCOVER)
+ case SOCKET_OPT_IPV6_MTU_DISCOVER:
+ result = nsetopt_lvl_ipv6_mtu_discover(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_MULTICAST_HOPS)
+ case SOCKET_OPT_IPV6_MULTICAST_HOPS:
+ result = nsetopt_lvl_ipv6_multicast_hops(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_MULTICAST_IF)
+ case SOCKET_OPT_IPV6_MULTICAST_IF:
+ result = nsetopt_lvl_ipv6_multicast_if(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_MULTICAST_LOOP)
+ case SOCKET_OPT_IPV6_MULTICAST_LOOP:
+ result = nsetopt_lvl_ipv6_multicast_loop(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_RECVERR)
+ case SOCKET_OPT_IPV6_RECVERR:
+ result = nsetopt_lvl_ipv6_recverr(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO)
+ case SOCKET_OPT_IPV6_RECVPKTINFO:
+ result = nsetopt_lvl_ipv6_recvpktinfo(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_ROUTER_ALERT)
+ case SOCKET_OPT_IPV6_ROUTER_ALERT:
+ result = nsetopt_lvl_ipv6_router_alert(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_RTHDR)
+ case SOCKET_OPT_IPV6_RTHDR:
+ result = nsetopt_lvl_ipv6_rthdr(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_UNICAST_HOPS)
+ case SOCKET_OPT_IPV6_UNICAST_HOPS:
+ result = nsetopt_lvl_ipv6_unicast_hops(env, descP, eVal);
+ break;
+#endif
+
+#if defined(IPV6_V6ONLY)
+ case SOCKET_OPT_IPV6_V6ONLY:
+ result = nsetopt_lvl_ipv6_v6only(env, descP, eVal);
+ break;
+#endif
+
+ default:
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_ipv6 -> unknown opt (%d)\r\n", eOpt) );
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_ipv6 -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+#if defined(IPV6_ADDRFORM)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_addrform(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ int res, edomain, domain;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_ipv6_addrform -> entry with"
+ "\r\n eVal: %T"
+ "\r\n", eVal) );
+
+ if (!GET_INT(env, eVal, &edomain))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_ipv6_addrform -> decode"
+ "\r\n edomain: %d"
+ "\r\n", edomain) );
+
+ if (!edomain2domain(edomain, &domain))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP, ("SOCKET", "nsetopt_lvl_ipv6_addrform -> try set opt to %d\r\n",
+ domain) );
+
+ res = socket_setopt(descP->sock,
+ SOL_IPV6, IPV6_ADDRFORM,
+ &domain, sizeof(domain));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ return result;
+}
+#endif
+
+
+#if defined(IPV6_ADD_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_add_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_lvl_ipv6_update_membership(env, descP, eVal,
+ IPV6_ADD_MEMBERSHIP);
+}
+#endif
+
+
+#if defined(IPV6_AUTHHDR)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_authhdr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, SOL_IPV6, IPV6_AUTHHDR, eVal);
+}
+#endif
+
+
+#if defined(IPV6_DROP_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_drop_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_lvl_ipv6_update_membership(env, descP, eVal,
+ IPV6_DROP_MEMBERSHIP);
+}
+#endif
+
+
+#if defined(IPV6_DSTOPTS)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_dstopts(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IPV6_DSTOPTS, eVal);
+}
+#endif
+
+
+#if defined(IPV6_FLOWINFO)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_flowinfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IPV6_FLOWINFO, eVal);
+}
+#endif
+
+
+#if defined(IPV6_HOPLIMIT)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_hoplimit(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IPV6_HOPLIMIT, eVal);
+}
+#endif
+
+
+#if defined(IPV6_HOPOPTS)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_hopopts(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IPV6_HOPOPTS, eVal);
+}
+#endif
+
+
+#if defined(IPV6_MTU)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_mtu(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IPV6_MTU, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_ipv6_mtu_discover - Level IPv6 MTU_DISCOVER option
+ *
+ * The value is an atom of the type ipv6_pmtudisc().
+ */
+#if defined(IPV6_MTU_DISCOVER)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ int val;
+ char* xres;
+ int res;
+
+ if ((xres = decode_ipv6_pmtudisc(env, eVal, &val)) != NULL) {
+
+ result = esock_make_error_str(env, xres);
+
+ } else {
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+
+ res = socket_setopt(descP->sock, level, IPV6_MTU_DISCOVER,
+ &val, sizeof(val));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ }
+
+ return result;
+}
+#endif
+
+
+#if defined(IPV6_MULTICAST_HOPS)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IPV6_MULTICAST_HOPS, eVal);
+}
+#endif
+
+
+
+#if defined(IPV6_MULTICAST_IF)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_if(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IPV6_MULTICAST_IF, eVal);
+}
+#endif
+
+
+
+#if defined(IPV6_MULTICAST_LOOP)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IPV6_MULTICAST_LOOP, eVal);
+}
+#endif
+
+
+#if defined(IPV6_RECVERR)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_recverr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IPV6_RECVERR, eVal);
+}
+#endif
+
+
+#if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+#if defined(IPV6_RECVPKTINFO)
+ int opt = IPV6_RECVPKTINFO;
+#else
+ int opt = IPV6_PKTINFO;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, opt, eVal);
+}
+#endif
+
+
+#if defined(IPV6_ROUTER_ALERT)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_router_alert(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IPV6_ROUTER_ALERT, eVal);
+}
+#endif
+
+
+
+#if defined(IPV6_RTHDR)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_rthdr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IPV6_RTHDR, eVal);
+}
+#endif
+
+
+#if defined(IPV6_UNICAST_HOPS)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_int_opt(env, descP, level, IPV6_UNICAST_HOPS, eVal);
+}
+#endif
+
+
+
+#if defined(IPV6_V6ONLY)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_v6only(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return nsetopt_bool_opt(env, descP, level, IPV6_V6ONLY, eVal);
+}
+#endif
+
+
+#if defined(IPV6_ADD_MEMBERSHIP) || defined(IPV6_DROP_MEMBERSHIP)
+static
+ERL_NIF_TERM nsetopt_lvl_ipv6_update_membership(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal,
+ int opt)
+{
+ ERL_NIF_TERM result, eMultiAddr, eInterface;
+ struct ipv6_mreq mreq;
+ char* xres;
+ int res;
+ size_t sz;
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ // It must be a map
+ if (!IS_MAP(env, eVal))
+ return enif_make_badarg(env);
+
+ // It must have atleast two attributes
+ if (!enif_get_map_size(env, eVal, &sz) || (sz >= 2))
+ return enif_make_badarg(env);
+
+ if (!GET_MAP_VAL(env, eVal, atom_multiaddr, &eMultiAddr))
+ return enif_make_badarg(env);
+
+ if (!GET_MAP_VAL(env, eVal, atom_interface, &eInterface))
+ return enif_make_badarg(env);
+
+ if ((xres = esock_decode_ip6_address(env,
+ eMultiAddr,
+ &mreq.ipv6mr_multiaddr)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ if (!GET_UINT(env, eInterface, &mreq.ipv6mr_interface))
+ return esock_make_error(env, esock_atom_einval);
+
+ res = socket_setopt(descP->sock, level, opt, &mreq, sizeof(mreq));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ return result;
+}
+#endif
+
+
+
+#endif // defined(HAVE_IPV6)
+
+
+
+/* nsetopt_lvl_tcp - Level *TCP* option(s)
+ */
+static
+ERL_NIF_TERM nsetopt_lvl_tcp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_tcp -> entry with"
+ "\r\n opt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(TCP_CONGESTION)
+ case SOCKET_OPT_TCP_CONGESTION:
+ result = nsetopt_lvl_tcp_congestion(env, descP, eVal);
+ break;
+#endif
+
+#if defined(TCP_MAXSEG)
+ case SOCKET_OPT_TCP_MAXSEG:
+ result = nsetopt_lvl_tcp_maxseg(env, descP, eVal);
+ break;
+#endif
+
+#if defined(TCP_NODELAY)
+ case SOCKET_OPT_TCP_NODELAY:
+ result = nsetopt_lvl_tcp_nodelay(env, descP, eVal);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return result;
+}
+
+
+/* nsetopt_lvl_tcp_congestion - Level TCP CONGESTION option
+ */
+#if defined(TCP_CONGESTION)
+static
+ERL_NIF_TERM nsetopt_lvl_tcp_congestion(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ int max = SOCKET_OPT_TCP_CONGESTION_NAME_MAX+1;
+
+ return nsetopt_str_opt(env, descP, IPPROTO_TCP, TCP_CONGESTION, max, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_tcp_maxseg - Level TCP MAXSEG option
+ */
+#if defined(TCP_MAXSEG)
+static
+ERL_NIF_TERM nsetopt_lvl_tcp_maxseg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, IPPROTO_TCP, TCP_MAXSEG, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_tcp_nodelay - Level TCP NODELAY option
+ */
+#if defined(TCP_NODELAY)
+static
+ERL_NIF_TERM nsetopt_lvl_tcp_nodelay(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, IPPROTO_TCP, TCP_NODELAY, eVal);
+}
+#endif
+
+
+
+/* nsetopt_lvl_udp - Level *UDP* option(s)
+ */
+static
+ERL_NIF_TERM nsetopt_lvl_udp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_udp -> entry with"
+ "\r\n opt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(UDP_CORK)
+ case SOCKET_OPT_UDP_CORK:
+ result = nsetopt_lvl_udp_cork(env, descP, eVal);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return result;
+}
+
+
+/* nsetopt_lvl_udp_cork - Level UDP CORK option
+ */
+#if defined(UDP_CORK)
+static
+ERL_NIF_TERM nsetopt_lvl_udp_cork(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, IPPROTO_UDP, UDP_CORK, eVal);
+}
+#endif
+
+
+
+
+/* nsetopt_lvl_sctp - Level *SCTP* option(s)
+ */
+#if defined(HAVE_SCTP)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp -> entry with"
+ "\r\n opt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(SCTP_ASSOCINFO)
+ case SOCKET_OPT_SCTP_ASSOCINFO:
+ result = nsetopt_lvl_sctp_associnfo(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SCTP_AUTOCLOSE)
+ case SOCKET_OPT_SCTP_AUTOCLOSE:
+ result = nsetopt_lvl_sctp_autoclose(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SCTP_DISABLE_FRAGMENTS)
+ case SOCKET_OPT_SCTP_DISABLE_FRAGMENTS:
+ result = nsetopt_lvl_sctp_disable_fragments(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SCTP_EVENTS)
+ case SOCKET_OPT_SCTP_EVENTS:
+ result = nsetopt_lvl_sctp_events(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SCTP_INITMSG)
+ case SOCKET_OPT_SCTP_INITMSG:
+ result = nsetopt_lvl_sctp_initmsg(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SCTP_MAXSEG)
+ case SOCKET_OPT_SCTP_MAXSEG:
+ result = nsetopt_lvl_sctp_maxseg(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SCTP_NODELAY)
+ case SOCKET_OPT_SCTP_NODELAY:
+ result = nsetopt_lvl_sctp_nodelay(env, descP, eVal);
+ break;
+#endif
+
+#if defined(SCTP_RTOINFO)
+ case SOCKET_OPT_SCTP_RTOINFO:
+ result = nsetopt_lvl_sctp_rtoinfo(env, descP, eVal);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return result;
+}
+
+
+/* nsetopt_lvl_sctp_associnfo - Level SCTP ASSOCINFO option
+ */
+#if defined(SCTP_ASSOCINFO)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp_associnfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ ERL_NIF_TERM eAssocId, eMaxRxt, eNumPeerDests;
+ ERL_NIF_TERM ePeerRWND, eLocalRWND, eCookieLife;
+ struct sctp_assocparams assocParams;
+ int res;
+ size_t sz;
+ unsigned int tmp;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_associnfo -> entry with"
+ "\r\n eVal: %T"
+ "\r\n", eVal) );
+
+ // It must be a map
+ if (!IS_MAP(env, eVal))
+ return esock_make_error(env, esock_atom_einval);
+
+ // It must have atleast ten attributes
+ if (!enif_get_map_size(env, eVal, &sz) || (sz < 6))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_associnfo -> extract attributes\r\n") );
+
+ if (!GET_MAP_VAL(env, eVal, atom_assoc_id, &eAssocId))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_max_rxt, &eMaxRxt))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_num_peer_dests, &eNumPeerDests))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_peer_rwnd, &ePeerRWND))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_local_rwnd, &eLocalRWND))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_cookie_life, &eCookieLife))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_associnfo -> decode attributes\r\n") );
+
+ /* On some platforms the assoc id is typed as an unsigned integer (uint32)
+ * So, to avoid warnings there, we always make an explicit cast...
+ * Also, size of types matter, so adjust for that...
+ */
+
+#if (SIZEOF_INT == 4)
+ {
+ int tmpAssocId;
+ if (!GET_INT(env, eAssocId, &tmpAssocId))
+ return esock_make_error(env, esock_atom_einval);
+ assocParams.sasoc_assoc_id =
+ (typeof(assocParams.sasoc_assoc_id)) tmpAssocId;
+ }
+#elif (SIZEOF_LONG == 4)
+ {
+ long tmpAssocId;
+ if (!GET_LONG(env, eAssocId, &tmpAssocId))
+ return esock_make_error(env, esock_atom_einval);
+ assocParams.sasoc_assoc_id =
+ (typeof(assocParams.sasoc_assoc_id)) tmpAssocId;
+ }
+#else
+ SIZE CHECK FOR ASSOC ID FAILED
+#endif
+
+
+ /*
+ * We should really make sure this is ok in erlang (to ensure that
+ * the values (max-rxt and num-peer-dests) fits in 16-bits).
+ * The value should be a 16-bit unsigned int...
+ * Both sasoc_asocmaxrxt and sasoc_number_peer_destinations.
+ */
+
+ if (!GET_UINT(env, eMaxRxt, &tmp))
+ return esock_make_error(env, esock_atom_einval);
+ assocParams.sasoc_asocmaxrxt = (Uint16) tmp;
+
+ if (!GET_UINT(env, eNumPeerDests, &tmp))
+ return esock_make_error(env, esock_atom_einval);
+ assocParams.sasoc_number_peer_destinations = (Uint16) tmp;
+
+ if (!GET_UINT(env, ePeerRWND, &assocParams.sasoc_peer_rwnd))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_UINT(env, eLocalRWND, &assocParams.sasoc_local_rwnd))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_UINT(env, eCookieLife, &assocParams.sasoc_cookie_life))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_associnfo -> set associnfo option\r\n") );
+
+ res = socket_setopt(descP->sock, IPPROTO_SCTP, SCTP_ASSOCINFO,
+ &assocParams, sizeof(assocParams));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_associnfo -> done with"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+
+}
+#endif
+
+
+/* nsetopt_lvl_sctp_autoclose - Level SCTP AUTOCLOSE option
+ */
+#if defined(SCTP_AUTOCLOSE)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp_autoclose(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, IPPROTO_SCTP, SCTP_AUTOCLOSE, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_sctp_disable_fragments - Level SCTP DISABLE_FRAGMENTS option
+ */
+#if defined(SCTP_DISABLE_FRAGMENTS)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp_disable_fragments(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, IPPROTO_SCTP, SCTP_DISABLE_FRAGMENTS, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_sctp_events - Level SCTP EVENTS option
+ */
+#if defined(SCTP_EVENTS)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp_events(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ ERL_NIF_TERM eDataIn, eAssoc, eAddr, eSndFailure;
+ ERL_NIF_TERM ePeerError, eShutdown, ePartialDelivery;
+ ERL_NIF_TERM eAdaptLayer;
+#if defined(HAVE_STRUCT_SCTP_EVENT_SUBSCRIBE_SCTP_AUTHENTICATION_EVENT)
+ ERL_NIF_TERM eAuth;
+#endif
+#if defined(HAVE_STRUCT_SCTP_EVENT_SUBSCRIBE_SCTP_SENDER_DRY_EVENT)
+ ERL_NIF_TERM eSndDry;
+#endif
+ struct sctp_event_subscribe events;
+ int res;
+ size_t sz;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_events -> entry with"
+ "\r\n eVal: %T"
+ "\r\n", eVal) );
+
+ // It must be a map
+ if (!IS_MAP(env, eVal))
+ return esock_make_error(env, esock_atom_einval);
+
+ // It must have atleast ten attributes
+ if (!enif_get_map_size(env, eVal, &sz) || (sz < 10))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_events -> extract attributes\r\n") );
+
+ if (!GET_MAP_VAL(env, eVal, atom_data_in, &eDataIn))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_association, &eAssoc))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_address, &eAddr))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_send_failure, &eSndFailure))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_peer_error, &ePeerError))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_shutdown, &eShutdown))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_partial_delivery, &ePartialDelivery))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_adaptation_layer, &eAdaptLayer))
+ return esock_make_error(env, esock_atom_einval);
+
+#if defined(HAVE_STRUCT_SCTP_EVENT_SUBSCRIBE_SCTP_AUTHENTICATION_EVENT)
+ if (!GET_MAP_VAL(env, eVal, atom_authentication, &eAuth))
+ return esock_make_error(env, esock_atom_einval);
+#endif
+
+#if defined(HAVE_STRUCT_SCTP_EVENT_SUBSCRIBE_SCTP_SENDER_DRY_EVENT)
+ if (!GET_MAP_VAL(env, eVal, atom_sender_dry, &eSndDry))
+ return esock_make_error(env, esock_atom_einval);
+#endif
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_events -> decode attributes\r\n") );
+
+ events.sctp_data_io_event = esock_decode_bool(eDataIn);
+ events.sctp_association_event = esock_decode_bool(eAssoc);
+ events.sctp_address_event = esock_decode_bool(eAddr);
+ events.sctp_send_failure_event = esock_decode_bool(eSndFailure);
+ events.sctp_peer_error_event = esock_decode_bool(ePeerError);
+ events.sctp_shutdown_event = esock_decode_bool(eShutdown);
+ events.sctp_partial_delivery_event = esock_decode_bool(ePartialDelivery);
+ events.sctp_adaptation_layer_event = esock_decode_bool(eAdaptLayer);
+#if defined(HAVE_STRUCT_SCTP_EVENT_SUBSCRIBE_SCTP_AUTHENTICATION_EVENT)
+ events.sctp_authentication_event = esock_decode_bool(eAuth);
+#endif
+#if defined(HAVE_STRUCT_SCTP_EVENT_SUBSCRIBE_SCTP_SENDER_DRY_EVENT)
+ events.sctp_sender_dry_event = esock_decode_bool(eSndDry);
+#endif
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_events -> set events option\r\n") );
+
+ res = socket_setopt(descP->sock, IPPROTO_SCTP, SCTP_EVENTS,
+ &events, sizeof(events));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_events -> done with"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+
+}
+#endif
+
+
+/* nsetopt_lvl_sctp_initmsg - Level SCTP INITMSG option
+ */
+#if defined(SCTP_INITMSG)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp_initmsg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ ERL_NIF_TERM eNumOut, eMaxIn, eMaxAttempts, eMaxInitTO;
+ struct sctp_initmsg initMsg;
+ int res;
+ size_t sz;
+ unsigned int tmp;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_initmsg -> entry with"
+ "\r\n eVal: %T"
+ "\r\n", eVal) );
+
+ // It must be a map
+ if (!IS_MAP(env, eVal))
+ return esock_make_error(env, esock_atom_einval);
+
+ // It must have atleast ten attributes
+ if (!enif_get_map_size(env, eVal, &sz) || (sz < 4))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_initmsg -> extract attributes\r\n") );
+
+ if (!GET_MAP_VAL(env, eVal, atom_num_outstreams, &eNumOut))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_max_instreams, &eMaxIn))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_max_attempts, &eMaxAttempts))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_max_init_timeo, &eMaxInitTO))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_initmsg -> decode attributes\r\n") );
+
+ if (!GET_UINT(env, eNumOut, &tmp))
+ return esock_make_error(env, esock_atom_einval);
+ initMsg.sinit_num_ostreams = (Uint16) tmp;
+
+ if (!GET_UINT(env, eMaxIn, &tmp))
+ return esock_make_error(env, esock_atom_einval);
+ initMsg.sinit_max_instreams = (Uint16) tmp;
+
+ if (!GET_UINT(env, eMaxAttempts, &tmp))
+ return esock_make_error(env, esock_atom_einval);
+ initMsg.sinit_max_attempts = (Uint16) tmp;
+
+ if (!GET_UINT(env, eMaxInitTO, &tmp))
+ return esock_make_error(env, esock_atom_einval);
+ initMsg.sinit_max_init_timeo = (Uint16) tmp;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_initmsg -> set initmsg option\r\n") );
+
+ res = socket_setopt(descP->sock, IPPROTO_SCTP, SCTP_INITMSG,
+ &initMsg, sizeof(initMsg));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_initmsg -> done with"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+
+}
+#endif
+
+
+/* nsetopt_lvl_sctp_maxseg - Level SCTP MAXSEG option
+ */
+#if defined(SCTP_MAXSEG)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp_maxseg(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_int_opt(env, descP, IPPROTO_SCTP, SCTP_MAXSEG, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_sctp_nodelay - Level SCTP NODELAY option
+ */
+#if defined(SCTP_NODELAY)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp_nodelay(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ return nsetopt_bool_opt(env, descP, IPPROTO_SCTP, SCTP_NODELAY, eVal);
+}
+#endif
+
+
+/* nsetopt_lvl_sctp_rtoinfo - Level SCTP RTOINFO option
+ */
+#if defined(SCTP_RTOINFO)
+static
+ERL_NIF_TERM nsetopt_lvl_sctp_rtoinfo(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ ERL_NIF_TERM eAssocId, eInitial, eMax, eMin;
+ struct sctp_rtoinfo rtoInfo;
+ int res;
+ size_t sz;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_rtoinfo -> entry with"
+ "\r\n eVal: %T"
+ "\r\n", eVal) );
+
+ // It must be a map
+ if (!IS_MAP(env, eVal))
+ return esock_make_error(env, esock_atom_einval);
+
+ // It must have atleast ten attributes
+ if (!enif_get_map_size(env, eVal, &sz) || (sz < 4))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_rtoinfo -> extract attributes\r\n") );
+
+ if (!GET_MAP_VAL(env, eVal, atom_assoc_id, &eAssocId))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_initial, &eInitial))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_max, &eMax))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_MAP_VAL(env, eVal, atom_min, &eMin))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_rtoinfo -> decode attributes\r\n") );
+
+ /* On some platforms the assoc id is typed as an unsigned integer (uint32)
+ * So, to avoid warnings there, we always make an explicit cast...
+ * Also, size of types matter, so adjust for that...
+ */
+
+#if (SIZEOF_INT == 4)
+ {
+ int tmpAssocId;
+ if (!GET_INT(env, eAssocId, &tmpAssocId))
+ return esock_make_error(env, esock_atom_einval);
+ rtoInfo.srto_assoc_id = (typeof(rtoInfo.srto_assoc_id)) tmpAssocId;
+ }
+#elif (SIZEOF_LONG == 4)
+ {
+ long tmpAssocId;
+ if (!GET_LONG(env, eAssocId, &tmpAssocId))
+ return esock_make_error(env, esock_atom_einval);
+ rtoInfo.srto_assoc_id = (typeof(rtoInfo.srto_assoc_id)) tmpAssocId;
+ }
+#else
+ SIZE CHECK FOR ASSOC ID FAILED
+#endif
+ /*
+ if (!GET_INT(env, eAssocId, &tmpAssocId))
+ return esock_make_error(env, esock_atom_einval);
+ rtoInfo.srto_assoc_id = (typeof(rtoInfo.srto_assoc_id)) tmpAssocId;
+ */
+
+ if (!GET_UINT(env, eInitial, &rtoInfo.srto_initial))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_UINT(env, eMax, &rtoInfo.srto_max))
+ return esock_make_error(env, esock_atom_einval);
+
+ if (!GET_UINT(env, eMin, &rtoInfo.srto_min))
+ return esock_make_error(env, esock_atom_einval);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_rtoinfo -> set associnfo option\r\n") );
+
+ res = socket_setopt(descP->sock, IPPROTO_SCTP, SCTP_RTOINFO,
+ &rtoInfo, sizeof(rtoInfo));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_lvl_sctp_rtoinfo -> done with"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+
+}
+#endif
+
+
+
+#endif // defined(HAVE_SCTP)
+
+
+
+
+/* nsetopt_bool_opt - set an option that has an (integer) bool value
+ */
+static
+ERL_NIF_TERM nsetopt_bool_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ BOOLEAN_T val;
+ int ival, res;
+
+ val = esock_decode_bool(eVal);
+
+ ival = (val) ? 1 : 0;
+ res = socket_setopt(descP->sock, level, opt, &ival, sizeof(ival));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ return result;
+}
+
+
+/* nsetopt_int_opt - set an option that has an integer value
+ */
+static
+ERL_NIF_TERM nsetopt_int_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ int val;
+
+ if (GET_INT(env, eVal, &val)) {
+ int res;
+
+ /*
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_int_opt -> set option"
+ "\r\n opt: %d"
+ "\r\n val: %d"
+ "\r\n", opt, val) );
+ */
+
+ res = socket_setopt(descP->sock, level, opt, &val, sizeof(val));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ } else {
+ result = esock_make_error(env, esock_atom_einval);
+ }
+
+ return result;
+}
+
+
+/* nsetopt_str_opt - set an option that has an string value
+ */
+#if defined(USE_SETOPT_STR_OPT)
+static
+ERL_NIF_TERM nsetopt_str_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ int max,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ char* val = MALLOC(max);
+
+ if (GET_STR(env, eVal, val, max) > 0) {
+ int optLen = strlen(val);
+ int res = socket_setopt(descP->sock, level, opt, &val, optLen);
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ } else {
+ result = esock_make_error(env, esock_atom_einval);
+ }
+
+ FREE(val);
+
+ return result;
+}
+#endif
+
+
+/* nsetopt_timeval_opt - set an option that has an (timeval) bool value
+ */
+static
+ERL_NIF_TERM nsetopt_timeval_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ ERL_NIF_TERM eVal)
+{
+ ERL_NIF_TERM result;
+ struct timeval timeVal;
+ int res;
+ char* xres;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_timeval_opt -> entry with"
+ "\r\n eVal: %T"
+ "\r\n", eVal) );
+
+ if ((xres = esock_decode_timeval(env, eVal, &timeVal)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_timeval_opt -> set timeval option\r\n") );
+
+ res = socket_setopt(descP->sock, level, opt, &timeVal, sizeof(timeVal));
+
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+
+ SSDBG( descP,
+ ("SOCKET", "nsetopt_timeval_opt -> done with"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+
+}
+
+
+
+static
+BOOLEAN_T elevel2level(BOOLEAN_T isEncoded,
+ int eLevel,
+ BOOLEAN_T* isOTP,
+ int* level)
+{
+ BOOLEAN_T result;
+
+ if (isEncoded) {
+ switch (eLevel) {
+ case SOCKET_OPT_LEVEL_OTP:
+ *isOTP = TRUE;
+ *level = -1;
+ result = TRUE;
+ break;
+
+ case SOCKET_OPT_LEVEL_SOCKET:
+ *isOTP = FALSE;
+ *level = SOL_SOCKET;
+ result = TRUE;
+ break;
+
+ case SOCKET_OPT_LEVEL_IP:
+ *isOTP = FALSE;
+#if defined(SOL_IP)
+ *level = SOL_IP;
+#else
+ *level = IPPROTO_IP;
+#endif
+ result = TRUE;
+ break;
+
+#if defined(HAVE_IPV6)
+ case SOCKET_OPT_LEVEL_IPV6:
+ *isOTP = FALSE;
+#if defined(SOL_IPV6)
+ *level = SOL_IPV6;
+#else
+ *level = IPPROTO_IPV6;
+#endif
+ result = TRUE;
+ break;
+#endif
+
+ case SOCKET_OPT_LEVEL_TCP:
+ *isOTP = FALSE;
+ *level = IPPROTO_TCP;
+ result = TRUE;
+ break;
+
+ case SOCKET_OPT_LEVEL_UDP:
+ *isOTP = FALSE;
+ *level = IPPROTO_UDP;
+ result = TRUE;
+ break;
+
+#ifdef HAVE_SCTP
+ case SOCKET_OPT_LEVEL_SCTP:
+ *isOTP = FALSE;
+ *level = IPPROTO_SCTP;
+ result = TRUE;
+ break;
+#endif
+
+ default:
+ *isOTP = FALSE;
+ *level = -1;
+ result = FALSE;
+ break;
+ }
+ } else {
+ *isOTP = FALSE;
+ *level = eLevel;
+ result = TRUE;
+ }
+
+ return result;
+}
+
+
+
+/* +++ socket_setopt +++
+ *
+ * <Per H @ Tail-f>
+ * The original code here had problems that possibly
+ * only occur if you abuse it for non-INET sockets, but anyway:
+ * a) If the getsockopt for SO_PRIORITY or IP_TOS failed, the actual
+ * requested setsockopt was never even attempted.
+ * b) If {get,set}sockopt for one of IP_TOS and SO_PRIORITY failed,
+ * but ditto for the other worked and that was actually the requested
+ * option, failure was still reported to erlang.
+ * </Per H @ Tail-f>
+ *
+ * <PaN>
+ * The relations between SO_PRIORITY, TOS and other options
+ * is not what you (or at least I) would expect...:
+ * If TOS is set after priority, priority is zeroed.
+ * If any other option is set after tos, tos might be zeroed.
+ * Therefore, save tos and priority. If something else is set,
+ * restore both after setting, if tos is set, restore only
+ * prio and if prio is set restore none... All to keep the
+ * user feeling socket options are independent.
+ * </PaN>
+ */
+static
+int socket_setopt(int sock, int level, int opt,
+ const void* optVal, const socklen_t optLen)
+{
+ int res;
+
+#if defined(IP_TOS) && defined(SOL_IP) && defined(SO_PRIORITY)
+ int tmpIValPRIO;
+ int tmpIValTOS;
+ int resPRIO;
+ int resTOS;
+ SOCKOPTLEN_T tmpArgSzPRIO = sizeof(tmpIValPRIO);
+ SOCKOPTLEN_T tmpArgSzTOS = sizeof(tmpIValTOS);
+
+ resPRIO = sock_getopt(sock, SOL_SOCKET, SO_PRIORITY,
+ &tmpIValPRIO, &tmpArgSzPRIO);
+ resTOS = sock_getopt(sock, SOL_IP, IP_TOS,
+ &tmpIValTOS, &tmpArgSzTOS);
+
+ res = sock_setopt(sock, level, opt, optVal, optLen);
+ if (res == 0) {
+
+ /* Ok, now we *maybe* need to "maybe" restore PRIO and TOS...
+ * maybe, possibly, ...
+ */
+
+ if (opt != SO_PRIORITY) {
+ if ((opt != IP_TOS) && (resTOS == 0)) {
+ resTOS = sock_setopt(sock, SOL_IP, IP_TOS,
+ (void *) &tmpIValTOS,
+ tmpArgSzTOS);
+ res = resTOS;
+ }
+ if ((res == 0) && (resPRIO == 0)) {
+ resPRIO = sock_setopt(sock, SOL_SOCKET, SO_PRIORITY,
+ &tmpIValPRIO,
+ tmpArgSzPRIO);
+
+ /* Some kernels set a SO_PRIORITY by default
+ * that you are not permitted to reset,
+ * silently ignore this error condition.
+ */
+
+ if ((resPRIO != 0) && (sock_errno() == EPERM)) {
+ res = 0;
+ } else {
+ res = resPRIO;
+ }
+ }
+ }
+ }
+
+#else
+
+ res = sock_setopt(sock, level, opt, optVal, optLen);
+
+#endif
+
+ return res;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_getopt
+ *
+ * Description:
+ * Get socket option.
+ * Its possible to use a "raw" mode (not encoded). That is, we do not
+ * interpret level and opt. They are passed "as is" to the
+ * getsockopt function call. The value in this case will "copied" as
+ * is and provided to the user in the form of a binary.
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * IsEncoded - Are the "arguments" encoded or not.
+ * Level - Level of the socket option.
+ * Opt - The socket option.
+ */
+
+static
+ERL_NIF_TERM nif_getopt(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ int eLevel, level = -1;
+ ERL_NIF_TERM eIsEncoded, eOpt;
+ BOOLEAN_T isEncoded, isOTP;
+
+ SGDBG( ("SOCKET", "nif_getopt -> entry with argc: %d\r\n", argc) );
+
+ if ((argc != 4) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP) ||
+ !GET_INT(env, argv[2], &eLevel)) {
+ SGDBG( ("SOCKET", "nif_getopt -> failed processing args\r\n") );
+ return enif_make_badarg(env);
+ }
+ eIsEncoded = argv[1];
+ eOpt = argv[3]; // Is "normally" an int, but if raw mode: {Int, ValueSz}
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ SSDBG( descP,
+ ("SOCKET", "nif_getopt -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n eIsEncoded: %T"
+ "\r\n eLevel: %d"
+ "\r\n eOpt: %T"
+ "\r\n", descP->sock, argv[0], eIsEncoded, eLevel, eOpt) );
+
+ isEncoded = esock_decode_bool(eIsEncoded);
+
+ if (!elevel2level(isEncoded, eLevel, &isOTP, &level))
+ return esock_make_error(env, esock_atom_einval);
+
+ return ngetopt(env, descP, isEncoded, isOTP, level, eOpt);
+#endif // if defined(__WIN32__)
+}
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM ngetopt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ BOOLEAN_T isEncoded,
+ BOOLEAN_T isOTP,
+ int level,
+ ERL_NIF_TERM eOpt)
+{
+ ERL_NIF_TERM result;
+ int opt;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt -> entry with"
+ "\r\n isEncoded: %s"
+ "\r\n isOTP: %s"
+ "\r\n level: %d"
+ "\r\n eOpt: %T"
+ "\r\n", B2S(isEncoded), B2S(isOTP), level, eOpt) );
+
+ if (isOTP) {
+ /* These are not actual socket options,
+ * but options for our implementation.
+ */
+ if (GET_INT(env, eOpt, &opt))
+ result = ngetopt_otp(env, descP, opt);
+ else
+ result = esock_make_error(env, esock_atom_einval);
+ } else if (!isEncoded) {
+ result = ngetopt_native(env, descP, level, eOpt);
+ } else {
+ if (GET_INT(env, eOpt, &opt))
+ result = ngetopt_level(env, descP, level, opt);
+ else
+ result = esock_make_error(env, esock_atom_einval);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+
+/* ngetopt_otp - Handle OTP (level) options
+ */
+static
+ERL_NIF_TERM ngetopt_otp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_otp -> entry with"
+ "\r\n eOpt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+ case SOCKET_OPT_OTP_DEBUG:
+ result = ngetopt_otp_debug(env, descP);
+ break;
+
+ case SOCKET_OPT_OTP_IOW:
+ result = ngetopt_otp_iow(env, descP);
+ break;
+
+ case SOCKET_OPT_OTP_CTRL_PROC:
+ result = ngetopt_otp_ctrl_proc(env, descP);
+ break;
+
+ case SOCKET_OPT_OTP_RCVBUF:
+ result = ngetopt_otp_rcvbuf(env, descP);
+ break;
+
+ case SOCKET_OPT_OTP_RCVCTRLBUF:
+ result = ngetopt_otp_rcvctrlbuf(env, descP);
+ break;
+
+ case SOCKET_OPT_OTP_SNDCTRLBUF:
+ result = ngetopt_otp_sndctrlbuf(env, descP);
+ break;
+
+ case SOCKET_OPT_OTP_FD:
+ result = ngetopt_otp_fd(env, descP);
+ break;
+
+ /* *** INTERNAL *** */
+ case SOCKET_OPT_OTP_DOMAIN:
+ result = ngetopt_otp_domain(env, descP);
+ break;
+
+ case SOCKET_OPT_OTP_TYPE:
+ result = ngetopt_otp_type(env, descP);
+ break;
+
+ case SOCKET_OPT_OTP_PROTOCOL:
+ result = ngetopt_otp_protocol(env, descP);
+ break;
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_otp -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+/* ngetopt_otp_debug - Handle the OTP (level) debug option
+ */
+static
+ERL_NIF_TERM ngetopt_otp_debug(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM eVal = esock_encode_bool(descP->dbg);
+
+ return esock_make_ok2(env, eVal);
+}
+
+
+/* ngetopt_otp_iow - Handle the OTP (level) iow option
+ */
+static
+ERL_NIF_TERM ngetopt_otp_iow(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM eVal = esock_encode_bool(descP->iow);
+
+ return esock_make_ok2(env, eVal);
+}
+
+
+/* ngetopt_otp_ctrl_proc - Handle the OTP (level) controlling_process option
+ */
+static
+ERL_NIF_TERM ngetopt_otp_ctrl_proc(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM eVal = MKPID(env, &descP->ctrlPid);
+
+ return esock_make_ok2(env, eVal);
+}
+
+
+
+/* ngetopt_otp_rcvbuf - Handle the OTP (level) rcvbuf option
+ */
+static
+ERL_NIF_TERM ngetopt_otp_rcvbuf(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM eVal;
+
+ if (descP->rNum == 0) {
+ eVal = MKI(env, descP->rBufSz);
+ } else {
+ eVal = MKT2(env, MKI(env, descP->rNum), MKI(env, descP->rBufSz));
+ }
+
+ return esock_make_ok2(env, eVal);
+}
+
+
+/* ngetopt_otp_rcvctrlbuf - Handle the OTP (level) rcvctrlbuf option
+ */
+static
+ERL_NIF_TERM ngetopt_otp_rcvctrlbuf(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM eVal = MKI(env, descP->rCtrlSz);
+
+ return esock_make_ok2(env, eVal);
+}
+
+
+/* ngetopt_otp_sndctrlbuf - Handle the OTP (level) sndctrlbuf option
+ */
+static
+ERL_NIF_TERM ngetopt_otp_sndctrlbuf(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM eVal = MKI(env, descP->wCtrlSz);
+
+ return esock_make_ok2(env, eVal);
+}
+
+
+/* ngetopt_otp_fd - Handle the OTP (level) fd option
+ */
+static
+ERL_NIF_TERM ngetopt_otp_fd(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM eVal = MKI(env, descP->sock);
+
+ return esock_make_ok2(env, eVal);
+}
+
+
+/* ngetopt_otp_domain - Handle the OTP (level) domain option
+ */
+static
+ERL_NIF_TERM ngetopt_otp_domain(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result, reason;
+ int val = descP->domain;
+
+ switch (val) {
+ case AF_INET:
+ result = esock_make_ok2(env, esock_atom_inet);
+ break;
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ case AF_INET6:
+ result = esock_make_ok2(env, esock_atom_inet6);
+ break;
+#endif
+
+#if defined(HAVE_SYS_UN_H)
+ case AF_UNIX:
+ result = esock_make_ok2(env, esock_atom_local);
+ break;
+#endif
+
+ default:
+ reason = MKT2(env, esock_atom_unknown, MKI(env, val));
+ result = esock_make_error(env, reason);
+ break;
+ }
+
+ return result;
+}
+
+
+/* ngetopt_otp_type - Handle the OTP (level) type options.
+ */
+static
+ERL_NIF_TERM ngetopt_otp_type(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result, reason;
+ int val = descP->type;
+
+ switch (val) {
+ case SOCK_STREAM:
+ result = esock_make_ok2(env, esock_atom_stream);
+ break;
+
+ case SOCK_DGRAM:
+ result = esock_make_ok2(env, esock_atom_dgram);
+ break;
+
+#ifdef HAVE_SCTP
+ case SOCK_SEQPACKET:
+ result = esock_make_ok2(env, esock_atom_seqpacket);
+ break;
+#endif
+ case SOCK_RAW:
+ result = esock_make_ok2(env, esock_atom_raw);
+ break;
+
+ case SOCK_RDM:
+ result = esock_make_ok2(env, esock_atom_rdm);
+ break;
+
+ default:
+ reason = MKT2(env, esock_atom_unknown, MKI(env, val));
+ result = esock_make_error(env, reason);
+ break;
+ }
+
+ return result;
+}
+
+
+/* ngetopt_otp_protocol - Handle the OTP (level) protocol options.
+ */
+static
+ERL_NIF_TERM ngetopt_otp_protocol(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result, reason;
+ int val = descP->protocol;
+
+ switch (val) {
+ case IPPROTO_IP:
+ result = esock_make_ok2(env, esock_atom_ip);
+ break;
+
+ case IPPROTO_TCP:
+ result = esock_make_ok2(env, esock_atom_tcp);
+ break;
+
+ case IPPROTO_UDP:
+ result = esock_make_ok2(env, esock_atom_udp);
+ break;
+
+#if defined(HAVE_SCTP)
+ case IPPROTO_SCTP:
+ result = esock_make_ok2(env, esock_atom_sctp);
+ break;
+#endif
+
+ default:
+ reason = MKT2(env, esock_atom_unknown, MKI(env, val));
+ result = esock_make_error(env, reason);
+ break;
+ }
+
+ return result;
+}
+
+
+
+/* The option has *not* been encoded. Instead it has been provided
+ * in "native mode" (option is provided as is). In this case it will have the
+ * format: {NativeOpt :: integer(), ValueSize :: non_neg_integer()}
+ */
+static
+ERL_NIF_TERM ngetopt_native(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ ERL_NIF_TERM eOpt)
+{
+ ERL_NIF_TERM result = enif_make_badarg(env);
+ int opt;
+ Uint16 valueType;
+ SOCKOPTLEN_T valueSz;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_native -> entry with"
+ "\r\n level: %d"
+ "\r\n eOpt: %T"
+ "\r\n", level, eOpt) );
+
+ /* <KOLLA>
+ * We should really make it possible to specify more common specific types,
+ * such as integer or boolean (instead of the size)...
+ * </KOLLA>
+ */
+
+ if (decode_native_get_opt(env, eOpt, &opt, &valueType, (int*) &valueSz)) {
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_native -> decoded opt"
+ "\r\n valueType: %d (%s)"
+ "\r\n ValueSize: %d"
+ "\r\n", valueType, VT2S(valueType), valueSz) );
+
+ switch (valueType) {
+ case SOCKET_OPT_VALUE_TYPE_UNSPEC:
+ result = ngetopt_native_unspec(env, descP, level, opt, valueSz);
+ break;
+ case SOCKET_OPT_VALUE_TYPE_INT:
+ result = ngetopt_int_opt(env, descP, level, opt);
+ break;
+ case SOCKET_OPT_VALUE_TYPE_BOOL:
+ result = ngetopt_bool_opt(env, descP, level, opt);
+ break;
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+ } else {
+ result = esock_make_error(env, esock_atom_einval);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_native -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+static
+ERL_NIF_TERM ngetopt_native_unspec(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ SOCKOPTLEN_T valueSz)
+{
+ ERL_NIF_TERM result = esock_make_error(env, esock_atom_einval);
+ int res;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_native_unspec -> entry with"
+ "\r\n level: %d"
+ "\r\n opt: %d"
+ "\r\n valueSz: %d"
+ "\r\n", level, opt, valueSz) );
+
+ if (valueSz == 0) {
+ res = sock_getopt(descP->sock, level, opt, NULL, NULL);
+ if (res != 0)
+ result = esock_make_error_errno(env, sock_errno());
+ else
+ result = esock_atom_ok;
+ } else {
+ SOCKOPTLEN_T vsz = valueSz;
+ ErlNifBinary val;
+
+ SSDBG( descP, ("SOCKET", "ngetopt_native_unspec -> try alloc buffer\r\n") );
+
+ if (ALLOC_BIN(vsz, &val)) {
+ int saveErrno;
+ res = sock_getopt(descP->sock, level, opt, val.data, &vsz);
+ if (res != 0) {
+ saveErrno = sock_errno();
+
+ result = esock_make_error_errno(env, saveErrno);
+ } else {
+
+ /* Did we use all of the buffer? */
+ if (vsz == val.size) {
+
+ result = esock_make_ok2(env, MKBIN(env, &val));
+
+ } else {
+
+ ERL_NIF_TERM tmp;
+
+ tmp = MKBIN(env, &val);
+ tmp = MKSBIN(env, tmp, 0, vsz);
+
+ result = esock_make_ok2(env, tmp);
+ }
+ }
+ } else {
+ result = enif_make_badarg(env);
+ }
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_native_unspec -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+
+/* ngetopt_level - A "proper" level (option) has been specified
+ */
+static
+ERL_NIF_TERM ngetopt_level(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int eOpt)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_level -> entry with"
+ "\r\n level: %d"
+ "\r\n eOpt: %d"
+ "\r\n", level, eOpt) );
+
+ switch (level) {
+ case SOL_SOCKET:
+ result = ngetopt_lvl_socket(env, descP, eOpt);
+ break;
+
+#if defined(SOL_IP)
+ case SOL_IP:
+#else
+ case IPPROTO_IP:
+#endif
+ result = ngetopt_lvl_ip(env, descP, eOpt);
+ break;
+
+#if defined(HAVE_IPV6)
+#if defined(SOL_IPV6)
+ case SOL_IPV6:
+#else
+ case IPPROTO_IPV6:
+#endif
+ result = ngetopt_lvl_ipv6(env, descP, eOpt);
+ break;
+#endif
+
+ case IPPROTO_TCP:
+ result = ngetopt_lvl_tcp(env, descP, eOpt);
+ break;
+
+ case IPPROTO_UDP:
+ result = ngetopt_lvl_udp(env, descP, eOpt);
+ break;
+
+#if defined(HAVE_SCTP)
+ case IPPROTO_SCTP:
+ result = ngetopt_lvl_sctp(env, descP, eOpt);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_level -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+/* ngetopt_lvl_socket - Level *SOCKET* option
+ */
+static
+ERL_NIF_TERM ngetopt_lvl_socket(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_socket -> entry with"
+ "\r\n eOpt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(SO_ACCEPTCONN)
+ case SOCKET_OPT_SOCK_ACCEPTCONN:
+ result = ngetopt_lvl_sock_acceptconn(env, descP);
+ break;
+#endif
+
+#if defined(SO_BINDTODEVICE)
+ case SOCKET_OPT_SOCK_BINDTODEVICE:
+ result = ngetopt_lvl_sock_bindtodevice(env, descP);
+ break;
+#endif
+
+#if defined(SO_BROADCAST)
+ case SOCKET_OPT_SOCK_BROADCAST:
+ result = ngetopt_lvl_sock_broadcast(env, descP);
+ break;
+#endif
+
+#if defined(SO_DEBUG)
+ case SOCKET_OPT_SOCK_DEBUG:
+ result = ngetopt_lvl_sock_debug(env, descP);
+ break;
+#endif
+
+#if defined(SO_DOMAIN)
+ case SOCKET_OPT_SOCK_DOMAIN:
+ result = ngetopt_lvl_sock_domain(env, descP);
+ break;
+#endif
+
+#if defined(SO_DONTROUTE)
+ case SOCKET_OPT_SOCK_DONTROUTE:
+ result = ngetopt_lvl_sock_dontroute(env, descP);
+ break;
+#endif
+
+#if defined(SO_KEEPALIVE)
+ case SOCKET_OPT_SOCK_KEEPALIVE:
+ result = ngetopt_lvl_sock_keepalive(env, descP);
+ break;
+#endif
+
+#if defined(SO_LINGER)
+ case SOCKET_OPT_SOCK_LINGER:
+ result = ngetopt_lvl_sock_linger(env, descP);
+ break;
+#endif
+
+#if defined(SO_OOBINLINE)
+ case SOCKET_OPT_SOCK_OOBINLINE:
+ result = ngetopt_lvl_sock_oobinline(env, descP);
+ break;
+#endif
+
+#if defined(SO_PEEK_OFF)
+ case SOCKET_OPT_SOCK_PEEK_OFF:
+ result = ngetopt_lvl_sock_peek_off(env, descP);
+ break;
+#endif
+
+#if defined(SO_PRIORITY)
+ case SOCKET_OPT_SOCK_PRIORITY:
+ result = ngetopt_lvl_sock_priority(env, descP);
+ break;
+#endif
+
+#if defined(SO_PROTOCOL)
+ case SOCKET_OPT_SOCK_PROTOCOL:
+ result = ngetopt_lvl_sock_protocol(env, descP);
+ break;
+#endif
+
+#if defined(SO_RCVBUF)
+ case SOCKET_OPT_SOCK_RCVBUF:
+ result = ngetopt_lvl_sock_rcvbuf(env, descP);
+ break;
+#endif
+
+#if defined(SO_RCVLOWAT)
+ case SOCKET_OPT_SOCK_RCVLOWAT:
+ result = ngetopt_lvl_sock_rcvlowat(env, descP);
+ break;
+#endif
+
+#if defined(SO_RCVTIMEO)
+ case SOCKET_OPT_SOCK_RCVTIMEO:
+ result = ngetopt_lvl_sock_rcvtimeo(env, descP);
+ break;
+#endif
+
+#if defined(SO_REUSEADDR)
+ case SOCKET_OPT_SOCK_REUSEADDR:
+ result = ngetopt_lvl_sock_reuseaddr(env, descP);
+ break;
+#endif
+
+#if defined(SO_REUSEPORT)
+ case SOCKET_OPT_SOCK_REUSEPORT:
+ result = ngetopt_lvl_sock_reuseport(env, descP);
+ break;
+#endif
+
+#if defined(SO_SNDBUF)
+ case SOCKET_OPT_SOCK_SNDBUF:
+ result = ngetopt_lvl_sock_sndbuf(env, descP);
+ break;
+#endif
+
+#if defined(SO_SNDLOWAT)
+ case SOCKET_OPT_SOCK_SNDLOWAT:
+ result = ngetopt_lvl_sock_sndlowat(env, descP);
+ break;
+#endif
+
+#if defined(SO_SNDTIMEO)
+ case SOCKET_OPT_SOCK_SNDTIMEO:
+ result = ngetopt_lvl_sock_sndtimeo(env, descP);
+ break;
+#endif
+
+#if defined(SO_TIMESTAMP)
+ case SOCKET_OPT_SOCK_TIMESTAMP:
+ result = ngetopt_lvl_sock_timestamp(env, descP);
+ break;
+#endif
+
+#if defined(SO_TYPE)
+ case SOCKET_OPT_SOCK_TYPE:
+ result = ngetopt_lvl_sock_type(env, descP);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_socket -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+#if defined(SO_ACCEPTCONN)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_acceptconn(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_ACCEPTCONN);
+}
+#endif
+
+
+#if defined(SO_BINDTODEVICE)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_bindtodevice(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_sock_bindtodevice -> entry with\r\n") );
+
+ return ngetopt_str_opt(env, descP, SOL_SOCKET, SO_BROADCAST, IFNAMSIZ+1);
+}
+#endif
+
+
+#if defined(SO_BROADCAST)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_broadcast(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_BROADCAST);
+}
+#endif
+
+
+#if defined(SO_DEBUG)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_debug(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_DEBUG);
+}
+#endif
+
+
+#if defined(SO_DOMAIN)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_domain(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result, reason;
+ int val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ res = sock_getopt(descP->sock, SOL_SOCKET, SO_DOMAIN,
+ &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ switch (val) {
+ case AF_INET:
+ result = esock_make_ok2(env, esock_atom_inet);
+ break;
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ case AF_INET6:
+ result = esock_make_ok2(env, esock_atom_inet6);
+ break;
+#endif
+
+#ifdef HAVE_SYS_UN_H
+ case AF_UNIX:
+ result = esock_make_ok2(env, esock_atom_local);
+ break;
+#endif
+
+ default:
+ reason = MKT2(env, esock_atom_unknown, MKI(env, val));
+ result = esock_make_error(env, reason);
+ break;
+ }
+ }
+
+ return result;
+}
+#endif
+
+
+#if defined(SO_DONTROUTE)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_dontroute(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_DONTROUTE);
+}
+#endif
+
+
+#if defined(SO_KEEPALIVE)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_keepalive(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_KEEPALIVE);
+}
+#endif
+
+
+#if defined(SO_LINGER)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_linger(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result;
+ struct linger val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ sys_memzero((void *) &val, sizeof(val));
+
+ res = sock_getopt(descP->sock, SOL_SOCKET, SO_LINGER,
+ &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM lOnOff = ((val.l_onoff) ? atom_true : atom_false);
+ ERL_NIF_TERM lSecs = MKI(env, val.l_linger);
+ ERL_NIF_TERM linger = MKT2(env, lOnOff, lSecs);
+
+ result = esock_make_ok2(env, linger);
+ }
+
+ return result;
+}
+#endif
+
+
+#if defined(SO_OOBINLINE)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_oobinline(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_OOBINLINE);
+}
+#endif
+
+
+#if defined(SO_PEEK_OFF)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_peek_off(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_PEEK_OFF);
+}
+#endif
+
+
+#if defined(SO_PRIORITY)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_priority(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_PRIORITY);
+}
+#endif
+
+
+#if defined(SO_PROTOCOL)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_protocol(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result, reason;
+ int val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ res = sock_getopt(descP->sock, SOL_SOCKET, SO_PROTOCOL,
+ &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ switch (val) {
+ case IPPROTO_IP:
+ result = esock_make_ok2(env, esock_atom_ip);
+ break;
+
+ case IPPROTO_TCP:
+ result = esock_make_ok2(env, esock_atom_tcp);
+ break;
+
+ case IPPROTO_UDP:
+ result = esock_make_ok2(env, esock_atom_udp);
+ break;
+
+#if defined(HAVE_SCTP)
+ case IPPROTO_SCTP:
+ result = esock_make_ok2(env, esock_atom_sctp);
+ break;
+#endif
+
+ default:
+ reason = MKT2(env, esock_atom_unknown, MKI(env, val));
+ result = esock_make_error(env, reason);
+ break;
+ }
+ }
+
+ return result;
+}
+#endif
+
+
+#if defined(SO_RCVBUF)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_rcvbuf(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_RCVBUF);
+}
+#endif
+
+
+#if defined(SO_RCVLOWAT)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_rcvlowat(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_RCVLOWAT);
+}
+#endif
+
+
+#if defined(SO_RCVTIMEO)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_rcvtimeo(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_timeval_opt(env, descP, SOL_SOCKET, SO_RCVTIMEO);
+}
+#endif
+
+
+#if defined(SO_REUSEADDR)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_reuseaddr(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_REUSEADDR);
+}
+#endif
+
+
+#if defined(SO_REUSEPORT)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_reuseport(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_REUSEPORT);
+}
+#endif
+
+
+#if defined(SO_SNDBUF)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_sndbuf(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_SNDBUF);
+}
+#endif
+
+
+#if defined(SO_SNDLOWAT)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_sndlowat(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, SOL_SOCKET, SO_SNDLOWAT);
+}
+#endif
+
+
+#if defined(SO_SNDTIMEO)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_sndtimeo(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_timeval_opt(env, descP, SOL_SOCKET, SO_SNDTIMEO);
+}
+#endif
+
+
+#if defined(SO_TIMESTAMP)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_timestamp(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_SOCKET, SO_TIMESTAMP);
+}
+#endif
+
+
+#if defined(SO_TYPE)
+static
+ERL_NIF_TERM ngetopt_lvl_sock_type(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result, reason;
+ int val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ res = sock_getopt(descP->sock, SOL_SOCKET, SO_TYPE, &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ switch (val) {
+ case SOCK_STREAM:
+ result = esock_make_ok2(env, esock_atom_stream);
+ break;
+ case SOCK_DGRAM:
+ result = esock_make_ok2(env, esock_atom_dgram);
+ break;
+#ifdef HAVE_SCTP
+ case SOCK_SEQPACKET:
+ result = esock_make_ok2(env, esock_atom_seqpacket);
+ break;
+#endif
+ case SOCK_RAW:
+ result = esock_make_ok2(env, esock_atom_raw);
+ break;
+ case SOCK_RDM:
+ result = esock_make_ok2(env, esock_atom_rdm);
+ break;
+ default:
+ reason = MKT2(env, esock_atom_unknown, MKI(env, val));
+ result = esock_make_error(env, reason);
+ break;
+ }
+ }
+
+ return result;
+}
+#endif
+
+
+/* ngetopt_lvl_ip - Level *IP* option(s)
+ */
+static
+ERL_NIF_TERM ngetopt_lvl_ip(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_ip -> entry with"
+ "\r\n eOpt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(IP_FREEBIND)
+ case SOCKET_OPT_IP_FREEBIND:
+ result = ngetopt_lvl_ip_freebind(env, descP);
+ break;
+#endif
+
+#if defined(IP_HDRINCL)
+ case SOCKET_OPT_IP_HDRINCL:
+ result = ngetopt_lvl_ip_hdrincl(env, descP);
+ break;
+#endif
+
+#if defined(IP_MINTTL)
+ case SOCKET_OPT_IP_MINTTL:
+ result = ngetopt_lvl_ip_minttl(env, descP);
+ break;
+#endif
+
+#if defined(IP_MTU)
+ case SOCKET_OPT_IP_MTU:
+ result = ngetopt_lvl_ip_mtu(env, descP);
+ break;
+#endif
+
+#if defined(IP_MTU_DISCOVER)
+ case SOCKET_OPT_IP_MTU_DISCOVER:
+ result = ngetopt_lvl_ip_mtu_discover(env, descP);
+ break;
+#endif
+
+#if defined(IP_MULTICAST_ALL)
+ case SOCKET_OPT_IP_MULTICAST_ALL:
+ result = ngetopt_lvl_ip_multicast_all(env, descP);
+ break;
+#endif
+
+#if defined(IP_MULTICAST_IF)
+ case SOCKET_OPT_IP_MULTICAST_IF:
+ result = ngetopt_lvl_ip_multicast_if(env, descP);
+ break;
+#endif
+
+#if defined(IP_MULTICAST_LOOP)
+ case SOCKET_OPT_IP_MULTICAST_LOOP:
+ result = ngetopt_lvl_ip_multicast_loop(env, descP);
+ break;
+#endif
+
+#if defined(IP_MULTICAST_TTL)
+ case SOCKET_OPT_IP_MULTICAST_TTL:
+ result = ngetopt_lvl_ip_multicast_ttl(env, descP);
+ break;
+#endif
+
+#if defined(IP_NODEFRAG)
+ case SOCKET_OPT_IP_NODEFRAG:
+ result = ngetopt_lvl_ip_nodefrag(env, descP);
+ break;
+#endif
+
+#if defined(IP_PKTINFO)
+ case SOCKET_OPT_IP_PKTINFO:
+ result = ngetopt_lvl_ip_pktinfo(env, descP);
+ break;
+#endif
+
+#if defined(IP_RECVDSTADDR)
+ case SOCKET_OPT_IP_RECVDSTADDR:
+ result = ngetopt_lvl_ip_recvdstaddr(env, descP);
+ break;
+#endif
+
+#if defined(IP_RECVERR)
+ case SOCKET_OPT_IP_RECVERR:
+ result = ngetopt_lvl_ip_recverr(env, descP);
+ break;
+#endif
+
+#if defined(IP_RECVIF)
+ case SOCKET_OPT_IP_RECVIF:
+ result = ngetopt_lvl_ip_recvif(env, descP);
+ break;
+#endif
+
+#if defined(IP_RECVOPTS)
+ case SOCKET_OPT_IP_RECVOPTS:
+ result = ngetopt_lvl_ip_recvopts(env, descP);
+ break;
+#endif
+
+#if defined(IP_RECVORIGDSTADDR)
+ case SOCKET_OPT_IP_RECVORIGDSTADDR:
+ result = ngetopt_lvl_ip_recvorigdstaddr(env, descP);
+ break;
+#endif
+
+#if defined(IP_RECVTOS)
+ case SOCKET_OPT_IP_RECVTOS:
+ result = ngetopt_lvl_ip_recvtos(env, descP);
+ break;
+#endif
+
+#if defined(IP_RECVTTL)
+ case SOCKET_OPT_IP_RECVTTL:
+ result = ngetopt_lvl_ip_recvttl(env, descP);
+ break;
+#endif
+
+#if defined(IP_RETOPTS)
+ case SOCKET_OPT_IP_RETOPTS:
+ result = ngetopt_lvl_ip_retopts(env, descP);
+ break;
+#endif
+
+#if defined(IP_ROUTER_ALERT)
+ case SOCKET_OPT_IP_ROUTER_ALERT:
+ result = ngetopt_lvl_ip_router_alert(env, descP);
+ break;
+#endif
+
+#if defined(IP_SENDSRCADDR)
+ case SOCKET_OPT_IP_SENDSRCADDR:
+ result = ngetopt_lvl_ip_sendsrcaddr(env, descP);
+ break;
+#endif
+
+#if defined(IP_TOS)
+ case SOCKET_OPT_IP_TOS:
+ result = ngetopt_lvl_ip_tos(env, descP);
+ break;
+#endif
+
+#if defined(IP_TRANSPARENT)
+ case SOCKET_OPT_IP_TRANSPARENT:
+ result = ngetopt_lvl_ip_transparent(env, descP);
+ break;
+#endif
+
+#if defined(IP_TTL)
+ case SOCKET_OPT_IP_TTL:
+ result = ngetopt_lvl_ip_ttl(env, descP);
+ break;
+#endif
+
+ default:
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_ip -> unknown opt %d\r\n", eOpt) );
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_ip -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+/* ngetopt_lvl_ip_minttl - Level IP MINTTL option
+ */
+#if defined(IP_MINTTL)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_minttl(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IP_MINTTL);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_freebind - Level IP FREEBIND option
+ */
+#if defined(IP_FREEBIND)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_freebind(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_FREEBIND);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_hdrincl - Level IP HDRINCL option
+ */
+#if defined(IP_HDRINCL)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_hdrincl(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_HDRINCL);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_mtu - Level IP MTU option
+ */
+#if defined(IP_MTU)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_mtu(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IP_MTU);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_mtu_discover - Level IP MTU_DISCOVER option
+ */
+#if defined(IP_MTU_DISCOVER)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_mtu_discover(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result;
+ ERL_NIF_TERM eMtuDisc;
+ int mtuDisc;
+ SOCKOPTLEN_T mtuDiscSz = sizeof(mtuDisc);
+ int res;
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ res = sock_getopt(descP->sock, level, IP_MTU_DISCOVER,
+ &mtuDisc, &mtuDiscSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ encode_ip_pmtudisc(env, mtuDisc, &eMtuDisc);
+ result = esock_make_ok2(env, eMtuDisc);
+ }
+
+ return result;
+
+}
+#endif
+
+
+/* ngetopt_lvl_ip_multicast_all - Level IP MULTICAST_ALL option
+ */
+#if defined(IP_MULTICAST_ALL)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_multicast_all(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_MULTICAST_ALL);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_multicast_if - Level IP MULTICAST_IF option
+ */
+#if defined(IP_MULTICAST_IF)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_multicast_if(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result;
+ ERL_NIF_TERM eAddr;
+ struct in_addr ifAddr;
+ SOCKOPTLEN_T ifAddrSz = sizeof(ifAddr);
+ char* xres;
+ int res;
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ res = sock_getopt(descP->sock, level, IP_MULTICAST_IF, &ifAddr, &ifAddrSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ if ((xres = esock_encode_ip4_address(env, &ifAddr, &eAddr)) != NULL) {
+ result = esock_make_error_str(env, xres);
+ } else {
+ result = esock_make_ok2(env, eAddr);
+ }
+ }
+
+ return result;
+
+}
+#endif
+
+
+/* ngetopt_lvl_ip_multicast_loop - Level IP MULTICAST_LOOP option
+ */
+#if defined(IP_MULTICAST_LOOP)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_multicast_loop(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_MULTICAST_LOOP);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_multicast_ttl - Level IP MULTICAST_TTL option
+ */
+#if defined(IP_MULTICAST_TTL)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_multicast_ttl(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IP_MULTICAST_TTL);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_nodefrag - Level IP NODEFRAG option
+ */
+#if defined(IP_NODEFRAG)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_nodefrag(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_NODEFRAG);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_pktinfo - Level IP PKTINFO option
+ */
+#if defined(IP_PKTINFO)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_pktinfo(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_PKTINFO);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_recvtos - Level IP RECVTOS option
+ */
+#if defined(IP_RECVTOS)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_recvtos(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_RECVTOS);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_recvdstaddr - Level IP RECVDSTADDR option
+ */
+#if defined(IP_RECVDSTADDR)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_recvdstaddr(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_RECVDSTADDR);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_recverr - Level IP RECVERR option
+ */
+#if defined(IP_RECVERR)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_recverr(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_RECVERR);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_recvif - Level IP RECVIF option
+ */
+#if defined(IP_RECVIF)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_recvif(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_RECVIF);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_recvopt - Level IP RECVOPTS option
+ */
+#if defined(IP_RECVOPTS)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_recvopts(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_RECVOPTS);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_recvorigdstaddr - Level IP RECVORIGDSTADDR option
+ */
+#if defined(IP_RECVORIGDSTADDR)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_recvorigdstaddr(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_RECVORIGDSTADDR);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_recvttl - Level IP RECVTTL option
+ */
+#if defined(IP_RECVTTL)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_recvttl(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_RECVTTL);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_retopts - Level IP RETOPTS option
+ */
+#if defined(IP_RETOPTS)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_retopts(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_RETOPTS);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_router_alert - Level IP ROUTER_ALERT option
+ */
+#if defined(IP_ROUTER_ALERT)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_router_alert(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IP_ROUTER_ALERT);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_sendsrcaddr - Level IP SENDSRCADDR option
+ */
+#if defined(IP_SENDSRCADDR)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_sendsrcaddr(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_SENDSRCADDR);
+}
+#endif
+
+
+/* ngetopt_lvl_ip_tos - Level IP TOS option
+ */
+#if defined(IP_TOS)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_tos(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+ ERL_NIF_TERM result;
+ int val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ res = sock_getopt(descP->sock, level, IP_TOS, &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ result = encode_ip_tos(env, val);
+ }
+
+ return result;
+}
+#endif
+
+
+/* ngetopt_lvl_ip_transparent - Level IP TRANSPARENT option
+ */
+#if defined(IP_TRANSPARENT)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_transparent(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IP_TRANSPARENT);
+}
+#endif
+
+
+
+/* ngetopt_lvl_ip_ttl - Level IP TTL option
+ */
+#if defined(IP_TTL)
+static
+ERL_NIF_TERM ngetopt_lvl_ip_ttl(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IP)
+ int level = SOL_IP;
+#else
+ int level = IPPROTO_IP;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IP_TTL);
+}
+#endif
+
+
+
+/* ngetopt_lvl_ipv6 - Level *IPv6* option(s)
+ */
+#if defined(HAVE_IPV6)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_ipv6 -> entry with"
+ "\r\n eOpt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(IPV6_AUTHHDR)
+ case SOCKET_OPT_IPV6_AUTHHDR:
+ result = ngetopt_lvl_ipv6_authhdr(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_DSTOPTS)
+ case SOCKET_OPT_IPV6_DSTOPTS:
+ result = ngetopt_lvl_ipv6_dstopts(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_FLOWINFO)
+ case SOCKET_OPT_IPV6_FLOWINFO:
+ result = ngetopt_lvl_ipv6_flowinfo(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_HOPLIMIT)
+ case SOCKET_OPT_IPV6_HOPLIMIT:
+ result = ngetopt_lvl_ipv6_hoplimit(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_HOPOPTS)
+ case SOCKET_OPT_IPV6_HOPOPTS:
+ result = ngetopt_lvl_ipv6_hopopts(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_MTU)
+ case SOCKET_OPT_IPV6_MTU:
+ result = ngetopt_lvl_ipv6_mtu(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_MTU_DISCOVER)
+ case SOCKET_OPT_IPV6_MTU_DISCOVER:
+ result = ngetopt_lvl_ipv6_mtu_discover(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_MULTICAST_HOPS)
+ case SOCKET_OPT_IPV6_MULTICAST_HOPS:
+ result = ngetopt_lvl_ipv6_multicast_hops(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_MULTICAST_IF)
+ case SOCKET_OPT_IPV6_MULTICAST_IF:
+ result = ngetopt_lvl_ipv6_multicast_if(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_MULTICAST_LOOP)
+ case SOCKET_OPT_IPV6_MULTICAST_LOOP:
+ result = ngetopt_lvl_ipv6_multicast_loop(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_RECVERR)
+ case SOCKET_OPT_IPV6_RECVERR:
+ result = ngetopt_lvl_ipv6_recverr(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO)
+ case SOCKET_OPT_IPV6_RECVPKTINFO:
+ result = ngetopt_lvl_ipv6_recvpktinfo(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_ROUTER_ALERT)
+ case SOCKET_OPT_IPV6_ROUTER_ALERT:
+ result = ngetopt_lvl_ipv6_router_alert(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_RTHDR)
+ case SOCKET_OPT_IPV6_RTHDR:
+ result = ngetopt_lvl_ipv6_rthdr(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_UNICAST_HOPS)
+ case SOCKET_OPT_IPV6_UNICAST_HOPS:
+ result = ngetopt_lvl_ipv6_unicast_hops(env, descP);
+ break;
+#endif
+
+#if defined(IPV6_V6ONLY)
+ case SOCKET_OPT_IPV6_V6ONLY:
+ result = ngetopt_lvl_ipv6_v6only(env, descP);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_ipv6 -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+#if defined(IPV6_AUTHHDR)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_authhdr(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, SOL_IPV6, IPV6_AUTHHDR);
+}
+#endif
+
+
+#if defined(IPV6_DSTOPTS)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_dstopts(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+ return ngetopt_bool_opt(env, descP, level, IPV6_DSTOPTS);
+}
+#endif
+
+
+#if defined(IPV6_FLOWINFO)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_flowinfo(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IPV6_FLOWINFO);
+}
+#endif
+
+
+#if defined(IPV6_HOPLIMIT)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_hoplimit(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IPV6_HOPLIMIT);
+}
+#endif
+
+
+#if defined(IPV6_HOPOPTS)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_hopopts(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IPV6_HOPOPTS);
+}
+#endif
+
+
+#if defined(IPV6_MTU)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_mtu(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IPV6_MTU);
+}
+#endif
+
+
+/* ngetopt_lvl_ipv6_mtu_discover - Level IPv6 MTU_DISCOVER option
+ */
+#if defined(IPV6_MTU_DISCOVER)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_mtu_discover(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result;
+ ERL_NIF_TERM eMtuDisc;
+ int mtuDisc;
+ SOCKOPTLEN_T mtuDiscSz = sizeof(mtuDisc);
+ int res;
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ res = sock_getopt(descP->sock, level, IPV6_MTU_DISCOVER,
+ &mtuDisc, &mtuDiscSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ encode_ipv6_pmtudisc(env, mtuDisc, &eMtuDisc);
+ result = esock_make_ok2(env, eMtuDisc);
+ }
+
+ return result;
+
+}
+#endif
+
+
+#if defined(IPV6_MULTICAST_HOPS)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_hops(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IPV6_MULTICAST_HOPS);
+}
+#endif
+
+
+#if defined(IPV6_MULTICAST_IF)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_if(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IPV6_MULTICAST_IF);
+}
+#endif
+
+
+#if defined(IPV6_MULTICAST_LOOP)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_multicast_loop(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IPV6_MULTICAST_LOOP);
+}
+#endif
+
+
+#if defined(IPV6_RECVERR)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_recverr(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IPV6_RECVERR);
+}
+#endif
+
+
+#if defined(IPV6_RECVPKTINFO) || defined(IPV6_PKTINFO)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_recvpktinfo(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+#if defined(IPV6_RECVPKTINFO)
+ int opt = IPV6_RECVPKTINFO;
+#else
+ int opt = IPV6_PKTINFO;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, opt);
+}
+#endif
+
+
+#if defined(IPV6_ROUTER_ALERT)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_router_alert(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IPV6_ROUTER_ALERT);
+}
+#endif
+
+
+#if defined(IPV6_RTHDR)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_rthdr(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IPV6_RTHDR);
+}
+#endif
+
+
+#if defined(IPV6_UNICAST_HOPS)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_unicast_hops(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_int_opt(env, descP, level, IPV6_UNICAST_HOPS);
+}
+#endif
+
+
+#if defined(IPV6_V6ONLY)
+static
+ERL_NIF_TERM ngetopt_lvl_ipv6_v6only(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+#if defined(SOL_IPV6)
+ int level = SOL_IPV6;
+#else
+ int level = IPPROTO_IPV6;
+#endif
+
+ return ngetopt_bool_opt(env, descP, level, IPV6_V6ONLY);
+}
+#endif
+
+
+#endif // defined(HAVE_IPV6)
+
+
+
+/* ngetopt_lvl_tcp - Level *TCP* option(s)
+ */
+static
+ERL_NIF_TERM ngetopt_lvl_tcp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt)
+{
+ ERL_NIF_TERM result;
+
+ switch (eOpt) {
+#if defined(TCP_CONGESTION)
+ case SOCKET_OPT_TCP_CONGESTION:
+ result = ngetopt_lvl_tcp_congestion(env, descP);
+ break;
+#endif
+
+#if defined(TCP_MAXSEG)
+ case SOCKET_OPT_TCP_MAXSEG:
+ result = ngetopt_lvl_tcp_maxseg(env, descP);
+ break;
+#endif
+
+#if defined(TCP_NODELAY)
+ case SOCKET_OPT_TCP_NODELAY:
+ result = ngetopt_lvl_tcp_nodelay(env, descP);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return result;
+}
+
+
+/* ngetopt_lvl_tcp_congestion - Level TCP CONGESTION option
+ */
+#if defined(TCP_CONGESTION)
+static
+ERL_NIF_TERM ngetopt_lvl_tcp_congestion(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ int max = SOCKET_OPT_TCP_CONGESTION_NAME_MAX+1;
+
+ return ngetopt_str_opt(env, descP, IPPROTO_TCP, TCP_CONGESTION, max);
+}
+#endif
+
+
+/* ngetopt_lvl_tcp_maxseg - Level TCP MAXSEG option
+ */
+#if defined(TCP_MAXSEG)
+static
+ERL_NIF_TERM ngetopt_lvl_tcp_maxseg(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, IPPROTO_TCP, TCP_MAXSEG);
+}
+#endif
+
+
+/* ngetopt_lvl_tcp_nodelay - Level TCP NODELAY option
+ */
+#if defined(TCP_NODELAY)
+static
+ERL_NIF_TERM ngetopt_lvl_tcp_nodelay(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, IPPROTO_TCP, TCP_NODELAY);
+}
+#endif
+
+
+
+/* ngetopt_lvl_udp - Level *UDP* option(s)
+ */
+static
+ERL_NIF_TERM ngetopt_lvl_udp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt)
+{
+ ERL_NIF_TERM result;
+
+ switch (eOpt) {
+#if defined(UDP_CORK)
+ case SOCKET_OPT_UDP_CORK:
+ result = ngetopt_lvl_udp_cork(env, descP);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ return result;
+}
+
+
+/* ngetopt_lvl_udp_cork - Level UDP CORK option
+ */
+#if defined(UDP_CORK)
+static
+ERL_NIF_TERM ngetopt_lvl_udp_cork(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, IPPROTO_UDP, UDP_CORK);
+}
+#endif
+
+
+
+/* ngetopt_lvl_sctp - Level *SCTP* option(s)
+ */
+#if defined(HAVE_SCTP)
+static
+ERL_NIF_TERM ngetopt_lvl_sctp(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int eOpt)
+{
+ ERL_NIF_TERM result;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_sctp -> entry with"
+ "\r\n opt: %d"
+ "\r\n", eOpt) );
+
+ switch (eOpt) {
+#if defined(SCTP_ASSOCINFO)
+ case SOCKET_OPT_SCTP_ASSOCINFO:
+ result = ngetopt_lvl_sctp_associnfo(env, descP);
+ break;
+#endif
+
+#if defined(SCTP_AUTOCLOSE)
+ case SOCKET_OPT_SCTP_AUTOCLOSE:
+ result = ngetopt_lvl_sctp_autoclose(env, descP);
+ break;
+#endif
+
+#if defined(SCTP_DISABLE_FRAGMENTS)
+ case SOCKET_OPT_SCTP_DISABLE_FRAGMENTS:
+ result = ngetopt_lvl_sctp_disable_fragments(env, descP);
+ break;
+#endif
+
+#if defined(SCTP_INITMSG)
+ case SOCKET_OPT_SCTP_INITMSG:
+ result = ngetopt_lvl_sctp_initmsg(env, descP);
+ break;
+#endif
+
+#if defined(SCTP_MAXSEG)
+ case SOCKET_OPT_SCTP_MAXSEG:
+ result = ngetopt_lvl_sctp_maxseg(env, descP);
+ break;
+#endif
+
+#if defined(SCTP_NODELAY)
+ case SOCKET_OPT_SCTP_NODELAY:
+ result = ngetopt_lvl_sctp_nodelay(env, descP);
+ break;
+#endif
+
+#if defined(SCTP_RTOINFO)
+ case SOCKET_OPT_SCTP_RTOINFO:
+ result = ngetopt_lvl_sctp_rtoinfo(env, descP);
+ break;
+#endif
+
+ default:
+ result = esock_make_error(env, esock_atom_einval);
+ break;
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_sctp -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+/* ngetopt_lvl_sctp_associnfo - Level SCTP ASSOCINFO option
+ *
+ * <KOLLA>
+ *
+ * We should really specify which association this relates to,
+ * as it is now we get assoc-id = 0. If this socket is an
+ * association (and not an endpoint) then it will have an
+ * assoc id. But since the sctp support at present is "limited",
+ * we leave it for now.
+ * What do we do if this is an endpoint? Invalid op?
+ *
+ * </KOLLA>
+ */
+#if defined(SCTP_ASSOCINFO)
+static
+ERL_NIF_TERM ngetopt_lvl_sctp_associnfo(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result;
+ struct sctp_assocparams val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ SSDBG( descP, ("SOCKET", "ngetopt_lvl_sctp_associnfo -> entry\r\n") );
+
+ sys_memzero((char*) &val, valSz);
+ res = sock_getopt(descP->sock, IPPROTO_SCTP, SCTP_ASSOCINFO, &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM eAssocParams;
+ ERL_NIF_TERM keys[] = {atom_assoc_id, atom_max_rxt, atom_num_peer_dests,
+ atom_peer_rwnd, atom_local_rwnd, atom_cookie_life};
+ ERL_NIF_TERM vals[] = {MKUI(env, val.sasoc_assoc_id),
+ MKUI(env, val.sasoc_asocmaxrxt),
+ MKUI(env, val.sasoc_number_peer_destinations),
+ MKUI(env, val.sasoc_peer_rwnd),
+ MKUI(env, val.sasoc_local_rwnd),
+ MKUI(env, val.sasoc_cookie_life)};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, &eAssocParams))
+ return esock_make_error(env, esock_atom_einval);;
+
+ result = esock_make_ok2(env, eAssocParams);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_sctp_associnfo -> done with"
+ "\r\n res: %d"
+ "\r\n result: %T"
+ "\r\n", res, result) );
+
+ return result;
+}
+#endif
+
+
+/* ngetopt_lvl_sctp_autoclose - Level SCTP AUTOCLOSE option
+ */
+#if defined(SCTP_AUTOCLOSE)
+static
+ERL_NIF_TERM ngetopt_lvl_sctp_autoclose(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, IPPROTO_SCTP, SCTP_AUTOCLOSE);
+}
+#endif
+
+
+/* ngetopt_lvl_sctp_disable_fragments - Level SCTP DISABLE:FRAGMENTS option
+ */
+#if defined(SCTP_DISABLE_FRAGMENTS)
+static
+ERL_NIF_TERM ngetopt_lvl_sctp_disable_fragments(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, IPPROTO_SCTP, SCTP_DISABLE_FRAGMENTS);
+}
+#endif
+
+
+/* ngetopt_lvl_sctp_initmsg - Level SCTP INITMSG option
+ *
+ */
+#if defined(SCTP_INITMSG)
+static
+ERL_NIF_TERM ngetopt_lvl_sctp_initmsg(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result;
+ struct sctp_initmsg val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ SSDBG( descP, ("SOCKET", "ngetopt_lvl_sctp_initmsg -> entry\r\n") );
+
+ sys_memzero((char*) &val, valSz);
+ res = sock_getopt(descP->sock, IPPROTO_SCTP, SCTP_INITMSG, &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM eInitMsg;
+ ERL_NIF_TERM keys[] = {atom_num_outstreams, atom_max_instreams,
+ atom_max_attempts, atom_max_init_timeo};
+ ERL_NIF_TERM vals[] = {MKUI(env, val.sinit_num_ostreams),
+ MKUI(env, val.sinit_max_instreams),
+ MKUI(env, val.sinit_max_attempts),
+ MKUI(env, val.sinit_max_init_timeo)};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, &eInitMsg))
+ return esock_make_error(env, esock_atom_einval);;
+
+ result = esock_make_ok2(env, eInitMsg);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_sctp_initmsg -> done with"
+ "\r\n res: %d"
+ "\r\n result: %T"
+ "\r\n", res, result) );
+
+ return result;
+}
+#endif
+
+
+/* ngetopt_lvl_sctp_maxseg - Level SCTP MAXSEG option
+ */
+#if defined(SCTP_MAXSEG)
+static
+ERL_NIF_TERM ngetopt_lvl_sctp_maxseg(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_int_opt(env, descP, IPPROTO_SCTP, SCTP_MAXSEG);
+}
+#endif
+
+
+/* ngetopt_lvl_sctp_nodelay - Level SCTP NODELAY option
+ */
+#if defined(SCTP_NODELAY)
+static
+ERL_NIF_TERM ngetopt_lvl_sctp_nodelay(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ return ngetopt_bool_opt(env, descP, IPPROTO_SCTP, SCTP_NODELAY);
+}
+#endif
+
+
+/* ngetopt_lvl_sctp_associnfo - Level SCTP ASSOCINFO option
+ *
+ * <KOLLA>
+ *
+ * We should really specify which association this relates to,
+ * as it is now we get assoc-id = 0. If this socket is an
+ * association (and not an endpoint) then it will have an
+ * assoc id (we can assume). But since the sctp support at
+ * present is "limited", we leave it for now.
+ * What do we do if this is an endpoint? Invalid op?
+ *
+ * </KOLLA>
+ */
+#if defined(SCTP_RTOINFO)
+static
+ERL_NIF_TERM ngetopt_lvl_sctp_rtoinfo(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM result;
+ struct sctp_rtoinfo val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ SSDBG( descP, ("SOCKET", "ngetopt_lvl_sctp_rtoinfo -> entry\r\n") );
+
+ sys_memzero((char*) &val, valSz);
+ res = sock_getopt(descP->sock, IPPROTO_SCTP, SCTP_RTOINFO, &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM eRTOInfo;
+ ERL_NIF_TERM keys[] = {atom_assoc_id, atom_initial, atom_max, atom_min};
+ ERL_NIF_TERM vals[] = {MKUI(env, val.srto_assoc_id),
+ MKUI(env, val.srto_initial),
+ MKUI(env, val.srto_max),
+ MKUI(env, val.srto_min)};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, &eRTOInfo))
+ return esock_make_error(env, esock_atom_einval);;
+
+ result = esock_make_ok2(env, eRTOInfo);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_lvl_sctp_rtoinfo -> done with"
+ "\r\n res: %d"
+ "\r\n result: %T"
+ "\r\n", res, result) );
+
+ return result;
+}
+#endif
+
+
+
+#endif // defined(HAVE_SCTP)
+
+
+
+/* ngetopt_bool_opt - get an (integer) bool option
+ */
+static
+ERL_NIF_TERM ngetopt_bool_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt)
+{
+ ERL_NIF_TERM result;
+ int val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ /*
+ SSDBG( descP, ("SOCKET", "ngetopt_bool_opt -> entry with"
+ "\r\n: level: %d"
+ "\r\n: opt: %d"
+ "\r\n", level, opt) );
+ */
+
+ res = sock_getopt(descP->sock, level, opt, &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM bval = ((val) ? atom_true : atom_false);
+
+ result = esock_make_ok2(env, bval);
+ }
+
+ /*
+ SSDBG( descP, ("SOCKET", "ngetopt_bool_opt -> done when"
+ "\r\n: res: %d"
+ "\r\n: result: %T"
+ "\r\n", res, result) );
+ */
+
+ return result;
+}
+
+
+/* ngetopt_int_opt - get an integer option
+ */
+static
+ERL_NIF_TERM ngetopt_int_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt)
+{
+ ERL_NIF_TERM result;
+ int val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ res = sock_getopt(descP->sock, level, opt, &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ result = esock_make_ok2(env, MKI(env, val));
+ }
+
+ return result;
+}
+
+
+
+/* ngetopt_timeval_opt - get an timeval option
+ */
+static
+ERL_NIF_TERM ngetopt_timeval_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt)
+{
+ ERL_NIF_TERM result;
+ struct timeval val;
+ SOCKOPTLEN_T valSz = sizeof(val);
+ int res;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_timeval_opt -> entry with"
+ "\r\n level: %d"
+ "\r\n opt: %d"
+ "\r\n", level, opt) );
+
+ sys_memzero((char*) &val, valSz);
+ res = sock_getopt(descP->sock, level, opt, &val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM eTimeVal;
+ char* xres;
+
+ if ((xres = esock_encode_timeval(env, &val, &eTimeVal)) != NULL)
+ result = esock_make_error_str(env, xres);
+ else
+ result = esock_make_ok2(env, eTimeVal);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_timeval_opt -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ return result;
+}
+
+
+
+/* ngetopt_str_opt - get an string option
+ *
+ * We provide the max size of the string. This is the
+ * size of the buffer we allocate for the value.
+ * The actual size of the (read) value will be communicated
+ * in the optSz variable.
+ */
+#if defined(USE_GETOPT_STR_OPT)
+static
+ERL_NIF_TERM ngetopt_str_opt(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int level,
+ int opt,
+ int max)
+{
+ ERL_NIF_TERM result;
+ char* val = MALLOC(max);
+ SOCKOPTLEN_T valSz = max;
+ int res;
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_str_opt -> entry with"
+ "\r\n level: %d"
+ "\r\n opt: %d"
+ "\r\n max: %d"
+ "\r\n", level, opt, max) );
+
+ res = sock_getopt(descP->sock, level, opt, val, &valSz);
+
+ if (res != 0) {
+ result = esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM sval = MKSL(env, val, valSz);
+
+ result = esock_make_ok2(env, sval);
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "ngetopt_str_opt -> done when"
+ "\r\n result: %T"
+ "\r\n", result) );
+
+ FREE(val);
+
+ return result;
+}
+#endif // if defined(USE_GETOPT_STR_OPT)
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_sockname - get socket name
+ *
+ * Description:
+ * Returns the current address to which the socket is bound.
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ */
+
+static
+ERL_NIF_TERM nif_sockname(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM res;
+
+ SGDBG( ("SOCKET", "nif_sockname -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 1) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ SSDBG( descP,
+ ("SOCKET", "nif_sockname -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n", descP->sock, argv[0]) );
+
+ res = nsockname(env, descP);
+
+ SSDBG( descP, ("SOCKET", "nif_sockname -> done with res = %T\r\n", res) );
+
+ return res;
+#endif // if defined(__WIN32__)
+}
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM nsockname(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ SocketAddress sa;
+ SocketAddress* saP = &sa;
+ unsigned int sz = sizeof(SocketAddress);
+
+ sys_memzero((char*) saP, sz);
+ if (IS_SOCKET_ERROR(sock_name(descP->sock, (struct sockaddr*) saP, &sz))) {
+ return esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM esa;
+ char* xres;
+
+ if ((xres = esock_encode_sockaddr(env, saP, sz, &esa)) != NULL)
+ return esock_make_error_str(env, xres);
+ else
+ return esock_make_ok2(env, esa);
+ }
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_peername - get name of the connected peer socket
+ *
+ * Description:
+ * Returns the address of the peer connected to the socket.
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ */
+
+static
+ERL_NIF_TERM nif_peername(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM res;
+
+ SGDBG( ("SOCKET", "nif_peername -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ if ((argc != 1) ||
+ !enif_get_resource(env, argv[0], sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ SSDBG( descP,
+ ("SOCKET", "nif_peername -> args when sock = %d:"
+ "\r\n Socket: %T"
+ "\r\n", descP->sock, argv[0]) );
+
+ res = npeername(env, descP);
+
+ SSDBG( descP, ("SOCKET", "nif_peername -> done with res = %T\r\n", res) );
+
+ return res;
+#endif // if defined(__WIN32__)
+}
+
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM npeername(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ SocketAddress sa;
+ SocketAddress* saP = &sa;
+ unsigned int sz = sizeof(SocketAddress);
+
+ sys_memzero((char*) saP, sz);
+ if (IS_SOCKET_ERROR(sock_peer(descP->sock, (struct sockaddr*) saP, &sz))) {
+ return esock_make_error_errno(env, sock_errno());
+ } else {
+ ERL_NIF_TERM esa;
+ char* xres;
+
+ if ((xres = esock_encode_sockaddr(env, saP, sz, &esa)) != NULL)
+ return esock_make_error_str(env, xres);
+ else
+ return esock_make_ok2(env, esa);
+ }
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * nif_cancel
+ *
+ * Description:
+ * Cancel a previous select!
+ *
+ * Arguments:
+ * Socket (ref) - Points to the socket descriptor.
+ * Operation (atom) - What kind of operation (accept, send, ...) is to be cancelled
+ * Ref (ref) - Unique id for the operation
+ */
+static
+ERL_NIF_TERM nif_cancel(ErlNifEnv* env,
+ int argc,
+ const ERL_NIF_TERM argv[])
+{
+#if defined(__WIN32__)
+ return enif_raise_exception(env, MKA(env, "notsup"));
+#else
+ SocketDescriptor* descP;
+ ERL_NIF_TERM op, sockRef, opRef, result;
+
+ SGDBG( ("SOCKET", "nif_cancel -> entry with argc: %d\r\n", argc) );
+
+ /* Extract arguments and perform preliminary validation */
+
+ sockRef = argv[0];
+ if ((argc != 3) ||
+ !enif_get_resource(env, sockRef, sockets, (void**) &descP)) {
+ return enif_make_badarg(env);
+ }
+ op = argv[1];
+ opRef = argv[2];
+
+ if (IS_CLOSED(descP) || IS_CLOSING(descP))
+ return esock_make_error(env, atom_closed);
+
+ SSDBG( descP,
+ ("SOCKET", "nif_cancel -> args when sock = %d:"
+ "\r\n op: %T"
+ "\r\n opRef: %T"
+ "\r\n", descP->sock, op, opRef) );
+
+ result = ncancel(env, descP, op, sockRef, opRef);
+
+ SSDBG( descP,
+ ("SOCKET", "nif_cancel -> done with result: "
+ "\r\n %T"
+ "\r\n", result) );
+
+ return result;
+#endif // if !defined(__WIN32__)
+}
+
+
+#if !defined(__WIN32__)
+static
+ERL_NIF_TERM ncancel(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM op,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef)
+{
+ /* <KOLLA>
+ *
+ * Do we really need all these variants? Should it not be enough with:
+ *
+ * connect | accept | send | recv
+ *
+ * </KOLLA>
+ */
+ if (COMPARE(op, esock_atom_connect) == 0) {
+ return ncancel_connect(env, descP, opRef);
+ } else if (COMPARE(op, esock_atom_accept) == 0) {
+ return ncancel_accept(env, descP, sockRef, opRef);
+ } else if (COMPARE(op, esock_atom_send) == 0) {
+ return ncancel_send(env, descP, sockRef, opRef);
+ } else if (COMPARE(op, esock_atom_sendto) == 0) {
+ return ncancel_send(env, descP, sockRef, opRef);
+ } else if (COMPARE(op, esock_atom_sendmsg) == 0) {
+ return ncancel_send(env, descP, sockRef, opRef);
+ } else if (COMPARE(op, esock_atom_recv) == 0) {
+ return ncancel_recv(env, descP, sockRef, opRef);
+ } else if (COMPARE(op, esock_atom_recvfrom) == 0) {
+ return ncancel_recv(env, descP, sockRef, opRef);
+ } else if (COMPARE(op, esock_atom_recvmsg) == 0) {
+ return ncancel_recv(env, descP, sockRef, opRef);
+ } else {
+ return esock_make_error(env, esock_atom_einval);
+ }
+}
+
+
+
+/* *** ncancel_connect ***
+ *
+ *
+ */
+static
+ERL_NIF_TERM ncancel_connect(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef)
+{
+ return ncancel_write_select(env, descP, opRef);
+}
+
+
+/* *** ncancel_accept ***
+ *
+ * We have two different cases:
+ * *) Its the current acceptor
+ * Cancel the select!
+ * We need to activate one of the waiting acceptors.
+ * *) Its one of the acceptors ("waiting") in the queue
+ * Simply remove the acceptor from the queue.
+ *
+ */
+static
+ERL_NIF_TERM ncancel_accept(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef)
+{
+ ERL_NIF_TERM res;
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_accept -> entry with"
+ "\r\n opRef: %T"
+ "\r\n %s"
+ "\r\n", opRef,
+ ((descP->currentAcceptorP == NULL) ? "without acceptor" : "with acceptor")) );
+
+ MLOCK(descP->accMtx);
+
+ if (descP->currentAcceptorP != NULL) {
+ if (COMPARE(opRef, descP->currentAcceptor.ref) == 0) {
+ res = ncancel_accept_current(env, descP, sockRef);
+ } else {
+ res = ncancel_accept_waiting(env, descP, opRef);
+ }
+ } else {
+ /* Or badarg? */
+ res = esock_make_error(env, esock_atom_einval);
+ }
+
+ MUNLOCK(descP->accMtx);
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_accept -> done with result:"
+ "\r\n %T"
+ "\r\n", res) );
+
+ return res;
+}
+
+
+/* The current acceptor process has an ongoing select we first must
+ * cancel. Then we must re-activate the "first" (the first
+ * in the acceptor queue).
+ */
+static
+ERL_NIF_TERM ncancel_accept_current(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef)
+{
+ ERL_NIF_TERM res;
+
+ SSDBG( descP, ("SOCKET", "ncancel_accept_current -> entry\r\n") );
+
+ DEMONP("ncancel_accept_current -> current acceptor",
+ env, descP, &descP->currentAcceptor.mon);
+ res = ncancel_read_select(env, descP, descP->currentAcceptor.ref);
+
+ SSDBG( descP, ("SOCKET",
+ "ncancel_accept_current -> cancel res: %T\r\n", res) );
+
+ if (!activate_next_acceptor(env, descP, sockRef)) {
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_accept_current -> no more writers\r\n") );
+
+ descP->state = SOCKET_STATE_LISTENING;
+
+ descP->currentAcceptorP = NULL;
+ descP->currentAcceptor.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentAcceptor.pid);
+ esock_monitor_init(&descP->currentAcceptor.mon);
+ }
+
+ SSDBG( descP, ("SOCKET", "ncancel_accept_current -> done with result:"
+ "\r\n %T"
+ "\r\n", res) );
+
+ return res;
+}
+
+
+/* These processes have not performed a select, so we can simply
+ * remove them from the acceptor queue.
+ */
+static
+ERL_NIF_TERM ncancel_accept_waiting(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef)
+{
+ ErlNifPid caller;
+
+ if (enif_self(env, &caller) == NULL)
+ return esock_make_error(env, atom_exself);
+
+ /* unqueue request from (acceptor) queue */
+
+ if (acceptor_unqueue(env, descP, &caller)) {
+ return esock_atom_ok;
+ } else {
+ /* Race? */
+ return esock_make_error(env, esock_atom_not_found);
+ }
+}
+
+
+
+/* *** ncancel_send ***
+ *
+ * Cancel a send operation.
+ * Its either the current writer or one of the waiting writers.
+ */
+static
+ERL_NIF_TERM ncancel_send(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef)
+{
+ ERL_NIF_TERM res;
+
+ MLOCK(descP->writeMtx);
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_send -> entry with"
+ "\r\n opRef: %T"
+ "\r\n %s"
+ "\r\n", opRef,
+ ((descP->currentWriterP == NULL) ? "without writer" : "with writer")) );
+
+ if (descP->currentWriterP != NULL) {
+ if (COMPARE(opRef, descP->currentWriter.ref) == 0) {
+ res = ncancel_send_current(env, descP, sockRef);
+ } else {
+ res = ncancel_send_waiting(env, descP, opRef);
+ }
+ } else {
+ /* Or badarg? */
+ res = esock_make_error(env, esock_atom_einval);
+ }
+
+ MUNLOCK(descP->writeMtx);
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_send -> done with result:"
+ "\r\n %T"
+ "\r\n", res) );
+
+ return res;
+}
+
+
+
+/* The current writer process has an ongoing select we first must
+ * cancel. Then we must re-activate the "first" (the first
+ * in the writer queue).
+ */
+static
+ERL_NIF_TERM ncancel_send_current(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef)
+{
+ ERL_NIF_TERM res;
+
+ SSDBG( descP, ("SOCKET", "ncancel_send_current -> entry\r\n") );
+
+ DEMONP("ncancel_send_current -> current writer",
+ env, descP, &descP->currentWriter.mon);
+ res = ncancel_write_select(env, descP, descP->currentWriter.ref);
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_send_current -> cancel res: %T\r\n", res) );
+
+ if (!activate_next_writer(env, descP, sockRef)) {
+ SSDBG( descP,
+ ("SOCKET", "ncancel_send_current -> no more writers\r\n") );
+ descP->currentWriterP = NULL;
+ descP->currentWriter.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentWriter.pid);
+ esock_monitor_init(&descP->currentWriter.mon);
+ }
+
+ SSDBG( descP, ("SOCKET", "ncancel_send_current -> done with result:"
+ "\r\n %T"
+ "\r\n", res) );
+
+ return res;
+}
+
+
+/* These processes have not performed a select, so we can simply
+ * remove them from the writer queue.
+ */
+static
+ERL_NIF_TERM ncancel_send_waiting(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef)
+{
+ ErlNifPid caller;
+
+ if (enif_self(env, &caller) == NULL)
+ return esock_make_error(env, atom_exself);
+
+ /* unqueue request from (writer) queue */
+
+ if (writer_unqueue(env, descP, &caller)) {
+ return esock_atom_ok;
+ } else {
+ /* Race? */
+ return esock_make_error(env, esock_atom_not_found);
+ }
+}
+
+
+
+/* *** ncancel_recv ***
+ *
+ * Cancel a read operation.
+ * Its either the current reader or one of the waiting readers.
+ */
+static
+ERL_NIF_TERM ncancel_recv(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM opRef)
+{
+ ERL_NIF_TERM res;
+
+ MLOCK(descP->readMtx);
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_recv -> entry with"
+ "\r\n opRef: %T"
+ "\r\n %s"
+ "\r\n", opRef,
+ ((descP->currentReaderP == NULL) ? "without reader" : "with reader")) );
+
+ if (descP->currentReaderP != NULL) {
+ if (COMPARE(opRef, descP->currentReader.ref) == 0) {
+ res = ncancel_recv_current(env, descP, sockRef);
+ } else {
+ res = ncancel_recv_waiting(env, descP, opRef);
+ }
+ } else {
+ /* Or badarg? */
+ res = esock_make_error(env, esock_atom_einval);
+ }
+
+ MUNLOCK(descP->readMtx);
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_recv -> done with result:"
+ "\r\n %T"
+ "\r\n", res) );
+
+ return res;
+}
+
+
+/* The current reader process has an ongoing select we first must
+ * cancel. Then we must re-activate the "first" (the first
+ * in the reader queue).
+ */
+static
+ERL_NIF_TERM ncancel_recv_current(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef)
+{
+ ERL_NIF_TERM res;
+
+ SSDBG( descP, ("SOCKET", "ncancel_recv_current -> entry\r\n") );
+
+ DEMONP("ncancel_recv_current -> current reader",
+ env, descP, &descP->currentReader.mon);
+ res = ncancel_read_select(env, descP, descP->currentReader.ref);
+
+ SSDBG( descP,
+ ("SOCKET", "ncancel_recv_current -> cancel res: %T\r\n", res) );
+
+ if (!activate_next_reader(env, descP, sockRef)) {
+ SSDBG( descP,
+ ("SOCKET", "ncancel_recv_current -> no more readers\r\n") );
+ descP->currentReaderP = NULL;
+ descP->currentReader.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentReader.pid);
+ esock_monitor_init(&descP->currentReader.mon);
+ }
+
+ SSDBG( descP, ("SOCKET", "ncancel_recv_current -> done with result:"
+ "\r\n %T"
+ "\r\n", res) );
+
+ return res;
+}
+
+
+/* These processes have not performed a select, so we can simply
+ * remove them from the reader queue.
+ */
+static
+ERL_NIF_TERM ncancel_recv_waiting(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef)
+{
+ ErlNifPid caller;
+
+ if (enif_self(env, &caller) == NULL)
+ return esock_make_error(env, atom_exself);
+
+ /* unqueue request from (reader) queue */
+
+ if (reader_unqueue(env, descP, &caller)) {
+ return esock_atom_ok;
+ } else {
+ /* Race? */
+ return esock_make_error(env, esock_atom_not_found);
+ }
+}
+
+
+
+static
+ERL_NIF_TERM ncancel_read_select(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef)
+{
+ return ncancel_mode_select(env, descP, opRef,
+ ERL_NIF_SELECT_READ,
+ ERL_NIF_SELECT_READ_CANCELLED);
+}
+
+
+static
+ERL_NIF_TERM ncancel_write_select(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef)
+{
+ return ncancel_mode_select(env, descP, opRef,
+ ERL_NIF_SELECT_WRITE,
+ ERL_NIF_SELECT_WRITE_CANCELLED);
+}
+
+
+static
+ERL_NIF_TERM ncancel_mode_select(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM opRef,
+ int smode,
+ int rmode)
+{
+ int selectRes = esock_select_cancel(env, descP->sock, smode, descP);
+
+ if (selectRes & rmode) {
+ /* Was cancelled */
+ return esock_atom_ok;
+ } else if (selectRes > 0) {
+ /* Has already sent the message */
+ return esock_make_error(env, esock_atom_select_sent);
+ } else {
+ /* Stopped? */
+ SSDBG( descP, ("SOCKET", "ncancel_mode_select -> failed: %d (0x%lX)"
+ "\r\n", selectRes, selectRes) );
+ return esock_make_error(env, esock_atom_einval);
+ }
+
+}
+#endif // if !defined(__WIN32__)
+
+
+
+
+/* ----------------------------------------------------------------------
+ * U t i l i t y F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+/* *** send_check_writer ***
+ *
+ * Checks if we have a current writer and if that is us. If not, then we must
+ * be made to wait for our turn. This is done by pushing us unto the writer queue.
+ */
+#if !defined(__WIN32__)
+static
+BOOLEAN_T send_check_writer(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ERL_NIF_TERM* checkResult)
+{
+ if (descP->currentWriterP != NULL) {
+ ErlNifPid caller;
+
+ if (enif_self(env, &caller) == NULL) {
+ *checkResult = esock_make_error(env, atom_exself);
+ return FALSE;
+ }
+
+ if (COMPARE_PIDS(&descP->currentWriter.pid, &caller) != 0) {
+ /* Not the "current writer", so (maybe) push onto queue */
+
+ SSDBG( descP,
+ ("SOCKET", "send_check_writer -> not (current) writer\r\n") );
+
+ if (!writer_search4pid(env, descP, &caller))
+ *checkResult = writer_push(env, descP, caller, ref);
+ else
+ *checkResult = esock_make_error(env, esock_atom_eagain);
+
+ SSDBG( descP,
+ ("SOCKET",
+ "send_check_writer -> queue (push) result: %T\r\n",
+ checkResult) );
+
+ return FALSE;
+
+ }
+
+ }
+
+ *checkResult = esock_atom_ok; // Does not actually matter in this case, but ...
+
+ return TRUE;
+}
+
+
+
+/* *** send_check_result ***
+ *
+ * Check the result of a socket send (send, sendto and sendmsg) call.
+ * If a "complete" send has been made, the next (waiting) writer will be
+ * scheduled (if there is one).
+ * If we did not manage to send the entire package, make another select,
+ * so that we can be informed when we can make another try (to send the rest),
+ * and return with the amount we actually managed to send (its up to the caller
+ * (that is the erlang code) to figure out hust much is left to send).
+ * If the write fail, we give up and return with the appropriate error code.
+ *
+ * What about the remaining writers!!
+ */
+static
+ERL_NIF_TERM send_check_result(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ssize_t written,
+ ssize_t dataSize,
+ int saveErrno,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM sendRef)
+{
+ int sres;
+
+ SSDBG( descP,
+ ("SOCKET", "send_check_result -> entry with"
+ "\r\n written: %d"
+ "\r\n dataSize: %d"
+ "\r\n saveErrno: %d"
+ "\r\n", written, dataSize, saveErrno) );
+
+ if (written >= dataSize) {
+
+ cnt_inc(&descP->writePkgCnt, 1);
+ cnt_inc(&descP->writeByteCnt, written);
+ if (descP->currentWriterP != NULL)
+ DEMONP("send_check_result -> current writer",
+ env, descP, &descP->currentWriter.mon);
+
+ SSDBG( descP,
+ ("SOCKET", "send_check_result -> "
+ "everything written (%d,%d) - done\r\n", dataSize, written) );
+
+ /* Ok, this write is done maybe activate the next (if any) */
+
+ if (!activate_next_writer(env, descP, sockRef)) {
+ descP->currentWriterP = NULL;
+ descP->currentWriter.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentWriter.pid);
+ esock_monitor_init(&descP->currentWriter.mon);
+ }
+
+ return esock_atom_ok;
+
+ } else if (written < 0) {
+
+ /* Some kind of send failure - check what kind */
+
+ if ((saveErrno != EAGAIN) && (saveErrno != EINTR)) {
+ SocketRequestor req;
+ ERL_NIF_TERM res, reason;
+
+ /*
+ * An actual failure - we (and everyone waiting) give up
+ */
+
+ cnt_inc(&descP->writeFails, 1);
+
+ SSDBG( descP,
+ ("SOCKET",
+ "send_check_result -> error: %d\r\n", saveErrno) );
+
+ reason = MKA(env, erl_errno_id(saveErrno));
+ res = esock_make_error(env, reason);
+
+ if (descP->currentWriterP != NULL) {
+
+ DEMONP("send_check_result -> current writer",
+ env, descP, &descP->currentWriter.mon);
+
+ while (writer_pop(env, descP, &req)) {
+ SSDBG( descP,
+ ("SOCKET", "send_check_result -> abort %T\r\n",
+ req.pid) );
+ esock_send_abort_msg(env, sockRef, req.ref,
+ reason, &req.pid);
+ DEMONP("send_check_result -> pop'ed writer",
+ env, descP, &req.mon);
+ }
+ }
+
+ return res;
+
+ } else {
+ /* Ok, try again later */
+
+ SSDBG( descP, ("SOCKET", "send_check_result -> try again\r\n") );
+ }
+
+ }
+ else {
+ SSDBG( descP,
+ ("SOCKET", "send_check_result -> "
+ "not entire package written (%d of %d)\r\n", written, dataSize) );
+ }
+
+ /* We failed to write the *entire* packet (anything less then size
+ * of the packet, which is 0 <= written < sizeof packet),
+ * so schedule the rest for later.
+ */
+
+ if (descP->currentWriterP == NULL) {
+ ErlNifPid caller;
+
+ if (enif_self(env, &caller) == NULL)
+ return esock_make_error(env, atom_exself);
+ descP->currentWriter.pid = caller;
+ if (MONP("send_check_result -> current writer",
+ env, descP,
+ &descP->currentWriter.pid,
+ &descP->currentWriter.mon) != 0)
+ return esock_make_error(env, atom_exmon);
+ descP->currentWriter.ref = enif_make_copy(descP->env, sendRef);
+ descP->currentWriterP = &descP->currentWriter;
+ }
+
+ cnt_inc(&descP->writeWaits, 1);
+
+ sres = esock_select_write(env, descP->sock, descP, NULL, sendRef);
+
+ if (written >= 0) {
+ if (sres < 0) {
+ /* Returned: {error, Reason}
+ * Reason: {select_failed, sres, written}
+ */
+ return esock_make_error(env,
+ MKT3(env,
+ esock_atom_select_failed,
+ MKI(env, sres),
+ MKI(env, written)));
+ } else {
+ return esock_make_ok2(env, MKI(env, written));
+ }
+ } else {
+ if (sres < 0) {
+ /* Returned: {error, Reason}
+ * Reason: {select_failed, sres}
+ */
+ return esock_make_error(env,
+ MKT2(env,
+ esock_atom_select_failed,
+ MKI(env, sres)));
+ } else {
+ return esock_make_error(env, esock_atom_eagain);
+ }
+ }
+}
+
+
+
+/* *** recv_check_reader ***
+ *
+ * Checks if we have a current reader and if that is us. If not, then we must
+ * be made to wait for our turn. This is done by pushing us unto the reader queue.
+ */
+static
+BOOLEAN_T recv_check_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM ref,
+ ERL_NIF_TERM* checkResult)
+{
+ if (descP->currentReaderP != NULL) {
+ ErlNifPid caller;
+
+ if (enif_self(env, &caller) == NULL) {
+ *checkResult = esock_make_error(env, atom_exself);
+ return FALSE;
+ }
+
+ if (COMPARE_PIDS(&descP->currentReader.pid, &caller) != 0) {
+ ERL_NIF_TERM tmp;
+
+ /* Not the "current reader", so (maybe) push onto queue */
+
+ SSDBG( descP,
+ ("SOCKET", "recv_check_reader -> not (current) reader\r\n") );
+
+ if (!reader_search4pid(env, descP, &caller))
+ tmp = reader_push(env, descP, caller, ref);
+ else
+ tmp = esock_make_error(env, esock_atom_eagain);
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recv_check_reader -> queue (push) result: %T\r\n", tmp) );
+
+ *checkResult = tmp;
+
+ return FALSE;
+
+ }
+
+ }
+
+ *checkResult = esock_atom_ok; // Does not actually matter in this case, but ...
+
+ return TRUE;
+}
+
+
+
+/* *** recv_init_current_reader ***
+ *
+ * Initiate (maybe) the currentReader structure of the descriptor.
+ * Including monitoring the calling process.
+ */
+static
+char* recv_init_current_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM recvRef)
+{
+ if (descP->currentReaderP == NULL) {
+ ErlNifPid caller;
+
+ if (enif_self(env, &caller) == NULL)
+ return str_exself;
+
+ descP->currentReader.pid = caller;
+ if (MONP("recv_init_current_reader -> current reader",
+ env, descP,
+ &descP->currentReader.pid,
+ &descP->currentReader.mon) != 0) {
+ return str_exmon;
+ }
+ descP->currentReader.ref = enif_make_copy(descP->env, recvRef);
+ descP->currentReaderP = &descP->currentReader;
+ }
+
+ return NULL;
+}
+
+
+
+/* *** recv_update_current_reader ***
+ *
+ * Demonitors the current reader process and pop's the reader queue.
+ * If there is a waiting (reader) process, then it will be assigned
+ * as the new current reader and a new (read) select will be done.
+ */
+
+static
+ERL_NIF_TERM recv_update_current_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef)
+{
+ ERL_NIF_TERM res = esock_atom_ok;
+
+ if (descP->currentReaderP != NULL) {
+
+ DEMONP("recv_update_current_reader -> current reader",
+ env, descP, &descP->currentReader.mon);
+
+ if (!activate_next_reader(env, descP, sockRef)) {
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recv_update_current_reader -> no more readers\r\n") );
+
+ descP->currentReaderP = NULL;
+ descP->currentReader.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentReader.pid);
+ esock_monitor_init(&descP->currentReader.mon);
+ }
+
+ }
+
+ return res;
+}
+
+
+
+/* *** recv_error_current_reader ***
+ *
+ * Process the current reader and any waiting readers
+ * when a read (fatal) error has occured.
+ * All waiting readers will be "aborted", that is a
+ * nif_abort message will be sent (with reaf and reason).
+ */
+static
+void recv_error_current_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM reason)
+{
+ SocketRequestor req;
+
+ if (descP->currentReaderP != NULL) {
+
+ DEMONP("recv_error_current_reader -> current reader",
+ env, descP, &descP->currentReader.mon);
+
+ while (reader_pop(env, descP, &req)) {
+ SSDBG( descP,
+ ("SOCKET", "recv_error_current_reader -> abort %T\r\n",
+ req.pid) );
+ esock_send_abort_msg(env, sockRef, req.ref, reason, &req.pid);
+ DEMONP("recv_error_current_reader -> pop'ed reader",
+ env, descP, &req.mon);
+ }
+ }
+}
+
+
+
+/* *** recv_check_result ***
+ *
+ * Process the result of a call to recv.
+ */
+static
+ERL_NIF_TERM recv_check_result(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int read,
+ int toRead,
+ int saveErrno,
+ ErlNifBinary* bufP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef)
+{
+ char* xres;
+ int sres;
+ ERL_NIF_TERM res, data;
+
+ SSDBG( descP,
+ ("SOCKET", "recv_check_result -> entry with"
+ "\r\n read: %d"
+ "\r\n toRead: %d"
+ "\r\n saveErrno: %d"
+ "\r\n recvRef: %T"
+ "\r\n", read, toRead, saveErrno, recvRef) );
+
+
+ /* <KOLLA>
+ *
+ * We need to handle read = 0 for other type(s) (DGRAM) when
+ * its actually valid to read 0 bytes.
+ *
+ * </KOLLA>
+ */
+
+ if ((read == 0) && (descP->type == SOCK_STREAM)) {
+
+ res = esock_make_error(env, atom_closed);
+
+ /*
+ * When a stream socket peer has performed an orderly shutdown, the return
+ * value will be 0 (the traditional "end-of-file" return).
+ *
+ * *We* do never actually try to read 0 bytes from a stream socket!
+ *
+ * We must also notify any waiting readers!
+ */
+
+ recv_error_current_reader(env, descP, sockRef, res);
+
+ FREE_BIN(bufP);
+
+ return res;
+
+ }
+
+ /* There is a special case: If the provided 'to read' value is
+ * zero (0) (only for type =/= stream).
+ * That means that we reads as much as we can, using the default
+ * read buffer size.
+ */
+
+ if (bufP->size == read) {
+
+ /* +++ We filled the buffer +++ */
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recv_check_result -> [%d] filled the buffer\r\n", toRead) );
+
+ if (toRead == 0) {
+
+ /* +++ Give us everything you have got => *
+ * (maybe) needs to continue +++ */
+
+ /* How do we do this?
+ * Either:
+ * 1) Send up each chunk of data for each of the read
+ * and let the erlang code assemble it: {ok, false, Bin}
+ * (when complete it should return {ok, true, Bin}).
+ * We need to read atleast one more time to be sure if its
+ * done...
+ * 2) Or put it in a buffer here, and then let the erlang code
+ * know that it should call again (special return value)
+ * (continuous binary realloc "here").
+ *
+ * => We choose alt 1 for now.
+ *
+ * Also, we need to check if the rNumCnt has reached its max (rNum),
+ * in which case we will assume the read to be done!
+ */
+
+ cnt_inc(&descP->readByteCnt, read);
+
+ SSDBG( descP,
+ ("SOCKET", "recv_check_result -> shall we continue reading"
+ "\r\n read: %d"
+ "\r\n rNum: %d"
+ "\r\n rNumCnt: %d"
+ "\r\n", read, descP->rNum, descP->rNumCnt) );
+
+ if (descP->rNum > 0) {
+
+ descP->rNumCnt++;
+ if (descP->rNumCnt >= descP->rNum) {
+
+ descP->rNumCnt = 0;
+
+ cnt_inc(&descP->readPkgCnt, 1);
+
+ recv_update_current_reader(env, descP, sockRef);
+
+ /* This transfers "ownership" of the *allocated* binary to an
+ * erlang term (no need for an explicit free).
+ */
+ data = MKBIN(env, bufP);
+
+ return esock_make_ok3(env, atom_true, data);
+
+ }
+ }
+
+ /* Yes, we *do* need to continue reading */
+
+ if ((xres = recv_init_current_reader(env,
+ descP, recvRef)) != NULL) {
+ descP->rNumCnt = 0;
+ FREE_BIN(bufP);
+ return esock_make_error_str(env, xres);
+ }
+
+ /* This transfers "ownership" of the *allocated* binary to an
+ * erlang term (no need for an explicit free).
+ */
+ data = MKBIN(env, bufP);
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recv_check_result -> [%d] "
+ "we are done for now - read more\r\n", toRead) );
+
+ return esock_make_ok3(env, atom_false, data);
+
+ } else {
+
+ /* +++ We got exactly as much as we requested => We are done +++ */
+
+ cnt_inc(&descP->readPkgCnt, 1);
+ cnt_inc(&descP->readByteCnt, read);
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recv_check_result -> [%d] "
+ "we got exactly what we could fit\r\n", toRead) );
+
+ recv_update_current_reader(env, descP, sockRef);
+
+ /* This transfers "ownership" of the *allocated* binary to an
+ * erlang term (no need for an explicit free).
+ */
+ data = MKBIN(env, bufP);
+
+ return esock_make_ok3(env, atom_true, data);
+
+ }
+
+ } else if (read < 0) {
+
+ /* +++ Error handling +++ */
+
+ FREE_BIN(bufP);
+
+ if (saveErrno == ECONNRESET) {
+
+ res = esock_make_error(env, atom_closed);
+
+ /* +++ Oups - closed +++ */
+
+ SSDBG( descP, ("SOCKET",
+ "recv_check_result -> [%d] closed\r\n", toRead) );
+
+ /* <KOLLA>
+ *
+ * IF THE CURRENT PROCESS IS *NOT* THE CONTROLLING
+ * PROCESS, WE NEED TO INFORM IT!!!
+ *
+ * ALL WAITING PROCESSES MUST ALSO GET THE ERROR!!
+ * HANDLED BY THE STOP (CALLBACK) FUNCTION?
+ *
+ * SINCE THIS IS A REMOTE CLOSE, WE DON'T NEED TO WAIT
+ * FOR OUTPUT TO BE WRITTEN (NO ONE WILL READ), JUST
+ * ABORT THE SOCKET REGARDLESS OF LINGER???
+ *
+ * </KOLLA>
+ */
+
+ descP->closeLocal = FALSE;
+ descP->state = SOCKET_STATE_CLOSING;
+
+ recv_error_current_reader(env, descP, sockRef, res);
+
+ if ((sres = esock_select_stop(env, descP->sock, descP)) < 0) {
+ esock_warning_msg("Failed stop select (closed) "
+ "for current reader (%T): %d\r\n",
+ recvRef, sres);
+ }
+
+ return res;
+
+ } else if ((saveErrno == ERRNO_BLOCK) ||
+ (saveErrno == EAGAIN)) {
+
+ SSDBG( descP, ("SOCKET",
+ "recv_check_result -> [%d] eagain\r\n", toRead) );
+
+ descP->rNumCnt = 0;
+ if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ SSDBG( descP, ("SOCKET", "recv_check_result -> SELECT for more\r\n") );
+
+ if ((sres = esock_select_read(env, descP->sock, descP,
+ NULL, recvRef)) < 0) {
+ res = esock_make_error(env,
+ MKT2(env,
+ esock_atom_select_failed,
+ MKI(env, sres)));
+ } else {
+ res = esock_make_error(env, esock_atom_eagain);
+ }
+
+ return res;
+ } else {
+ ERL_NIF_TERM res = esock_make_error_errno(env, saveErrno);
+
+ SSDBG( descP, ("SOCKET", "recv_check_result -> [%d] errno: %d\r\n",
+ toRead, saveErrno) );
+
+ recv_error_current_reader(env, descP, sockRef, res);
+
+ return res;
+ }
+
+ } else {
+
+ /* +++ We did not fill the buffer +++ */
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recv_check_result -> [%d] "
+ "did not fill the buffer (%d of %d)\r\n",
+ toRead, read, bufP->size) );
+
+ if (toRead == 0) {
+
+ /* +++ We got it all, but since we +++
+ * +++ did not fill the buffer, we +++
+ * +++ must split it into a sub-binary. +++
+ */
+
+ SSDBG( descP, ("SOCKET",
+ "recv_check_result -> [%d] split buffer\r\n", toRead) );
+
+ descP->rNumCnt = 0;
+ cnt_inc(&descP->readPkgCnt, 1);
+ cnt_inc(&descP->readByteCnt, read);
+
+ recv_update_current_reader(env, descP, sockRef);
+
+ /* This transfers "ownership" of the *allocated* binary to an
+ * erlang term (no need for an explicit free).
+ */
+ data = MKBIN(env, bufP);
+ data = MKSBIN(env, data, 0, read);
+
+ SSDBG( descP,
+ ("SOCKET", "recv_check_result -> [%d] done\r\n", toRead) );
+
+ return esock_make_ok3(env, atom_true, data);
+
+ } else {
+
+ /* +++ We got only a part of what was expected +++
+ * +++ => select for more more later and +++
+ * +++ deliver what we got. +++ */
+
+ SSDBG( descP, ("SOCKET", "recv_check_result -> [%d] "
+ "only part of message - expect more\r\n", toRead) );
+
+ if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL) {
+ FREE_BIN(bufP);
+ return esock_make_error_str(env, xres);
+ }
+
+ data = MKBIN(env, bufP);
+ data = MKSBIN(env, data, 0, read);
+
+ cnt_inc(&descP->readByteCnt, read);
+
+ /* SELECT for more data */
+
+ if ((sres = esock_select_read(env, descP->sock, descP,
+ NULL, recvRef)) < 0) {
+ /* Result: {error, Reason}
+ * Reason: {select_failed, sres, data}
+ */
+ res = esock_make_error(env,
+ MKT3(env,
+ esock_atom_select_failed,
+ MKI(env, sres),
+ data));
+ } else {
+ res = esock_make_ok3(env, atom_false, data);
+ }
+
+ /* This transfers "ownership" of the *allocated* binary to an
+ * erlang term (no need for an explicit free).
+ */
+ return res;
+ }
+ }
+}
+
+
+/* The recvfrom function delivers one (1) message. If our buffer
+ * is to small, the message will be truncated. So, regardless
+ * if we filled the buffer or not, we have got what we are going
+ * to get regarding this message.
+ */
+static
+ERL_NIF_TERM recvfrom_check_result(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int read,
+ int saveErrno,
+ ErlNifBinary* bufP,
+ SocketAddress* fromAddrP,
+ unsigned int fromAddrLen,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef)
+{
+ char* xres;
+ int sres;
+ ERL_NIF_TERM data, res;
+
+ SSDBG( descP,
+ ("SOCKET", "recvfrom_check_result -> entry with"
+ "\r\n read: %d"
+ "\r\n saveErrno: %d"
+ "\r\n recvRef: %T"
+ "\r\n", read, saveErrno, recvRef) );
+
+
+ /* There is a special case: If the provided 'to read' value is
+ * zero (0). That means that we reads as much as we can, using
+ * the default read buffer size.
+ */
+
+ if (read < 0) {
+
+ /* +++ Error handling +++ */
+
+ if (saveErrno == ECONNRESET) {
+ res = esock_make_error(env, atom_closed);
+
+ /* +++ Oups - closed +++ */
+
+ SSDBG( descP, ("SOCKET", "recvfrom_check_result -> closed\r\n") );
+
+ /* <KOLLA>
+ * IF THE CURRENT PROCESS IS *NOT* THE CONTROLLING
+ * PROCESS, WE NEED TO INFORM IT!!!
+ *
+ * ALL WAITING PROCESSES MUST ALSO GET THE ERROR!!
+ *
+ * </KOLLA>
+ */
+
+ descP->closeLocal = FALSE;
+ descP->state = SOCKET_STATE_CLOSING;
+
+ recv_error_current_reader(env, descP, sockRef, res);
+
+ if ((sres = esock_select_stop(env, descP->sock, descP)) < 0) {
+ esock_warning_msg("Failed stop select (closed) "
+ "for current reader (%T): %d\r\n",
+ recvRef, sres);
+ }
+
+ FREE_BIN(bufP);
+
+ return res;
+
+ } else if ((saveErrno == ERRNO_BLOCK) ||
+ (saveErrno == EAGAIN)) {
+
+ SSDBG( descP, ("SOCKET", "recvfrom_check_result -> eagain\r\n") );
+
+ FREE_BIN(bufP);
+
+ if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ if ((sres = esock_select_read(env, descP->sock, descP,
+ NULL, recvRef)) < 0) {
+ res = esock_make_error(env,
+ MKT2(env,
+ esock_atom_select_failed,
+ MKI(env, sres)));
+ } else {
+ res = esock_make_error(env, esock_atom_eagain);
+ }
+
+ return res;
+ } else {
+
+ res = esock_make_error_errno(env, saveErrno);
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recvfrom_check_result -> errno: %d\r\n", saveErrno) );
+
+ recv_error_current_reader(env, descP, sockRef, res);
+
+ FREE_BIN(bufP);
+
+ return res;
+ }
+
+ } else {
+
+ /* +++ We sucessfully got a message - time to encode the address +++ */
+
+ ERL_NIF_TERM eSockAddr;
+
+ esock_encode_sockaddr(env,
+ fromAddrP, fromAddrLen,
+ &eSockAddr);
+
+ if (read == bufP->size) {
+ data = MKBIN(env, bufP);
+ } else {
+
+ /* +++ We got a chunk of data but +++
+ * +++ since we did not fill the +++
+ * +++ buffer, we must split it +++
+ * +++ into a sub-binary. +++
+ */
+
+ data = MKBIN(env, bufP);
+ data = MKSBIN(env, data, 0, read);
+ }
+
+ recv_update_current_reader(env, descP, sockRef);
+
+ return esock_make_ok2(env, MKT2(env, eSockAddr, data));
+
+ }
+}
+
+
+
+/* The recvmsg function delivers one (1) message. If our buffer
+ * is to small, the message will be truncated. So, regardless
+ * if we filled the buffer or not, we have got what we are going
+ * to get regarding this message.
+ */
+static
+ERL_NIF_TERM recvmsg_check_result(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int read,
+ int saveErrno,
+ struct msghdr* msgHdrP,
+ ErlNifBinary* dataBufP,
+ ErlNifBinary* ctrlBufP,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef)
+{
+ int sres;
+ ERL_NIF_TERM res;
+
+ SSDBG( descP,
+ ("SOCKET", "recvmsg_check_result -> entry with"
+ "\r\n read: %d"
+ "\r\n saveErrno: %d"
+ "\r\n recvRef: %T"
+ "\r\n", read, saveErrno, recvRef) );
+
+
+ /* <KOLLA>
+ *
+ * We need to handle read = 0 for other type(s) (DGRAM) when
+ * its actually valid to read 0 bytes.
+ *
+ * </KOLLA>
+ */
+
+ if ((read == 0) && (descP->type == SOCK_STREAM)) {
+
+ /*
+ * When a stream socket peer has performed an orderly shutdown, the return
+ * value will be 0 (the traditional "end-of-file" return).
+ *
+ * *We* do never actually try to read 0 bytes from a stream socket!
+ */
+
+
+ FREE_BIN(dataBufP); FREE_BIN(ctrlBufP);
+
+ return esock_make_error(env, atom_closed);
+
+ }
+
+
+ /* There is a special case: If the provided 'to read' value is
+ * zero (0). That means that we reads as much as we can, using
+ * the default read buffer size.
+ */
+
+ if (read < 0) {
+
+ /* +++ Error handling +++ */
+
+ if (saveErrno == ECONNRESET) {
+
+ /* +++ Oups - closed +++ */
+
+ SSDBG( descP, ("SOCKET", "recvmsg_check_result -> closed\r\n") );
+
+ /* <KOLLA>
+ * IF THE CURRENT PROCESS IS *NOT* THE CONTROLLING
+ * PROCESS, WE NEED TO INFORM IT!!!
+ *
+ * ALL WAITING PROCESSES MUST ALSO GET THE ERROR!!
+ *
+ * </KOLLA>
+ */
+
+ res = esock_make_error(env, atom_closed);
+ descP->closeLocal = FALSE;
+ descP->state = SOCKET_STATE_CLOSING;
+
+ recv_error_current_reader(env, descP, sockRef, res);
+
+ if ((sres = esock_select_stop(env, descP->sock, descP)) < 0) {
+ esock_warning_msg("Failed stop select (closed) "
+ "for current reader (%T): %d\r\n",
+ recvRef, sres);
+ }
+
+ FREE_BIN(dataBufP); FREE_BIN(ctrlBufP);
+
+ return res;;
+
+ } else if ((saveErrno == ERRNO_BLOCK) ||
+ (saveErrno == EAGAIN)) {
+ char* xres;
+
+ SSDBG( descP, ("SOCKET", "recvmsg_check_result -> eagain\r\n") );
+
+ FREE_BIN(dataBufP); FREE_BIN(ctrlBufP);
+
+ if ((xres = recv_init_current_reader(env, descP, recvRef)) != NULL)
+ return esock_make_error_str(env, xres);
+
+ if ((sres = esock_select_read(env, descP->sock, descP,
+ NULL, recvRef)) < 0) {
+ res = esock_make_error(env,
+ MKT2(env,
+ esock_atom_select_failed,
+ MKI(env, sres)));
+ } else {
+ res = esock_make_error(env, esock_atom_eagain);
+ }
+
+ return res;
+
+ } else {
+
+ res = esock_make_error_errno(env, saveErrno);
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recvmsg_check_result -> errno: %d\r\n", saveErrno) );
+
+ recv_error_current_reader(env, descP, sockRef, res);
+
+ FREE_BIN(dataBufP); FREE_BIN(ctrlBufP);
+
+ return res;
+ }
+
+ } else {
+
+ /* +++ We sucessfully got a message - time to encode it +++ */
+
+ ERL_NIF_TERM eMsgHdr;
+ char* xres;
+
+ /*
+ * <KOLLA>
+ *
+ * The return value of recvmsg is the *total* number of bytes
+ * that where successfully read. This data has been put into
+ * the *IO vector*.
+ *
+ * </KOLLA>
+ */
+
+ if ((xres = encode_msghdr(env, descP,
+ read, msgHdrP, dataBufP, ctrlBufP,
+ &eMsgHdr)) != NULL) {
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recvmsg_check_result -> "
+ "(msghdr) encode failed: %s\r\n", xres) );
+
+ recv_update_current_reader(env, descP, sockRef);
+
+ FREE_BIN(dataBufP); FREE_BIN(ctrlBufP);
+
+ return esock_make_error_str(env, xres);
+ } else {
+
+ SSDBG( descP,
+ ("SOCKET",
+ "recvmsg_check_result -> "
+ "(msghdr) encode ok: %T\r\n", eMsgHdr) );
+
+ recv_update_current_reader(env, descP, sockRef);
+
+ return esock_make_ok2(env, eMsgHdr);
+ }
+
+ }
+}
+
+
+
+
+/* +++ encode_msghdr +++
+ *
+ * Encode a msghdr (recvmsg). In erlang its represented as
+ * a map, which has a specific set of attributes:
+ *
+ * addr (source address) - sockaddr()
+ * iov - [binary()]
+ * ctrl - [cmsghdr()]
+ * flags - msghdr_flags()
+ */
+
+extern
+char* encode_msghdr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int read,
+ struct msghdr* msgHdrP,
+ ErlNifBinary* dataBufP,
+ ErlNifBinary* ctrlBufP,
+ ERL_NIF_TERM* eSockAddr)
+{
+ char* xres;
+ ERL_NIF_TERM addr, iov, ctrl, flags;
+
+ SSDBG( descP,
+ ("SOCKET", "encode_msghdr -> entry with"
+ "\r\n read: %d"
+ "\r\n", read) );
+
+ /* The address is not used if we are connected,
+ * so check (length = 0) before we try to encodel
+ */
+ if (msgHdrP->msg_namelen != 0) {
+ if ((xres = esock_encode_sockaddr(env,
+ (SocketAddress*) msgHdrP->msg_name,
+ msgHdrP->msg_namelen,
+ &addr)) != NULL)
+ return xres;
+ } else {
+ addr = esock_atom_undefined;
+ }
+
+ SSDBG( descP, ("SOCKET", "encode_msghdr -> try encode iov\r\n") );
+ if ((xres = esock_encode_iov(env,
+ read,
+ msgHdrP->msg_iov,
+ msgHdrP->msg_iovlen,
+ dataBufP,
+ &iov)) != NULL)
+ return xres;
+
+ SSDBG( descP, ("SOCKET", "encode_msghdr -> try encode cmsghdrs\r\n") );
+ if ((xres = encode_cmsghdrs(env, descP, ctrlBufP, msgHdrP, &ctrl)) != NULL)
+ return xres;
+
+ SSDBG( descP, ("SOCKET", "encode_msghdr -> try encode flags\r\n") );
+ if ((xres = encode_msghdr_flags(env, descP, msgHdrP->msg_flags, &flags)) != NULL)
+ return xres;
+
+ SSDBG( descP,
+ ("SOCKET", "encode_msghdr -> components encoded:"
+ "\r\n addr: %T"
+ "\r\n iov: %T"
+ "\r\n ctrl: %T"
+ "\r\n flags: %T"
+ "\r\n", addr, iov, ctrl, flags) );
+ {
+ ERL_NIF_TERM keys[] = {esock_atom_addr,
+ esock_atom_iov,
+ esock_atom_ctrl,
+ esock_atom_flags};
+ ERL_NIF_TERM vals[] = {addr, iov, ctrl, flags};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+ ERL_NIF_TERM tmp;
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ SSDBG( descP, ("SOCKET", "encode_msghdr -> create msghdr map\r\n") );
+ if (!MKMA(env, keys, vals, numKeys, &tmp))
+ return ESOCK_STR_EINVAL;
+
+ SSDBG( descP, ("SOCKET", "encode_msghdr -> msghdr: "
+ "\r\n %T"
+ "\r\n", tmp) );
+
+ *eSockAddr = tmp;
+ }
+
+ SSDBG( descP, ("SOCKET", "encode_msghdr -> done\r\n") );
+
+ return NULL;
+}
+
+
+
+
+/* +++ encode_cmsghdrs +++
+ *
+ * Encode a list of cmsghdr(). There can be 0 or more cmsghdr "blocks".
+ *
+ * Our "problem" is that we have no idea how many control messages
+ * we have.
+ *
+ * The cmsgHdrP arguments points to the start of the control data buffer,
+ * an actual binary. Its the only way to create sub-binaries. So, what we
+ * need to continue processing this is to turn that into an binary erlang
+ * term (which can then in turn be turned into sub-binaries).
+ *
+ * We need the cmsgBufP (even though cmsgHdrP points to it) to be able
+ * to create sub-binaries (one for each cmsg hdr).
+ *
+ * The TArray (term array) is created with the size of 128, which should
+ * be enough. But if its not, then it will be automatically realloc'ed during
+ * add. Once we are done adding hdr's to it, we convert the tarray to a list.
+ */
+
+extern
+char* encode_cmsghdrs(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ErlNifBinary* cmsgBinP,
+ struct msghdr* msgHdrP,
+ ERL_NIF_TERM* eCMsgHdr)
+{
+ ERL_NIF_TERM ctrlBuf = MKBIN(env, cmsgBinP); // The *entire* binary
+ SocketTArray cmsghdrs = TARRAY_CREATE(128);
+ struct cmsghdr* firstP = CMSG_FIRSTHDR(msgHdrP);
+ struct cmsghdr* currentP;
+
+ SSDBG( descP, ("SOCKET", "encode_cmsghdrs -> entry\r\n") );
+
+ for (currentP = firstP;
+ currentP != NULL;
+ currentP = CMSG_NXTHDR(msgHdrP, currentP)) {
+
+ SSDBG( descP,
+ ("SOCKET", "encode_cmsghdrs -> process cmsg header when"
+ "\r\n TArray Size: %d"
+ "\r\n", TARRAY_SZ(cmsghdrs)) );
+
+ /* MUST check this since on Linux the returned "cmsg" may actually
+ * go too far!
+ */
+ if (((CHARP(currentP) + currentP->cmsg_len) - CHARP(firstP)) >
+ msgHdrP->msg_controllen) {
+ /* Ouch, fatal error - give up
+ * We assume we cannot trust any data if this is wrong.
+ */
+ TARRAY_DELETE(cmsghdrs);
+ return ESOCK_STR_EINVAL;
+ } else {
+ ERL_NIF_TERM level, type, data;
+ unsigned char* dataP = (unsigned char*) CMSG_DATA(currentP);
+ size_t dataPos = dataP - cmsgBinP->data;
+ size_t dataLen = currentP->cmsg_len - (CHARP(currentP)-CHARP(dataP));
+
+ SSDBG( descP,
+ ("SOCKET", "encode_cmsghdrs -> cmsg header data: "
+ "\r\n dataPos: %d"
+ "\r\n dataLen: %d"
+ "\r\n", dataPos, dataLen) );
+
+ /* We can't give up just because its an unknown protocol,
+ * so if its a protocol we don't know, we return its integer
+ * value and leave it to the user.
+ */
+ if (encode_cmsghdr_level(env, currentP->cmsg_level, &level) != NULL)
+ level = MKI(env, currentP->cmsg_level);
+
+ if (encode_cmsghdr_type(env,
+ currentP->cmsg_level, currentP->cmsg_type,
+ &type) != NULL)
+ type = MKI(env, currentP->cmsg_type);
+
+ if (encode_cmsghdr_data(env, ctrlBuf,
+ currentP->cmsg_level,
+ currentP->cmsg_type,
+ dataP, dataPos, dataLen,
+ &data) != NULL)
+ data = MKSBIN(env, ctrlBuf, dataPos, dataLen);
+
+ SSDBG( descP,
+ ("SOCKET", "encode_cmsghdrs -> "
+ "\r\n level: %T"
+ "\r\n type: %T"
+ "\r\n data: %T"
+ "\r\n", level, type, data) );
+
+ /* And finally create the 'cmsghdr' map -
+ * and if successfull add it to the tarray.
+ */
+ {
+ ERL_NIF_TERM keys[] = {esock_atom_level,
+ esock_atom_type,
+ esock_atom_data};
+ ERL_NIF_TERM vals[] = {level, type, data};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+ ERL_NIF_TERM cmsgHdr;
+
+ /* Guard agains cut-and-paste errors */
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, &cmsgHdr)) {
+ TARRAY_DELETE(cmsghdrs);
+ return ESOCK_STR_EINVAL;
+ }
+
+ /* And finally add it to the list... */
+ TARRAY_ADD(cmsghdrs, cmsgHdr);
+ }
+ }
+ }
+
+ SSDBG( descP,
+ ("SOCKET", "encode_cmsghdrs -> cmsg headers processed when"
+ "\r\n TArray Size: %d"
+ "\r\n", TARRAY_SZ(cmsghdrs)) );
+
+ /* The tarray is populated - convert it to a list */
+ TARRAY_TOLIST(cmsghdrs, env, eCMsgHdr);
+
+ return NULL;
+}
+
+
+
+/* +++ decode_cmsghdrs +++
+ *
+ * Decode a list of cmsghdr(). There can be 0 or more cmsghdr "blocks".
+ *
+ * Each element can either be a (erlang) map that needs to be decoded,
+ * or a (erlang) binary that just needs to be appended to the control
+ * buffer.
+ *
+ * Our "problem" is that we have no idea much memory we actually need.
+ *
+ */
+
+extern
+char* decode_cmsghdrs(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eCMsgHdr,
+ char* cmsgHdrBufP,
+ size_t cmsgHdrBufLen,
+ size_t* cmsgHdrBufUsed)
+{
+ ERL_NIF_TERM elem, tail, list;
+ char* bufP;
+ size_t rem, used, totUsed = 0;
+ unsigned int len;
+ int i;
+ char* xres;
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdrs -> entry with"
+ "\r\n cmsgHdrBufP: 0x%lX"
+ "\r\n cmsgHdrBufLen: %d"
+ "\r\n", cmsgHdrBufP, cmsgHdrBufLen) );
+
+ if (IS_LIST(env, eCMsgHdr) && GET_LIST_LEN(env, eCMsgHdr, &len)) {
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdrs -> list length: %d\r\n", len) );
+
+ for (i = 0, list = eCMsgHdr, rem = cmsgHdrBufLen, bufP = cmsgHdrBufP;
+ i < len; i++) {
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdrs -> process elem %d:"
+ "\r\n (buffer) rem: %u"
+ "\r\n (buffer) totUsed: %u"
+ "\r\n", i, rem, totUsed) );
+
+ /* Extract the (current) head of the (cmsg hdr) list */
+ if (!GET_LIST_ELEM(env, list, &elem, &tail))
+ return ESOCK_STR_EINVAL;
+
+ used = 0; // Just in case...
+ if ((xres = decode_cmsghdr(env, descP, elem, bufP, rem, &used)) != NULL)
+ return xres;
+
+ bufP = CHARP( ULONG(bufP) + used );
+ rem = SZT( rem - used );
+ list = tail;
+ totUsed += used;
+
+ }
+
+ SSDBG( descP, ("SOCKET",
+ "decode_cmsghdrs -> all %d ctrl headers processed\r\n",
+ len) );
+
+ xres = NULL;
+ } else {
+ xres = ESOCK_STR_EINVAL;
+ }
+
+ *cmsgHdrBufUsed = totUsed;
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdrs -> done with %s when"
+ "\r\n totUsed = %u\r\n",
+ ((xres != NULL) ? xres : "NULL"), totUsed) );
+
+ return xres;
+}
+
+
+/* +++ decode_cmsghdr +++
+ *
+ * Decode one cmsghdr(). Put the "result" into the buffer and advance the
+ * pointer (of the buffer) afterwards. Also update 'rem' accordingly.
+ * But before the actual decode, make sure that there is enough room in
+ * the buffer for the cmsg header (sizeof(*hdr) < rem).
+ *
+ * The eCMsgHdr should be a map with three fields:
+ *
+ * level :: cmsghdr_level() (socket | protocol() | integer())
+ * type :: cmsghdr_type() (atom() | integer())
+ * What values are valid depend on the level
+ * data :: cmsghdr_data() (term() | binary())
+ * The type of the data depends on
+ * level and type, but can be a binary,
+ * which means that the data is already coded.
+ */
+extern
+char* decode_cmsghdr(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM eCMsgHdr,
+ char* bufP,
+ size_t rem,
+ size_t* used)
+{
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr -> entry with"
+ "\r\n eCMsgHdr: %T"
+ "\r\n", eCMsgHdr) );
+
+ if (IS_MAP(env, eCMsgHdr)) {
+ ERL_NIF_TERM eLevel, eType, eData;
+ int level, type;
+ char* xres;
+
+ /* First extract all three attributes (as terms) */
+
+ if (!GET_MAP_VAL(env, eCMsgHdr, esock_atom_level, &eLevel))
+ return ESOCK_STR_EINVAL;
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr -> eLevel: %T"
+ "\r\n", eLevel) );
+
+ if (!GET_MAP_VAL(env, eCMsgHdr, esock_atom_type, &eType))
+ return ESOCK_STR_EINVAL;
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr -> eType: %T"
+ "\r\n", eType) );
+
+ if (!GET_MAP_VAL(env, eCMsgHdr, esock_atom_data, &eData))
+ return ESOCK_STR_EINVAL;
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr -> eData: %T"
+ "\r\n", eData) );
+
+ /* Second, decode level */
+ if ((xres = decode_cmsghdr_level(env, eLevel, &level)) != NULL)
+ return xres;
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr -> level: %d\r\n", level) );
+
+ /* third, decode type */
+ if ((xres = decode_cmsghdr_type(env, level, eType, &type)) != NULL)
+ return xres;
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr -> type: %d\r\n", type) );
+
+ /* And finally data
+ * If its a binary, we are done. Otherwise, we need to check
+ * level and type to know what kind of data to expect.
+ */
+
+ return decode_cmsghdr_data(env, descP, bufP, rem, level, type, eData, used);
+
+ } else {
+ *used = 0;
+ return ESOCK_STR_EINVAL;
+ }
+
+ return NULL;
+}
+
+
+/* *** decode_cmsghdr_data ***
+ *
+ * For all combinations of level and type we accept a binary as data,
+ * so we begin by testing for that. If its not a binary, then we check
+ * level (ip) and type (tos or ttl), in which case the data *must* be
+ * an integer and ip_tos() respectively.
+ */
+static
+char* decode_cmsghdr_data(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ char* bufP,
+ size_t rem,
+ int level,
+ int type,
+ ERL_NIF_TERM eData,
+ size_t* used)
+{
+ char* xres;
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr_data -> entry with"
+ "\r\n eData: %T"
+ "\r\n", eData) );
+
+ if (IS_BIN(env, eData)) {
+ ErlNifBinary bin;
+
+ if (GET_BIN(env, eData, &bin)) {
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr_data -> "
+ "do final decode with binary\r\n") );
+ return decode_cmsghdr_final(descP, bufP, rem, level, type,
+ (char*) bin.data, bin.size,
+ used);
+ } else {
+ *used = 0;
+ xres = ESOCK_STR_EINVAL;
+ }
+ } else {
+
+ /* Its *not* a binary so we need to look at what level and type
+ * we have and treat them individually.
+ */
+
+ switch (level) {
+#if defined(SOL_IP)
+ case SOL_IP:
+#else
+ case IPPROTO_IP:
+#endif
+ switch (type) {
+#if defined(IP_TOS)
+ case IP_TOS:
+ {
+ int data;
+ if (decode_ip_tos(env, eData, &data)) {
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr_data -> "
+ "do final decode with tos\r\n") );
+ return decode_cmsghdr_final(descP, bufP, rem, level, type,
+ (char*) &data,
+ sizeof(data),
+ used);
+ } else {
+ *used = 0;
+ xres = ESOCK_STR_EINVAL;
+ }
+ }
+ break;
+#endif
+
+#if defined(IP_TTL)
+ case IP_TTL:
+ {
+ int data;
+ if (GET_INT(env, eData, &data)) {
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr_data -> "
+ "do final decode with ttl\r\n") );
+ return decode_cmsghdr_final(descP, bufP, rem, level, type,
+ (char*) &data,
+ sizeof(data),
+ used);
+ } else {
+ *used = 0;
+ xres = ESOCK_STR_EINVAL;
+ }
+ }
+ break;
+#endif
+
+ }
+ break;
+
+ default:
+ *used = 0;
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+
+ }
+
+ return xres;
+}
+
+
+/* *** decode_cmsghdr_final ***
+ *
+ * This does the final create of the cmsghdr (including the data copy).
+ */
+static
+char* decode_cmsghdr_final(SocketDescriptor* descP,
+ char* bufP,
+ size_t rem,
+ int level,
+ int type,
+ char* data,
+ int sz,
+ size_t* used)
+{
+ int len = CMSG_LEN(sz);
+ int space = CMSG_SPACE(sz);
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr_data -> entry when"
+ "\r\n level: %d"
+ "\r\n type: %d"
+ "\r\n sz: %d => %d, %d"
+ "\r\n", level, type, sz, len, space) );
+
+ if (rem >= space) {
+ struct cmsghdr* cmsgP = (struct cmsghdr*) bufP;
+
+ /* The header */
+ cmsgP->cmsg_len = len;
+ cmsgP->cmsg_level = level;
+ cmsgP->cmsg_type = type;
+
+ sys_memcpy(CMSG_DATA(cmsgP), data, sz);
+ *used = space;
+ } else {
+ *used = 0;
+ return ESOCK_STR_EINVAL;
+ }
+
+ SSDBG( descP, ("SOCKET", "decode_cmsghdr_final -> done\r\n") );
+
+ return NULL;
+}
+
+
+/* +++ encode_cmsghdr_level +++
+ *
+ * Encode the level part of the cmsghdr().
+ *
+ */
+
+static
+char* encode_cmsghdr_level(ErlNifEnv* env,
+ int level,
+ ERL_NIF_TERM* eLevel)
+{
+ char* xres;
+
+ switch (level) {
+ case SOL_SOCKET:
+ *eLevel = esock_atom_socket;
+ xres = NULL;
+ break;
+
+#if defined(SOL_IP)
+ case SOL_IP:
+#else
+ case IPPROTO_IP:
+#endif
+ *eLevel = esock_atom_ip;
+ xres = NULL;
+ break;
+
+#if defined(HAVE_IPV6)
+#if defined(SOL_IPV6)
+ case SOL_IPV6:
+#else
+ case IPPROTO_IPV6:
+#endif
+ *eLevel = esock_atom_ip;
+ xres = NULL;
+ break;
+#endif
+
+ case IPPROTO_UDP:
+ *eLevel = esock_atom_udp;
+ xres = NULL;
+ break;
+
+ default:
+ *eLevel = MKI(env, level);
+ xres = NULL;
+ break;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ decode_cmsghdr_level +++
+ *
+ * Decode the level part of the cmsghdr().
+ *
+ */
+
+static
+char* decode_cmsghdr_level(ErlNifEnv* env,
+ ERL_NIF_TERM eLevel,
+ int* level)
+{
+ char* xres = NULL;
+
+ if (IS_ATOM(env, eLevel)) {
+
+ if (COMPARE(eLevel, esock_atom_socket) == 0) {
+ *level = SOL_SOCKET;
+ xres = NULL;
+ } else if (COMPARE(eLevel, esock_atom_ip) == 0) {
+#if defined(SOL_IP)
+ *level = SOL_IP;
+#else
+ *level = IPPROTO_IP;
+#endif
+ xres = NULL;
+#if defined(HAVE_IPV6)
+ } else if (COMPARE(eLevel, esock_atom_ipv6) == 0) {
+#if defined(SOL_IPV6)
+ *level = SOL_IPV6;
+#else
+ *level = IPPROTO_IPV6;
+#endif
+ xres = NULL;
+#endif
+ } else if (COMPARE(eLevel, esock_atom_udp) == 0) {
+ *level = IPPROTO_UDP;
+ xres = NULL;
+ } else {
+ *level = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ } else if (IS_NUM(env, eLevel)) {
+ if (!GET_INT(env, eLevel, level))
+ xres = ESOCK_STR_EINVAL;
+ } else {
+ *level = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ encode_cmsghdr_type +++
+ *
+ * Encode the type part of the cmsghdr().
+ *
+ */
+
+static
+char* encode_cmsghdr_type(ErlNifEnv* env,
+ int level,
+ int type,
+ ERL_NIF_TERM* eType)
+{
+ char* xres = NULL;
+
+ switch (level) {
+ case SOL_SOCKET:
+ switch (type) {
+#if defined(SO_TIMESTAMP)
+ case SO_TIMESTAMP:
+ *eType = esock_atom_timestamp;
+ break;
+#endif
+
+#if defined(SCM_RIGHTS)
+ case SCM_RIGHTS:
+ *eType = esock_atom_rights;
+ break;
+#endif
+
+#if defined(SCM_CREDENTIALS)
+ case SCM_CREDENTIALS:
+ *eType = esock_atom_credentials;
+ break;
+#endif
+
+ default:
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+ break;
+
+#if defined(SOL_IP)
+ case SOL_IP:
+#else
+ case IPPROTO_IP:
+#endif
+ switch (type) {
+#if defined(IP_TOS)
+ case IP_TOS:
+ *eType = esock_atom_tos;
+ break;
+#endif
+
+#if defined(IP_TTL)
+ case IP_TTL:
+ *eType = esock_atom_ttl;
+ break;
+#endif
+
+#if defined(IP_PKTINFO)
+ case IP_PKTINFO:
+ *eType = esock_atom_pktinfo;
+ break;
+#endif
+
+#if defined(IP_ORIGDSTADDR)
+ case IP_ORIGDSTADDR:
+ *eType = esock_atom_origdstaddr;
+ break;
+#endif
+
+ default:
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+ break;
+
+#if defined(HAVE_IPV6)
+#if defined(SOL_IPV6)
+ case SOL_IPV6:
+#else
+ case IPPROTO_IPV6:
+#endif
+ switch (type) {
+#if defined(IPV6_PKTINFO)
+ case IPV6_PKTINFO:
+ *eType = esock_atom_pktinfo;
+ break;
+#endif
+
+ default:
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+ break;
+#endif
+
+ case IPPROTO_TCP:
+ switch (type) {
+ default:
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+ break;
+
+ case IPPROTO_UDP:
+ switch (type) {
+ default:
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+ break;
+
+#if defined(HAVE_SCTP)
+ case IPPROTO_SCTP:
+ switch (type) {
+ default:
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+ break;
+#endif
+
+ default:
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ decode_cmsghdr_type +++
+ *
+ * Decode the type part of the cmsghdr().
+ *
+ */
+
+static
+char* decode_cmsghdr_type(ErlNifEnv* env,
+ int level,
+ ERL_NIF_TERM eType,
+ int* type)
+{
+ char* xres = NULL;
+
+ switch (level) {
+ case SOL_SOCKET:
+ if (IS_NUM(env, eType)) {
+ if (!GET_INT(env, eType, type)) {
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ } else {
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ break;
+
+
+#if defined(SOL_IP)
+ case SOL_IP:
+#else
+ case IPPROTO_IP:
+#endif
+ if (IS_ATOM(env, eType)) {
+ if (COMPARE(eType, esock_atom_tos) == 0) {
+#if defined(IP_TOS)
+ *type = IP_TOS;
+#else
+ xres = ESOCK_STR_EINVAL;
+#endif
+ } else if (COMPARE(eType, esock_atom_ttl) == 0) {
+#if defined(IP_TTL)
+ *type = IP_TTL;
+#else
+ xres = ESOCK_STR_EINVAL;
+#endif
+ } else {
+ xres = ESOCK_STR_EINVAL;
+ }
+ } else if (IS_NUM(env, eType)) {
+ if (!GET_INT(env, eType, type)) {
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ } else {
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ break;
+
+#if defined(HAVE_IPV6)
+#if defined(SOL_IPV6)
+ case SOL_IPV6:
+#else
+ case IPPROTO_IPV6:
+#endif
+ if (IS_NUM(env, eType)) {
+ if (!GET_INT(env, eType, type)) {
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ } else {
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ break;
+#endif
+
+ case IPPROTO_UDP:
+ if (IS_NUM(env, eType)) {
+ if (!GET_INT(env, eType, type)) {
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ } else {
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ }
+ break;
+
+ default:
+ *type = -1;
+ xres = ESOCK_STR_EINVAL;
+ break;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ encode_cmsghdr_data +++
+ *
+ * Encode the data part of the cmsghdr().
+ *
+ */
+
+static
+char* encode_cmsghdr_data(ErlNifEnv* env,
+ ERL_NIF_TERM ctrlBuf,
+ int level,
+ int type,
+ unsigned char* dataP,
+ size_t dataPos,
+ size_t dataLen,
+ ERL_NIF_TERM* eCMsgHdrData)
+{
+ char* xres;
+
+ switch (level) {
+#if defined(SOL_SOCKET)
+ case SOL_SOCKET:
+ xres = encode_cmsghdr_data_socket(env, ctrlBuf, type,
+ dataP, dataPos, dataLen,
+ eCMsgHdrData);
+ break;
+#endif
+
+#if defined(SOL_IP)
+ case SOL_IP:
+#else
+ case IPPROTO_IP:
+#endif
+ xres = encode_cmsghdr_data_ip(env, ctrlBuf, type,
+ dataP, dataPos, dataLen,
+ eCMsgHdrData);
+ break;
+
+#if defined(HAVE_IPV6)
+#if defined(SOL_IPV6)
+ case SOL_IPV6:
+#else
+ case IPPROTO_IPV6:
+#endif
+ xres = encode_cmsghdr_data_ipv6(env, ctrlBuf, type,
+ dataP, dataPos, dataLen,
+ eCMsgHdrData);
+ break;
+#endif
+
+ /*
+ case IPPROTO_TCP:
+ xres = encode_cmsghdr_data_tcp(env, type, dataP, eCMsgHdrData);
+ break;
+ */
+
+ /*
+ case IPPROTO_UDP:
+ xres = encode_cmsghdr_data_udp(env, type, dataP, eCMsgHdrData);
+ break;
+ */
+
+ /*
+ #if defined(HAVE_SCTP)
+ case IPPROTO_SCTP:
+ xres = encode_cmsghdr_data_sctp(env, type, dataP, eCMsgHdrData);
+ break;
+ #endif
+ */
+
+ default:
+ *eCMsgHdrData = MKSBIN(env, ctrlBuf, dataPos, dataLen);
+ xres = NULL;
+ break;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ encode_cmsghdr_data_socket +++
+ *
+ * Encode the data part when "protocol" = socket of the cmsghdr().
+ *
+ */
+
+static
+char* encode_cmsghdr_data_socket(ErlNifEnv* env,
+ ERL_NIF_TERM ctrlBuf,
+ int type,
+ unsigned char* dataP,
+ size_t dataPos,
+ size_t dataLen,
+ ERL_NIF_TERM* eCMsgHdrData)
+{
+ // char* xres;
+
+ switch (type) {
+#if defined(SO_TIMESTAMP)
+ case SO_TIMESTAMP:
+ {
+ struct timeval* timeP = (struct timeval*) dataP;
+
+ if (esock_encode_timeval(env, timeP, eCMsgHdrData) != NULL)
+ *eCMsgHdrData = MKSBIN(env, ctrlBuf, dataPos, dataLen);
+ }
+ break;
+#endif
+
+ default:
+ *eCMsgHdrData = MKSBIN(env, ctrlBuf, dataPos, dataLen);
+ break;
+ }
+
+ return NULL;
+}
+
+
+
+/* +++ encode_cmsghdr_data_ip +++
+ *
+ * Encode the data part when protocol = IP of the cmsghdr().
+ *
+ */
+
+static
+char* encode_cmsghdr_data_ip(ErlNifEnv* env,
+ ERL_NIF_TERM ctrlBuf,
+ int type,
+ unsigned char* dataP,
+ size_t dataPos,
+ size_t dataLen,
+ ERL_NIF_TERM* eCMsgHdrData)
+{
+ char* xres = NULL;
+
+ switch (type) {
+#if defined(IP_TOS)
+ case IP_TOS:
+ {
+ unsigned char tos = *dataP;
+ switch (IPTOS_TOS(tos)) {
+ case IPTOS_LOWDELAY:
+ *eCMsgHdrData = esock_atom_lowdelay;
+ break;
+ case IPTOS_THROUGHPUT:
+ *eCMsgHdrData = esock_atom_throughput;
+ break;
+ case IPTOS_RELIABILITY:
+ *eCMsgHdrData = esock_atom_reliability;
+ break;
+#if defined(IPTOS_MINCOST)
+ case IPTOS_MINCOST:
+ *eCMsgHdrData = esock_atom_mincost;
+ break;
+#endif
+ default:
+ *eCMsgHdrData = MKUI(env, tos);
+ break;
+ }
+ }
+ break;
+#endif
+
+#if defined(IP_TTL)
+ case IP_TTL:
+ {
+ int ttl = *((int*) dataP);
+ *eCMsgHdrData = MKI(env, ttl);
+ }
+ break;
+#endif
+
+#if defined(IP_PKTINFO)
+ case IP_PKTINFO:
+ {
+ struct in_pktinfo* pktInfoP = (struct in_pktinfo*) dataP;
+ ERL_NIF_TERM ifIndex = MKUI(env, pktInfoP->ipi_ifindex);
+ ERL_NIF_TERM specDst, addr;
+
+ if ((xres = esock_encode_ip4_address(env,
+ &pktInfoP->ipi_spec_dst,
+ &specDst)) != NULL) {
+ *eCMsgHdrData = esock_atom_undefined;
+ return xres;
+ }
+
+ if ((xres = esock_encode_ip4_address(env,
+ &pktInfoP->ipi_addr,
+ &addr)) != NULL) {
+ *eCMsgHdrData = esock_atom_undefined;
+ return xres;
+ }
+
+
+ {
+ ERL_NIF_TERM keys[] = {esock_atom_ifindex,
+ esock_atom_spec_dst,
+ esock_atom_addr};
+ ERL_NIF_TERM vals[] = {ifIndex, specDst, addr};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, eCMsgHdrData)) {
+ *eCMsgHdrData = esock_atom_undefined;
+ return ESOCK_STR_EINVAL;
+ }
+ }
+ }
+ break;
+#endif
+
+#if defined(IP_ORIGDSTADDR)
+ case IP_ORIGDSTADDR:
+ if ((xres = esock_encode_sockaddr_in4(env,
+ (struct sockaddr_in*) dataP,
+ dataLen,
+ eCMsgHdrData)) != NULL) {
+ *eCMsgHdrData = esock_atom_undefined;
+ return xres;
+ }
+ break;
+#endif
+
+ default:
+ *eCMsgHdrData = MKSBIN(env, ctrlBuf, dataPos, dataLen);
+ break;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ encode_cmsghdr_data_ipv6 +++
+ *
+ * Encode the data part when protocol = IPv6 of the cmsghdr().
+ *
+ */
+#if defined(HAVE_IPV6)
+static
+char* encode_cmsghdr_data_ipv6(ErlNifEnv* env,
+ ERL_NIF_TERM ctrlBuf,
+ int type,
+ unsigned char* dataP,
+ size_t dataPos,
+ size_t dataLen,
+ ERL_NIF_TERM* eCMsgHdrData)
+{
+ char* xres;
+
+ switch (type) {
+#if defined(IPV6_PKTINFO)
+ case IPV6_PKTINFO:
+ {
+ struct in6_pktinfo* pktInfoP = (struct in6_pktinfo*) dataP;
+ ERL_NIF_TERM ifIndex = MKI(env, pktInfoP->ipi6_ifindex);
+ ERL_NIF_TERM addr;
+
+ if ((xres = esock_encode_ip6_address(env,
+ &pktInfoP->ipi6_addr,
+ &addr)) != NULL) {
+ *eCMsgHdrData = esock_atom_undefined;
+ return xres;
+ }
+
+ {
+ ERL_NIF_TERM keys[] = {esock_atom_addr, esock_atom_ifindex};
+ ERL_NIF_TERM vals[] = {addr, ifIndex};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, eCMsgHdrData)) {
+ *eCMsgHdrData = esock_atom_undefined;
+ return ESOCK_STR_EINVAL;
+ }
+ }
+ }
+ break;
+#endif
+
+ default:
+ *eCMsgHdrData = MKSBIN(env, ctrlBuf, dataPos, dataLen);
+ break;
+ }
+
+ return NULL;
+}
+#endif
+
+
+
+/* +++ encode_msghdr_flags +++
+ *
+ * Encode a list of msghdr_flag().
+ *
+ * The following flags are handled: eor | trunc | ctrunc | oob | errqueue.
+ */
+
+extern
+char* encode_msghdr_flags(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ int msgFlags,
+ ERL_NIF_TERM* flags)
+{
+ SSDBG( descP,
+ ("SOCKET", "encode_cmsghdrs_flags -> entry with"
+ "\r\n msgFlags: %d (0x%lX)"
+ "\r\n", msgFlags, msgFlags) );
+
+ if (msgFlags == 0) {
+ *flags = MKEL(env);
+ return NULL;
+ } else {
+ SocketTArray ta = TARRAY_CREATE(10); // Just to be on the safe side
+
+#if defined(MSG_EOR)
+ if ((msgFlags & MSG_EOR) == MSG_EOR)
+ TARRAY_ADD(ta, esock_atom_eor);
+#endif
+
+#if defined(MSG_TRUNC)
+ if ((msgFlags & MSG_TRUNC) == MSG_TRUNC)
+ TARRAY_ADD(ta, esock_atom_trunc);
+#endif
+
+#if defined(MSG_CTRUNC)
+ if ((msgFlags & MSG_CTRUNC) == MSG_CTRUNC)
+ TARRAY_ADD(ta, esock_atom_ctrunc);
+#endif
+
+#if defined(MSG_OOB)
+ if ((msgFlags & MSG_OOB) == MSG_OOB)
+ TARRAY_ADD(ta, esock_atom_oob);
+#endif
+
+#if defined(MSG_ERRQUEUE)
+ if ((msgFlags & MSG_ERRQUEUE) == MSG_ERRQUEUE)
+ TARRAY_ADD(ta, esock_atom_errqueue);
+#endif
+
+ SSDBG( descP,
+ ("SOCKET", "esock_encode_cmsghdrs -> flags processed when"
+ "\r\n TArray size: %d"
+ "\r\n", TARRAY_SZ(ta)) );
+
+ TARRAY_TOLIST(ta, env, flags);
+
+ return NULL;
+ }
+}
+
+
+
+
+/* +++ decode the linger value +++
+ * The (socket) linger option is provided as a two tuple:
+ *
+ * {OnOff :: boolean(), Time :: integer()}
+ *
+ */
+static
+BOOLEAN_T decode_sock_linger(ErlNifEnv* env, ERL_NIF_TERM eVal, struct linger* valP)
+{
+ const ERL_NIF_TERM* lt; // The array of the elements of the tuple
+ int sz; // The size of the tuple - should be 2
+ BOOLEAN_T onOff;
+ int secs;
+
+ if (!GET_TUPLE(env, eVal, &sz, &lt))
+ return FALSE;
+
+ if (sz != 2)
+ return FALSE;
+
+
+ /* So fas so good - now check the two elements of the tuple. */
+
+ onOff = esock_decode_bool(lt[0]);
+
+ if (!GET_INT(env, lt[1], &secs))
+ return FALSE;
+
+ valP->l_onoff = (onOff) ? 1 : 0;
+ valP->l_linger = secs;
+
+ return TRUE;
+}
+
+
+
+/* +++ decode the ip socket option TOS +++
+ * The (ip) option can be provide in two ways:
+ *
+ * atom() | integer()
+ *
+ * When its an atom it can have the values:
+ *
+ * lowdelay | throughput | reliability | mincost
+ *
+ */
+#if defined(IP_TOS)
+static
+BOOLEAN_T decode_ip_tos(ErlNifEnv* env, ERL_NIF_TERM eVal, int* val)
+{
+ BOOLEAN_T result = FALSE;
+
+ if (IS_ATOM(env, eVal)) {
+
+ if (COMPARE(eVal, esock_atom_lowdelay) == 0) {
+ *val = IPTOS_LOWDELAY;
+ result = TRUE;
+ } else if (COMPARE(eVal, esock_atom_throughput) == 0) {
+ *val = IPTOS_THROUGHPUT;
+ result = TRUE;
+ } else if (COMPARE(eVal, esock_atom_reliability) == 0) {
+ *val = IPTOS_RELIABILITY;
+ result = TRUE;
+#if defined(IPTOS_MINCOST)
+ } else if (COMPARE(eVal, esock_atom_mincost) == 0) {
+ *val = IPTOS_MINCOST;
+ result = TRUE;
+#endif
+ } else {
+ *val = -1;
+ result = FALSE;
+ }
+
+ } else if (IS_NUM(env, eVal)) {
+
+ if (GET_INT(env, eVal, val)) {
+ result = TRUE;
+ } else {
+ *val = -1;
+ result = FALSE;
+ }
+
+ } else {
+ *val = -1;
+ result = FALSE;
+ }
+
+ return result;
+}
+#endif
+
+
+
+/* +++ decode the ip socket option MTU_DISCOVER +++
+ * The (ip) option can be provide in two ways:
+ *
+ * atom() | integer()
+ *
+ * When its an atom it can have the values:
+ *
+ * want | dont | do | probe
+ *
+ */
+#if defined(IP_MTU_DISCOVER)
+static
+char* decode_ip_pmtudisc(ErlNifEnv* env, ERL_NIF_TERM eVal, int* val)
+{
+ char* res = NULL;
+
+ if (IS_ATOM(env, eVal)) {
+
+ if (COMPARE(eVal, atom_want) == 0) {
+ *val = IP_PMTUDISC_WANT;
+ } else if (COMPARE(eVal, atom_dont) == 0) {
+ *val = IP_PMTUDISC_DONT;
+ } else if (COMPARE(eVal, atom_do) == 0) {
+ *val = IP_PMTUDISC_DO;
+#if defined(IP_PMTUDISC_PROBE)
+ } else if (COMPARE(eVal, atom_probe) == 0) {
+ *val = IP_PMTUDISC_PROBE;
+#endif
+ } else {
+ *val = -1;
+ res = ESOCK_STR_EINVAL;
+ }
+
+ } else if (IS_NUM(env, eVal)) {
+
+ if (!GET_INT(env, eVal, val)) {
+ *val = -1;
+ res = ESOCK_STR_EINVAL;
+ }
+
+ } else {
+
+ *val = -1;
+ res = ESOCK_STR_EINVAL;
+
+ }
+
+ return res;
+}
+#endif
+
+
+
+/* +++ decode the ipv6 socket option MTU_DISCOVER +++
+ * The (ip) option can be provide in two ways:
+ *
+ * atom() | integer()
+ *
+ * When its an atom it can have the values:
+ *
+ * want | dont | do | probe
+ *
+ */
+#if defined(IPV6_MTU_DISCOVER)
+static
+char* decode_ipv6_pmtudisc(ErlNifEnv* env, ERL_NIF_TERM eVal, int* val)
+{
+ char* res = NULL;
+
+ if (IS_ATOM(env, eVal)) {
+
+ if (COMPARE(eVal, atom_want) == 0) {
+ *val = IPV6_PMTUDISC_WANT;
+ } else if (COMPARE(eVal, atom_dont) == 0) {
+ *val = IPV6_PMTUDISC_DONT;
+ } else if (COMPARE(eVal, atom_do) == 0) {
+ *val = IPV6_PMTUDISC_DO;
+#if defined(IPV6_PMTUDISC_PROBE)
+ } else if (COMPARE(eVal, atom_probe) == 0) {
+ *val = IPV6_PMTUDISC_PROBE;
+#endif
+ } else {
+ *val = -1;
+ res = ESOCK_STR_EINVAL;
+ }
+
+ } else if (IS_NUM(env, eVal)) {
+
+ if (!GET_INT(env, eVal, val)) {
+ *val = -1;
+ res = ESOCK_STR_EINVAL;
+ }
+
+ } else {
+
+ *val = -1;
+ res = ESOCK_STR_EINVAL;
+
+ }
+
+ return res;
+}
+#endif
+
+
+
+/* +++ encode the ip socket option MTU_DISCOVER +++
+ * The (ip) option can be provide in two ways:
+ *
+ * atom() | integer()
+ *
+ * If its one of the "known" values, it will be an atom:
+ *
+ * want | dont | do | probe
+ *
+ */
+#if defined(IP_MTU_DISCOVER)
+static
+void encode_ip_pmtudisc(ErlNifEnv* env, int val, ERL_NIF_TERM* eVal)
+{
+ switch (val) {
+ case IP_PMTUDISC_WANT:
+ *eVal = atom_want;
+ break;
+
+ case IP_PMTUDISC_DONT:
+ *eVal = atom_dont;
+ break;
+
+ case IP_PMTUDISC_DO:
+ *eVal = atom_do;
+ break;
+
+#if defined(IP_PMTUDISC_PROBE)
+ case IP_PMTUDISC_PROBE:
+ *eVal = atom_probe;
+ break;
+#endif
+
+ default:
+ *eVal = MKI(env, val);
+ break;
+ }
+
+ return;
+}
+#endif
+
+
+
+/* +++ encode the ipv6 socket option MTU_DISCOVER +++
+ * The (ipv6) option can be provide in two ways:
+ *
+ * atom() | integer()
+ *
+ * If its one of the "known" values, it will be an atom:
+ *
+ * want | dont | do | probe
+ *
+ */
+#if defined(IPV6_MTU_DISCOVER)
+static
+void encode_ipv6_pmtudisc(ErlNifEnv* env, int val, ERL_NIF_TERM* eVal)
+{
+ switch (val) {
+ case IPV6_PMTUDISC_WANT:
+ *eVal = atom_want;
+ break;
+
+ case IPV6_PMTUDISC_DONT:
+ *eVal = atom_dont;
+ break;
+
+ case IPV6_PMTUDISC_DO:
+ *eVal = atom_do;
+ break;
+
+#if defined(IPV6_PMTUDISC_PROBE)
+ case IPV6_PMTUDISC_PROBE:
+ *eVal = atom_probe;
+ break;
+#endif
+
+ default:
+ *eVal = MKI(env, val);
+ break;
+ }
+
+ return;
+}
+#endif
+
+
+
+/* +++ decocde the native getopt option +++
+ * The option is in this case provide in the form of a two tuple:
+ *
+ * {NativeOpt, ValueSize}
+ *
+ * NativeOpt :: integer()
+ * ValueSize :: int | bool | non_neg_integer()
+ *
+ */
+static
+BOOLEAN_T decode_native_get_opt(ErlNifEnv* env, ERL_NIF_TERM eVal,
+ int* opt, Uint16* valueType, int* valueSz)
+{
+ const ERL_NIF_TERM* nativeOptT;
+ int nativeOptTSz;
+
+ /* First, get the tuple and verify its size (2) */
+
+ if (!GET_TUPLE(env, eVal, &nativeOptTSz, &nativeOptT))
+ return FALSE;
+
+ if (nativeOptTSz != 2)
+ return FALSE;
+
+ /* So far so good.
+ * First element is an integer.
+ * Second element is an atom or an integer.
+ * The only "types" that we support at the moment are:
+ *
+ * bool - Which is actually a integer
+ * (but will be *returned* as a boolean())
+ * int - Just short for integer
+ */
+
+ if (!GET_INT(env, nativeOptT[0], opt))
+ return FALSE;
+
+ if (IS_ATOM(env, nativeOptT[1])) {
+
+ if (COMPARE(nativeOptT[1], atom_int) == 0) {
+ SGDBG( ("SOCKET", "decode_native_get_opt -> int\r\n") );
+ *valueType = SOCKET_OPT_VALUE_TYPE_INT;
+ *valueSz = sizeof(int); // Just to be sure
+ } else if (COMPARE(nativeOptT[1], atom_bool) == 0) {
+ SGDBG( ("SOCKET", "decode_native_get_opt -> bool\r\n") );
+ *valueType = SOCKET_OPT_VALUE_TYPE_BOOL;
+ *valueSz = sizeof(int); // Just to be sure
+ } else {
+ return FALSE;
+ }
+ } else if (IS_NUM(env, nativeOptT[1])) {
+ if (GET_INT(env, nativeOptT[1], valueSz)) {
+ SGDBG( ("SOCKET", "decode_native_get_opt -> unspec\r\n") );
+ *valueType = SOCKET_OPT_VALUE_TYPE_UNSPEC;
+ } else {
+ return FALSE;
+ }
+ } else {
+ return FALSE;
+ }
+
+ SGDBG( ("SOCKET", "decode_native_get_opt -> done\r\n") );
+
+ return TRUE;
+}
+
+
+
+/* +++ encode the ip socket option tos +++
+ * The (ip) option can be provide as:
+ *
+ * lowdelay | throughput | reliability | mincost | integer()
+ *
+ */
+static
+ERL_NIF_TERM encode_ip_tos(ErlNifEnv* env, int val)
+{
+ ERL_NIF_TERM result;
+
+ switch (IPTOS_TOS(val)) {
+ case IPTOS_LOWDELAY:
+ result = esock_make_ok2(env, esock_atom_lowdelay);
+ break;
+
+ case IPTOS_THROUGHPUT:
+ result = esock_make_ok2(env, esock_atom_throughput);
+ break;
+
+ case IPTOS_RELIABILITY:
+ result = esock_make_ok2(env, esock_atom_reliability);
+ break;
+
+#if defined(IPTOS_MINCOST)
+ case IPTOS_MINCOST:
+ result = esock_make_ok2(env, esock_atom_mincost);
+ break;
+#endif
+
+ default:
+ result = esock_make_ok2(env, MKI(env, val));
+ break;
+ }
+
+ return result;
+}
+
+
+
+
+
+/* *** alloc_descriptor ***
+ *
+ * Allocate and perform basic initialization of a socket descriptor.
+ *
+ */
+static
+SocketDescriptor* alloc_descriptor(SOCKET sock, HANDLE event)
+{
+ SocketDescriptor* descP;
+
+ if ((descP = enif_alloc_resource(sockets, sizeof(SocketDescriptor))) != NULL) {
+ char buf[64]; /* Buffer used for building the mutex name */
+
+ // This needs to be released when the socket is closed!
+ descP->env = enif_alloc_env();
+
+ sprintf(buf, "socket[w,%d]", sock);
+ descP->writeMtx = MCREATE(buf);
+ descP->currentWriterP = NULL; // currentWriter not used
+ descP->writersQ.first = NULL;
+ descP->writersQ.last = NULL;
+ descP->isWritable = FALSE; // TRUE;
+ descP->writePkgCnt = 0;
+ descP->writeByteCnt = 0;
+ descP->writeTries = 0;
+ descP->writeWaits = 0;
+ descP->writeFails = 0;
+
+ sprintf(buf, "socket[r,%d]", sock);
+ descP->readMtx = MCREATE(buf);
+ descP->currentReaderP = NULL; // currentReader not used
+ descP->readersQ.first = NULL;
+ descP->readersQ.last = NULL;
+ descP->isReadable = FALSE; // TRUE;
+ descP->readPkgCnt = 0;
+ descP->readByteCnt = 0;
+ descP->readTries = 0;
+ descP->readWaits = 0;
+
+ sprintf(buf, "socket[acc,%d]", sock);
+ descP->accMtx = MCREATE(buf);
+ descP->currentAcceptorP = NULL; // currentAcceptor not used
+ descP->acceptorsQ.first = NULL;
+ descP->acceptorsQ.last = NULL;
+
+ sprintf(buf, "socket[close,%d]", sock);
+ descP->closeMtx = MCREATE(buf);
+ descP->closeEnv = NULL;
+ descP->closeRef = esock_atom_undefined;
+
+ descP->rBufSz = SOCKET_RECV_BUFFER_SIZE_DEFAULT;
+ descP->rNum = 0;
+ descP->rNumCnt = 0;
+ descP->rCtrlSz = SOCKET_RECV_CTRL_BUFFER_SIZE_DEFAULT;
+ descP->wCtrlSz = SOCKET_SEND_CTRL_BUFFER_SIZE_DEFAULT;
+ descP->iow = FALSE;
+ descP->dbg = SOCKET_DEBUG_DEFAULT;
+
+ descP->sock = sock;
+ descP->event = event;
+
+ MON_INIT(&descP->currentWriter.mon);
+ MON_INIT(&descP->currentReader.mon);
+ MON_INIT(&descP->currentAcceptor.mon);
+ MON_INIT(&descP->ctrlMon);
+ MON_INIT(&descP->closerMon);
+ }
+
+ return descP;
+}
+
+
+
+/* Decrement counters for when a socket is closed
+ */
+static
+void dec_socket(int domain, int type, int protocol)
+{
+ MLOCK(data.cntMtx);
+
+ cnt_dec(&data.numSockets, 1);
+
+ /* *** Domain counter *** */
+ if (domain == AF_INET)
+ cnt_dec(&data.numDomainInet, 1);
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ else if (domain == AF_INET6)
+ cnt_dec(&data.numDomainInet6, 1);
+#endif
+#if defined(HAVE_SYS_UN_H)
+ else if (domain == AF_UNIX)
+ cnt_dec(&data.numDomainInet6, 1);
+#endif
+
+ /* *** Type counter *** */
+ if (type == SOCK_STREAM)
+ cnt_dec(&data.numTypeStreams, 1);
+ else if (type == SOCK_DGRAM)
+ cnt_dec(&data.numTypeDGrams, 1);
+#ifdef HAVE_SCTP
+ else if (type == SOCK_SEQPACKET)
+ cnt_dec(&data.numTypeSeqPkgs, 1);
+#endif
+
+ /* *** Protocol counter *** */
+ if (protocol == IPPROTO_IP)
+ cnt_dec(&data.numProtoIP, 1);
+ else if (protocol == IPPROTO_TCP)
+ cnt_dec(&data.numProtoTCP, 1);
+ else if (protocol == IPPROTO_UDP)
+ cnt_dec(&data.numProtoUDP, 1);
+#if defined(HAVE_SCTP)
+ else if (protocol == IPPROTO_SCTP)
+ cnt_dec(&data.numProtoSCTP, 1);
+#endif
+
+ MUNLOCK(data.cntMtx);
+}
+
+
+/* Increment counters for when a socket is opened
+ */
+static
+void inc_socket(int domain, int type, int protocol)
+{
+ MLOCK(data.cntMtx);
+
+ cnt_inc(&data.numSockets, 1);
+
+ /* *** Domain counter *** */
+ if (domain == AF_INET)
+ cnt_inc(&data.numDomainInet, 1);
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ else if (domain == AF_INET6)
+ cnt_inc(&data.numDomainInet6, 1);
+#endif
+#if defined(HAVE_SYS_UN_H)
+ else if (domain == AF_UNIX)
+ cnt_inc(&data.numDomainInet6, 1);
+#endif
+
+ /* *** Type counter *** */
+ if (type == SOCK_STREAM)
+ cnt_inc(&data.numTypeStreams, 1);
+ else if (type == SOCK_DGRAM)
+ cnt_inc(&data.numTypeDGrams, 1);
+#ifdef HAVE_SCTP
+ else if (type == SOCK_SEQPACKET)
+ cnt_inc(&data.numTypeSeqPkgs, 1);
+#endif
+
+ /* *** Protocol counter *** */
+ if (protocol == IPPROTO_IP)
+ cnt_inc(&data.numProtoIP, 1);
+ else if (protocol == IPPROTO_TCP)
+ cnt_inc(&data.numProtoTCP, 1);
+ else if (protocol == IPPROTO_UDP)
+ cnt_inc(&data.numProtoUDP, 1);
+#if defined(HAVE_SCTP)
+ else if (protocol == IPPROTO_SCTP)
+ cnt_inc(&data.numProtoSCTP, 1);
+#endif
+
+ MUNLOCK(data.cntMtx);
+}
+
+
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * D e c o d e / E n c o d e F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+/* edomain2domain - convert internal (erlang) domain to (proper) domain
+ *
+ * Note that only a subset is supported.
+ */
+#if !defined(__WIN32__)
+static
+BOOLEAN_T edomain2domain(int edomain, int* domain)
+{
+ switch (edomain) {
+ case SOCKET_DOMAIN_INET:
+ *domain = AF_INET;
+ break;
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ case SOCKET_DOMAIN_INET6:
+ *domain = AF_INET6;
+ break;
+#endif
+#ifdef HAVE_SYS_UN_H
+ case SOCKET_DOMAIN_LOCAL:
+ *domain = AF_UNIX;
+ break;
+#endif
+
+ default:
+ *domain = -1;
+ return FALSE;
+ }
+
+ return TRUE;
+}
+
+
+/* etype2type - convert internal (erlang) type to (proper) type
+ *
+ * Note that only a subset is supported.
+ */
+static
+BOOLEAN_T etype2type(int etype, int* type)
+{
+ switch (etype) {
+ case SOCKET_TYPE_STREAM:
+ *type = SOCK_STREAM;
+ break;
+
+ case SOCKET_TYPE_DGRAM:
+ *type = SOCK_DGRAM;
+ break;
+
+ case SOCKET_TYPE_RAW:
+ *type = SOCK_RAW;
+ break;
+
+#ifdef HAVE_SCTP
+ case SOCKET_TYPE_SEQPACKET:
+ *type = SOCK_SEQPACKET;
+ break;
+#endif
+
+ default:
+ *type = -1;
+ return FALSE;
+ }
+
+ return TRUE;
+}
+
+
+/* eproto2proto - convert internal (erlang) protocol to (proper) protocol
+ *
+ * Note that only a subset is supported.
+ */
+static
+BOOLEAN_T eproto2proto(ErlNifEnv* env,
+ ERL_NIF_TERM eproto,
+ int* proto)
+{
+ if (IS_NUM(env, eproto)) {
+ int ep;
+
+ if (!GET_INT(env, eproto, &ep)) {
+ *proto = -1;
+ return FALSE;
+ }
+
+ switch (ep) {
+ case SOCKET_PROTOCOL_IP:
+ *proto = IPPROTO_IP;
+ break;
+
+ case SOCKET_PROTOCOL_TCP:
+ *proto = IPPROTO_TCP;
+ break;
+
+ case SOCKET_PROTOCOL_UDP:
+ *proto = IPPROTO_UDP;
+ break;
+
+#if defined(HAVE_SCTP)
+ case SOCKET_PROTOCOL_SCTP:
+ *proto = IPPROTO_SCTP;
+ break;
+#endif
+
+ case SOCKET_PROTOCOL_ICMP:
+ *proto = IPPROTO_ICMP;
+ break;
+
+ case SOCKET_PROTOCOL_IGMP:
+ *proto = IPPROTO_IGMP;
+ break;
+
+ default:
+ *proto = -2;
+ return FALSE;
+ }
+ } else {
+ const ERL_NIF_TERM* a;
+ int sz;
+
+ if (!GET_TUPLE(env, eproto, &sz, &a)) {
+ *proto = -3;
+ return FALSE;
+ }
+
+ if (sz != 2) {
+ *proto = -4;
+ return FALSE;
+ }
+
+ if (COMPARE(a[0], esock_atom_raw) != 0) {
+ *proto = -5;
+ return FALSE;
+ }
+
+ if (!GET_INT(env, a[1], proto)) {
+ *proto = -6;
+ return FALSE;
+ }
+ }
+
+ return TRUE;
+}
+
+
+#ifdef HAVE_SETNS
+ /* emap2netns - extract the netns field from the extra map
+ *
+ * Note that currently we only support one extra option, the netns.
+ */
+static
+BOOLEAN_T emap2netns(ErlNifEnv* env, ERL_NIF_TERM map, char** netns)
+{
+ size_t sz;
+ ERL_NIF_TERM key;
+ ERL_NIF_TERM value;
+ unsigned int len;
+ char* buf;
+ int written;
+
+ /* Note that its acceptable that the extra map is empty */
+ if (!enif_get_map_size(env, map, &sz) ||
+ (sz != 1)) {
+ *netns = NULL;
+ return TRUE;
+ }
+
+ /* The currently only supported extra option is: netns */
+ key = enif_make_atom(env, "netns");
+ if (!GET_MAP_VAL(env, map, key, &value)) {
+ *netns = NULL; // Just in case...
+ return FALSE;
+ }
+
+ /* So far so good. The value should be a string, check. */
+ if (!enif_is_list(env, value)) {
+ *netns = NULL; // Just in case...
+ return FALSE;
+ }
+
+ if (!enif_get_list_length(env, value, &len)) {
+ *netns = NULL; // Just in case...
+ return FALSE;
+ }
+
+ if ((buf = MALLOC(len+1)) == NULL) {
+ *netns = NULL; // Just in case...
+ return FALSE;
+ }
+
+ written = enif_get_string(env, value, buf, len+1, ERL_NIF_LATIN1);
+ if (written == (len+1)) {
+ *netns = buf;
+ return TRUE;
+ } else {
+ *netns = NULL; // Just in case...
+ return FALSE;
+ }
+}
+#endif
+
+
+/* esendflags2sendflags - convert internal (erlang) send flags to (proper)
+ * send flags.
+ */
+static
+BOOLEAN_T esendflags2sendflags(unsigned int eflags, int* flags)
+{
+ unsigned int ef;
+ int tmp = 0;
+
+ /* First, check if we have any flags at all */
+ if (eflags == 0) {
+ *flags = 0;
+ return TRUE;
+ }
+
+ for (ef = SOCKET_SEND_FLAG_LOW; ef <= SOCKET_SEND_FLAG_HIGH; ef++) {
+
+ switch (ef) {
+#if defined(MSG_CONFIRM)
+ case SOCKET_SEND_FLAG_CONFIRM:
+ if ((1 << SOCKET_SEND_FLAG_CONFIRM) & eflags)
+ tmp |= MSG_CONFIRM;
+ break;
+#endif
+
+#if defined(MSG_DONTROUTE)
+ case SOCKET_SEND_FLAG_DONTROUTE:
+ if ((1 << SOCKET_SEND_FLAG_DONTROUTE) & eflags)
+ tmp |= MSG_DONTROUTE;
+ break;
+#endif
+
+#if defined(MSG_EOR)
+ case SOCKET_SEND_FLAG_EOR:
+ if ((1 << SOCKET_SEND_FLAG_EOR) & eflags)
+ tmp |= MSG_EOR;
+ break;
+#endif
+
+#if defined(MSG_MORE)
+ case SOCKET_SEND_FLAG_MORE:
+ if ((1 << SOCKET_SEND_FLAG_MORE) & eflags)
+ tmp |= MSG_MORE;
+ break;
+#endif
+
+#if defined(MSG_NOSIGNAL)
+ case SOCKET_SEND_FLAG_NOSIGNAL:
+ if ((1 << SOCKET_SEND_FLAG_NOSIGNAL) & eflags)
+ tmp |= MSG_NOSIGNAL;
+ break;
+#endif
+
+#if defined(MSG_OOB)
+ case SOCKET_SEND_FLAG_OOB:
+ if ((1 << SOCKET_SEND_FLAG_OOB) & eflags)
+ tmp |= MSG_OOB;
+ break;
+#endif
+
+ default:
+ return FALSE;
+ }
+
+ }
+
+ *flags = tmp;
+
+ return TRUE;
+}
+
+
+
+/* erecvflags2recvflags - convert internal (erlang) send flags to (proper)
+ * send flags.
+ */
+static
+BOOLEAN_T erecvflags2recvflags(unsigned int eflags, int* flags)
+{
+ unsigned int ef;
+ int tmp = 0;
+
+ SGDBG( ("SOCKET", "erecvflags2recvflags -> entry with"
+ "\r\n eflags: %d"
+ "\r\n", eflags) );
+
+ if (eflags == 0) {
+ *flags = 0;
+ return TRUE;
+ }
+
+ for (ef = SOCKET_RECV_FLAG_LOW; ef <= SOCKET_RECV_FLAG_HIGH; ef++) {
+
+ SGDBG( ("SOCKET", "erecvflags2recvflags -> iteration"
+ "\r\n ef: %d"
+ "\r\n tmp: %d"
+ "\r\n", ef, tmp) );
+
+ switch (ef) {
+#if defined(MSG_CMSG_CLOEXEC)
+ case SOCKET_RECV_FLAG_CMSG_CLOEXEC:
+ if ((1 << SOCKET_RECV_FLAG_CMSG_CLOEXEC) & eflags)
+ tmp |= MSG_CMSG_CLOEXEC;
+ break;
+#endif
+
+#if defined(MSG_ERRQUEUE)
+ case SOCKET_RECV_FLAG_ERRQUEUE:
+ if ((1 << SOCKET_RECV_FLAG_ERRQUEUE) & eflags)
+ tmp |= MSG_ERRQUEUE;
+ break;
+#endif
+
+#if defined(MSG_OOB)
+ case SOCKET_RECV_FLAG_OOB:
+ if ((1 << SOCKET_RECV_FLAG_OOB) & eflags)
+ tmp |= MSG_OOB;
+ break;
+#endif
+
+ /*
+ * <KOLLA>
+ *
+ * We need to handle this, because it may effect the read algorithm
+ *
+ * </KOLLA>
+ */
+#if defined(MSG_PEEK)
+ case SOCKET_RECV_FLAG_PEEK:
+ if ((1 << SOCKET_RECV_FLAG_PEEK) & eflags)
+ tmp |= MSG_PEEK;
+ break;
+#endif
+
+#if defined(MSG_TRUNC)
+ case SOCKET_RECV_FLAG_TRUNC:
+ if ((1 << SOCKET_RECV_FLAG_TRUNC) & eflags)
+ tmp |= MSG_TRUNC;
+ break;
+#endif
+
+ default:
+ return FALSE;
+ }
+
+ }
+
+ *flags = tmp;
+
+ return TRUE;
+}
+
+
+
+/* eproto2proto - convert internal (erlang) protocol to (proper) protocol
+ *
+ * Note that only a subset is supported.
+ */
+static
+BOOLEAN_T ehow2how(unsigned int ehow, int* how)
+{
+ switch (ehow) {
+ case SOCKET_SHUTDOWN_HOW_RD:
+ *how = SHUT_RD;
+ break;
+
+ case SOCKET_SHUTDOWN_HOW_WR:
+ *how = SHUT_WR;
+ break;
+
+ case SOCKET_SHUTDOWN_HOW_RDWR:
+ *how = SHUT_RDWR;
+ break;
+
+ default:
+ return FALSE;
+ }
+
+ return TRUE;
+}
+
+
+
+#if defined(HAVE_SYS_UN_H) || defined(SO_BINDTODEVICE)
+/* strnlen doesn't exist everywhere */
+/*
+static
+size_t my_strnlen(const char *s, size_t maxlen)
+{
+ size_t i = 0;
+ while (i < maxlen && s[i] != '\0')
+ i++;
+ return i;
+}
+*/
+#endif
+
+
+/* Send an error closed message to the specified process:
+ *
+ * This message is for processes that are waiting in the
+ * erlang API functions for a select message.
+ */
+/*
+static
+char* send_msg_error_closed(ErlNifEnv* env,
+ ErlNifPid* pid)
+{
+ return send_msg_error(env, atom_closed, pid);
+}
+*/
+
+/* Send an error message to the specified process:
+ * A message in the form:
+ *
+ * {error, Reason}
+ *
+ * This message is for processes that are waiting in the
+ * erlang API functions for a select message.
+ */
+/*
+static
+char* send_msg_error(ErlNifEnv* env,
+ ERL_NIF_TERM reason,
+ ErlNifPid* pid)
+{
+ ERL_NIF_TERM msg = enif_make_tuple2(env, atom_error, reason);
+
+ return send_msg(env, msg, pid);
+}
+*/
+
+
+/* Send an close message to the specified process:
+ * A message in the form:
+ *
+ * {'$socket', SockRef, close, CloseRef}
+ *
+ * This message is for processes that is waiting in the
+ * erlang API (close-) function for the socket to be "closed"
+ * (actually that the 'stop' callback function has been called).
+ */
+static
+char* esock_send_close_msg(ErlNifEnv* env,
+ SocketDescriptor* descP)
+{
+ ERL_NIF_TERM sockRef = enif_make_resource(descP->closeEnv, descP);
+ char* res = esock_send_socket_msg(env,
+ sockRef,
+ esock_atom_close,
+ descP->closeRef,
+ &descP->closerPid,
+ descP->closeEnv);
+
+ descP->closeEnv = NULL;
+
+ return res;
+}
+
+
+/* Send an abort message to the specified process:
+ * A message in the form:
+ *
+ * {'$socket', SockRef, abort, {RecvRef, Reason}}
+ *
+ * This message is for processes that is waiting in the
+ * erlang API functions for a select message.
+ */
+static
+char* esock_send_abort_msg(ErlNifEnv* env,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM recvRef,
+ ERL_NIF_TERM reason,
+ ErlNifPid* pid)
+{
+ ErlNifEnv* msg_env = enif_alloc_env();
+ ERL_NIF_TERM info = MKT2(msg_env,
+ enif_make_copy(msg_env, recvRef),
+ enif_make_copy(msg_env, reason));
+
+ return esock_send_socket_msg(env, sockRef, esock_atom_abort, info, pid,
+ msg_env);
+}
+
+
+/* *** esock_send_socket_msg ***
+ *
+ * This function sends a general purpose socket message to an erlang
+ * process. A general 'socket' message has the ("erlang") form:
+ *
+ * {'$socket', SockRef, Tag, Info}
+ *
+ * Where
+ *
+ * SockRef: reference()
+ * Tag: atom()
+ * Info: term()
+ *
+ */
+
+static
+char* esock_send_socket_msg(ErlNifEnv* env,
+ ERL_NIF_TERM sockRef,
+ ERL_NIF_TERM tag,
+ ERL_NIF_TERM info,
+ ErlNifPid* pid,
+ ErlNifEnv* msg_env)
+{
+ ERL_NIF_TERM msg;
+ if (!msg_env) {
+ msg_env = enif_alloc_env();
+ sockRef = enif_make_copy(msg_env, sockRef);
+ tag = enif_make_copy(msg_env, tag);
+ info = enif_make_copy(msg_env, info);
+ }
+ msg = MKT4(msg_env, esock_atom_socket_tag, sockRef, tag, info);
+
+ return esock_send_msg(env, msg, pid, msg_env);
+}
+
+
+/* Send a message to the specified process.
+ */
+static
+char* esock_send_msg(ErlNifEnv* env,
+ ERL_NIF_TERM msg,
+ ErlNifPid* pid,
+ ErlNifEnv* msg_env)
+{
+ int res = enif_send(env, pid, msg_env, msg);
+ if (msg_env)
+ enif_free_env(msg_env);
+
+ if (!res)
+ return str_exsend;
+ else
+ return NULL;
+}
+#endif // #if defined(__WIN32__)
+
+
+/* ----------------------------------------------------------------------
+ * S e l e c t W r a p p e r F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+static
+int esock_select_read(ErlNifEnv* env,
+ ErlNifEvent event,
+ void* obj,
+ const ErlNifPid* pid,
+ ERL_NIF_TERM ref)
+{
+ return enif_select(env, event, (ERL_NIF_SELECT_READ), obj, pid, ref);
+}
+
+
+static
+int esock_select_write(ErlNifEnv* env,
+ ErlNifEvent event,
+ void* obj,
+ const ErlNifPid* pid,
+ ERL_NIF_TERM ref)
+{
+ return enif_select(env, event, (ERL_NIF_SELECT_WRITE), obj, pid, ref);
+}
+
+
+static
+int esock_select_stop(ErlNifEnv* env,
+ ErlNifEvent event,
+ void* obj)
+{
+ return enif_select(env, event, (ERL_NIF_SELECT_STOP), obj, NULL,
+ esock_atom_undefined);
+}
+
+static
+int esock_select_cancel(ErlNifEnv* env,
+ ErlNifEvent event,
+ enum ErlNifSelectFlags mode,
+ void* obj)
+{
+ return enif_select(env, event, (ERL_NIF_SELECT_CANCEL | mode), obj, NULL,
+ esock_atom_undefined);
+}
+
+
+/* ----------------------------------------------------------------------
+ * A c t i v a t e N e x t ( o p e r a t o r ) F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+/* *** activate_next_acceptor ***
+ * *** activate_next_writer ***
+ * *** activate_next_reader ***
+ *
+ * This functions pops the requestors queue and then selects until it
+ * manages to successfully activate a requestor or the queue is empty.
+ * Return value indicates if a new requestor was activated or not.
+ */
+
+#define ACTIVATE_NEXT_FUNCS \
+ ACTIVATE_NEXT_FUNC_DECL(acceptor, read, currentAcceptor, acceptorsQ) \
+ ACTIVATE_NEXT_FUNC_DECL(writer, write, currentWriter, writersQ) \
+ ACTIVATE_NEXT_FUNC_DECL(reader, read, currentReader, readersQ)
+
+#define ACTIVATE_NEXT_FUNC_DECL(F, S, R, Q) \
+ static \
+ BOOLEAN_T activate_next_##F(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ ERL_NIF_TERM sockRef) \
+ { \
+ BOOLEAN_T popped, activated; \
+ int sres; \
+ SocketRequestor* reqP = &descP->R; \
+ SocketRequestQueue* q = &descP->Q; \
+ \
+ popped = FALSE; \
+ do { \
+ \
+ if (requestor_pop(q, reqP)) { \
+ \
+ /* There was another one */ \
+ \
+ SSDBG( descP, \
+ ("SOCKET", \
+ "activate_next_" #F " -> new (active) requestor: " \
+ "\r\n pid: %T" \
+ "\r\n ref: %T" \
+ "\r\n", reqP->pid, reqP->ref) ); \
+ \
+ if ((sres = esock_select_##S(env, descP->sock, descP, \
+ &reqP->pid, reqP->ref)) < 0) { \
+ /* We need to inform this process, reqP->pid, */ \
+ /* that we failed to select, so we don't leave */ \
+ /* it hanging. */ \
+ /* => send abort */ \
+ \
+ esock_send_abort_msg(env, sockRef, reqP->ref, \
+ sres, &reqP->pid); \
+ \
+ } else { \
+ \
+ /* Success: New requestor selected */ \
+ popped = TRUE; \
+ activated = FALSE; \
+ \
+ } \
+ \
+ } else { \
+ \
+ SSDBG( descP, \
+ ("SOCKET", \
+ "activate_next_" #F " -> no more requestors\r\n") ); \
+ \
+ popped = TRUE; \
+ activated = FALSE; \
+ } \
+ \
+ } while (!popped); \
+ \
+ SSDBG( descP, \
+ ("SOCKET", "activate_next_" #F " -> " \
+ "done with %s\r\n", B2S(activated)) ); \
+ \
+ return activated; \
+ }
+ACTIVATE_NEXT_FUNCS
+#undef ACTIVATE_NEXT_FUNC_DECL
+
+
+
+
+/* ----------------------------------------------------------------------
+ * R e q u e s t o r Q u e u e F u n c t i o n s
+ * ----------------------------------------------------------------------
+ *
+ * Since each of these functions (search4pid, push, pop and unqueue
+ * are virtually identical for acceptors, writers and readers,
+ * we make use of set of declaration macros.
+ */
+
+#if !defined(__WIN32__)
+
+/* *** acceptor_search4pid ***
+ * *** writer_search4pid ***
+ * *** reader_search4pid ***
+ *
+ * Search for a pid in the requestor (acceptor, writer, or reader) queue.
+ *
+ */
+
+#define REQ_SEARCH4PID_FUNCS \
+ REQ_SEARCH4PID_FUNC_DECL(acceptor, acceptorsQ) \
+ REQ_SEARCH4PID_FUNC_DECL(writer, writersQ) \
+ REQ_SEARCH4PID_FUNC_DECL(reader, readersQ)
+
+#define REQ_SEARCH4PID_FUNC_DECL(F, Q) \
+ static \
+ BOOLEAN_T F##_search4pid(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ ErlNifPid* pid) \
+ { \
+ return qsearch4pid(env, &descP->Q, pid); \
+ }
+REQ_SEARCH4PID_FUNCS
+#undef REQ_SEARCH4PID_FUNC_DECL
+
+
+
+/* *** acceptor_push ***
+ * *** writer_push ***
+ * *** reader_push ***
+ *
+ * Push a requestor (acceptor, writer, or reader) onto its queue.
+ * This happens when we already have a current request (of its type).
+ *
+ */
+
+#define REQ_PUSH_FUNCS \
+ REQ_PUSH_FUNC_DECL(acceptor, acceptorsQ) \
+ REQ_PUSH_FUNC_DECL(writer, writersQ) \
+ REQ_PUSH_FUNC_DECL(reader, readersQ)
+
+#define REQ_PUSH_FUNC_DECL(F, Q) \
+ static \
+ ERL_NIF_TERM F##_push(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ ErlNifPid pid, \
+ ERL_NIF_TERM ref) \
+ { \
+ SocketRequestQueueElement* e = MALLOC(sizeof(SocketRequestQueueElement)); \
+ SocketRequestor* reqP = &e->data; \
+ \
+ reqP->pid = pid; \
+ reqP->ref = enif_make_copy(descP->env, ref); \
+ \
+ if (MONP("reader_push -> " #F " request", \
+ env, descP, &pid, &reqP->mon) != 0) { \
+ FREE(reqP); \
+ return esock_make_error(env, atom_exmon); \
+ } \
+ \
+ qpush(&descP->Q, e); \
+ \
+ return esock_make_error(env, esock_atom_eagain); \
+ }
+REQ_PUSH_FUNCS
+#undef REQ_PUSH_FUNC_DECL
+
+
+
+/* *** acceptor_pop ***
+ * *** writer_pop ***
+ * *** reader_pop ***
+ *
+ * Pop a requestor (acceptor, writer, or reader) from its queue.
+ *
+ */
+#define REQ_POP_FUNCS \
+ REQ_POP_FUNC_DECL(acceptor, acceptorsQ) \
+ REQ_POP_FUNC_DECL(writer, writersQ) \
+ REQ_POP_FUNC_DECL(reader, readersQ)
+
+#define REQ_POP_FUNC_DECL(F, Q) \
+ static \
+ BOOLEAN_T F##_pop(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ SocketRequestor* reqP) \
+ { \
+ return requestor_pop(&descP->Q, reqP); \
+ }
+REQ_POP_FUNCS
+#undef REQ_POP_FUNC_DECL
+
+
+
+/* *** acceptor_unqueue ***
+ * *** writer_unqueue ***
+ * *** reader_unqueue ***
+ *
+ * Remove a requestor (acceptor, writer, or reader) from its queue.
+ *
+ */
+
+#define REQ_UNQUEUE_FUNCS \
+ REQ_UNQUEUE_FUNC_DECL(acceptor, acceptorsQ) \
+ REQ_UNQUEUE_FUNC_DECL(writer, writersQ) \
+ REQ_UNQUEUE_FUNC_DECL(reader, readersQ)
+
+#define REQ_UNQUEUE_FUNC_DECL(F, Q) \
+ static \
+ BOOLEAN_T F##_unqueue(ErlNifEnv* env, \
+ SocketDescriptor* descP, \
+ const ErlNifPid* pid) \
+ { \
+ return qunqueue(env, descP, "qunqueue -> waiting " #F, \
+ &descP->Q, pid); \
+ }
+REQ_UNQUEUE_FUNCS
+#undef REQ_UNQUEUE_FUNC_DECL
+
+
+
+/* *** requestor pop ***
+ *
+ * Pop an requestor from its queue.
+ */
+static
+BOOLEAN_T requestor_pop(SocketRequestQueue* q,
+ SocketRequestor* reqP)
+{
+ SocketRequestQueueElement* e = qpop(q);
+
+ if (e != NULL) {
+ reqP->pid = e->data.pid;
+ reqP->mon = e->data.mon;
+ reqP->ref = e->data.ref;
+ FREE(e);
+ return TRUE;
+ } else {
+ /* (writers) Queue was empty */
+ enif_set_pid_undefined(&reqP->pid);
+ // *reqP->mon = NULL; we have no null value for monitors
+ reqP->ref = esock_atom_undefined; // Just in case
+ return FALSE;
+ }
+
+}
+
+
+static
+BOOLEAN_T qsearch4pid(ErlNifEnv* env,
+ SocketRequestQueue* q,
+ ErlNifPid* pid)
+{
+ SocketRequestQueueElement* tmp = q->first;
+
+ while (tmp != NULL) {
+ if (COMPARE_PIDS(&tmp->data.pid, pid) == 0)
+ return TRUE;
+ else
+ tmp = tmp->nextP;
+ }
+
+ return FALSE;
+}
+
+
+static
+void qpush(SocketRequestQueue* q,
+ SocketRequestQueueElement* e)
+{
+ if (q->first != NULL) {
+ q->last->nextP = e;
+ q->last = e;
+ e->nextP = NULL;
+ } else {
+ q->first = e;
+ q->last = e;
+ e->nextP = NULL;
+ }
+}
+
+
+static
+SocketRequestQueueElement* qpop(SocketRequestQueue* q)
+{
+ SocketRequestQueueElement* e = q->first;
+
+ if (e != NULL) {
+ /* Atleast one element in the queue */
+ if (e == q->last) {
+ /* Only one element in the queue */
+ q->first = q->last = NULL;
+ } else {
+ /* More than one element in the queue */
+ q->first = e->nextP;
+ }
+ }
+
+ return e;
+}
+
+
+
+static
+BOOLEAN_T qunqueue(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ const char* slogan,
+ SocketRequestQueue* q,
+ const ErlNifPid* pid)
+{
+ SocketRequestQueueElement* e = q->first;
+ SocketRequestQueueElement* p = NULL;
+
+ /* Check if it was one of the waiting acceptor processes */
+ while (e != NULL) {
+ if (COMPARE_PIDS(&e->data.pid, pid) == 0) {
+
+ /* We have a match */
+
+ DEMONP(slogan, env, descP, &e->data.mon);
+
+ if (p != NULL) {
+ /* Not the first, but could be the last */
+ if (q->last == e) {
+ q->last = p;
+ p->nextP = NULL;
+ } else {
+ p->nextP = e->nextP;
+ }
+
+ } else {
+ /* The first and could also be the last */
+ if (q->last == e) {
+ q->last = NULL;
+ q->first = NULL;
+ } else {
+ q->first = e->nextP;
+ }
+ }
+
+ FREE(e);
+
+ return TRUE;
+ }
+
+ /* Try next */
+ p = e;
+ e = e->nextP;
+ }
+
+ return FALSE;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * C o u n t e r F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+#if !defined(__WIN32__)
+static
+BOOLEAN_T cnt_inc(Uint32* cnt, Uint32 inc)
+{
+ BOOLEAN_T wrap;
+ Uint32 max = 0xFFFFFFFF;
+ Uint32 current = *cnt;
+
+ if ((max - inc) >= current) {
+ *cnt += inc;
+ wrap = FALSE;
+ } else {
+ *cnt = inc - (max - current) - 1;
+ wrap = TRUE;
+ }
+
+ return (wrap);
+}
+
+
+static
+void cnt_dec(Uint32* cnt, Uint32 dec)
+{
+ Uint32 current = *cnt;
+
+ if (dec > current)
+ *cnt = 0; // The counter cannot be < 0 so this is the best we can do...
+ else
+ *cnt -= dec;
+
+ return;
+}
+#endif // if !defined(__WIN32__)
+
+
+
+
+/* ----------------------------------------------------------------------
+ * M o n i t o r W r a p p e r F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+#if !defined(__WIN32__)
+
+static
+int esock_monitor(const char* slogan,
+ ErlNifEnv* env,
+ SocketDescriptor* descP,
+ const ErlNifPid* pid,
+ ESockMonitor* monP)
+{
+ int res;
+
+ SSDBG( descP, ("SOCKET", "[%d] %s: try monitor\r\n", descP->sock, slogan) );
+ res = enif_monitor_process(env, descP, pid, &monP->mon);
+
+ if (res != 0) {
+ monP->is_active = 0;
+ SSDBG( descP, ("SOCKET", "[%d] monitor failed: %d\r\n", descP->sock, res) );
+ } else {
+ monP->is_active = 1;
+ }
+
+ return res;
+}
+
+
+static
+int esock_demonitor(const char* slogan,
+ ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ESockMonitor* monP)
+{
+ int res;
+
+ if (!monP->is_active)
+ return 1;
+
+ SSDBG( descP, ("SOCKET", "[%d] %s: try demonitor\r\n", descP->sock, slogan) );
+
+ res = enif_demonitor_process(env, descP, &monP->mon);
+
+ if (res == 0) {
+ esock_monitor_init(monP);
+ } else {
+ SSDBG( descP,
+ ("SOCKET", "[%d] demonitor failed: %d\r\n", descP->sock, res) );
+ }
+
+ return res;
+}
+
+
+static
+void esock_monitor_init(ESockMonitor* monP)
+{
+ monP->is_active = 0;
+}
+
+#endif // if !defined(__WIN32__)
+
+
+/*
+static
+int esock_monitor_compare(const ErlNifMonitor* mon1,
+ const ESockMonitor* mon2)
+{
+ return enif_compare_monitors(mon1, &mon2->mon);
+}
+*/
+
+
+/* ----------------------------------------------------------------------
+ * C a l l b a c k F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+/* =========================================================================
+ * socket_dtor - Callback function for resource destructor
+ *
+ */
+static
+void socket_dtor(ErlNifEnv* env, void* obj)
+{
+#if !defined(__WIN32__)
+ SocketDescriptor* descP = (SocketDescriptor*) obj;
+
+ enif_clear_env(descP->env);
+ enif_free_env(descP->env);
+ descP->env = NULL;
+
+ MDESTROY(descP->writeMtx);
+ MDESTROY(descP->readMtx);
+ MDESTROY(descP->accMtx);
+ MDESTROY(descP->closeMtx);
+#endif
+}
+
+
+/* =========================================================================
+ * socket_stop - Callback function for resource stop
+ *
+ * When the socket is stopped, we need to inform:
+ *
+ * * the controlling process
+ * * the current writer and any waiting writers
+ * * the current reader and any waiting readers
+ * * the current acceptor and any waiting acceptor
+ *
+ * Also, make sure no process gets the message twice
+ * (in case it is, for instance, both controlling process
+ * and a writer).
+ *
+ */
+static
+void socket_stop(ErlNifEnv* env, void* obj, int fd, int is_direct_call)
+{
+#if !defined(__WIN32__)
+ SocketDescriptor* descP = (SocketDescriptor*) obj;
+ ERL_NIF_TERM sockRef;
+
+ SSDBG( descP,
+ ("SOCKET", "socket_stop -> entry when %s"
+ "\r\n sock: %d (%d)"
+ "\r\n",
+ ((is_direct_call) ? "called" : "scheduled"), descP->sock, fd) );
+
+ /* +++ Lock it down +++ */
+
+ MLOCK(descP->writeMtx);
+ MLOCK(descP->readMtx);
+ MLOCK(descP->accMtx);
+ if (!is_direct_call) MLOCK(descP->closeMtx);
+
+ SSDBG( descP, ("SOCKET", "socket_stop -> "
+ "[%d, %T] all mutex(s) locked when counters:"
+ "\r\n writePkgCnt: %u"
+ "\r\n writeByteCnt: %u"
+ "\r\n writeTries: %u"
+ "\r\n writeWaits: %u"
+ "\r\n writeFails: %u"
+ "\r\n readPkgCnt: %u"
+ "\r\n readByteCnt: %u"
+ "\r\n readTries: %u"
+ "\r\n readWaits: %u"
+ "\r\n",
+ descP->sock, descP->ctrlPid,
+ descP->writePkgCnt,
+ descP->writeByteCnt,
+ descP->writeTries,
+ descP->writeWaits,
+ descP->writeFails,
+ descP->readPkgCnt,
+ descP->readByteCnt,
+ descP->readTries,
+ descP->readWaits) );
+
+ sockRef = enif_make_resource(env, descP);
+ descP->state = SOCKET_STATE_CLOSING; // Just in case...???
+ descP->isReadable = FALSE;
+ descP->isWritable = FALSE;
+
+ /* We should check that we actually have a monitor.
+ * This *should* be done with a "NULL" monitor value,
+ * which there currently is none...
+ * If we got here because the controlling process died,
+ * there is no point to demonitor. Also, we do not actually
+ * have a monitor in that case...
+ */
+ DEMONP("socket_stop -> ctrl", env, descP, &descP->ctrlMon);
+
+
+
+ /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ *
+ * Check current and waiting Writers
+ *
+ * +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ */
+
+ if (descP->currentWriterP != NULL) {
+ /* We have a (current) writer and *may* therefor also have
+ * writers waiting.
+ */
+
+ DEMONP("socket_stop -> current writer",
+ env, descP, &descP->currentWriter.mon);
+
+ SSDBG( descP, ("SOCKET", "socket_stop -> handle current writer\r\n") );
+ if (COMPARE_PIDS(&descP->closerPid, &descP->currentWriter.pid) != 0) {
+ SSDBG( descP, ("SOCKET", "socket_stop -> "
+ "send abort message to current writer %T\r\n",
+ descP->currentWriter.pid) );
+ if (esock_send_abort_msg(env,
+ sockRef,
+ descP->currentWriter.ref,
+ atom_closed,
+ &descP->currentWriter.pid) != NULL) {
+ /* Shall we really do this?
+ * This happens if the controlling process has been killed!
+ */
+ esock_warning_msg("Failed sending abort (%T) message to "
+ "current writer %T\r\n",
+ descP->currentWriter.ref,
+ descP->currentWriter.pid);
+ }
+ }
+
+ /* And also deal with the waiting writers (in the same way) */
+ SSDBG( descP, ("SOCKET", "socket_stop -> handle waiting writer(s)\r\n") );
+ inform_waiting_procs(env, "writer",
+ descP, &descP->writersQ, TRUE, atom_closed);
+ }
+
+
+ /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ *
+ * Check current and waiting Readers
+ *
+ * +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ */
+
+ if (descP->currentReaderP != NULL) {
+
+ /* We have a (current) reader and *may* therefor also have
+ * readers waiting.
+ */
+
+ DEMONP("socket_stop -> current reader",
+ env, descP, &descP->currentReader.mon);
+
+ SSDBG( descP, ("SOCKET", "socket_stop -> handle current reader\r\n") );
+ if (COMPARE_PIDS(&descP->closerPid, &descP->currentReader.pid) != 0) {
+ SSDBG( descP, ("SOCKET", "socket_stop -> "
+ "send abort message to current reader %T\r\n",
+ descP->currentReader.pid) );
+ /*
+ esock_dbg_printf("SOCKET", "socket_stop -> "
+ "send abort message to current reader %T\r\n",
+ descP->currentReader.pid);
+ */
+ if (esock_send_abort_msg(env,
+ sockRef,
+ descP->currentReader.ref,
+ atom_closed,
+ &descP->currentReader.pid) != NULL) {
+ /* Shall we really do this?
+ * This happens if the controlling process has been killed!
+ */
+ esock_warning_msg("Failed sending abort (%T) message to "
+ "current reader %T\r\n",
+ descP->currentReader.ref,
+ descP->currentReader.pid);
+ }
+ }
+
+ /* And also deal with the waiting readers (in the same way) */
+ SSDBG( descP, ("SOCKET", "socket_stop -> handle waiting reader(s)\r\n") );
+ inform_waiting_procs(env, "reader",
+ descP, &descP->readersQ, TRUE, atom_closed);
+ }
+
+
+
+ /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ *
+ * Check current and waiting Acceptors
+ *
+ * +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ */
+
+ if (descP->currentAcceptorP != NULL) {
+ /* We have a (current) acceptor and *may* therefor also have
+ * acceptors waiting.
+ */
+
+ DEMONP("socket_stop -> current acceptor",
+ env, descP, &descP->currentAcceptor.mon);
+
+ SSDBG( descP, ("SOCKET", "socket_stop -> handle current acceptor\r\n") );
+ if (COMPARE_PIDS(&descP->closerPid, &descP->currentAcceptor.pid) != 0) {
+ SSDBG( descP, ("SOCKET", "socket_stop -> "
+ "send abort message to current acceptor %T\r\n",
+ descP->currentAcceptor.pid) );
+ if (esock_send_abort_msg(env,
+ sockRef,
+ descP->currentAcceptor.ref,
+ atom_closed,
+ &descP->currentAcceptor.pid) != NULL) {
+ /* Shall we really do this?
+ * This happens if the controlling process has been killed!
+ */
+ esock_warning_msg("Failed sending abort (%T) message to "
+ "current acceptor %T\r\n",
+ descP->currentAcceptor.ref,
+ descP->currentAcceptor.pid);
+ }
+ }
+
+ /* And also deal with the waiting acceptors (in the same way) */
+ SSDBG( descP, ("SOCKET", "socket_stop -> handle waiting acceptor(s)\r\n") );
+ inform_waiting_procs(env, "acceptor",
+ descP, &descP->acceptorsQ, TRUE, atom_closed);
+ }
+
+
+
+ /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ *
+ * Maybe inform waiting closer
+ *
+ * +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+ */
+
+ if (descP->sock != INVALID_SOCKET) {
+
+ if (descP->closeLocal) {
+ if (!is_direct_call) {
+
+ /* +++ send close message to the waiting process +++ */
+
+ esock_send_close_msg(env, descP);
+
+ DEMONP("socket_stop -> closer", env, descP, &descP->closerMon);
+
+ } else {
+
+ /* We only need to explicitly free the environment here
+ * since the message send takes care of it if scheduled.
+ */
+
+ if (descP->closeEnv != NULL) enif_free_env(descP->closeEnv);
+
+ }
+ }
+ }
+
+
+ SSDBG( descP, ("SOCKET", "socket_stop -> unlock all mutex(s)\r\n") );
+
+ if (!is_direct_call) MUNLOCK(descP->closeMtx);
+ MUNLOCK(descP->accMtx);
+ MUNLOCK(descP->readMtx);
+ MUNLOCK(descP->writeMtx);
+
+ SSDBG( descP,
+ ("SOCKET", "socket_stop -> done (%d, %d)\r\n", descP->sock, fd) );
+
+#endif // if !defined(__WIN32__)
+}
+
+
+
+/* This function traverse the queue and sends the specified
+ * nif_abort message with the specified reason to each member,
+ * and if the 'free' argument is TRUE, the queue will be emptied.
+ */
+#if !defined(__WIN32__)
+static void inform_waiting_procs(ErlNifEnv* env,
+ char* role,
+ SocketDescriptor* descP,
+ SocketRequestQueue* q,
+ BOOLEAN_T free,
+ ERL_NIF_TERM reason)
+{
+ SocketRequestQueueElement* currentP = q->first;
+ SocketRequestQueueElement* nextP;
+ ERL_NIF_TERM sockRef = enif_make_resource(env, descP);
+
+ /*
+ esock_dbg_printf("SOCKET", "inform_waiting_procs -> entry with: "
+ "\r\n role: %s"
+ "\r\n free: %s"
+ "\r\n reason: %T"
+ "\r\n", role, B2S(free), reason);
+ */
+
+ while (currentP != NULL) {
+
+ /* <KOLLA>
+ *
+ * Should we inform anyone if we fail to demonitor?
+ * NOT SURE WHAT THAT WOULD REPRESENT AND IT IS NOT
+ * IMPORTANT IN *THIS* CASE, BUT ITS A FUNDAMENTAL OP...
+ *
+ * </KOLLA>
+ */
+
+ SSDBG( descP,
+ ("SOCKET", "inform_waiting_procs -> abort request %T (from %T)\r\n",
+ currentP->data.ref, currentP->data.pid) );
+
+ /*
+ esock_dbg_printf("SOCKET", "inform_waiting_procs -> "
+ "try sending abort to %s %T "
+ "\r\n", role, currentP->data.pid);
+ */
+
+ if (esock_send_abort_msg(env,
+ sockRef,
+ currentP->data.ref,
+ reason,
+ &currentP->data.pid) != NULL) {
+
+ esock_warning_msg("Failed sending abort (%T) message to "
+ "current %s %T\r\n",
+ currentP->data.ref,
+ role,
+ currentP->data.pid);
+
+ }
+
+ DEMONP("inform_waiting_procs -> current 'request'",
+ env, descP, &currentP->data.mon);
+ nextP = currentP->nextP;
+ if (free) FREE(currentP);
+ currentP = nextP;
+ }
+
+ if (free) {
+ q->first = NULL;
+ q->last = NULL;
+ }
+}
+#endif // if !defined(__WIN32__)
+
+
+/* =========================================================================
+ * socket_down - Callback function for resource down (monitored processes)
+ *
+ */
+static
+void socket_down(ErlNifEnv* env,
+ void* obj,
+ const ErlNifPid* pid,
+ const ErlNifMonitor* mon)
+{
+#if !defined(__WIN32__)
+ SocketDescriptor* descP = (SocketDescriptor*) obj;
+ int sres;
+ ERL_NIF_TERM sockRef;
+
+ SSDBG( descP, ("SOCKET", "socket_down -> entry with"
+ "\r\n sock: %d"
+ "\r\n pid: %T"
+ "\r\n Close: %s (%s)"
+ "\r\n",
+ descP->sock, *pid,
+ B2S(IS_CLOSED(descP)),
+ B2S(IS_CLOSING(descP))) );
+
+ if (!IS_CLOSED(descP)) {
+
+ if (COMPARE_PIDS(&descP->ctrlPid, pid) == 0) {
+
+ /* We don't bother with the queue cleanup here -
+ * we leave it to the stop callback function.
+ */
+
+ SSDBG( descP,
+ ("SOCKET", "socket_down -> controlling process exit\r\n") );
+
+ descP->state = SOCKET_STATE_CLOSING;
+ descP->closeLocal = TRUE;
+ descP->closerPid = *pid;
+ MON_INIT(&descP->closerMon);
+
+ sres = esock_select_stop(env, descP->sock, descP);
+
+ if (sres & ERL_NIF_SELECT_STOP_CALLED) {
+
+ /* We are done - we can finalize (socket close) directly */
+ SSDBG( descP,
+ ("SOCKET",
+ "socket_down -> [%d] stop called\r\n", descP->sock) );
+
+ dec_socket(descP->domain, descP->type, descP->protocol);
+ descP->state = SOCKET_STATE_CLOSED;
+
+ /* And finally close the socket.
+ * Since we close the socket because of an exiting owner,
+ * we do not need to wait for buffers to sync (linger).
+ * If the owner wish to ensure the buffer are written,
+ * it should have closed the socket explicitly...
+ */
+ if (sock_close(descP->sock) != 0) {
+ int save_errno = sock_errno();
+
+ esock_warning_msg("Failed closing socket for terminating "
+ "controlling process: "
+ "\r\n Controlling Process: %T"
+ "\r\n Descriptor: %d"
+ "\r\n Errno: %d"
+ "\r\n", pid, descP->sock, save_errno);
+ }
+ sock_close_event(descP->event);
+
+ descP->sock = INVALID_SOCKET;
+ descP->event = INVALID_EVENT;
+
+ descP->state = SOCKET_STATE_CLOSED;
+
+ } else if (sres & ERL_NIF_SELECT_STOP_SCHEDULED) {
+
+ /* The stop callback function has been *scheduled* which means
+ * that "should" wait for it to complete. But since we are in
+ * a callback (down) function, we cannot...
+ * So, we must close the socket
+ */
+ SSDBG( descP,
+ ("SOCKET",
+ "socket_down -> [%d] stop scheduled\r\n",
+ descP->sock) );
+
+ dec_socket(descP->domain, descP->type, descP->protocol);
+
+ /* And now what? We can't wait for the stop function here...
+ * So, we simply close it here and leave the rest of the "close"
+ * for later (when the stop function actually gets called...
+ */
+
+ if (sock_close(descP->sock) != 0) {
+ int save_errno = sock_errno();
+
+ esock_warning_msg("Failed closing socket for terminating "
+ "controlling process: "
+ "\r\n Controlling Process: %T"
+ "\r\n Descriptor: %d"
+ "\r\n Errno: %d"
+ "\r\n", pid, descP->sock, save_errno);
+ }
+ sock_close_event(descP->event);
+
+ } else {
+
+ esock_warning_msg("Failed selecting stop when handling down "
+ "of controlling process: "
+ "\r\n Select Res: %d"
+ "\r\n Controlling Process: %T"
+ "\r\n Descriptor: %d"
+ "\r\n Monitor: %T"
+ "\r\n", sres, pid, descP->sock,
+ MON2T(env, mon));
+ }
+
+ } else {
+
+ /* check all operation queue(s): acceptor, writer and reader.
+ *
+ * Is it really any point in doing this if the socket is closed?
+ *
+ */
+
+ SSDBG( descP, ("SOCKET", "socket_down -> other process term\r\n") );
+
+ sockRef = enif_make_resource(env, descP);
+
+ MLOCK(descP->accMtx);
+ if (descP->currentAcceptorP != NULL)
+ socket_down_acceptor(env, descP, sockRef, pid);
+ MUNLOCK(descP->accMtx);
+
+ MLOCK(descP->writeMtx);
+ if (descP->currentWriterP != NULL)
+ socket_down_writer(env, descP, sockRef, pid);
+ MUNLOCK(descP->writeMtx);
+
+ MLOCK(descP->readMtx);
+ if (descP->currentReaderP != NULL)
+ socket_down_reader(env, descP, sockRef, pid);
+ MUNLOCK(descP->readMtx);
+
+ }
+ }
+
+ SSDBG( descP, ("SOCKET", "socket_down -> done\r\n") );
+
+#endif // if !defined(__WIN32__)
+}
+
+
+
+/* *** socket_down_acceptor ***
+ *
+ * Check and then handle a downed acceptor process.
+ *
+ */
+#if !defined(__WIN32__)
+static
+void socket_down_acceptor(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ const ErlNifPid* pid)
+{
+ if (COMPARE_PIDS(&descP->currentAcceptor.pid, pid) == 0) {
+
+ SSDBG( descP, ("SOCKET",
+ "socket_down_acceptor -> "
+ "current acceptor - try activate next\r\n") );
+
+ if (!activate_next_acceptor(env, descP, sockRef)) {
+
+ SSDBG( descP,
+ ("SOCKET", "socket_down_acceptor -> no more writers\r\n") );
+
+ descP->state = SOCKET_STATE_LISTENING;
+
+ descP->currentAcceptorP = NULL;
+ descP->currentAcceptor.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentAcceptor.pid);
+ esock_monitor_init(&descP->currentAcceptor.mon);
+ }
+
+ } else {
+
+ /* Maybe unqueue one of the waiting acceptors */
+
+ SSDBG( descP, ("SOCKET",
+ "socket_down_acceptor -> "
+ "not current acceptor - maybe a waiting acceptor\r\n") );
+
+ acceptor_unqueue(env, descP, pid);
+ }
+}
+
+
+
+
+/* *** socket_down_writer ***
+ *
+ * Check and then handle a downed writer process.
+ *
+ */
+static
+void socket_down_writer(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ const ErlNifPid* pid)
+{
+ if (COMPARE_PIDS(&descP->currentWriter.pid, pid) == 0) {
+
+ SSDBG( descP, ("SOCKET",
+ "socket_down_writer -> "
+ "current writer - try activate next\r\n") );
+
+ if (!activate_next_writer(env, descP, sockRef)) {
+ SSDBG( descP, ("SOCKET",
+ "socket_down_writer -> no active writer\r\n") );
+ descP->currentWriterP = NULL;
+ descP->currentWriter.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentWriter.pid);
+ esock_monitor_init(&descP->currentWriter.mon);
+ }
+
+ } else {
+
+ /* Maybe unqueue one of the waiting writer(s) */
+
+ SSDBG( descP, ("SOCKET",
+ "socket_down_writer -> "
+ "not current writer - maybe a waiting writer\r\n") );
+
+ writer_unqueue(env, descP, pid);
+ }
+}
+
+
+
+
+/* *** socket_down_reader ***
+ *
+ * Check and then handle a downed reader process.
+ *
+ */
+static
+void socket_down_reader(ErlNifEnv* env,
+ SocketDescriptor* descP,
+ ERL_NIF_TERM sockRef,
+ const ErlNifPid* pid)
+{
+ if (COMPARE_PIDS(&descP->currentReader.pid, pid) == 0) {
+
+ SSDBG( descP, ("SOCKET",
+ "socket_down_reader -> "
+ "current reader - try activate next\r\n") );
+
+ if (!activate_next_reader(env, descP, sockRef)) {
+ SSDBG( descP,
+ ("SOCKET", "ncancel_recv_current -> no more readers\r\n") );
+ descP->currentReaderP = NULL;
+ descP->currentReader.ref = esock_atom_undefined;
+ enif_set_pid_undefined(&descP->currentReader.pid);
+ esock_monitor_init(&descP->currentReader.mon);
+ }
+
+ } else {
+
+ /* Maybe unqueue one of the waiting reader(s) */
+
+ SSDBG( descP, ("SOCKET",
+ "socket_down_reader -> "
+ "not current reader - maybe a waiting reader\r\n") );
+
+ reader_unqueue(env, descP, pid);
+ }
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* ----------------------------------------------------------------------
+ * L o a d / u n l o a d / u p g r a d e F u n c t i o n s
+ * ----------------------------------------------------------------------
+ */
+
+static
+ErlNifFunc socket_funcs[] =
+{
+ // Some utility and support functions
+ {"nif_info", 0, nif_info, 0},
+ {"nif_supports", 1, nif_supports, 0},
+ // {"nif_debug", 1, nif_debug, 0},
+ // {"nif_command", 1, nif_command, 0},
+
+ // The proper "socket" interface
+ // nif_open/1 is used when we already have a file descriptor
+ // {"nif_open", 1, nif_open, 0},
+ {"nif_open", 4, nif_open, 0},
+ {"nif_bind", 2, nif_bind, 0},
+ {"nif_connect", 2, nif_connect, 0},
+ {"nif_listen", 2, nif_listen, 0},
+ {"nif_accept", 2, nif_accept, 0},
+ {"nif_send", 4, nif_send, 0},
+ {"nif_sendto", 5, nif_sendto, 0},
+ {"nif_sendmsg", 4, nif_sendmsg, 0},
+ {"nif_recv", 4, nif_recv, 0},
+ {"nif_recvfrom", 4, nif_recvfrom, 0},
+ {"nif_recvmsg", 5, nif_recvmsg, 0},
+ {"nif_close", 1, nif_close, 0},
+ {"nif_shutdown", 2, nif_shutdown, 0},
+ {"nif_setopt", 5, nif_setopt, 0},
+ {"nif_getopt", 4, nif_getopt, 0},
+ {"nif_sockname", 1, nif_sockname, 0},
+ {"nif_peername", 1, nif_peername, 0},
+
+ /* Misc utility functions */
+
+ /* "Extra" functions to "complete" the socket interface.
+ * For instance, the function nif_finalize_connection
+ * is called after the connect *select* has "completed".
+ */
+ {"nif_finalize_connection", 1, nif_finalize_connection, 0},
+ {"nif_cancel", 3, nif_cancel, 0},
+ {"nif_finalize_close", 1, nif_finalize_close, ERL_NIF_DIRTY_JOB_IO_BOUND}
+};
+
+
+#if !defined(__WIN32__)
+static
+BOOLEAN_T extract_debug(ErlNifEnv* env,
+ ERL_NIF_TERM map)
+{
+ /*
+ * We need to do this here since the "proper" atom has not been
+ * created when this function is called.
+ */
+ ERL_NIF_TERM debug = MKA(env, "debug");
+
+ return esock_extract_bool_from_map(env, map, debug, SOCKET_GLOBAL_DEBUG_DEFAULT);
+}
+
+static
+BOOLEAN_T extract_iow(ErlNifEnv* env,
+ ERL_NIF_TERM map)
+{
+ /*
+ * We need to do this here since the "proper" atom has not been
+ * created when this function is called.
+ */
+ ERL_NIF_TERM iow = MKA(env, "iow");
+
+ return esock_extract_bool_from_map(env, map, iow, SOCKET_NIF_IOW_DEFAULT);
+}
+#endif // if !defined(__WIN32__)
+
+
+
+/* =======================================================================
+ * load_info - A map of misc info (e.g global debug)
+ */
+
+static
+int on_load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
+{
+#if !defined(__WIN32__)
+ esock_dbg_init(ESOCK_DBGOUT_DEFAULT);
+ // esock_dbg_init(ESOCK_DBGOUT_UNIQUE);
+
+ data.dbg = extract_debug(env, load_info);
+ data.iow = extract_iow(env, load_info);
+
+ /* +++ Global Counters +++ */
+ data.cntMtx = MCREATE("socket[gcnt]");
+ data.numSockets = 0;
+ data.numTypeDGrams = 0;
+ data.numTypeStreams = 0;
+ data.numTypeSeqPkgs = 0;
+ data.numDomainLocal = 0;
+ data.numDomainInet = 0;
+ data.numDomainInet6 = 0;
+ data.numProtoIP = 0;
+ data.numProtoTCP = 0;
+ data.numProtoUDP = 0;
+ data.numProtoSCTP = 0;
+#endif
+
+ /* +++ Local atoms and error reason atoms +++ */
+#define LOCAL_ATOM_DECL(A) atom_##A = MKA(env, #A)
+LOCAL_ATOMS
+LOCAL_ERROR_REASON_ATOMS
+#undef LOCAL_ATOM_DECL
+
+ /* Global atom(s) and error reason atom(s) */
+#define GLOBAL_ATOM_DECL(A) esock_atom_##A = MKA(env, #A)
+GLOBAL_ATOMS
+GLOBAL_ERROR_REASON_ATOMS
+#undef GLOBAL_ATOM_DECL
+ esock_atom_socket_tag = MKA(env, "$socket");
+
+ sockets = enif_open_resource_type_x(env,
+ "sockets",
+ &socketInit,
+ ERL_NIF_RT_CREATE,
+ NULL);
+
+ return !sockets;
+}
+
+ERL_NIF_INIT(socket, socket_funcs, on_load, NULL, NULL, NULL)
diff --git a/erts/emulator/nifs/common/socket_tarray.c b/erts/emulator/nifs/common/socket_tarray.c
new file mode 100644
index 0000000000..def22c4919
--- /dev/null
+++ b/erts/emulator/nifs/common/socket_tarray.c
@@ -0,0 +1,143 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2019. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : Build and "maintain" a (erlang) term array of
+ * variable length.
+ * ----------------------------------------------------------------------
+ *
+ */
+
+/* #ifdef HAVE_CONFIG_H */
+/* #include "config.h" */
+/* #endif */
+
+#include <stdio.h>
+
+#include <erl_nif.h>
+
+#include "socket_int.h"
+#include <sys.h>
+#include "socket_util.h"
+#include "socket_tarray.h"
+
+
+
+/* ----------------------------------------------------------------------
+ * Types
+ */
+
+typedef struct {
+ Uint32 sz;
+ Uint32 idx;
+ ERL_NIF_TERM* array;
+} SocketTArrayInt;
+
+
+/* ----------------------------------------------------------------------
+ * Forward for internal functions
+ */
+
+static void esock_tarray_add1(SocketTArrayInt* taP, ERL_NIF_TERM t);
+static void esock_tarray_ensure_fits(SocketTArrayInt* taP, Uint32 needs);
+
+
+/* ----------------------------------------------------------------------
+ * API
+ */
+
+extern
+void* esock_tarray_create(Uint32 sz)
+{
+ SocketTArrayInt* tarrayP;
+
+ ESOCK_ASSERT( (sz > 0) );
+
+ tarrayP = MALLOC(sizeof(SocketTArrayInt));
+ ESOCK_ASSERT( (tarrayP != NULL) );
+
+ tarrayP->array = MALLOC(sz * sizeof(ERL_NIF_TERM));
+ ESOCK_ASSERT( (tarrayP->array != NULL) );
+ tarrayP->sz = sz;
+ tarrayP->idx = 0;
+
+ return ((SocketTArray) tarrayP);
+}
+
+extern
+void esock_tarray_delete(SocketTArray ta)
+{
+ SocketTArrayInt* taP = (SocketTArrayInt*) ta;
+
+ FREE(taP->array);
+ FREE(taP);
+}
+
+
+extern
+Uint32 esock_tarray_sz(SocketTArray a)
+{
+ return ( ((SocketTArrayInt*) a)->idx );
+}
+
+extern
+void esock_tarray_add(SocketTArray ta, ERL_NIF_TERM t)
+{
+ esock_tarray_add1((SocketTArrayInt*) ta, t);
+}
+
+extern
+void esock_tarray_tolist(SocketTArray ta,
+ ErlNifEnv* env,
+ ERL_NIF_TERM* list)
+{
+ SocketTArrayInt* taP = (SocketTArrayInt*) ta;
+
+ *list = MKLA(env, taP->array, taP->idx);
+
+ esock_tarray_delete(taP);
+}
+
+
+
+/* ----------------------------------------------------------------------
+ * "Internal" functions
+ */
+
+static
+void esock_tarray_add1(SocketTArrayInt* taP, ERL_NIF_TERM t)
+{
+ esock_tarray_ensure_fits(taP, 1);
+
+ taP->array[taP->idx++] = t;
+}
+
+static
+void esock_tarray_ensure_fits(SocketTArrayInt* taP, Uint32 needs)
+{
+ if (taP->sz < (taP->idx + needs)) {
+ Uint32 newSz = (needs < taP->sz) ? 2*taP->sz : 2*needs;
+ void* mem = REALLOC(taP->array, newSz * sizeof(ERL_NIF_TERM));
+
+ ESOCK_ASSERT( (mem != NULL) );
+
+ taP->sz = newSz;
+ taP->array = (ERL_NIF_TERM*) mem;
+ }
+}
diff --git a/erts/emulator/nifs/common/socket_tarray.h b/erts/emulator/nifs/common/socket_tarray.h
new file mode 100644
index 0000000000..4f1152fb9e
--- /dev/null
+++ b/erts/emulator/nifs/common/socket_tarray.h
@@ -0,0 +1,47 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2019. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : Build and "maintain" a (erlang) term array of
+ * variable length.
+ * ----------------------------------------------------------------------
+ *
+ */
+
+#ifndef SOCKET_TARRAY_H__
+#define SOCKET_TARRAY_H__
+
+typedef void* SocketTArray;
+
+extern SocketTArray esock_tarray_create(Uint32 sz);
+extern void esock_tarray_delete(SocketTArray ta);
+extern Uint32 esock_tarray_sz(SocketTArray ta);
+extern void esock_tarray_add(SocketTArray ta, ERL_NIF_TERM t);
+extern void esock_tarray_tolist(SocketTArray ta,
+ ErlNifEnv* env,
+ ERL_NIF_TERM* list);
+
+#define TARRAY_CREATE(SZ) esock_tarray_create((SZ))
+#define TARRAY_DELETE(TA) esock_tarray_delete((TA))
+#define TARRAY_SZ(TA) esock_tarray_sz((TA))
+#define TARRAY_ADD(TA, T) esock_tarray_add((TA), (T))
+#define TARRAY_TOLIST(TA, E, L) esock_tarray_tolist((TA), (E), (L))
+
+
+#endif // SOCKET_TARRAY_H__
diff --git a/erts/emulator/nifs/common/socket_util.c b/erts/emulator/nifs/common/socket_util.c
new file mode 100644
index 0000000000..b817ae7636
--- /dev/null
+++ b/erts/emulator/nifs/common/socket_util.c
@@ -0,0 +1,1658 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2019. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : Utility functions for the socket and net NIF(s).
+ * ----------------------------------------------------------------------
+ *
+ */
+
+#include <stdarg.h>
+#include <string.h>
+#include <stdio.h>
+#include <ctype.h>
+#include <time.h>
+#include <stddef.h>
+
+#include "socket_int.h"
+#include "sys.h"
+#include "socket_util.h"
+#include "socket_dbg.h"
+
+/* We don't have a "debug flag" to check here, so we
+ * should use the compile debug flag, whatever that is...
+ */
+
+// #define COMPILE_DEBUG_FLAG_WE_NEED_TO_CHECK 1
+#if defined(COMPILE_DEBUG_FLAG_WE_NEED_TO_CHECK)
+#define UTIL_DEBUG TRUE
+#else
+#define UTIL_DEBUG FALSE
+#endif
+
+#define UDBG( proto ) ESOCK_DBG_PRINTF( UTIL_DEBUG , proto )
+
+
+extern char* erl_errno_id(int error); /* THIS IS JUST TEMPORARY??? */
+
+static int realtime(struct timespec* tsP);
+static int timespec2str(char *buf, unsigned int len, struct timespec *ts);
+
+static char* make_sockaddr_in4(ErlNifEnv* env,
+ ERL_NIF_TERM port,
+ ERL_NIF_TERM addr,
+ ERL_NIF_TERM* sa);
+static char* make_sockaddr_in6(ErlNifEnv* env,
+ ERL_NIF_TERM port,
+ ERL_NIF_TERM addr,
+ ERL_NIF_TERM flowInfo,
+ ERL_NIF_TERM scopeId,
+ ERL_NIF_TERM* sa);
+static char* make_sockaddr_un(ErlNifEnv* env,
+ ERL_NIF_TERM path,
+ ERL_NIF_TERM* sa);
+
+
+/* +++ esock_encode_iov +++
+ *
+ * Encode an IO Vector. In erlang we represented this as a list of binaries.
+ *
+ * We iterate through the IO vector, and as long as the remaining (rem)
+ * number of bytes is greater than the size of the current buffer, we
+ * contunue. When we have a buffer that is greater than rem, we have found
+ * the last buffer (it may be empty, and then the previous was last).
+ * We may need to split this (if 0 < rem < bufferSz).
+ */
+
+extern
+char* esock_encode_iov(ErlNifEnv* env,
+ int read,
+ struct iovec* iov,
+ size_t len,
+ ErlNifBinary* data,
+ ERL_NIF_TERM* eIOV)
+{
+ int rem = read;
+ Uint16 i;
+ BOOLEAN_T done = FALSE;
+ ERL_NIF_TERM a[len]; // At most this length
+
+ UDBG( ("SUTIL", "esock_encode_iov -> entry with"
+ "\r\n read: %d"
+ "\r\n (IOV) len: %d"
+ "\r\n", read, len) );
+
+ if (len == 0) {
+ *eIOV = MKEL(env);
+ return NULL;
+ }
+
+ for (i = 0; (!done) && (i < len); i++) {
+ UDBG( ("SUTIL", "esock_encode_iov -> process iov:"
+ "\r\n iov[%d].iov_len: %d"
+ "\r\n rem: %d"
+ "\r\n", i, iov[i].iov_len, rem) );
+ if (iov[i].iov_len == rem) {
+ /* We have the exact amount - we are done */
+ UDBG( ("SUTIL", "esock_encode_iov -> exact => done\r\n") );
+ a[i] = MKBIN(env, &data[i]);
+ rem = 0; // Besserwisser
+ done = TRUE;
+ } else if (iov[i].iov_len < rem) {
+ /* Filled another buffer - continue */
+ UDBG( ("SUTIL", "esock_encode_iov -> filled => continue\r\n") );
+ a[i] = MKBIN(env, &data[i]);
+ rem -= iov[i].iov_len;
+ } else if (iov[i].iov_len > rem) {
+ /* Partly filled buffer (=> split) - we are done */
+ ERL_NIF_TERM tmp;
+ UDBG( ("SUTIL", "esock_encode_iov -> split => done\r\n") );
+ tmp = MKBIN(env, &data[i]);
+ a[i] = MKSBIN(env, tmp, 0, rem);
+ rem = 0; // Besserwisser
+ done = TRUE;
+ }
+ }
+
+ UDBG( ("SUTIL", "esock_encode_iov -> create the IOV list (%d)\r\n", i) );
+
+ *eIOV = MKLA(env, a, i);
+
+ UDBG( ("SUTIL", "esock_encode_msghdr -> done\r\n") );
+
+ return NULL;
+}
+
+
+
+/* +++ esock_decode_iov +++
+ *
+ * Decode an IO Vector. In erlang we represented this as a list of binaries.
+ *
+ * We assume that we have already figured out how long the iov (actually
+ * eIOV) is (len), and therefor allocated an array of bins and iov to be
+ * used.
+ */
+
+extern
+char* esock_decode_iov(ErlNifEnv* env,
+ ERL_NIF_TERM eIOV,
+ ErlNifBinary* bufs,
+ struct iovec* iov,
+ size_t len,
+ ssize_t* totSize)
+{
+ Uint16 i;
+ ssize_t sz;
+ ERL_NIF_TERM elem, tail, list;
+
+ UDBG( ("SUTIL", "esock_decode_iov -> entry with"
+ "\r\n (IOV) len: %d"
+ "\r\n", read, len) );
+
+ for (i = 0, list = eIOV, sz = 0; (i < len); i++) {
+
+ UDBG( ("SUTIL", "esock_decode_iov -> "
+ "\r\n iov[%d].iov_len: %d"
+ "\r\n rem: %d"
+ "\r\n", i) );
+
+ if (!GET_LIST_ELEM(env, list, &elem, &tail))
+ return ESOCK_STR_EINVAL;
+
+ if (IS_BIN(env, elem) && GET_BIN(env, elem, &bufs[i])) {
+ iov[i].iov_base = (caddr_t) bufs[i].data;
+ iov[i].iov_len = bufs[i].size;
+ sz += bufs[i].size;
+ } else {
+ return ESOCK_STR_EINVAL;
+ }
+
+ list = tail;
+ }
+
+ *totSize = sz;
+
+ UDBG( ("SUTIL", "esock_decode_msghdr -> done (%d)\r\n", sz) );
+
+ return NULL;
+}
+
+
+
+/* +++ esock_decode_sockaddr +++
+ *
+ * Decode a socket address - sockaddr. In erlang its represented as
+ * a map, which has a specific set of attributes, depending on one
+ * mandatory attribute; family. So depending on the value of the family
+ * attribute:
+ *
+ * local - sockaddr_un: path
+ * inet - sockaddr_in4: port, addr
+ * inet6 - sockaddr_in6: port, addr, flowinfo, scope_id
+ */
+
+extern
+char* esock_decode_sockaddr(ErlNifEnv* env,
+ ERL_NIF_TERM eSockAddr,
+ SocketAddress* sockAddrP,
+ unsigned int* addrLen)
+{
+ ERL_NIF_TERM efam;
+ int fam;
+ char* xres;
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr -> entry\r\n") );
+
+ if (!IS_MAP(env, eSockAddr))
+ return ESOCK_STR_EINVAL;
+
+ if (!GET_MAP_VAL(env, eSockAddr, esock_atom_family, &efam))
+ return ESOCK_STR_EINVAL;
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr -> try decode domain (%T)\r\n", efam) );
+ if ((xres = esock_decode_domain(env, efam, &fam)) != NULL)
+ return xres;
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr -> fam: %d\r\n", fam) );
+ switch (fam) {
+ case AF_INET:
+ xres = esock_decode_sockaddr_in4(env, eSockAddr,
+ &sockAddrP->in4, addrLen);
+ break;
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ case AF_INET6:
+ xres = esock_decode_sockaddr_in6(env, eSockAddr,
+ &sockAddrP->in6, addrLen);
+ break;
+#endif
+
+#ifdef HAVE_SYS_UN_H
+ case AF_UNIX:
+ xres = esock_decode_sockaddr_un(env, eSockAddr,
+ &sockAddrP->un, addrLen);
+ break;
+#endif
+
+ default:
+ xres = ESOCK_STR_EAFNOSUPPORT;
+ break;
+
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_encode_sockaddr +++
+ *
+ * Encode a socket address - sockaddr. In erlang its represented as
+ * a map, which has a specific set of attributes, depending on one
+ * mandatory attribute; family. So depending on the value of the family
+ * attribute:
+ *
+ * local - sockaddr_un: path
+ * inet - sockaddr_in4: port, addr
+ * inet6 - sockaddr_in6: port, addr, flowinfo, scope_id
+ */
+
+extern
+char* esock_encode_sockaddr(ErlNifEnv* env,
+ SocketAddress* sockAddrP,
+ unsigned int addrLen,
+ ERL_NIF_TERM* eSockAddr)
+{
+ char* xres;
+
+ UDBG( ("SUTIL", "esock_encode_sockaddr -> entry with"
+ "\r\n family: %d"
+ "\r\n addrLen: %d"
+ "\r\n", sockAddrP->sa.sa_family, addrLen) );
+
+ switch (sockAddrP->sa.sa_family) {
+ case AF_INET:
+ xres = esock_encode_sockaddr_in4(env, &sockAddrP->in4, addrLen, eSockAddr);
+ break;
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ case AF_INET6:
+ xres = esock_encode_sockaddr_in6(env, &sockAddrP->in6, addrLen, eSockAddr);
+ break;
+#endif
+
+#ifdef HAVE_SYS_UN_H
+ case AF_UNIX:
+ xres = esock_encode_sockaddr_un(env, &sockAddrP->un, addrLen, eSockAddr);
+ break;
+#endif
+
+ default:
+ *eSockAddr = esock_atom_undefined;
+ xres = ESOCK_STR_EAFNOSUPPORT;
+ break;
+
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_decode_sockaddr_in4 +++
+ *
+ * Decode a IPv4 socket address - sockaddr_in4. In erlang its represented as
+ * a map, which has a specific set of attributes (beside the mandatory family
+ * attribute, which is "inherited" from the "sockaddr" type):
+ *
+ * port :: port_numbber()
+ * addr :: ip4_address()
+ *
+ * The erlang module ensures that both of these has values exist, so there
+ * is no need for any elaborate error handling.
+ */
+
+extern
+char* esock_decode_sockaddr_in4(ErlNifEnv* env,
+ ERL_NIF_TERM eSockAddr,
+ struct sockaddr_in* sockAddrP,
+ unsigned int* addrLen)
+{
+ ERL_NIF_TERM eport, eaddr;
+ int port;
+ char* xres;
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in4 -> entry\r\n") );
+
+ /* Basic init */
+ sys_memzero((char*) sockAddrP, sizeof(struct sockaddr_in));
+
+#ifndef NO_SA_LEN
+ sockAddrP->sin_len = sizeof(struct sockaddr_in);
+#endif
+
+ sockAddrP->sin_family = AF_INET;
+
+ /* Extract (e) port number from map */
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in4 -> try get port number\r\n") );
+ if (!GET_MAP_VAL(env, eSockAddr, esock_atom_port, &eport))
+ return ESOCK_STR_EINVAL;
+
+ /* Decode port number */
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in4 -> try decode port number\r\n") );
+ if (!GET_INT(env, eport, &port))
+ return ESOCK_STR_EINVAL;
+
+ sockAddrP->sin_port = htons(port);
+
+ /* Extract (e) address from map */
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in4 -> try get (ip) address\r\n") );
+ if (!GET_MAP_VAL(env, eSockAddr, esock_atom_addr, &eaddr))
+ return ESOCK_STR_EINVAL;
+
+ /* Decode address */
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in4 -> try decode (ip) address\r\n") );
+ if ((xres = esock_decode_ip4_address(env,
+ eaddr,
+ &sockAddrP->sin_addr)) != NULL)
+ return xres;
+
+ *addrLen = sizeof(struct sockaddr_in);
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in4 -> done\r\n") );
+
+ return NULL;
+}
+
+
+
+/* +++ esock_encode_sockaddr_in4 +++
+ *
+ * Encode a IPv4 socket address - sockaddr_in4. In erlang its represented as
+ * a map, which has a specific set of attributes (beside the mandatory family
+ * attribute, which is "inherited" from the "sockaddr" type):
+ *
+ * port :: port_numbber()
+ * addr :: ip4_address()
+ *
+ */
+
+extern
+char* esock_encode_sockaddr_in4(ErlNifEnv* env,
+ struct sockaddr_in* sockAddrP,
+ unsigned int addrLen,
+ ERL_NIF_TERM* eSockAddr)
+{
+ ERL_NIF_TERM ePort, eAddr;
+ int port;
+ char* xres = NULL;
+
+ UDBG( ("SUTIL", "esock_encode_sockaddr_in4 -> entry\r\n") );
+
+ if (addrLen >= sizeof(struct sockaddr_in)) {
+ /* The port */
+ port = ntohs(sockAddrP->sin_port);
+ ePort = MKI(env, port);
+
+ /* The address */
+ if ((xres = esock_encode_ip4_address(env, &sockAddrP->sin_addr,
+ &eAddr)) == NULL) {
+ /* And finally construct the in4_sockaddr record */
+ xres = make_sockaddr_in4(env, ePort, eAddr, eSockAddr);
+ } else {
+ UDBG( ("SUTIL", "esock_encode_sockaddr_in4 -> "
+ "failed encoding (ip) address: "
+ "\r\n xres: %s"
+ "\r\n", xres) );
+ *eSockAddr = esock_atom_undefined;
+ xres = ESOCK_STR_EINVAL;
+ }
+
+ } else {
+ UDBG( ("SUTIL", "esock_encode_sockaddr_in4 -> wrong size: "
+ "\r\n addrLen: %d"
+ "\r\n addr size: %d"
+ "\r\n", addrLen, sizeof(struct sockaddr_in)) );
+ *eSockAddr = esock_atom_undefined;
+ xres = ESOCK_STR_EINVAL;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_decode_sockaddr_in6 +++
+ *
+ * Decode a IPv6 socket address - sockaddr_in6. In erlang its represented as
+ * a map, which has a specific set of attributes (beside the mandatory family
+ * attribute, which is "inherited" from the "sockaddr" type):
+ *
+ * port :: port_numbber() (integer)
+ * addr :: ip6_address() (tuple)
+ * flowinfo :: in6_flow_info() (integer)
+ * scope_id :: in6_scope_id() (integer)
+ *
+ * The erlang module ensures that all of these has values exist, so there
+ * is no need for any elaborate error handling here.
+ */
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+extern
+char* esock_decode_sockaddr_in6(ErlNifEnv* env,
+ ERL_NIF_TERM eSockAddr,
+ struct sockaddr_in6* sockAddrP,
+ unsigned int* addrLen)
+{
+ ERL_NIF_TERM eport, eaddr, eflowInfo, escopeId;
+ int port;
+ unsigned int flowInfo, scopeId;
+ char* xres;
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in6 -> entry\r\n") );
+
+ /* Basic init */
+ sys_memzero((char*) sockAddrP, sizeof(struct sockaddr_in6));
+#ifndef NO_SA_LEN
+ sockAddrP->sin6_len = sizeof(struct sockaddr_in);
+#endif
+
+ sockAddrP->sin6_family = AF_INET6;
+
+ /* *** Extract (e) port number from map *** */
+ if (!GET_MAP_VAL(env, eSockAddr, esock_atom_port, &eport))
+ return ESOCK_STR_EINVAL;
+
+ /* Decode port number */
+ if (!GET_INT(env, eport, &port))
+ return ESOCK_STR_EINVAL;
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in6 -> port: %d\r\n", port) );
+
+ sockAddrP->sin6_port = htons(port);
+
+ /* *** Extract (e) flowinfo from map *** */
+ if (!GET_MAP_VAL(env, eSockAddr, esock_atom_flowinfo, &eflowInfo))
+ return ESOCK_STR_EINVAL;
+
+ /* 4: Get the flowinfo */
+ if (!GET_UINT(env, eflowInfo, &flowInfo))
+ return ESOCK_STR_EINVAL;
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in6 -> flowinfo: %d\r\n", flowInfo) );
+
+ sockAddrP->sin6_flowinfo = flowInfo;
+
+ /* *** Extract (e) scope_id from map *** */
+ if (!GET_MAP_VAL(env, eSockAddr, esock_atom_scope_id, &escopeId))
+ return ESOCK_STR_EINVAL;
+
+ /* *** Get the scope_id *** */
+ if (!GET_UINT(env, escopeId, &scopeId))
+ return ESOCK_STR_EINVAL;
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in6 -> scopeId: %d\r\n", scopeId) );
+
+ sockAddrP->sin6_scope_id = scopeId;
+
+ /* *** Extract (e) address from map *** */
+ if (!GET_MAP_VAL(env, eSockAddr, esock_atom_addr, &eaddr))
+ return ESOCK_STR_EINVAL;
+
+ /* Decode address */
+ if ((xres = esock_decode_ip6_address(env,
+ eaddr,
+ &sockAddrP->sin6_addr)) != NULL)
+ return xres;
+
+ *addrLen = sizeof(struct sockaddr_in6);
+
+ UDBG( ("SUTIL", "esock_decode_sockaddr_in6 -> done\r\n") );
+
+ return NULL;
+}
+#endif
+
+
+
+/* +++ esock_encode_sockaddr_in6 +++
+ *
+ * Encode a IPv6 socket address - sockaddr_in6. In erlang its represented as
+ * a map, which has a specific set of attributes (beside the mandatory family
+ * attribute, which is "inherited" from the "sockaddr" type):
+ *
+ * port :: port_numbber() (integer)
+ * addr :: ip6_address() (tuple)
+ * flowinfo :: in6_flow_info() (integer)
+ * scope_id :: in6_scope_id() (integer)
+ *
+ */
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+extern
+char* esock_encode_sockaddr_in6(ErlNifEnv* env,
+ struct sockaddr_in6* sockAddrP,
+ unsigned int addrLen,
+ ERL_NIF_TERM* eSockAddr)
+{
+ ERL_NIF_TERM ePort, eAddr, eFlowInfo, eScopeId;
+ char* xres;
+
+ if (addrLen >= sizeof(struct sockaddr_in6)) {
+ /* The port */
+ ePort = MKI(env, ntohs(sockAddrP->sin6_port));
+
+ /* The flowInfo */
+ eFlowInfo = MKI(env, sockAddrP->sin6_flowinfo);
+
+ /* The scopeId */
+ eScopeId = MKI(env, sockAddrP->sin6_scope_id);
+
+ /* The address */
+ if ((xres = esock_encode_ip6_address(env, &sockAddrP->sin6_addr,
+ &eAddr)) == NULL) {
+ /* And finally construct the in6_sockaddr record */
+ xres = make_sockaddr_in6(env,
+ ePort, eAddr, eFlowInfo, eScopeId, eSockAddr);
+ } else {
+ *eSockAddr = esock_atom_undefined;
+ xres = ESOCK_STR_EINVAL;
+ }
+
+ } else {
+ *eSockAddr = esock_atom_undefined;
+ xres = ESOCK_STR_EINVAL;
+ }
+
+ return xres;
+}
+#endif
+
+
+
+/* +++ esock_decode_sockaddr_un +++
+ *
+ * Decode a Unix Domain socket address - sockaddr_un. In erlang its
+ * represented as a map, which has a specific set of attributes
+ * (beside the mandatory family attribute, which is "inherited" from
+ * the "sockaddr" type):
+ *
+ * path :: binary()
+ *
+ * The erlang module ensures that this value exist, so there
+ * is no need for any elaborate error handling here.
+ */
+
+#ifdef HAVE_SYS_UN_H
+extern
+char* esock_decode_sockaddr_un(ErlNifEnv* env,
+ ERL_NIF_TERM eSockAddr,
+ struct sockaddr_un* sockAddrP,
+ unsigned int* addrLen)
+{
+ ErlNifBinary bin;
+ ERL_NIF_TERM epath;
+ unsigned int len;
+
+ /* *** Extract (e) path (a binary) from map *** */
+ if (!GET_MAP_VAL(env, eSockAddr, esock_atom_path, &epath))
+ return ESOCK_STR_EINVAL;
+
+ /* Get the path */
+ if (!GET_BIN(env, epath, &bin))
+ return ESOCK_STR_EINVAL;
+
+ if ((bin.size +
+#ifdef __linux__
+ /* Make sure the address gets zero terminated
+ * except when the first byte is \0 because then it is
+ * sort of zero terminated although the zero termination
+ * comes before the address...
+ * This fix handles Linux's nonportable
+ * abstract socket address extension.
+ */
+ (bin.data[0] == '\0' ? 0 : 1)
+#else
+ 1
+#endif
+ ) > sizeof(sockAddrP->sun_path))
+ return ESOCK_STR_EINVAL;
+
+
+ sys_memzero((char*) sockAddrP, sizeof(struct sockaddr_un));
+ sockAddrP->sun_family = AF_UNIX;
+
+ sys_memcpy(sockAddrP->sun_path, bin.data, bin.size);
+ len = offsetof(struct sockaddr_un, sun_path) + bin.size;
+
+#ifndef NO_SA_LEN
+ sockAddrP->sun_len = len;
+#endif
+ *addrLen = len;
+
+ return NULL;
+}
+#endif
+
+
+
+/* +++ esock_encode_sockaddr_un +++
+ *
+ * Encode a Unix Domain socket address - sockaddr_un. In erlang its
+ * represented as a map, which has a specific set of attributes
+ * (beside the mandatory family attribute, which is "inherited" from
+ * the "sockaddr" type):
+ *
+ * path :: binary()
+ *
+ */
+
+#ifdef HAVE_SYS_UN_H
+extern
+char* esock_encode_sockaddr_un(ErlNifEnv* env,
+ struct sockaddr_un* sockAddrP,
+ unsigned int addrLen,
+ ERL_NIF_TERM* eSockAddr)
+{
+ ERL_NIF_TERM ePath;
+ size_t n, m;
+ char* xres;
+
+ if (addrLen >= offsetof(struct sockaddr_un, sun_path)) {
+ n = addrLen - offsetof(struct sockaddr_un, sun_path);
+ if (255 < n) {
+ *eSockAddr = esock_atom_undefined;
+ xres = ESOCK_STR_EINVAL;
+ } else {
+ m = esock_strnlen(sockAddrP->sun_path, n);
+#ifdef __linux__
+ /* Assume that the address is a zero terminated string,
+ * except when the first byte is \0 i.e the string length is 0,
+ * then use the reported length instead.
+ * This fix handles Linux's nonportable
+ * abstract socket address extension.
+ */
+ if (m == 0) {
+ m = n;
+ }
+#endif
+
+ /* And finally build the 'path' attribute */
+ ePath = MKSL(env, sockAddrP->sun_path, m);
+
+ /* And the socket address */
+ xres = make_sockaddr_un(env, ePath, eSockAddr);
+ }
+ } else {
+ *eSockAddr = esock_atom_undefined;
+ xres = ESOCK_STR_EINVAL;
+ }
+
+ return xres;
+}
+#endif
+
+
+
+/* +++ esock_decode_ip4_address +++
+ *
+ * Decode a IPv4 address. This can be three things:
+ *
+ * + Then atom 'any'
+ * + Then atom 'loopback'
+ * + An ip4_address() (4 tuple)
+ *
+ * Note that this *only* decodes the "address" part of a
+ * (IPv4) socket address.
+ */
+
+extern
+char* esock_decode_ip4_address(ErlNifEnv* env,
+ ERL_NIF_TERM eAddr,
+ struct in_addr* inAddrP)
+{
+ struct in_addr addr;
+
+ UDBG( ("SUTIL", "esock_decode_ip4_address -> entry with"
+ "\r\n eAddr: %T"
+ "\r\n", eAddr) );
+
+ if (IS_ATOM(env, eAddr)) {
+ /* This is either 'any' or 'loopback' */
+
+ if (COMPARE(esock_atom_loopback, eAddr) == 0) {
+ UDBG( ("SUTIL", "esock_decode_ip4_address -> address: lookback\r\n") );
+ addr.s_addr = htonl(INADDR_LOOPBACK);
+ } else if (COMPARE(esock_atom_any, eAddr) == 0) {
+ UDBG( ("SUTIL", "esock_decode_ip4_address -> address: any\r\n") );
+ addr.s_addr = htonl(INADDR_ANY);
+ } else {
+ UDBG( ("SUTIL", "esock_decode_ip4_address -> address: unknown\r\n") );
+ return ESOCK_STR_EINVAL;
+ }
+
+ inAddrP->s_addr = addr.s_addr;
+
+ } else {
+ /* This is a 4-tuple */
+
+ const ERL_NIF_TERM* addrt;
+ int addrtSz;
+ int a, v;
+ char addr[4];
+
+ if (!GET_TUPLE(env, eAddr, &addrtSz, &addrt))
+ return ESOCK_STR_EINVAL;
+
+ if (addrtSz != 4)
+ return ESOCK_STR_EINVAL;
+
+ for (a = 0; a < 4; a++) {
+ if (!GET_INT(env, addrt[a], &v))
+ return ESOCK_STR_EINVAL;
+ addr[a] = v;
+ }
+
+ sys_memcpy(inAddrP, &addr, sizeof(addr));
+
+ }
+
+ return NULL;
+}
+
+
+
+/* +++ esock_encode_ip4_address +++
+ *
+ * Encode a IPv4 address:
+ *
+ * + An ip4_address() (4 tuple)
+ *
+ * Note that this *only* decodes the "address" part of a
+ * (IPv4) socket address. There are several other things (port).
+ */
+
+extern
+char* esock_encode_ip4_address(ErlNifEnv* env,
+ struct in_addr* addrP,
+ ERL_NIF_TERM* eAddr)
+{
+ unsigned int i;
+ ERL_NIF_TERM at[4];
+ unsigned int atLen = sizeof(at) / sizeof(ERL_NIF_TERM);
+ unsigned char* a = (unsigned char*) addrP;
+ ERL_NIF_TERM addr;
+
+ /* The address */
+ for (i = 0; i < atLen; i++) {
+ at[i] = MKI(env, a[i]);
+ }
+
+ addr = MKTA(env, at, atLen);
+ UDBG( ("SUTIL", "esock_encode_ip4_address -> addr: %T\r\n", addr) );
+ // *eAddr = MKTA(env, at, atLen);
+ *eAddr = addr;
+
+ return NULL;
+}
+
+
+
+/* +++ esock_decode_ip6_address +++
+ *
+ * Decode a IPv6 address. This can be three things:
+ *
+ * + Then atom 'any'
+ * + Then atom 'loopback'
+ * + An ip6_address() (8 tuple)
+ *
+ * Note that this *only* decodes the "address" part of a
+ * (IPv6) socket address. There are several other things
+ * (port, flowinfo and scope_id) that are handled elsewhere).
+ */
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+extern
+char* esock_decode_ip6_address(ErlNifEnv* env,
+ ERL_NIF_TERM eAddr,
+ struct in6_addr* inAddrP)
+{
+ UDBG( ("SUTIL", "esock_decode_ip6_address -> entry with"
+ "\r\n eAddr: %T"
+ "\r\n", eAddr) );
+
+ if (IS_ATOM(env, eAddr)) {
+ /* This is either 'any' or 'loopback' */
+ const struct in6_addr* addr;
+
+ if (COMPARE(esock_atom_loopback, eAddr) == 0) {
+ addr = &in6addr_loopback;
+ } else if (COMPARE(esock_atom_any, eAddr) == 0) {
+ addr = &in6addr_any;
+ } else {
+ return ESOCK_STR_EINVAL;
+ }
+
+ *inAddrP = *addr;
+
+ } else {
+ /* This is a 8-tuple */
+
+ const ERL_NIF_TERM* addrt;
+ int addrtSz;
+ int ai, v;
+ unsigned char addr[16];
+ unsigned char* a = addr;
+ unsigned int addrLen = sizeof(addr) / sizeof(unsigned char);
+
+ if (!GET_TUPLE(env, eAddr, &addrtSz, &addrt))
+ return ESOCK_STR_EINVAL;
+
+ if (addrtSz != 8)
+ return ESOCK_STR_EINVAL;
+
+ for (ai = 0; ai < 8; ai++) {
+ if (!GET_INT(env, addrt[ai], &v))
+ return ESOCK_STR_EINVAL;
+ put_int16(v, a);
+ a += 2;
+ }
+
+ sys_memcpy(inAddrP, &addr, addrLen);
+
+ }
+
+ return NULL;
+}
+#endif
+
+
+
+/* +++ esock_encode_ip6_address +++
+ *
+ * Encode a IPv6 address:
+ *
+ * + An ip6_address() (8 tuple)
+ *
+ * Note that this *only* encodes the "address" part of a
+ * (IPv6) socket address. There are several other things
+ * (port, flowinfo and scope_id) that are handled elsewhere).
+ */
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+extern
+char* esock_encode_ip6_address(ErlNifEnv* env,
+ struct in6_addr* addrP,
+ ERL_NIF_TERM* eAddr)
+{
+ unsigned int i;
+ ERL_NIF_TERM at[8];
+ unsigned int atLen = sizeof(at) / sizeof(ERL_NIF_TERM);
+ unsigned char* a = (unsigned char*) addrP;
+
+ /* The address */
+ for (i = 0; i < atLen; i++) {
+ at[i] = MKI(env, get_int16(a + i*2));
+ }
+
+ *eAddr = MKTA(env, at, atLen);
+
+ return NULL;
+}
+#endif
+
+
+
+/* +++ esock_encode_timeval +++
+ *
+ * Encode a timeval struct into its erlang form, a map with two fields:
+ *
+ * sec
+ * usec
+ *
+ */
+extern
+char* esock_encode_timeval(ErlNifEnv* env,
+ struct timeval* timeP,
+ ERL_NIF_TERM* eTime)
+{
+ ERL_NIF_TERM keys[] = {esock_atom_sec, esock_atom_usec};
+ ERL_NIF_TERM vals[] = {MKL(env, timeP->tv_sec), MKL(env, timeP->tv_usec)};
+
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, eTime))
+ return ESOCK_STR_EINVAL;
+
+ return NULL;
+}
+
+
+
+/* +++ esock_decode_timeval +++
+ *
+ * Decode a timeval in its erlang form (a map) into its native form,
+ * a timeval struct.
+ *
+ */
+extern
+char* esock_decode_timeval(ErlNifEnv* env,
+ ERL_NIF_TERM eTime,
+ struct timeval* timeP)
+{
+ ERL_NIF_TERM eSec, eUSec;
+ size_t sz;
+
+ // It must be a map
+ if (!IS_MAP(env, eTime))
+ return ESOCK_STR_EINVAL;
+
+ // It must have atleast two attributes
+ if (!enif_get_map_size(env, eTime, &sz) || (sz < 2))
+ return ESOCK_STR_EINVAL;
+
+ if (!GET_MAP_VAL(env, eTime, esock_atom_sec, &eSec))
+ return ESOCK_STR_EINVAL;
+
+ if (!GET_MAP_VAL(env, eTime, esock_atom_usec, &eUSec))
+ return ESOCK_STR_EINVAL;
+
+ if (!GET_LONG(env, eSec, &timeP->tv_sec))
+ return ESOCK_STR_EINVAL;
+
+ if (!GET_LONG(env, eUSec, &timeP->tv_usec))
+ return ESOCK_STR_EINVAL;
+
+ return NULL;
+}
+
+
+
+/* +++ esock_decode_domain +++
+ *
+ * Decode the Erlang form of the 'domain' type, that is:
+ *
+ * inet => AF_INET
+ * inet6 => AF_INET6
+ * local => AF_UNIX
+ *
+ */
+extern
+char* esock_decode_domain(ErlNifEnv* env,
+ ERL_NIF_TERM eDomain,
+ int* domain)
+{
+ char* xres = NULL;
+
+ if (COMPARE(esock_atom_inet, eDomain) == 0) {
+ *domain = AF_INET;
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ } else if (COMPARE(esock_atom_inet6, eDomain) == 0) {
+ *domain = AF_INET6;
+#endif
+
+#ifdef HAVE_SYS_UN_H
+ } else if (COMPARE(esock_atom_local, eDomain) == 0) {
+ *domain = AF_UNIX;
+#endif
+
+ } else {
+ *domain = -1;
+ xres = ESOCK_STR_EAFNOSUPPORT;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_encode_domain +++
+ *
+ * Encode the native domain to the Erlang form, that is:
+ *
+ * AF_INET => inet
+ * AF_INET6 => inet6
+ * AF_UNIX => local
+ *
+ */
+extern
+char* esock_encode_domain(ErlNifEnv* env,
+ int domain,
+ ERL_NIF_TERM* eDomain)
+{
+ char* xres = NULL;
+
+ switch (domain) {
+ case AF_INET:
+ *eDomain = esock_atom_inet;
+ break;
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+ case AF_INET6:
+ *eDomain = esock_atom_inet6;
+ break;
+#endif
+
+#ifdef HAVE_SYS_UN_H
+ case AF_UNIX:
+ *eDomain = esock_atom_local;
+ break;
+#endif
+
+ default:
+ *eDomain = esock_atom_undefined; // Just in case
+ xres = ESOCK_STR_EAFNOSUPPORT;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_decode_type +++
+ *
+ * Decode the Erlang form of the 'type' type, that is:
+ *
+ * stream => SOCK_STREAM
+ * dgram => SOCK_DGRAM
+ * raw => SOCK_RAW
+ * seqpacket => SOCK_SEQPACKET
+ *
+ */
+extern
+char* esock_decode_type(ErlNifEnv* env,
+ ERL_NIF_TERM eType,
+ int* type)
+{
+ char* xres = NULL;
+
+ if (COMPARE(esock_atom_stream, eType) == 0) {
+ *type = SOCK_STREAM;
+ } else if (COMPARE(esock_atom_dgram, eType) == 0) {
+ *type = SOCK_DGRAM;
+ } else if (COMPARE(esock_atom_raw, eType) == 0) {
+ *type = SOCK_RAW;
+
+#if defined(HAVE_SCTP)
+ } else if (COMPARE(esock_atom_seqpacket, eType) == 0) {
+ *type = SOCK_SEQPACKET;
+#endif
+
+ } else {
+ *type = -1;
+ xres = ESOCK_STR_EAFNOSUPPORT;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_decode_type +++
+ *
+ * Encode the native type to the Erlang form, that is:
+ *
+ * SOCK_STREAM => stream
+ * SOCK_DGRAM => dgram
+ * SOCK_RAW => raw
+ * SOCK_SEQPACKET => seqpacket
+ *
+ */
+extern
+char* esock_encode_type(ErlNifEnv* env,
+ int type,
+ ERL_NIF_TERM* eType)
+{
+ char* xres = NULL;
+
+ switch (type) {
+ case SOCK_STREAM:
+ *eType = esock_atom_stream;
+ break;
+
+ case SOCK_DGRAM:
+ *eType = esock_atom_dgram;
+ break;
+
+ case SOCK_RAW:
+ *eType = esock_atom_raw;
+ break;
+
+#if defined(HAVE_SCTP)
+ case SOCK_SEQPACKET:
+ *eType = esock_atom_seqpacket;
+ break;
+#endif
+
+ default:
+ *eType = esock_atom_undefined; // Just in case
+ xres = ESOCK_STR_EAFNOSUPPORT;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_encode_protocol +++
+ *
+ * Encode the native protocol to the Erlang form, that is:
+ *
+ * SOL_IP | IPPROTO_IP => ip
+ * SOL_IPV6 => ipv6
+ * SOL_TCP => tcp
+ * SOL_UDP => udp
+ * SOL_SCTP => sctp
+ *
+ */
+extern
+char* esock_encode_protocol(ErlNifEnv* env,
+ int proto,
+ ERL_NIF_TERM* eProto)
+{
+ char* xres = NULL;
+
+ switch (proto) {
+#if defined(SOL_IP)
+ case SOL_IP:
+#else
+ case IPPROTO_IP:
+#endif
+ *eProto = esock_atom_ip;
+ break;
+
+#if defined(SOL_IPV6)
+ case SOL_IPV6:
+ *eProto = esock_atom_ipv6;
+ break;
+#endif
+
+ case IPPROTO_TCP:
+ *eProto = esock_atom_tcp;
+ break;
+
+ case IPPROTO_UDP:
+ *eProto = esock_atom_udp;
+ break;
+
+#if defined(HAVE_SCTP)
+ case IPPROTO_SCTP:
+ *eProto = esock_atom_sctp;
+ break;
+#endif
+
+ default:
+ *eProto = esock_atom_undefined;
+ xres = ESOCK_STR_EAFNOSUPPORT;
+ break;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_decode_protocol +++
+ *
+ * Decode the Erlang form of the 'protocol' type, that is:
+ *
+ * ip => SOL_IP | IPPROTO_IP
+ * ipv6 => SOL_IPV6
+ * tcp => SOL_TCP
+ * udp => SOL_UDP
+ * sctp => SOL_SCTP
+ *
+ */
+extern
+char* esock_decode_protocol(ErlNifEnv* env,
+ ERL_NIF_TERM eProto,
+ int* proto)
+{
+ char* xres = NULL;
+
+ if (COMPARE(esock_atom_ip, eProto) == 0) {
+#if defined(SOL_IP)
+ *proto = SOL_IP;
+#else
+ *proto = IPPROTO_IP;
+#endif
+ } else if (COMPARE(esock_atom_ipv6, eProto) == 0) {
+#if defined(SOL_IPV6)
+ *proto = SOL_IPV6;
+#else
+ *proto = IPPROTO_IPV6;
+#endif
+ } else if (COMPARE(esock_atom_tcp, eProto) == 0) {
+ *proto = IPPROTO_TCP;
+ } else if (COMPARE(esock_atom_udp, eProto) == 0) {
+ *proto = IPPROTO_UDP;
+#if defined(HAVE_SCTP)
+ } else if (COMPARE(esock_atom_sctp, eProto) == 0) {
+ *proto = IPPROTO_SCTP;
+#endif
+ } else {
+ *proto = -1;
+ xres = ESOCK_STR_EAFNOSUPPORT;
+ }
+
+ return xres;
+}
+
+
+
+/* +++ esock_decode_bufsz +++
+ *
+ * Decode an buffer size. The size of a buffer is:
+ *
+ * Sz > 0 => Use provided value
+ * Sz => Use provided default
+ *
+ */
+extern
+char* esock_decode_bufsz(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ size_t defSz,
+ size_t* sz)
+{
+ int val;
+
+ if (!GET_INT(env, eVal, &val))
+ return ESOCK_STR_EINVAL;
+
+ if (val > 0)
+ *sz = (size_t) val;
+ else
+ *sz = defSz;
+
+ return NULL;
+}
+
+
+
+/* *** esock_decode_string ***
+ *
+ * Decode a string value. A successful decode results in an
+ * allocation of the string, which the caller has to free
+ * once the string has been used.
+ */
+extern
+BOOLEAN_T esock_decode_string(ErlNifEnv* env,
+ const ERL_NIF_TERM eString,
+ char** stringP)
+{
+ BOOLEAN_T result;
+ unsigned int len;
+ char* bufP;
+
+ if (!GET_LIST_LEN(env, eString, &len) && (len != 0)) {
+ *stringP = NULL;
+ result = FALSE;
+ } else {
+
+ UDBG( ("SUTIL", "esock_decode_string -> len: %d\r\n", len) );
+
+ bufP = MALLOC(len + 1); // We shall NULL-terminate
+
+ if (GET_STR(env, eString, bufP, len+1)) {
+ UDBG( ("SUTIL", "esock_decode_string -> buf: %s\r\n", bufP) );
+ // bufP[len] = '\0';
+ *stringP = bufP;
+ result = TRUE;
+ } else {
+ *stringP = NULL;
+ result = FALSE;
+ FREE(bufP);
+ }
+ }
+
+ return result;
+}
+
+
+
+/* *** esock_extract_bool_from_map ***
+ *
+ * Extract an boolean item from a map.
+ *
+ */
+extern
+BOOLEAN_T esock_extract_bool_from_map(ErlNifEnv* env,
+ ERL_NIF_TERM map,
+ ERL_NIF_TERM key,
+ BOOLEAN_T def)
+{
+ ERL_NIF_TERM val;
+
+ if (!GET_MAP_VAL(env, map, key, &val))
+ return def;
+
+ if (!IS_ATOM(env, val))
+ return def;
+
+ if (COMPARE(val, esock_atom_true) == 0)
+ return TRUE;
+ else
+ return FALSE;
+}
+
+
+
+/* *** esock_decode_bool ***
+ *
+ * Decode a boolean value.
+ *
+ */
+extern
+BOOLEAN_T esock_decode_bool(ERL_NIF_TERM val)
+{
+ if (COMPARE(esock_atom_true, val) == 0)
+ return TRUE;
+ else
+ return FALSE;
+}
+
+
+/* *** esock_encode_bool ***
+ *
+ * Encode a boolean value.
+ *
+ */
+extern
+ERL_NIF_TERM esock_encode_bool(BOOLEAN_T val)
+{
+ if (val)
+ return esock_atom_true;
+ else
+ return esock_atom_false;
+}
+
+
+/* Create an ok two (2) tuple in the form:
+ *
+ * {ok, Any}
+ *
+ * The second element (Any) is already in the form of an
+ * ERL_NIF_TERM so all we have to do is create the tuple.
+ */
+extern
+ERL_NIF_TERM esock_make_ok2(ErlNifEnv* env, ERL_NIF_TERM any)
+{
+ return MKT2(env, esock_atom_ok, any);
+}
+
+
+/* Create an ok three (3) tuple in the form:
+ *
+ * {ok, Val1, Val2}
+ *
+ * The second (Val1) and third (Val2) elements are already in
+ * the form of an ERL_NIF_TERM so all we have to do is create
+ * the tuple.
+ */
+extern
+ERL_NIF_TERM esock_make_ok3(ErlNifEnv* env, ERL_NIF_TERM val1, ERL_NIF_TERM val2)
+{
+ return MKT3(env, esock_atom_ok, val1, val2);
+}
+
+
+
+/* Create an error two (2) tuple in the form:
+ *
+ * {error, Reason}
+ *
+ * The second element (Reason) is already in the form of an
+ * ERL_NIF_TERM so all we have to do is create the tuple.
+ */
+extern
+ERL_NIF_TERM esock_make_error(ErlNifEnv* env, ERL_NIF_TERM reason)
+{
+ return MKT2(env, esock_atom_error, reason);
+}
+
+
+
+/* Create an error two (2) tuple in the form: {error, Reason}.
+ *
+ * {error, Reason}
+ *
+ * The second element, Reason, is the reason string that has
+ * converted into an atom.
+ */
+extern
+ERL_NIF_TERM esock_make_error_str(ErlNifEnv* env, char* reason)
+{
+ return esock_make_error(env, MKA(env, reason));
+}
+
+
+/* Create an error two (2) tuple in the form:
+ *
+ * {error, Reason}
+ *
+ * The second element, Reason, is the errno value in its
+ * basic form (integer) which has been converted into an atom.
+ */
+extern
+ERL_NIF_TERM esock_make_error_errno(ErlNifEnv* env, int err)
+{
+ return esock_make_error_str(env, erl_errno_id(err));
+}
+
+
+
+/* strnlen doesn't exist everywhere */
+extern
+size_t esock_strnlen(const char *s, size_t maxlen)
+{
+ size_t i = 0;
+ while (i < maxlen && s[i] != '\0')
+ i++;
+ return i;
+}
+
+
+
+/* *** esock_abort ***
+ *
+ * Generate an abort with "extra" info. This should be called
+ * via the ESOCK_ABORT macro.
+ * Basically it prints the extra info onto stderr before aborting.
+ *
+ */
+extern
+void esock_abort(const char* expr,
+ const char* func,
+ const char* file,
+ int line)
+{
+ fflush(stdout);
+ fprintf(stderr, "%s:%d:%s() Assertion failed: %s\n",
+ file, line, func, expr);
+ fflush(stderr);
+ abort();
+}
+
+
+
+/* *** esock_warning_msg ***
+ *
+ * Temporary function for issuing warning messages.
+ *
+ */
+extern
+void esock_warning_msg( const char* format, ... )
+{
+ va_list args;
+ char f[512 + sizeof(format)]; // This has to suffice...
+ char stamp[64]; // Just in case...
+ struct timespec ts;
+ int res;
+
+ /*
+ * We should really include self in the printout, so we can se which process
+ * are executing the code. But then I must change the API....
+ * ....something for later.
+ */
+
+ // 2018-06-29 12:13:21.232089
+ // 29-Jun-2018::13:47:25.097097
+
+ if (!realtime(&ts)) {
+ if (timespec2str(stamp, sizeof(stamp), &ts) != 0) {
+ res = enif_snprintf(f, sizeof(f), "=WARNING MSG==== %s", format);
+ } else {
+ res = enif_snprintf(f, sizeof(f),
+ "=WARNING MSG==== %s ===\r\n%s" , stamp, format);
+ }
+
+ if (res > 0) {
+ va_start (args, format);
+ enif_vfprintf (stdout, f, args);
+ va_end (args);
+ fflush(stdout);
+ }
+ }
+
+ return;
+}
+
+
+static
+int realtime(struct timespec* tsP)
+{
+ return clock_gettime(CLOCK_REALTIME, tsP);
+}
+
+
+/*
+ * Convert a timespec struct into a readable/printable string.
+ *
+ * "%F::%T" => 2018-06-29 12:13:21[.232089]
+ * "%d-%b-%Y::%T" => 29-Jun-2018::13:47:25.097097
+ */
+static
+int timespec2str(char *buf, unsigned int len, struct timespec *ts)
+{
+ int ret, buflen;
+ struct tm t;
+
+ tzset();
+ if (localtime_r(&(ts->tv_sec), &t) == NULL)
+ return 1;
+
+ ret = strftime(buf, len, "%d-%B-%Y::%T", &t);
+ if (ret == 0)
+ return 2;
+ len -= ret - 1;
+ buflen = strlen(buf);
+
+ ret = snprintf(&buf[buflen], len, ".%06ld", ts->tv_nsec/1000);
+ if (ret >= len)
+ return 3;
+
+ return 0;
+}
+
+
+/* =================================================================== *
+ * *
+ * Various (internal) utility functions *
+ * *
+ * =================================================================== */
+
+/* Construct the IPv4 socket address */
+static
+char* make_sockaddr_in4(ErlNifEnv* env,
+ ERL_NIF_TERM port,
+ ERL_NIF_TERM addr,
+ ERL_NIF_TERM* sa)
+{
+ ERL_NIF_TERM keys[] = {esock_atom_family, esock_atom_port, esock_atom_addr};
+ ERL_NIF_TERM vals[] = {esock_atom_inet, port, addr};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, sa)) {
+ *sa = esock_atom_undefined;
+ return ESOCK_STR_EINVAL;
+ } else {
+ return NULL;
+ }
+}
+
+
+/* Construct the IPv6 socket address */
+static
+char* make_sockaddr_in6(ErlNifEnv* env,
+ ERL_NIF_TERM port,
+ ERL_NIF_TERM addr,
+ ERL_NIF_TERM flowInfo,
+ ERL_NIF_TERM scopeId,
+ ERL_NIF_TERM* sa)
+{
+ ERL_NIF_TERM keys[] = {esock_atom_family,
+ esock_atom_port,
+ esock_atom_addr,
+ esock_atom_flowinfo,
+ esock_atom_scope_id};
+ ERL_NIF_TERM vals[] = {esock_atom_inet6, port, addr, flowInfo, scopeId};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, sa)) {
+ *sa = esock_atom_undefined;
+ return ESOCK_STR_EINVAL;
+ } else {
+ return NULL;
+ }
+}
+
+
+/* Construct the Unix Domain socket address */
+static
+char* make_sockaddr_un(ErlNifEnv* env,
+ ERL_NIF_TERM path,
+ ERL_NIF_TERM* sa)
+{
+ ERL_NIF_TERM keys[] = {esock_atom_family, esock_atom_path};
+ ERL_NIF_TERM vals[] = {esock_atom_inet, path};
+ unsigned int numKeys = sizeof(keys) / sizeof(ERL_NIF_TERM);
+ unsigned int numVals = sizeof(vals) / sizeof(ERL_NIF_TERM);
+
+ ESOCK_ASSERT( (numKeys == numVals) );
+
+ if (!MKMA(env, keys, vals, numKeys, sa)) {
+ *sa = esock_atom_undefined;
+ return ESOCK_STR_EINVAL;
+ } else {
+ return NULL;
+ }
+}
+
+
diff --git a/erts/emulator/nifs/common/socket_util.h b/erts/emulator/nifs/common/socket_util.h
new file mode 100644
index 0000000000..1b5d003155
--- /dev/null
+++ b/erts/emulator/nifs/common/socket_util.h
@@ -0,0 +1,205 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2018-2018. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ *
+ * ----------------------------------------------------------------------
+ * Purpose : Utility "stuff" for socket and net.
+ * ----------------------------------------------------------------------
+ *
+ */
+
+#ifndef SOCKET_UTIL_H__
+#define SOCKET_UTIL_H__
+
+#include <erl_nif.h>
+#include "socket_int.h"
+
+#define CHAR(C) ((char) (C))
+#define UCHAR(C) ((unsigned char) (C))
+#define INT(I) ((int) (I))
+#define UINT(U) ((unsigned int) (U))
+#define LONG(L) ((long) (L))
+#define ULONG(L) ((unsigned long) (L))
+#define SZT(I) ((size_t) (I))
+#define VOIDP(P) ((void*) (P))
+#define CHARP(P) ((char*) (P))
+
+#define ESOCK_ABORT(E) esock_abort(E, __func__, __FILE__, __LINE__)
+#define ESOCK_ASSERT(e) ((void) ((e) ? 1 : (ESOCK_ABORT(#e), 0)))
+
+extern
+char* esock_encode_iov(ErlNifEnv* env,
+ int read,
+ struct iovec* iov,
+ size_t len,
+ ErlNifBinary* data,
+ ERL_NIF_TERM* eIOV);
+extern
+char* esock_decode_iov(ErlNifEnv* env,
+ ERL_NIF_TERM eIOV,
+ ErlNifBinary* bufs,
+ struct iovec* iov,
+ size_t len,
+ ssize_t* totSize);
+extern
+char* esock_decode_sockaddr(ErlNifEnv* env,
+ ERL_NIF_TERM eSockAddr,
+ SocketAddress* sockAddrP,
+ unsigned int* addrLen);
+extern
+char* esock_encode_sockaddr(ErlNifEnv* env,
+ SocketAddress* sockAddrP,
+ unsigned int addrLen,
+ ERL_NIF_TERM* eSockAddr);
+
+extern
+char* esock_decode_sockaddr_in4(ErlNifEnv* env,
+ ERL_NIF_TERM eSockAddr,
+ struct sockaddr_in* sockAddrP,
+ unsigned int* addrLen);
+extern
+char* esock_encode_sockaddr_in4(ErlNifEnv* env,
+ struct sockaddr_in* sockAddrP,
+ unsigned int addrLen,
+ ERL_NIF_TERM* eSockAddr);
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+extern
+char* esock_decode_sockaddr_in6(ErlNifEnv* env,
+ ERL_NIF_TERM eSockAddr,
+ struct sockaddr_in6* sockAddrP,
+ unsigned int* addrLen);
+extern
+char* esock_encode_sockaddr_in6(ErlNifEnv* env,
+ struct sockaddr_in6* sockAddrP,
+ unsigned int addrLen,
+ ERL_NIF_TERM* eSockAddr);
+#endif
+
+#ifdef HAVE_SYS_UN_H
+extern
+char* esock_decode_sockaddr_un(ErlNifEnv* env,
+ ERL_NIF_TERM eSockAddr,
+ struct sockaddr_un* sockAddrP,
+ unsigned int* addrLen);
+extern
+char* esock_encode_sockaddr_un(ErlNifEnv* env,
+ struct sockaddr_un* sockAddrP,
+ unsigned int addrLen,
+ ERL_NIF_TERM* eSockAddr);
+#endif
+
+extern
+char* esock_decode_ip4_address(ErlNifEnv* env,
+ ERL_NIF_TERM eAddr,
+ struct in_addr* inAddrP);
+extern
+char* esock_encode_ip4_address(ErlNifEnv* env,
+ struct in_addr* addrP,
+ ERL_NIF_TERM* eAddr);
+
+#if defined(HAVE_IN6) && defined(AF_INET6)
+extern
+char* esock_decode_ip6_address(ErlNifEnv* env,
+ ERL_NIF_TERM eAddr,
+ struct in6_addr* inAddrP);
+extern
+char* esock_encode_ip6_address(ErlNifEnv* env,
+ struct in6_addr* addrP,
+ ERL_NIF_TERM* eAddr);
+#endif
+
+extern char* esock_encode_timeval(ErlNifEnv* env,
+ struct timeval* timeP,
+ ERL_NIF_TERM* eTime);
+extern char* esock_decode_timeval(ErlNifEnv* env,
+ ERL_NIF_TERM eTime,
+ struct timeval* timeP);
+extern
+char* esock_decode_domain(ErlNifEnv* env,
+ ERL_NIF_TERM eDomain,
+ int* domain);
+extern
+char* esock_encode_domain(ErlNifEnv* env,
+ int domain,
+ ERL_NIF_TERM* eDomain);
+
+extern
+char* esock_decode_type(ErlNifEnv* env,
+ ERL_NIF_TERM eType,
+ int* type);
+extern
+char* esock_encode_type(ErlNifEnv* env,
+ int type,
+ ERL_NIF_TERM* eType);
+
+extern
+char* esock_decode_protocol(ErlNifEnv* env,
+ ERL_NIF_TERM eProtocol,
+ int* protocol);
+extern
+char* esock_encode_protocol(ErlNifEnv* env,
+ int type,
+ ERL_NIF_TERM* eProtocol);
+
+extern
+char* esock_decode_bufsz(ErlNifEnv* env,
+ ERL_NIF_TERM eVal,
+ size_t defSz,
+ size_t* sz);
+
+extern
+BOOLEAN_T esock_decode_string(ErlNifEnv* env,
+ const ERL_NIF_TERM eString,
+ char** stringP);
+
+extern
+BOOLEAN_T esock_extract_bool_from_map(ErlNifEnv* env,
+ ERL_NIF_TERM map,
+ ERL_NIF_TERM key,
+ BOOLEAN_T def);
+extern
+BOOLEAN_T esock_decode_bool(ERL_NIF_TERM val);
+extern
+ERL_NIF_TERM esock_encode_bool(BOOLEAN_T val);
+
+extern
+size_t esock_strnlen(const char *s, size_t maxlen);
+extern
+void esock_abort(const char* expr,
+ const char* func,
+ const char* file,
+ int line);
+
+extern
+ERL_NIF_TERM esock_make_ok2(ErlNifEnv* env, ERL_NIF_TERM any);
+extern
+ERL_NIF_TERM esock_make_ok3(ErlNifEnv* env, ERL_NIF_TERM val1, ERL_NIF_TERM val2);
+
+extern
+ERL_NIF_TERM esock_make_error(ErlNifEnv* env, ERL_NIF_TERM reason);
+extern
+ERL_NIF_TERM esock_make_error_str(ErlNifEnv* env, char* reason);
+extern
+ERL_NIF_TERM esock_make_error_errno(ErlNifEnv* env, int err);
+
+extern
+void esock_warning_msg(const char* format, ... );
+
+
+#endif // SOCKET_UTIL_H__
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index d413659f81..80e8030d74 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -44,7 +44,7 @@
#include "erl_time.h"
#if 0
-#define DEBUG_PRINT(FMT, ...) erts_printf(FMT "\r\n", ##__VA_ARGS__)
+#define DEBUG_PRINT(FMT, ...) do { erts_printf(FMT "\r\n", ##__VA_ARGS__); fflush(stdout); } while(0)
#define DEBUG_PRINT_FD(FMT, STATE, ...) \
DEBUG_PRINT("%d: " FMT " (ev=%s, ac=%s, flg=%s)", \
(STATE) ? (STATE)->fd : (ErtsSysFdType)-1, ##__VA_ARGS__, \
@@ -1061,7 +1061,7 @@ enif_select_x(ErlNifEnv* env,
ErtsDrvSelectDataState *free_select = NULL;
ErtsNifSelectDataState *free_nif = NULL;
- ASSERT(!resource->monitors);
+ ASSERT(!erts_dbg_is_resource_dying(resource));
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
if (!grow_drv_ev_state(fd)) {
@@ -1181,6 +1181,7 @@ enif_select_x(ErlNifEnv* env,
if (on) {
const Eterm recipient = pid ? pid->pid : env->proc->common.id;
+ ASSERT(is_internal_pid(recipient));
if (!state->driver.nif)
state->driver.nif = alloc_nif_select_data();
if (state->type == ERTS_EV_TYPE_NONE) {
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
index e1ff0fe80a..3085bf7e19 100644
--- a/erts/emulator/sys/common/erl_mmap.h
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -203,7 +203,7 @@ ERTS_GLB_INLINE void erts_mem_discard(void *p, UWord size);
data[i] = pattern[i % sizeof(pattern)];
}
}
-#elif defined(HAVE_SYS_MMAN_H)
+#elif defined(HAVE_SYS_MMAN_H) && !(defined(__sun) || defined(__sun__))
#include <sys/mman.h>
ERTS_GLB_INLINE void erts_mem_discard(void *ptr, UWord size) {
diff --git a/erts/emulator/sys/common/erl_osenv.c b/erts/emulator/sys/common/erl_osenv.c
index 6a16377736..f055c5f854 100644
--- a/erts/emulator/sys/common/erl_osenv.c
+++ b/erts/emulator/sys/common/erl_osenv.c
@@ -167,9 +167,10 @@ void erts_osenv_init(erts_osenv_t *env) {
env->tree = NULL;
}
-static void destroy_foreach(env_rbtnode_t *node, void *_state) {
+static int destroy_foreach(env_rbtnode_t *node, void *_state, Sint reds) {
erts_free(ERTS_ALC_T_ENVIRONMENT, node);
(void)_state;
+ return 1;
}
void erts_osenv_clear(erts_osenv_t *env) {
@@ -182,7 +183,7 @@ struct __env_merge {
erts_osenv_t *env;
};
-static void merge_foreach(env_rbtnode_t *node, void *_state) {
+static int merge_foreach(env_rbtnode_t *node, void *_state, Sint reds) {
struct __env_merge *state = (struct __env_merge*)(_state);
env_rbtnode_t *existing_node;
@@ -191,6 +192,7 @@ static void merge_foreach(env_rbtnode_t *node, void *_state) {
if(existing_node == NULL || state->overwrite_existing) {
erts_osenv_put_native(state->env, &node->key, &node->value);
}
+ return 1;
}
void erts_osenv_merge(erts_osenv_t *env, const erts_osenv_t *with, int overwrite) {
@@ -208,7 +210,7 @@ struct __env_foreach_term {
void *user_state;
};
-static void foreach_term_wrapper(env_rbtnode_t *node, void *_state) {
+static int foreach_term_wrapper(env_rbtnode_t *node, void *_state, Sint reds) {
struct __env_foreach_term *state = (struct __env_foreach_term*)_state;
Eterm key, value;
@@ -218,6 +220,7 @@ static void foreach_term_wrapper(env_rbtnode_t *node, void *_state) {
node->value.length, (byte*)node->value.data);
state->user_callback(state->process, state->user_state, key, value);
+ return 1;
}
void erts_osenv_foreach_term(const erts_osenv_t *env, struct process *process,
@@ -314,10 +317,11 @@ struct __env_foreach_native {
void *user_state;
};
-static void foreach_native_wrapper(env_rbtnode_t *node, void *_state) {
+static int foreach_native_wrapper(env_rbtnode_t *node, void *_state, Sint reds) {
struct __env_foreach_native *state = (struct __env_foreach_native*)_state;
state->user_callback(state->user_state, &node->key, &node->value);
+ return 1;
}
void erts_osenv_foreach_native(const erts_osenv_t *env, void *state,
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index 27ffba58bd..c71d23f58c 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -872,8 +872,8 @@ update_pollset(ErtsPollSet *ps, int fd, ErtsPollOp op, ErtsPollEvents events)
}
}
-#if defined(EV_DISPATCH) && !defined(__OpenBSD__)
- /* If we have EV_DISPATCH we use it, unless we are on OpenBSD as the
+#if defined(EV_DISPATCH) && !(defined(__OpenBSD__) || defined(__NetBSD__))
+ /* If we have EV_DISPATCH we use it, unless we are on OpenBSD/NetBSD as the
behavior of EV_EOF seems to be edge triggered there and we need it
to be level triggered.
diff --git a/erts/emulator/sys/unix/sys_drivers.c b/erts/emulator/sys/unix/sys_drivers.c
index 2f5459bee5..042a091db1 100644
--- a/erts/emulator/sys/unix/sys_drivers.c
+++ b/erts/emulator/sys/unix/sys_drivers.c
@@ -732,7 +732,8 @@ static ErlDrvData spawn_start(ErlDrvPort port_num, char* name,
proto->u.start.fds[1] = ifd[1];
proto->u.start.fds[2] = stderrfd;
proto->u.start.port_id = opts->exit_status ? erts_drvport2id(port_num) : THE_NON_VALUE;
- if (erl_drv_port_control(forker_port, 'S', (char*)proto, sizeof(*proto))) {
+ if (erl_drv_port_control(forker_port, ERTS_FORKER_DRV_CONTROL_MAGIC_NUMBER,
+ (char*)proto, sizeof(*proto))) {
/* The forker port has been killed, we close both fd's which will
make open_port throw an epipe error */
close(ofd[0]);
@@ -759,6 +760,9 @@ static ErlDrvSSizeT spawn_control(ErlDrvData e, unsigned int cmd, char *buf,
ErtsSysDriverData *dd = (ErtsSysDriverData*)e;
ErtsSysForkerProto *proto = (ErtsSysForkerProto *)buf;
+ if (cmd != ERTS_SPAWN_DRV_CONTROL_MAGIC_NUMBER)
+ return -1;
+
ASSERT(len == sizeof(*proto));
ASSERT(proto->action == ErtsSysForkerProtoAction_SigChld);
@@ -799,6 +803,8 @@ static ErlDrvSSizeT fd_control(ErlDrvData drv_data,
{
int fd = (int)(long)drv_data;
char resbuff[2*sizeof(Uint32)];
+
+ command -= ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER;
switch (command) {
case FD_CTRL_OP_GET_WINSIZE:
{
@@ -810,7 +816,7 @@ static ErlDrvSSizeT fd_control(ErlDrvData drv_data,
}
break;
default:
- return 0;
+ return -1;
}
if (rlen < 2*sizeof(Uint32)) {
*rbuf = driver_alloc(2*sizeof(Uint32));
@@ -1693,7 +1699,8 @@ static void forker_sigchld(Eterm port_id, int error)
already used by the spawn_driver, we use control instead.
Note that when using erl_drv_port_control it is an asynchronous
control. */
- erl_drv_port_control(port_id, 'S', (char*)proto, sizeof(*proto));
+ erl_drv_port_control(port_id, ERTS_SPAWN_DRV_CONTROL_MAGIC_NUMBER,
+ (char*)proto, sizeof(*proto));
}
static void forker_ready_input(ErlDrvData e, ErlDrvEvent fd)
@@ -1778,6 +1785,9 @@ static ErlDrvSSizeT forker_control(ErlDrvData e, unsigned int cmd, char *buf,
ErlDrvPort port_num = (ErlDrvPort)e;
int res;
+ if (cmd != ERTS_FORKER_DRV_CONTROL_MAGIC_NUMBER)
+ return -1;
+
if (first_call) {
/*
* Do driver_select here when schedulers and their pollsets have started.
diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile
index b66cc1b2a3..8c2054cb51 100644
--- a/erts/emulator/test/Makefile
+++ b/erts/emulator/test/Makefile
@@ -28,6 +28,24 @@ EBIN = .
# Target Specs
# ----------------------------------------------------
+SOCKET_MODULES = \
+ socket_test_lib \
+ socket_test_logger \
+ socket_test_evaluator \
+ socket_test_ttest_lib \
+ socket_test_ttest_tcp_gen \
+ socket_test_ttest_tcp_socket \
+ socket_test_ttest_tcp_client \
+ socket_test_ttest_tcp_client_gen \
+ socket_test_ttest_tcp_client_socket \
+ socket_test_ttest_tcp_server \
+ socket_test_ttest_tcp_server_gen \
+ socket_test_ttest_tcp_server_socket \
+ socket_SUITE
+
+NET_MODULES = \
+ net_SUITE
+
MODULES= \
a_SUITE \
after_SUITE \
@@ -84,6 +102,7 @@ MODULES= \
monitor_SUITE \
multi_load_SUITE \
nested_SUITE \
+ $(NET_MODULES) \
nif_SUITE \
node_container_SUITE \
nofrag_SUITE \
@@ -106,6 +125,7 @@ MODULES= \
sensitive_SUITE \
signal_SUITE \
smoke_test_SUITE \
+ $(SOCKET_MODULES) \
statistics_SUITE \
system_info_SUITE \
system_profile_SUITE \
@@ -153,8 +173,14 @@ NATIVE_MODULES= $(NATIVE:%=%_native_SUITE)
NATIVE_ERL_FILES= $(NATIVE_MODULES:%=%.erl)
ERL_FILES= $(MODULES:%=%.erl)
+HRL_FILES= \
+ socket_test_evaluator.hrl \
+ socket_test_ttest.hrl \
+ socket_test_ttest_client.hrl
TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+NET_TARGETS = $(NET_MODULES:%=$(EBIN)/%.$(EMULATOR))
+SOCKET_TARGETS = $(SOCKET_MODULES:%=$(EBIN)/%.$(EMULATOR))
EMAKEFILE=Emakefile
@@ -201,6 +227,10 @@ clean:
docs:
+targets: $(TARGET_FILES)
+socket_targets: $(SOCKET_TARGETS)
+net_targets: $(NET_TARGETS)
+
# ----------------------------------------------------
# Special targets
# ----------------------------------------------------
@@ -221,7 +251,7 @@ release_spec:
release_tests_spec: make_emakefile
$(INSTALL_DIR) "$(RELSYSDIR)"
$(INSTALL_DATA) $(EMAKEFILE) $(TEST_SPEC_FILES) \
- $(ERL_FILES) "$(RELSYSDIR)"
+ $(ERL_FILES) $(HRL_FILES) "$(RELSYSDIR)"
$(INSTALL_DATA) $(NO_OPT_ERL_FILES) "$(RELSYSDIR)"
$(INSTALL_DATA) $(NATIVE_ERL_FILES) "$(RELSYSDIR)"
chmod -R u+w "$(RELSYSDIR)"
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 23c675733c..1406ddc9dc 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -40,6 +40,7 @@
%%
-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
@@ -50,6 +51,14 @@
terms/1, terms_float/1, float_middle_endian/1,
b2t_used_big/1,
external_size/1, t_iolist_size/1,
+ t_iolist_size_huge_list/1,
+ t_iolist_size_huge_bad_arg_list/1,
+ t_iolist_size_shallow_trapping/1,
+ t_iolist_size_shallow_short_lists/1,
+ t_iolist_size_shallow_tiny_lists/1,
+ t_iolist_size_deep_trapping/1,
+ t_iolist_size_deep_short_lists/1,
+ t_iolist_size_deep_tiny_lists/1,
t_hash/1,
bad_size/1,
bad_term_to_binary/1,
@@ -75,6 +84,9 @@ all() ->
t_split_binary, bad_split,
bad_list_to_binary, bad_binary_to_list, terms,
terms_float, float_middle_endian, external_size, t_iolist_size,
+ t_iolist_size_huge_list,
+ t_iolist_size_huge_bad_arg_list,
+ {group, iolist_size_benchmarks},
b2t_used_big,
bad_binary_to_term_2, safe_binary_to_term2,
bad_binary_to_term, bad_terms, t_hash, bad_size,
@@ -86,13 +98,36 @@ all() ->
error_after_yield, cmp_old_impl].
groups() ->
- [].
+ [
+ {
+ iolist_size_benchmarks,
+ [],
+ [t_iolist_size_shallow_trapping,
+ t_iolist_size_shallow_short_lists,
+ t_iolist_size_shallow_tiny_lists,
+ t_iolist_size_deep_trapping,
+ t_iolist_size_deep_short_lists,
+ t_iolist_size_deep_tiny_lists
+ ]
+ }
+ ].
init_per_suite(Config) ->
+ A0 = case application:start(sasl) of
+ ok -> [sasl];
+ _ -> []
+ end,
+ A = case application:start(os_mon) of
+ ok -> [os_mon|A0];
+ _ -> A0
+ end,
+ [{started_apps, A}|Config].
+
+end_per_suite(Config) ->
+ As = proplists:get_value(started_apps, Config),
+ lists:foreach(fun (A) -> application:stop(A) end, As),
Config.
-end_per_suite(_Config) ->
- ok.
init_per_group(_GroupName, Config) ->
Config.
@@ -615,6 +650,143 @@ build_iolist(N0, Base) ->
[47,L,L|Seq]
end.
+approx_4GB_bin() ->
+ Bin = lists:duplicate(4194304, 255),
+ BinRet = erlang:iolist_to_binary(lists:duplicate(1124, Bin)),
+ BinRet.
+
+duplicate_iolist(IOList, 0) ->
+ IOList;
+duplicate_iolist(IOList, NrOfTimes) ->
+ duplicate_iolist([IOList, IOList], NrOfTimes - 1).
+
+t_iolist_size_huge_list(Config) when is_list(Config) ->
+ run_when_enough_resources(
+ fun() ->
+ {TimeToCreateIOList, IOList} = timer:tc(fun()->duplicate_iolist(approx_4GB_bin(), 32) end),
+ {IOListSizeTime, CalculatedSize} = timer:tc(fun()->erlang:iolist_size(IOList) end),
+ 20248183924657750016 = CalculatedSize,
+ {comment, io_lib:format("Time to create iolist: ~f s. Time to calculate size: ~f s.",
+ [TimeToCreateIOList / 1000000, IOListSizeTime / 1000000])}
+ end).
+
+t_iolist_size_huge_bad_arg_list(Config) when is_list(Config) ->
+ run_when_enough_resources(
+ fun() ->
+ P = self(),
+ spawn_link(fun()-> IOListTmp = duplicate_iolist(approx_4GB_bin(), 32),
+ IOList = [IOListTmp, [badarg]],
+ {'EXIT',{badarg,_}} = (catch erlang:iolist_size(IOList)),
+ P ! ok
+ end),
+ receive ok -> ok end
+ end).
+
+%% iolist_size tests for shallow lists
+
+t_iolist_size_shallow_trapping(Config) when is_list(Config) ->
+ Lengths = [2000, 20000, 200000, 200000, 2000000, 20000000],
+ run_iolist_size_test_and_benchmark(Lengths, fun make_shallow_iolist/2).
+
+t_iolist_size_shallow_short_lists(Config) when is_list(Config) ->
+ Lengths = lists:duplicate(15000, 300),
+ run_iolist_size_test_and_benchmark(Lengths, fun make_shallow_iolist/2).
+
+t_iolist_size_shallow_tiny_lists(Config) when is_list(Config) ->
+ Lengths = lists:duplicate(250000, 18),
+ run_iolist_size_test_and_benchmark(Lengths, fun make_shallow_iolist/2).
+
+make_shallow_iolist(SizeDiv2, LastItem) ->
+ lists:map(
+ fun(I) ->
+ case I of
+ SizeDiv2 -> [1, LastItem];
+ _ -> [1, 1]
+ end
+ end,
+ lists:seq(1, SizeDiv2)).
+
+%% iolist_size tests for deep lists
+
+t_iolist_size_deep_trapping(Config) when is_list(Config) ->
+ Lengths = [2000, 20000, 200000, 200000, 2000000, 10000000],
+ run_iolist_size_test_and_benchmark(Lengths, fun make_deep_iolist/2).
+
+t_iolist_size_deep_short_lists(Config) when is_list(Config) ->
+ Lengths = lists:duplicate(10000, 300),
+ run_iolist_size_test_and_benchmark(Lengths, fun make_deep_iolist/2).
+
+t_iolist_size_deep_tiny_lists(Config) when is_list(Config) ->
+ Lengths = lists:duplicate(150000, 18),
+ run_iolist_size_test_and_benchmark(Lengths, fun make_deep_iolist/2).
+
+make_deep_iolist(1, LastItem) ->
+ [1, LastItem];
+make_deep_iolist(Depth, LastItem) ->
+ [[1, 1], make_deep_iolist(Depth - 1, LastItem)].
+
+% Helper functions for iolist_size tests
+
+run_iolist_size_test_and_benchmark(Lengths, ListGenerator) ->
+ run_when_enough_resources(
+ fun() ->
+ GoodListsWithSizes =
+ lists:map(fun(Length) -> {Length*2, ListGenerator(Length, 1)} end, Lengths),
+ BadListsWithSizes =
+ lists:map(fun(Length) -> {Length*2, ListGenerator(Length, bad)} end, Lengths),
+ erlang:garbage_collect(),
+ report_throughput(
+ fun() ->
+ lists:foreach(
+ fun(_)->
+ lists:foreach(
+ fun({Size, List}) -> Size = iolist_size(List) end,
+ GoodListsWithSizes),
+ lists:foreach(
+ fun({_, List}) -> {'EXIT',_} = (catch (iolist_size(List))) end,
+ BadListsWithSizes)
+ end,
+ lists:seq(1,3))
+ end,
+ lists:sum(Lengths)*4)
+ end).
+
+report_throughput(Fun, NrOfItems) ->
+ Parent = self(),
+ spawn(fun() -> Parent ! timer:tc(Fun) end),
+ {Time, _} = receive D -> D end,
+ ItemsPerMicrosecond = NrOfItems / Time,
+ ct_event:notify(#event{ name = benchmark_data, data = [{value, ItemsPerMicrosecond}]}),
+ {comment, io_lib:format("Items per microsecond: ~p, Nr of items: ~p, Benchmark time: ~p seconds)",
+ [ItemsPerMicrosecond, NrOfItems, Time/1000000])}.
+
+total_memory() ->
+ %% Total memory in GB.
+ try
+ MemoryData = memsup:get_system_memory_data(),
+ case lists:keysearch(total_memory, 1, MemoryData) of
+ {value, {total_memory, TM}} ->
+ TM div (1024*1024*1024);
+ false ->
+ {value, {system_total_memory, STM}} =
+ lists:keysearch(system_total_memory, 1, MemoryData),
+ STM div (1024*1024*1024)
+ end
+ catch
+ _ : _ ->
+ undefined
+ end.
+
+run_when_enough_resources(Fun) ->
+ case {total_memory(), erlang:system_info(wordsize)} of
+ {Mem, 8} when is_integer(Mem) andalso Mem >= 15 ->
+ Fun();
+ {Mem, WordSize} ->
+ {skipped,
+ io_lib:format("Not enough resources (System Memory >= ~p, Word Size = ~p)",
+ [Mem, WordSize])}
+ end.
+
%% OTP-4053
bad_binary_to_term_2(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index 885c66331c..4f70b51aa0 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -62,7 +62,12 @@
bad_dist_ext_control/1,
bad_dist_ext_connection_id/1,
bad_dist_ext_size/1,
- start_epmd_false/1, epmd_module/1]).
+ start_epmd_false/1, epmd_module/1,
+ bad_dist_fragments/1,
+ message_latency_large_message/1,
+ message_latency_large_link_exit/1,
+ message_latency_large_monitor_exit/1,
+ message_latency_large_exit2/1]).
%% Internal exports.
-export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0,
@@ -90,7 +95,8 @@ all() ->
dist_parallel_send, atom_roundtrip, unicode_atom_roundtrip,
atom_roundtrip_r16b,
contended_atom_cache_entry, contended_unicode_atom_cache_entry,
- bad_dist_structure, {group, bad_dist_ext},
+ {group, message_latency},
+ {group, bad_dist}, {group, bad_dist_ext},
start_epmd_false, epmd_module].
groups() ->
@@ -100,10 +106,18 @@ groups() ->
{trap_bif, [], [trap_bif_1, trap_bif_2, trap_bif_3]},
{dist_auto_connect, [],
[dist_auto_connect_never, dist_auto_connect_once]},
+ {bad_dist, [],
+ [bad_dist_structure, bad_dist_fragments]},
{bad_dist_ext, [],
[bad_dist_ext_receive, bad_dist_ext_process_info,
bad_dist_ext_size,
- bad_dist_ext_control, bad_dist_ext_connection_id]}].
+ bad_dist_ext_control, bad_dist_ext_connection_id]},
+ {message_latency, [],
+ [message_latency_large_message,
+ message_latency_large_link_exit,
+ message_latency_large_monitor_exit,
+ message_latency_large_exit2]}
+ ].
%% Tests pinging a node in different ways.
ping(Config) when is_list(Config) ->
@@ -568,10 +582,20 @@ do_busy_test(Node, Fun) ->
%% Don't match arity; it is different in debug and
%% optimized emulator
[{status, suspended},
- {current_function, {erlang, bif_return_trap, _}}] = Pinfo,
+ {current_function, {Mod, Func, _}}] = Pinfo,
+ if
+ Mod =:= erlang andalso Func =:= bif_return_trap ->
+ true;
+ Mod =:= erts_internal andalso Func =:= dsend_continue_trap ->
+ true;
+ true ->
+ ct:fail({incorrect, pinfo, Pinfo})
+ end,
receive
{'DOWN', M, process, P, Reason} ->
io:format("~p died with exit reason ~p~n", [P, Reason]),
+ verify_nc(node()),
+ verify_nc(Node),
normal = Reason
end
end.
@@ -931,7 +955,9 @@ dist_auto_connect_never(Config) when is_list(Config) ->
ok;
{do_dist_auto_connect, Error} ->
{error, Error};
- Other ->
+ %% The io:formats in dos_dist_auto_connect will
+ %% generate port output messages that are ok
+ Other when not is_port(element(1, Other))->
{error, Other}
after 32000 ->
timeout
@@ -1364,6 +1390,131 @@ get_conflicting_unicode_atoms(CIX, N) ->
get_conflicting_unicode_atoms(CIX, N)
end.
+
+%% The message_latency_large tests that small distribution messages are
+%% not blocked by other large distribution messages. Basically it tests
+%% that fragmentation of distribution messages works.
+message_latency_large_message(Config) when is_list(Config) ->
+ measure_latency_large_message(?FUNCTION_NAME, fun(Dropper, Payload) -> Dropper ! Payload end).
+
+message_latency_large_exit2(Config) when is_list(Config) ->
+ measure_latency_large_message(?FUNCTION_NAME, fun erlang:exit/2).
+
+message_latency_large_link_exit(Config) when is_list(Config) ->
+ message_latency_large_exit(?FUNCTION_NAME, fun erlang:link/1).
+
+message_latency_large_monitor_exit(Config) when is_list(Config) ->
+ message_latency_large_exit(?FUNCTION_NAME, fun(Dropper) ->
+ Dropper ! {monitor, self()},
+ receive ok -> ok end
+ end).
+
+message_latency_large_exit(Nodename, ReasonFun) ->
+ measure_latency_large_message(
+ Nodename,
+ fun(Dropper, Payload) ->
+ Pid = spawn(fun() ->
+ receive go -> ok end,
+ ReasonFun(Dropper),
+ exit(Payload)
+ end),
+
+ FlushTrace = fun F() ->
+ receive
+ {trace, Pid, _, _} = M ->
+ F()
+ after 0 ->
+ ok
+ end
+ end,
+
+ erlang:trace(Pid, true, [exiting]),
+ Pid ! go,
+ receive
+ {trace, Pid, out_exited, 0} ->
+ FlushTrace()
+ end
+ end).
+
+measure_latency_large_message(Nodename, DataFun) ->
+
+ erlang:system_monitor(self(), [busy_dist_port]),
+
+ {ok, N} = start_node(Nodename),
+
+ Dropper = spawn(N, fun F() ->
+ process_flag(trap_exit, true),
+ receive
+ {monitor,Pid} ->
+ erlang:monitor(process, Pid),
+ Pid ! ok;
+ _ -> ok
+ end,
+ F()
+ end),
+
+ Echo = spawn(N, fun F() -> receive {From, Msg} -> From ! Msg, F() end end),
+
+ %% Test 32 MB and 320 MB and test the latency difference of sent messages
+ Payloads = [{I, <<0:(I * 32 * 1024 * 1024 * 8)>>} || I <- [1,10]],
+
+ IndexTimes = [{I, measure_latency(DataFun, Dropper, Echo, P)}
+ || {I, P} <- Payloads],
+
+ Times = [ Time || {_I, Time} <- IndexTimes],
+
+ ct:pal("~p",[IndexTimes]),
+
+ case {lists:max(Times), lists:min(Times)} of
+ {Max, Min} when Max * 0.25 > Min ->
+ ct:fail({incorrect_latency, IndexTimes});
+ _ ->
+ ok
+ end.
+
+measure_latency(DataFun, Dropper, Echo, Payload) ->
+
+ flush(),
+
+ Senders = [spawn_monitor(
+ fun F() ->
+ DataFun(Dropper, Payload),
+ receive
+ die -> ok
+ after 0 ->
+ F()
+ end
+ end) || _ <- lists:seq(1,2)],
+
+ [receive
+ {monitor, _Sender, busy_dist_port, _Info} = M ->
+ ok
+ end || _ <- lists:seq(1,10)],
+
+ {TS, _} =
+ timer:tc(fun() ->
+ [begin
+ Echo ! {self(), hello},
+ receive hello -> ok end
+ end || _ <- lists:seq(1,100)]
+ end),
+ [begin
+ Sender ! die,
+ receive
+ {'DOWN', Ref, process, _, _} ->
+ ok
+ end
+ end || {Sender, Ref} <- Senders],
+ TS.
+
+flush() ->
+ receive
+ _ ->
+ flush()
+ after 0 ->
+ ok
+ end.
+
-define(COOKIE, '').
-define(DOP_LINK, 1).
-define(DOP_SEND, 2).
@@ -1382,6 +1533,15 @@ get_conflicting_unicode_atoms(CIX, N) ->
-define(DOP_DEMONITOR_P, 20).
-define(DOP_MONITOR_P_EXIT, 21).
+-define(DOP_SEND_SENDER, 22).
+-define(DOP_SEND_SENDER_TT, 23).
+
+-define(DOP_PAYLOAD_EXIT, 24).
+-define(DOP_PAYLOAD_EXIT_TT, 25).
+-define(DOP_PAYLOAD_EXIT2, 26).
+-define(DOP_PAYLOAD_EXIT2_TT, 27).
+-define(DOP_PAYLOAD_MONITOR_P_EXIT, 28).
+
start_monitor(Offender,P) ->
Parent = self(),
Q = spawn(Offender,
@@ -1515,7 +1675,145 @@ bad_dist_structure(Config) when is_list(Config) ->
stop_node(Victim),
ok.
+%% Test various dist fragmentation errors
+bad_dist_fragments(Config) when is_list(Config) ->
+ ct:timetrap({seconds, 15}),
+
+ {ok, Offender} = start_node(bad_dist_fragment_offender),
+ {ok, Victim} = start_node(bad_dist_fragment_victim),
+
+ Msg = iolist_to_binary(dmsg_ext(lists:duplicate(255,255))),
+
+ start_node_monitors([Offender,Victim]),
+ Parent = self(),
+ P = spawn(Victim,
+ fun () ->
+ process_flag(trap_exit,true),
+ Parent ! {self(), started},
+ receive check_msgs -> ok end,
+ bad_dist_struct_check_msgs([one,
+ two]),
+ Parent ! {self(), messages_checked},
+ receive done -> ok end
+ end),
+ receive {P, started} -> ok end,
+ pong = rpc:call(Victim, net_adm, ping, [Offender]),
+ verify_up(Offender, Victim),
+ true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])),
+ start_monitor(Offender,P),
+ P ! one,
+
+ start_monitor(Offender,P),
+ send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P},3,
+ [{frg, 1, binary:part(Msg, 10,byte_size(Msg)-10)}]),
+ start_monitor(Offender,P),
+ send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P},3,
+ [{hdr, 3, binary:part(Msg, 0,10)},
+ {frg, 1, binary:part(Msg, 10,byte_size(Msg)-10)}]),
+
+ start_monitor(Offender,P),
+ send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P},3,
+ [{hdr, 3, binary:part(Msg, 0,10)},
+ {hdr, 3, binary:part(Msg, 0,10)}]),
+
+ start_monitor(Offender,P),
+ send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P,broken},3,
+ [{hdr, 1, binary:part(Msg, 10,byte_size(Msg)-10)}]),
+
+ start_monitor(Offender,P),
+ send_bad_fragments(Offender, Victim, P,{?DOP_SEND,?COOKIE,P},3,
+ [{hdr, 3, binary:part(Msg, 10,byte_size(Msg)-10)},
+ close]),
+
+ start_monitor(Offender,P),
+ ExitVictim = spawn(Victim, fun() -> receive ok -> ok end end),
+ send_bad_fragments(Offender, Victim, P,{?DOP_PAYLOAD_EXIT,P,ExitVictim},2,
+ [{hdr, 1, [131]}]),
+
+ start_monitor(Offender,P),
+ Exit2Victim = spawn(Victim, fun() -> receive ok -> ok end end),
+ send_bad_fragments(Offender, Victim, P,{?DOP_PAYLOAD_EXIT2,P,ExitVictim},2,
+ [{hdr, 1, [132]}]),
+
+ start_monitor(Offender,P),
+ DownVictim = spawn(Victim, fun() -> receive ok -> ok end end),
+ DownRef = erlang:monitor(process, DownVictim),
+ send_bad_fragments(Offender, Victim, P,{?DOP_PAYLOAD_MONITOR_P_EXIT,P,DownVictim,DownRef},2,
+ [{hdr, 1, [133]}]),
+
+ P ! two,
+ P ! check_msgs,
+ receive
+ {P, messages_checked} -> ok
+ after 5000 ->
+ exit(victim_is_dead)
+ end,
+
+ {message_queue_len, 0}
+ = rpc:call(Victim, erlang, process_info, [P, message_queue_len]),
+
+ unlink(P),
+ P ! done,
+ stop_node(Offender),
+ stop_node(Victim),
+ ok.
+
+dmsg_frag_hdr(Frag) ->
+ dmsg_frag_hdr(erlang:phash2(self()), Frag).
+dmsg_frag_hdr(Seq, Frag) ->
+ [131, $E, uint64_be(Seq), uint64_be(Frag), 0].
+
+dmsg_frag(Frag) ->
+ dmsg_frag(erlang:phash2(self()), Frag).
+dmsg_frag(Seq, Frag) ->
+ [131, $F, uint64_be(Seq), uint64_be(Frag)].
+
+send_bad_fragments(Offender,VictimNode,Victim,Ctrl,WhereToPutSelf,Fragments) ->
+ Parent = self(),
+ Done = make_ref(),
+ ct:pal("Send: ~p",[Fragments]),
+ spawn_link(Offender,
+ fun () ->
+ Node = node(Victim),
+ pong = net_adm:ping(Node),
+ erlang:monitor_node(Node, true),
+ DCtrl = dctrl(Node),
+ Ctrl1 = case WhereToPutSelf of
+ 0 ->
+ Ctrl;
+ N when N > 0 ->
+ setelement(N,Ctrl,self())
+ end,
+
+ FragData = [case Type of
+ hdr ->
+ [dmsg_frag_hdr(FragId),
+ dmsg_ext(Ctrl1), FragPayload];
+ frg ->
+ [dmsg_frag(FragId), FragPayload]
+ end || {Type, FragId, FragPayload} <- Fragments],
+
+ receive {nodedown, Node} -> exit("premature nodedown")
+ after 10 -> ok
+ end,
+
+ [ dctrl_send(DCtrl, D) || D <- FragData ],
+ [ erlang:port_close(DCtrl) || close <- Fragments],
+
+ receive {nodedown, Node} -> ok
+ after 5000 -> exit("missing nodedown")
+ end,
+ Parent ! {FragData,Done}
+ end),
+ receive
+ {WhatSent,Done} ->
+ io:format("Offender sent ~p~n",[WhatSent]),
+ verify_nc(VictimNode),
+ ok
+ after 7000 ->
+ exit(unable_to_send)
+ end.
bad_dist_ext_receive(Config) when is_list(Config) ->
{ok, Offender} = start_node(bad_dist_ext_receive_offender),
@@ -2124,8 +2422,25 @@ start_node(Config, Args, Rel) when is_list(Config), is_list(Rel) ->
start_node(Name, Args, Rel).
stop_node(Node) ->
+ verify_nc(Node),
test_server:stop_node(Node).
+verify_nc(Node) ->
+ P = self(),
+ Ref = make_ref(),
+ spawn(Node,
+ fun() ->
+ R = erts_test_utils:check_node_dist(fun(E) -> E end),
+ P ! {Ref, R}
+ end),
+ receive
+ {Ref, ok} ->
+ ok;
+ {Ref, Error} ->
+ ct:log("~s",[Error]),
+ ct:fail(failed_nc_refc_check)
+ end.
+
freeze_node(Node, MS) ->
Own = 300,
DoingIt = make_ref(),
@@ -2485,6 +2800,17 @@ mk_ref({NodeNameExt, Creation}, Numbers) when is_integer(Creation),
exit({unexpected_binary_to_term_result, Other})
end.
+uint64_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 64 ->
+ [(Uint bsr 56) band 16#ff,
+ (Uint bsr 48) band 16#ff,
+ (Uint bsr 40) band 16#ff,
+ (Uint bsr 32) band 16#ff,
+ (Uint bsr 24) band 16#ff,
+ (Uint bsr 16) band 16#ff,
+ (Uint bsr 8) band 16#ff,
+ Uint band 16#ff];
+uint64_be(Uint) ->
+ exit({badarg, uint64_be, [Uint]}).
uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 ->
[(Uint bsr 24) band 16#ff,
diff --git a/erts/emulator/test/emulator_bench.spec b/erts/emulator/test/emulator_bench.spec
index f709d913b7..2a180b440c 100644
--- a/erts/emulator/test/emulator_bench.spec
+++ b/erts/emulator/test/emulator_bench.spec
@@ -1 +1,2 @@
{groups,"../emulator_test",estone_SUITE,[estone_bench]}.
+{groups,"../emulator_test",binary_SUITE,[iolist_size_benchmarks]}.
diff --git a/erts/emulator/test/erts_test_utils.erl b/erts/emulator/test/erts_test_utils.erl
index ac2f2435be..0c3ef3e0fc 100644
--- a/erts/emulator/test/erts_test_utils.erl
+++ b/erts/emulator/test/erts_test_utils.erl
@@ -27,6 +27,7 @@
-export([mk_ext_pid/3,
mk_ext_port/2,
mk_ext_ref/2,
+ available_internal_state/1,
check_node_dist/0, check_node_dist/1, check_node_dist/3]).
@@ -157,6 +158,21 @@ mk_ext_ref({NodeName, Creation}, Numbers) when is_list(NodeName),
end.
+available_internal_state(Bool) when Bool == true; Bool == false ->
+ case {Bool,
+ (catch erts_debug:get_internal_state(available_internal_state))} of
+ {true, true} ->
+ true;
+ {false, true} ->
+ erts_debug:set_internal_state(available_internal_state, false),
+ true;
+ {true, _} ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ false;
+ {false, _} ->
+ false
+ end.
+
%%
%% Check reference counters for node- and dist entries.
@@ -168,16 +184,21 @@ check_node_dist() ->
end).
check_node_dist(Fail) ->
+ AIS = available_internal_state(true),
+ [erlang:garbage_collect(P) || P <- erlang:processes()],
{{node_references, NodeRefs},
{dist_references, DistRefs}} =
erts_debug:get_internal_state(node_and_dist_references),
- check_node_dist(Fail, NodeRefs, DistRefs).
-
-
+ R = check_node_dist(Fail, NodeRefs, DistRefs),
+ available_internal_state(AIS),
+ R.
check_node_dist(Fail, NodeRefs, DistRefs) ->
- check_nd_refc({node(),erlang:system_info(creation)},
- NodeRefs, DistRefs, Fail).
+ AIS = available_internal_state(true),
+ R = check_nd_refc({node(),erlang:system_info(creation)},
+ NodeRefs, DistRefs, Fail),
+ available_internal_state(AIS),
+ R.
check_nd_refc({ThisNodeName, ThisCreation}, NodeRefs, DistRefs, Fail) ->
diff --git a/erts/emulator/test/esock_misc/socket_client.erl b/erts/emulator/test/esock_misc/socket_client.erl
new file mode 100644
index 0000000000..1c07e799b8
--- /dev/null
+++ b/erts/emulator/test/esock_misc/socket_client.erl
@@ -0,0 +1,538 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_client).
+
+-export([
+ start/1, start/2, start/5, start/6,
+ start_tcp/1, start_tcp/2, start_tcp/3,
+ start_tcp4/1, start_tcp4/2, start_tcp6/1, start_tcp6/2,
+ start_udp/1, start_udp/2, start_udp/3,
+ start_udp4/1, start_udp4/2, start_udp6/1, start_udp6/2
+ ]).
+
+-define(LIB, socket_lib).
+
+-record(client, {socket, verbose = true, msg = true, type, dest, msg_id = 1}).
+
+start(Port) ->
+ start(Port, 1).
+
+start(Port, Num) ->
+ start_tcp(Port, Num).
+
+start_tcp(Port) ->
+ start_tcp(Port, 1).
+
+start_tcp(Port, Num) ->
+ start_tcp4(Port, Num).
+
+start_tcp4(Port) ->
+ start_tcp4(Port, 1).
+
+start_tcp4(Port, Num) ->
+ start(inet, stream, tcp, Port, Num).
+
+start_tcp6(Port) ->
+ start_tcp6(Port, 1).
+
+start_tcp6(Port, Num) ->
+ start(inet6, stream, tcp, Port, Num).
+
+start_tcp(Addr, Port, Num) when (size(Addr) =:= 4) andalso
+ is_integer(Num) andalso
+ (Num > 0) ->
+ start(inet, stream, tcp, Addr, Port, Num);
+start_tcp(Addr, Port, Num) when (size(Addr) =:= 8) andalso
+ is_integer(Num) andalso
+ (Num > 0) ->
+ start(inet6, stream, tcp, Addr, Port, Num).
+
+
+start_udp(Port) ->
+ start_udp(Port, 1).
+
+start_udp(Port, Num) ->
+ start_udp4(Port, Num).
+
+start_udp4(Port) ->
+ start_udp4(Port, 1).
+
+start_udp4(Port, Num) ->
+ start(inet, dgram, udp, Port, Num).
+
+start_udp6(Port) ->
+ start_udp6(Port, 1).
+
+start_udp6(Port, Num) ->
+ start(inet6, dgram, udp, Port, Num).
+
+start_udp(Addr, Port, Num) when (size(Addr) =:= 4) ->
+ start(inet, dgram, udp, Addr, Port, Num);
+start_udp(Addr, Port, Num) when (size(Addr) =:= 8) ->
+ start(inet6, dgram, udp, Addr, Port, Num).
+
+
+start(Domain, Type, Proto, Port, Num)
+ when is_integer(Port) andalso is_integer(Num) ->
+ start(Domain, Type, Proto, which_addr(Domain), Port, Num);
+
+start(Domain, Type, Proto, Addr, Port) ->
+ start(Domain, Type, Proto, Addr, Port, 1).
+
+start(Domain, Type, Proto, Addr, Port, 1 = Num) ->
+ start(Domain, Type, Proto, Addr, Port, Num, true);
+start(Domain, Type, Proto, Addr, Port, Num)
+ when is_integer(Num) andalso (Num > 1) ->
+ start(Domain, Type, Proto, Addr, Port, Num, false).
+
+start(Domain, Type, Proto, Addr, Port, Num, Verbose) ->
+ put(sname, "starter"),
+ Clients = start_clients(Num, Domain, Type, Proto, Addr, Port, Verbose),
+ await_clients(Clients).
+
+start_clients(Num, Domain, Type, Proto, Addr, Port, Verbose) ->
+ start_clients(Num, 1, Domain, Type, Proto, Addr, Port, Verbose, []).
+
+start_clients(Num, ID, Domain, Type, Proto, Addr, Port, Verbose, Acc)
+ when (Num > 0) ->
+ StartClient = fun() ->
+ start_client(ID, Domain, Type, Proto, Addr, Port, Verbose)
+ end,
+ {Pid, _} = spawn_monitor(StartClient),
+ ?LIB:sleep(500),
+ i("start client ~w", [ID]),
+ start_clients(Num-1, ID+1, Domain, Type, Proto, Addr, Port, Verbose, [Pid|Acc]);
+start_clients(_, _, _, _, _, _, _, _, Acc) ->
+ i("all client(s) started"),
+ lists:reverse(Acc).
+
+await_clients([]) ->
+ i("all clients done");
+await_clients(Clients) ->
+ receive
+ {'DOWN', _MRef, process, Pid, _Reason} ->
+ case lists:delete(Pid, Clients) of
+ Clients2 when (Clients2 =/= Clients) ->
+ i("client ~p done", [Pid]),
+ await_clients(Clients2);
+ _ ->
+ await_clients(Clients)
+ end
+ end.
+
+
+start_client(ID, Domain, Type, Proto, Addr, Port, Verbose) ->
+ put(sname, ?LIB:f("client[~w]", [ID])),
+ SA = #{family => Domain,
+ addr => Addr,
+ port => Port},
+ %% The way we use tos only works because we
+ %% send so few messages (a new value for every
+ %% message).
+ tos_init(),
+ do_start(Domain, Type, Proto, SA, Verbose).
+
+do_start(Domain, stream = Type, Proto, SA, Verbose) ->
+ try do_init(Domain, Type, Proto) of
+ Sock ->
+ connect(Sock, SA),
+ maybe_print_start_info(Verbose, Sock, Type),
+ %% Give the server some time...
+ ?LIB:sleep(5000),
+ %% ok = socket:close(Sock),
+ send_loop(#client{socket = Sock,
+ type = Type,
+ verbose = Verbose})
+ catch
+ throw:E ->
+ e("Failed initiate: "
+ "~n Error: ~p", [E])
+ end;
+do_start(Domain, dgram = Type, Proto, SA, Verbose) ->
+ try do_init(Domain, Type, Proto) of
+ Sock ->
+ maybe_print_start_info(Verbose, Sock, Type),
+ %% Give the server some time...
+ ?LIB:sleep(5000),
+ %% ok = socket:close(Sock),
+ send_loop(#client{socket = Sock,
+ type = Type,
+ dest = SA,
+ verbose = Verbose})
+ catch
+ throw:E ->
+ e("Failed initiate: "
+ "~n Error: ~p", [E])
+ end.
+
+maybe_print_start_info(true = _Verbose, Sock, stream = _Type) ->
+ {ok, Name} = socket:sockname(Sock),
+ {ok, Peer} = socket:peername(Sock),
+ {ok, Domain} = socket:getopt(Sock, socket, domain),
+ {ok, Type} = socket:getopt(Sock, socket, type),
+ {ok, Proto} = socket:getopt(Sock, socket, protocol),
+ {ok, OOBI} = socket:getopt(Sock, socket, oobinline),
+ {ok, SndBuf} = socket:getopt(Sock, socket, sndbuf),
+ {ok, RcvBuf} = socket:getopt(Sock, socket, rcvbuf),
+ {ok, Linger} = socket:getopt(Sock, socket, linger),
+ {ok, MTU} = socket:getopt(Sock, ip, mtu),
+ {ok, MTUDisc} = socket:getopt(Sock, ip, mtu_discover),
+ {ok, MALL} = socket:getopt(Sock, ip, multicast_all),
+ {ok, MIF} = socket:getopt(Sock, ip, multicast_if),
+ {ok, MLoop} = socket:getopt(Sock, ip, multicast_loop),
+ {ok, MTTL} = socket:getopt(Sock, ip, multicast_ttl),
+ {ok, RecvTOS} = socket:getopt(Sock, ip, recvtos),
+ i("connected: "
+ "~n From: ~p"
+ "~n To: ~p"
+ "~nwhen"
+ "~n (socket) Domain: ~p"
+ "~n (socket) Type: ~p"
+ "~n (socket) Protocol: ~p"
+ "~n (socket) OOBInline: ~p"
+ "~n (socket) SndBuf: ~p"
+ "~n (socket) RcvBuf: ~p"
+ "~n (socket) Linger: ~p"
+ "~n (ip) MTU: ~p"
+ "~n (ip) MTU Discovery: ~p"
+ "~n (ip) Multicast ALL: ~p"
+ "~n (ip) Multicast IF: ~p"
+ "~n (ip) Multicast Loop: ~p"
+ "~n (ip) Multicast TTL: ~p"
+ "~n (ip) RecvTOS: ~p"
+ "~n => wait some",
+ [Name, Peer,
+ Domain, Type, Proto,
+ OOBI, SndBuf, RcvBuf, Linger,
+ MTU, MTUDisc, MALL, MIF, MLoop, MTTL,
+ RecvTOS]);
+maybe_print_start_info(true = _Verbose, Sock, dgram = _Type) ->
+ {ok, Domain} = socket:getopt(Sock, socket, domain),
+ {ok, Type} = socket:getopt(Sock, socket, type),
+ {ok, Proto} = socket:getopt(Sock, socket, protocol),
+ {ok, OOBI} = socket:getopt(Sock, socket, oobinline),
+ {ok, SndBuf} = socket:getopt(Sock, socket, sndbuf),
+ {ok, RcvBuf} = socket:getopt(Sock, socket, rcvbuf),
+ {ok, Linger} = socket:getopt(Sock, socket, linger),
+ {ok, MALL} = socket:getopt(Sock, ip, multicast_all),
+ {ok, MIF} = socket:getopt(Sock, ip, multicast_if),
+ {ok, MLoop} = socket:getopt(Sock, ip, multicast_loop),
+ {ok, MTTL} = socket:getopt(Sock, ip, multicast_ttl),
+ {ok, RecvTOS} = socket:getopt(Sock, ip, recvtos),
+ {ok, RecvTTL} = socket:getopt(Sock, ip, recvttl),
+ i("initiated when: "
+ "~n (socket) Domain: ~p"
+ "~n (socket) Type: ~p"
+ "~n (socket) Protocol: ~p"
+ "~n (socket) OOBInline: ~p"
+ "~n (socket) SndBuf: ~p"
+ "~n (socket) RcvBuf: ~p"
+ "~n (socket) Linger: ~p"
+ "~n (ip) Multicast ALL: ~p"
+ "~n (ip) Multicast IF: ~p"
+ "~n (ip) Multicast Loop: ~p"
+ "~n (ip) Multicast TTL: ~p"
+ "~n (ip) RecvTOS: ~p"
+ "~n (ip) RecvTTL: ~p"
+ "~n => wait some",
+ [Domain, Type, Proto,
+ OOBI, SndBuf, RcvBuf, Linger,
+ MALL, MIF, MLoop, MTTL,
+ RecvTOS, RecvTTL]);
+maybe_print_start_info(_Verbose, _Sock, _Type) ->
+ ok.
+
+
+do_init(Domain, stream = Type, Proto) ->
+ i("try (socket) open"),
+ Sock = case socket:open(Domain, Type, Proto) of
+ {ok, S} ->
+ S;
+ {error, OReason} ->
+ throw({open, OReason})
+ end,
+ i("try (socket) bind"),
+ case socket:bind(Sock, any) of
+ {ok, _P} ->
+ ok = socket:setopt(Sock, socket, timestamp, true),
+ ok = socket:setopt(Sock, ip, tos, mincost),
+ ok = socket:setopt(Sock, ip, recvtos, true),
+ Sock;
+ {error, BReason} ->
+ throw({bind, BReason})
+ end;
+do_init(Domain, dgram = Type, Proto) ->
+ i("try (socket) open"),
+ Sock = case socket:open(Domain, Type, Proto) of
+ {ok, S} ->
+ S;
+ {error, OReason} ->
+ throw({open, OReason})
+ end,
+ case socket:bind(Sock, any) of
+ {ok, _} ->
+ ok = socket:setopt(Sock, socket, timestamp, true),
+ ok = socket:setopt(Sock, ip, tos, mincost),
+ ok = socket:setopt(Sock, ip, recvtos, true),
+ ok = socket:setopt(Sock, ip, recvttl, true),
+ Sock;
+ {error, BReason} ->
+ throw({bind, BReason})
+ end.
+
+
+which_addr(Domain) ->
+ Iflist = case inet:getifaddrs() of
+ {ok, IFL} ->
+ IFL;
+ {error, Reason} ->
+ throw({inet,getifaddrs,Reason})
+ end,
+ which_addr(Domain, Iflist).
+
+
+connect(Sock, SA) ->
+ i("try (socket) connect to:"
+ "~n ~p", [SA]),
+ case socket:connect(Sock, SA) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ e("connect failure: "
+ "~n ~p", [Reason]),
+ exit({connect, Reason})
+ end.
+
+
+send_loop(#client{msg_id = N} = C) when (N =< 10) ->
+ i("try send request ~w", [N]),
+ Req = ?LIB:enc_req_msg(N, "hejsan"),
+ case send(C, Req) of
+ ok ->
+ i("request ~w sent - now try read answer", [N]),
+ case recv(C) of
+ {ok, {Source, Msg}} ->
+ if
+ (C#client.verbose =:= true) ->
+ i("received ~w bytes of data~s",
+ [size(Msg), case Source of
+ undefined -> "";
+ _ -> ?LIB:f(" from:~n ~p", [Source])
+ end]);
+ true ->
+ i("received ~w bytes", [size(Msg)])
+ end,
+ case ?LIB:dec_msg(Msg) of
+ {reply, N, Reply} ->
+ if
+ (C#client.verbose =:= true) ->
+ i("received reply ~w: ~p", [N, Reply]);
+ true ->
+ i("received reply ~w", [N])
+ end,
+ ?LIB:sleep(500), % Just to spread it out a bit
+ send_loop(C#client{msg_id = N+1})
+ end;
+ {error, RReason} ->
+ e("Failed recv response for request ~w: "
+ "~n ~p", [N, RReason]),
+ exit({failed_recv, RReason})
+ end;
+ {error, SReason} ->
+ e("Failed send request ~w: "
+ "~n ~p", [N, SReason]),
+ exit({failed_send, SReason})
+ end;
+send_loop(Client) ->
+ sock_close(Client).
+
+sock_close(#client{socket = Sock, verbose = true}) ->
+ i("we are done - close the socket when: "
+ "~n ~p", [socket:info()]),
+ ok = socket:close(Sock),
+ i("we are done - socket closed when: "
+ "~n ~p", [socket:info()]);
+sock_close(#client{socket = Sock}) ->
+ i("we are done"),
+ ok = socket:close(Sock).
+
+
+
+send(#client{socket = Sock, type = stream}, Msg) ->
+ socket:send(Sock, Msg);
+send(#client{socket = Sock, type = dgram, dest = Dest}, Msg) ->
+ %% i("try send to: "
+ %% "~n ~p", [Dest]),
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ TOS = tos_next(),
+ ok = socket:setopt(Sock, ip, tos, TOS),
+ case socket:sendto(Sock, Msg, Dest) of
+ ok = OK ->
+ OK;
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+recv(#client{socket = Sock, type = stream, msg = false}) ->
+ case socket:recv(Sock) of
+ {ok, Msg} ->
+ {ok, {undefined, Msg}};
+ {error, _} = ERROR ->
+ ERROR
+ end;
+recv(#client{socket = Sock, verbose = Verbose, type = stream, msg = true}) ->
+ case socket:recvmsg(Sock) of
+ %% An iov of length 1 is an simplification...
+ {ok, #{addr := undefined = Source,
+ iov := [Msg],
+ ctrl := CMsgHdrs,
+ flags := Flags}} ->
+ if
+ (Verbose =:= true) ->
+ i("received message: "
+ "~n CMsgHdr: ~p"
+ "~n Flags: ~p", [CMsgHdrs, Flags]);
+ true ->
+ ok
+ end,
+ {ok, {Source, Msg}};
+ {error, _} = ERROR ->
+ ERROR
+ end;
+recv(#client{socket = Sock, type = dgram, msg = false}) ->
+ socket:recvfrom(Sock);
+recv(#client{socket = Sock, verbose = Verbose, type = dgram, msg = true}) ->
+ case socket:recvmsg(Sock) of
+ {ok, #{addr := Source,
+ iov := [Msg],
+ ctrl := CMsgHdrs,
+ flags := Flags}} ->
+ if
+ (Verbose =:= true) ->
+ i("received message: "
+ "~n CMsgHdr: ~p"
+ "~n Flags: ~p", [CMsgHdrs, Flags]);
+ true ->
+ ok
+ end,
+ {ok, {Source, Msg}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+
+which_addr(_Domain, []) ->
+ throw(no_address);
+which_addr(Domain, [{Name, IFO}|_IFL]) when (Name =/= "lo") ->
+ which_addr2(Domain, IFO);
+which_addr(Domain, [_|IFL]) ->
+ which_addr(Domain, IFL).
+
+which_addr2(inet = _Domain, [{addr, Addr}|_IFO]) when (size(Addr) =:= 4) ->
+ Addr;
+which_addr2(inet6 = _Domain, [{addr, Addr}|_IFO]) when (size(Addr) =:= 8) ->
+ Addr;
+which_addr2(Domain, [_|IFO]) ->
+ which_addr2(Domain, IFO).
+
+
+%% ---
+
+%% enc_req_msg(N, Data) ->
+%% enc_msg(?REQ, N, Data).
+
+%% enc_rep_msg(N, Data) ->
+%% enc_msg(?REP, N, Data).
+
+%% enc_msg(Type, N, Data) when is_list(Data) ->
+%% enc_msg(Type, N, list_to_binary(Data));
+%% enc_msg(Type, N, Data)
+%% when is_integer(Type) andalso is_integer(N) andalso is_binary(Data) ->
+%% <<Type:32/integer, N:32/integer, Data/binary>>.
+
+%% dec_msg(<<?REQ:32/integer, N:32/integer, Data/binary>>) ->
+%% {request, N, Data};
+%% dec_msg(<<?REP:32/integer, N:32/integer, Data/binary>>) ->
+%% {reply, N, Data}.
+
+
+%% ---
+
+%% sleep(T) ->
+%% receive after T -> ok end.
+
+
+%% ---
+
+%% formated_timestamp() ->
+%% format_timestamp(os:timestamp()).
+
+%% format_timestamp(Now) ->
+%% N2T = fun(N) -> calendar:now_to_local_time(N) end,
+%% format_timestamp(Now, N2T, true).
+
+%% format_timestamp({_N1, _N2, N3} = N, N2T, true) ->
+%% FormatExtra = ".~.2.0w",
+%% ArgsExtra = [N3 div 10000],
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra);
+%% format_timestamp({_N1, _N2, _N3} = N, N2T, false) ->
+%% FormatExtra = "",
+%% ArgsExtra = [],
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra).
+
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra) ->
+%% {Date, Time} = N2T(N),
+%% {YYYY,MM,DD} = Date,
+%% {Hour,Min,Sec} = Time,
+%% FormatDate =
+%% io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w" ++ FormatExtra,
+%% [YYYY, MM, DD, Hour, Min, Sec] ++ ArgsExtra),
+%% lists:flatten(FormatDate).
+
+
+%% ---
+
+tos_init() ->
+ put(tos, 1).
+
+tos_next() ->
+ case get(tos) of
+ TOS when (TOS < 100) ->
+ put(tos, TOS + 1),
+ TOS;
+ _ ->
+ put(tos, 1),
+ 1
+ end.
+
+
+%% ---
+
+e(F, A) ->
+ ?LIB:e(F, A).
+
+i(F) ->
+ ?LIB:i(F).
+
+i(F, A) ->
+ ?LIB:i(F, A).
+
diff --git a/erts/emulator/test/esock_misc/socket_lib.erl b/erts/emulator/test/esock_misc/socket_lib.erl
new file mode 100644
index 0000000000..9d6524d467
--- /dev/null
+++ b/erts/emulator/test/esock_misc/socket_lib.erl
@@ -0,0 +1,133 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_lib).
+
+-export([
+ sleep/1,
+ req/0, rep/0,
+ enc_req_msg/2, enc_rep_msg/2,
+ enc_msg/3, dec_msg/1,
+ request/3, reply/4,
+ f/2,
+ i/1, i/2,
+ e/2
+ ]).
+
+
+-define(REQ, 0).
+-define(REP, 1).
+
+
+%% ---
+
+sleep(T) ->
+ receive after T -> ok end.
+
+
+%% ---
+
+req() -> ?REQ.
+rep() -> ?REP.
+
+enc_req_msg(N, Data) ->
+ enc_msg(?REQ, N, Data).
+
+enc_rep_msg(N, Data) ->
+ enc_msg(?REP, N, Data).
+
+enc_msg(Type, N, Data) when is_list(Data) ->
+ enc_msg(Type, N, list_to_binary(Data));
+enc_msg(Type, N, Data)
+ when is_integer(Type) andalso is_integer(N) andalso is_binary(Data) ->
+ <<Type:32/integer, N:32/integer, Data/binary>>.
+
+dec_msg(<<?REQ:32/integer, N:32/integer, Data/binary>>) ->
+ {request, N, Data};
+dec_msg(<<?REP:32/integer, N:32/integer, Data/binary>>) ->
+ {reply, N, Data}.
+
+
+%% ---
+
+request(Tag, Pid, Request) ->
+ Ref = make_ref(),
+ Pid ! {Tag, self(), Ref, Request},
+ receive
+ {Tag, Pid, Ref, Reply} ->
+ Reply
+ end.
+
+reply(Tag, Pid, Ref, Reply) ->
+ Pid ! {Tag, self(), Ref, Reply}.
+
+
+%% ---
+
+f(F, A) ->
+ lists:flatten(io_lib:format(F, A)).
+
+
+%% ---
+
+e(F, A) ->
+ p("<ERROR> " ++ F, A).
+
+i(F) ->
+ i(F, []).
+i(F, A) ->
+ p("*** " ++ F, A).
+
+p(F, A) ->
+ p(get(sname), F, A).
+
+p(SName, F, A) ->
+ io:format("[~s,~p][~s] " ++ F ++ "~n",
+ [SName,self(),formated_timestamp()|A]).
+
+
+%% ---
+
+formated_timestamp() ->
+ format_timestamp(os:timestamp()).
+
+format_timestamp(Now) ->
+ N2T = fun(N) -> calendar:now_to_local_time(N) end,
+ format_timestamp(Now, N2T, true).
+
+format_timestamp({_N1, _N2, N3} = N, N2T, true) ->
+ FormatExtra = ".~.2.0w",
+ ArgsExtra = [N3 div 10000],
+ format_timestamp(N, N2T, FormatExtra, ArgsExtra);
+format_timestamp({_N1, _N2, _N3} = N, N2T, false) ->
+ FormatExtra = "",
+ ArgsExtra = [],
+ format_timestamp(N, N2T, FormatExtra, ArgsExtra).
+
+format_timestamp(N, N2T, FormatExtra, ArgsExtra) ->
+ {Date, Time} = N2T(N),
+ {YYYY,MM,DD} = Date,
+ {Hour,Min,Sec} = Time,
+ FormatDate =
+ io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w" ++ FormatExtra,
+ [YYYY, MM, DD, Hour, Min, Sec] ++ ArgsExtra),
+ lists:flatten(FormatDate).
+
+
diff --git a/erts/emulator/test/esock_misc/socket_server.erl b/erts/emulator/test/esock_misc/socket_server.erl
new file mode 100644
index 0000000000..45adffc5e6
--- /dev/null
+++ b/erts/emulator/test/esock_misc/socket_server.erl
@@ -0,0 +1,954 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_server).
+
+-export([
+ start/0, start/5,
+ start_tcp/0, start_tcp/1, start_tcp/3,
+ start_tcp4/0, start_tcp4/1, start_tcp4/2,
+ start_tcp6/0, start_tcp6/1, start_tcp6/2,
+ start_udp/0, start_udp/1, start_udp/3,
+ start_udp4/0, start_udp4/1, start_udp4/2,
+ start_udp6/0, start_udp6/1, start_udp6/2,
+ start_sctp/0, start_sctp/1
+ ]).
+
+-define(LIB, socket_lib).
+
+-record(manager, {socket, msg, peek, acceptors, handler_id, handlers}).
+-record(acceptor, {id, socket, manager,
+ atimeout = 5000}).
+-record(handler, {socket, peek, msg, type, manager,
+ stimeout = 5000, rtimeout = 5000}).
+
+-define(NUM_ACCEPTORS, 5).
+
+start() ->
+ start_tcp().
+
+start_tcp() ->
+ start_tcp4().
+
+start_tcp(Peek) ->
+ start_tcp4(Peek).
+
+start_tcp4() ->
+ start_tcp4(false).
+
+start_tcp4(Peek) ->
+ start_tcp4(false, Peek).
+
+start_tcp4(UseMsg, Peek) ->
+ start_tcp(inet, UseMsg, Peek).
+
+start_tcp6() ->
+ start_tcp6(false).
+
+start_tcp6(Peek) ->
+ start_tcp6(false, Peek).
+
+start_tcp6(UseMsg, Peek) ->
+ start_tcp(inet6, UseMsg, Peek).
+
+start_tcp(Domain, UseMsg, Peek) when is_boolean(UseMsg) andalso is_boolean(Peek) ->
+ start(Domain, stream, tcp, UseMsg, Peek).
+
+start_udp() ->
+ start_udp4().
+
+start_udp(Peek) ->
+ start_udp4(Peek).
+
+start_udp4() ->
+ start_udp4(false).
+
+start_udp4(Peek) ->
+ start_udp4(false, Peek).
+
+start_udp4(UseMsg, Peek) ->
+ start_udp(inet, UseMsg, Peek).
+
+start_udp6() ->
+ start_udp6(false, false).
+
+start_udp6(Peek) ->
+ start_udp6(false, Peek).
+
+start_udp6(UseMsg, Peek) ->
+ start_udp(inet6, UseMsg, Peek).
+
+start_udp(Domain, UseMsg, Peek) when is_boolean(UseMsg) andalso is_boolean(Peek) ->
+ start(Domain, dgram, udp, UseMsg, Peek).
+
+
+start_sctp() ->
+ start_sctp(inet).
+
+start_sctp(Domain) when ((Domain =:= inet) orelse (Domain =:= inet6)) ->
+ start(Domain, seqpacket, sctp, true, false).
+
+start(Domain, Type, Proto, UseMsg, Peek) ->
+ put(sname, "starter"),
+ i("try start manager"),
+ {Pid, MRef} = manager_start(Domain, Type, Proto, UseMsg, Peek),
+ i("manager (~p) started", [Pid]),
+ loop(Pid, MRef).
+
+loop(Pid, MRef) ->
+ receive
+ {'DOWN', MRef, process, Pid, Reason} ->
+ i("manager process exited: "
+ "~n ~p", [Reason]),
+ ok
+ end.
+
+
+%% =========================================================================
+
+manager_start(Domain, Type, Proto, UseMsg, Peek) ->
+ spawn_monitor(fun() -> manager_init(Domain, Type, Proto, UseMsg, Peek) end).
+
+manager_start_handler(Pid, Sock) ->
+ manager_request(Pid, {start_handler, Sock}).
+
+manager_stop(Pid, Reason) ->
+ manager_request(Pid, {stop, Reason}).
+
+manager_request(Pid, Request) ->
+ ?LIB:request(manager, Pid, Request).
+
+manager_reply(Pid, Ref, Reply) ->
+ ?LIB:reply(manager, Pid, Ref, Reply).
+
+
+manager_init(Domain, Type, Proto, UseMsg, Peek) ->
+ put(sname, "manager"),
+ do_manager_init(Domain, Type, Proto, UseMsg, Peek).
+
+do_manager_init(Domain, stream = Type, Proto, UseMsg, Peek) ->
+ i("try start acceptor(s)"),
+ {Sock, Acceptors} = manager_stream_init(Domain, Type, Proto),
+ manager_loop(#manager{socket = Sock,
+ msg = UseMsg,
+ peek = Peek,
+ acceptors = Acceptors,
+ handler_id = 1,
+ handlers = []});
+do_manager_init(Domain, dgram = Type, Proto, UseMsg, Peek) ->
+ i("try open socket"),
+ case socket:open(Domain, Type, Proto) of
+ {ok, Sock} ->
+ F = fun(X) -> case socket:getopt(Sock, socket, X) of
+ {ok, V} -> f("~p", [V]);
+ {error, R} -> f("error: ~p", [R])
+ end
+ end,
+ i("socket opened (~s,~s,~s): "
+ "~n broadcast: ~s"
+ "~n dontroute: ~s"
+ "~n keepalive: ~s"
+ "~n reuseaddr: ~s"
+ "~n linger: ~s"
+ "~n debug: ~s"
+ "~n prio: ~s"
+ "~n rcvbuf: ~s"
+ "~n rcvtimeo: ~s"
+ "~n sndbuf: ~s"
+ "~n sndtimeo: ~s"
+ "~n => try find (local) address",
+ [F(domain), F(type), F(protocol),
+ F(broadcast), F(dontroute), F(keepalive), F(reuseaddr), F(linger),
+ F(debug), F(priority),
+ F(rcvbuf), F(rcvtimeo), F(sndbuf), F(sndtimeo)]),
+ Addr = which_addr(Domain),
+ SA = #{family => Domain,
+ addr => Addr},
+ i("try bind to: "
+ "~n ~p", [Addr]),
+ case socket:bind(Sock, SA) of
+ {ok, _P} ->
+ ok;
+ {error, BReason} ->
+ throw({bind, BReason})
+ end,
+ i("bound to: "
+ "~n ~s"
+ "~n => try start handler",
+ [case socket:sockname(Sock) of
+ {ok, Name} -> f("~p", [Name]);
+ {error, R} -> f("error: ~p", [R])
+ end]),
+ case handler_start(1, Sock, UseMsg, Peek) of
+ {ok, {Pid, MRef}} ->
+ i("handler (~p) started", [Pid]),
+ handler_continue(Pid),
+ manager_loop(#manager{peek = Peek,
+ msg = UseMsg,
+ handler_id = 2, % Just in case
+ handlers = [{1, Pid, MRef}]});
+ {error, SReason} ->
+ e("Failed starting handler: "
+ "~n ~p", [SReason]),
+ exit({failed_start_handler, SReason})
+ end;
+ {error, OReason} ->
+ e("Failed open socket: "
+ "~n ~p", [OReason]),
+ exit({failed_open_socket, OReason})
+ end;
+do_manager_init(Domain, seqpacket = Type, sctp = Proto, _UseMsg, _Peek) ->
+ %% This is as far as I have got with SCTP at the moment...
+ case socket:open(Domain, Type, Proto) of
+ {ok, Sock} ->
+ i("(sctp) socket opened: "
+ "~n ~p", [Sock]),
+ EXP = fun(_Desc, Expect, Expect) ->
+ Expect;
+ (Desc, Expect, Actual) ->
+ e("Unexpected result ~w: "
+ "~n Expect: ~p"
+ "~n Actual: ~p", [Desc, Expect, Actual]),
+ exit({Desc, Expect, Actual})
+ end,
+ GO = fun(O) -> case socket:getopt(Sock, sctp, O) of
+ {ok, V} -> f("~p", [V]);
+ {error, R} -> f("error: ~p", [R])
+ end
+ end,
+ %% ok = socket:setopt(Sock, otp, debug, true),
+
+ i("Miscellaneous options: "
+ "~n associnfo: ~s"
+ "~n autoclose: ~s"
+ "~n disable-fragments: ~s"
+ "~n initmsg: ~s"
+ "~n maxseg: ~s"
+ "~n nodelay: ~s"
+ "~n rtoinfo: ~s",
+ [GO(associnfo),
+ GO(autoclose),
+ GO(disable_fragments),
+ GO(initmsg),
+ GO(maxseg),
+ GO(nodelay),
+ GO(rtoinfo)]),
+
+ Events = #{data_in => true,
+ association => true,
+ address => true,
+ send_failure => true,
+ peer_error => true,
+ shutdown => true,
+ partial_delivery => true,
+ adaptation_layer => true,
+ authentication => true,
+ sender_dry => true},
+ EXP(set_sctp_events, ok, socket:setopt(Sock, sctp, events, Events)),
+ EXP(close_socket, ok, socket:close(Sock));
+ {error, Reason} ->
+ exit({failed_open, Reason})
+ end;
+do_manager_init(Domain, raw = Type, Proto, UseMsg, Peek) when is_integer(Proto) ->
+ do_manager_init(Domain, Type, {raw, Proto}, UseMsg, Peek);
+do_manager_init(Domain, raw = Type, Proto, _UseMsg, _Peek) ->
+ case socket:open(Domain, Type, Proto) of
+ {ok, Sock} ->
+ i("(sctp) socket opened: "
+ "~n ~p", [Sock]),
+ socket:close(Sock);
+ {error, Reason} ->
+ exit({failed_open, Reason})
+ end.
+
+
+
+manager_stream_init(Domain, Type, Proto) ->
+ i("try (socket) open"),
+ Sock = case socket:open(Domain, Type, Proto) of
+ {ok, S} ->
+ S;
+ {error, OReason} ->
+ throw({open, OReason})
+ end,
+ F = fun(X) -> case socket:getopt(Sock, socket, X) of
+ {ok, V} -> f("~p", [V]);
+ {error, R} -> f("error: ~p", [R])
+ end
+ end,
+ i("(socket) open (~s,~s,~s): "
+ "~n debug: ~s"
+ "~n prio: ~s"
+ "~n => try find (local) address",
+ [F(domain), F(type), F(protocol), F(debug), F(priority)]),
+ Addr = which_addr(Domain),
+ SA = #{family => Domain,
+ addr => Addr},
+ i("found: "
+ "~n ~p"
+ "~n => try (socket) bind", [Addr]),
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ %% ok = socket:setopt(Sock, socket, debug, 1), %% must have rights!!
+ Port = case socket:bind(Sock, SA) of
+ {ok, P} ->
+ %% ok = socket:setopt(Sock, socket, debug, 0), %% must have rights!!
+ %% ok = socket:setopt(Sock, otp, debug, false),
+ P;
+ {error, BReason} ->
+ throw({bind, BReason})
+ end,
+ i("bound to: "
+ "~n ~p"
+ "~n => try (socket) listen (acceptconn: ~s)",
+ [Port, F(acceptconn)]),
+ case socket:listen(Sock) of
+ ok ->
+ i("listening (acceptconn: ~s)",
+ [F(acceptconn)]),
+ manager_stream_init(Sock, 1, ?NUM_ACCEPTORS, []);
+ {error, LReason} ->
+ throw({listen, LReason})
+ end.
+
+which_addr(Domain) ->
+ Iflist = case inet:getifaddrs() of
+ {ok, IFL} ->
+ IFL;
+ {error, Reason} ->
+ throw({inet,getifaddrs,Reason})
+ end,
+ which_addr(Domain, Iflist).
+
+which_addr(_Domain, []) ->
+ throw(no_address);
+which_addr(Domain, [{Name, IFO}|_IFL]) when (Name =/= "lo") ->
+ which_addr2(Domain, IFO);
+which_addr(Domain, [_|IFL]) ->
+ which_addr(Domain, IFL).
+
+which_addr2(_, []) ->
+ throw(no_address);
+which_addr2(inet = _Domain, [{addr, Addr}|_IFO]) when (size(Addr) =:= 4) ->
+ Addr;
+which_addr2(inet6 = _Domain, [{addr, Addr}|_IFO]) when (size(Addr) =:= 8) ->
+ Addr;
+which_addr2(Domain, [_|IFO]) ->
+ which_addr2(Domain, IFO).
+
+
+manager_stream_init(Sock, ID, NumAcceptors, Acc)
+ when (NumAcceptors > 0) ->
+ i("try start acceptor"),
+ case acceptor_start(Sock, ID) of
+ {ok, {Pid, MRef}} ->
+ i("acceptor ~w (~p) started", [ID, Pid]),
+ ?LIB:sleep(2000),
+ manager_stream_init(Sock, ID+1, NumAcceptors-1,
+ [{ID, Pid, MRef}|Acc]);
+ {error, Reason} ->
+ exit({failed_starting_acceptor, Reason})
+ end;
+manager_stream_init(Sock, _ID, 0, Acc) ->
+ %% Req = {kill_acceptor, length(Acc)}, % Last in the queue
+ %% Req = {kill_acceptor, 3}, % In the "middle" of the queue
+ %% Req = {kill_acceptor, 2}, % The first in the queue
+ %% Req = {kill_acceptor, 1}, % Current acceptor
+ %% Msg = {manager, self(), make_ref(), Req},
+ %% erlang:send_after(timer:seconds(10), self(), Msg),
+ {Sock, lists:reverse(Acc)}.
+
+
+manager_loop(M) ->
+ receive
+ {'DOWN', MRef, process, Pid, Reason} ->
+ M2 = manager_handle_down(M, MRef, Pid, Reason),
+ manager_loop(M2);
+
+ {manager, Pid, Ref, Request} ->
+ M2 = manager_handle_request(M, Pid, Ref, Request),
+ manager_loop(M2)
+ end.
+
+
+manager_handle_down(#manager{acceptors = Acceptors,
+ handlers = Handlers} = M, MRef, Pid, Reason) ->
+ case lists:keysearch(Pid, 2, Acceptors) of
+ {value, {ID, Pid, MRef}} when (Reason =:= normal) ->
+ i("acceptor ~w exited (normally)", [ID]),
+ case lists:keydelete(Pid, 2, Acceptors) of
+ [] ->
+ %% We are done
+ i("the last acceptor - we are done"),
+ exit(normal);
+ Acceptors2 ->
+ M#manager{acceptors = Acceptors2}
+ end;
+ {value, {ID, Pid, MRef}} ->
+ e("acceptor ~w crashed: "
+ "~n ~p", [ID, Reason]),
+ exit({acceptor_died, Reason});
+
+ false -> %% handler!
+ if
+ (Reason =/= normal) ->
+ e("handler ~p died: "
+ "~n ~p", [Pid, Reason]);
+ true ->
+ i("handler ~p terminated", [Pid])
+ end,
+ Handlers2 = lists:keydelete(Pid, 2, Handlers),
+ M#manager{handlers = Handlers2}
+ end.
+
+
+manager_handle_request(#manager{peek = Peek,
+ msg = UseMsg,
+ handler_id = HID,
+ handlers = Handlers} = M, Pid, Ref,
+ {start_handler, Sock}) ->
+ i("try start handler (~w)", [HID]),
+ case handler_start(HID, Sock, UseMsg, Peek) of
+ {ok, {HPid, HMRef}} ->
+ i("handler ~w started", [HID]),
+ manager_reply(Pid, Ref, {ok, HPid}),
+ M#manager{handler_id = HID+1,
+ handlers = [{HID, HPid, HMRef}|Handlers]};
+ {error, Reason} = ERROR ->
+ e("Failed starting new handler: "
+ "~n Sock: ~p"
+ "~n Reason: ~p", [Sock, Reason]),
+ manager_reply(Pid, Ref, ERROR),
+ M
+ end;
+manager_handle_request(#manager{socket = Sock,
+ acceptors = [{AID, APid, AMRef}]} = M, _Pid, _Ref,
+ {kill_acceptor, AID}) ->
+ i("try kill (only remeining) acceptor ~w", [AID]),
+ socket:setopt(Sock, otp, debug, true),
+ manager_stop_acceptor(APid, AMRef, AID, kill),
+ M#manager{acceptors = []};
+manager_handle_request(#manager{socket = Sock,
+ acceptors = Acceptors} = M, _Pid, _Ref,
+ {kill_acceptor, AID}) ->
+ i("try kill acceptor ~w", [AID]),
+ case lists:keysearch(AID, 1, Acceptors) of
+ {value, {AID, APid, AMRef}} ->
+ socket:setopt(Sock, otp, debug, true),
+ manager_stop_acceptor(APid, AMRef, AID, kill),
+ Acceptors2 = lists:keydelete(AID, 1, Acceptors),
+ M#manager{acceptors = Acceptors2};
+ false ->
+ e("no such acceptor"),
+ M
+ end;
+manager_handle_request(#manager{acceptors = Acceptors,
+ handlers = Handlers}, Pid, Ref,
+ {stop, Reason}) ->
+ i("stop"),
+ manager_reply(Pid, Ref, ok),
+ manager_stop_handlers(Handlers, Reason),
+ manager_stop_acceptors(Acceptors, Reason),
+ i("stopped", []),
+ exit(Reason).
+
+manager_stop_acceptors(Acceptors, Reason) ->
+ lists:foreach(fun({ID,P,M}) ->
+ manager_stop_acceptor(P, M, ID, Reason)
+ end, Acceptors).
+
+manager_stop_acceptor(Pid, MRef, ID, Reason) ->
+ i("try stop acceptor ~w (~p): ~p", [ID, Pid, Reason]),
+ erlang:demonitor(MRef, [flush]),
+ acceptor_stop(Pid, Reason),
+ ok.
+
+manager_stop_handlers(Handlers, Reason) ->
+ lists:foreach(fun({ID,P,M}) ->
+ manager_stop_handler(P, M, ID, Reason)
+ end, Handlers).
+
+manager_stop_handler(Pid, MRef, ID, Reason) ->
+ i("try stop handler ~w (~p): ~p", [ID, Pid, Reason]),
+ erlang:demonitor(MRef, [flush]),
+ handler_stop(Pid, Reason),
+ ok.
+
+
+
+%% =========================================================================
+
+acceptor_start(Sock, ID) ->
+ Self = self(),
+ A = {Pid, _} = spawn_monitor(fun() ->
+ acceptor_init(Self, Sock, ID)
+ end),
+ receive
+ {acceptor, Pid, ok} ->
+ {ok, A};
+ {acceptor, Pid, {error, _} = Error} ->
+ exit(Pid, kill), % Just in case
+ Error;
+ {'DOWN', _MRef, process, Pid, Reason} ->
+ {error, {crashed, Reason}}
+ end.
+
+acceptor_stop(Pid, _Reason) ->
+ %% acceptor_request(Pid, {stop, Reason}).
+ exit(Pid, kill).
+
+%% acceptor_request(Pid, Request) ->
+%% request(acceptor, Pid, Request).
+
+%% acceptor_reply(Pid, Ref, Reply) ->
+%% reply(acceptor, Pid, Ref, Reply).
+
+
+acceptor_init(Manager, Sock, ID) ->
+ put(sname, f("acceptor[~w]", [ID])),
+ Manager ! {acceptor, self(), ok},
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ acceptor_loop(#acceptor{id = ID,
+ manager = Manager,
+ socket = Sock}).
+
+acceptor_loop(#acceptor{socket = LSock, atimeout = Timeout} = A) ->
+ i("try accept"),
+ case socket:accept(LSock, Timeout) of
+ {ok, Sock} ->
+ i("accepted: "
+ "~n ~p"
+ "~nwhen"
+ "~n ~p", [Sock, socket:info()]),
+ case acceptor_handle_accept_success(A, Sock) of
+ ok ->
+ acceptor_loop(A);
+ {error, Reason} ->
+ e("Failed starting handler: "
+ "~n ~p", [Reason]),
+ socket:close(Sock),
+ exit({failed_starting_handler, Reason})
+ end;
+ {error, timeout} ->
+ i("timeout"),
+ acceptor_loop(A);
+ {error, Reason} ->
+ e("accept failure: "
+ "~n ~p", [Reason]),
+ exit({accept, Reason})
+ end.
+
+acceptor_handle_accept_success(#acceptor{manager = Manager}, Sock) ->
+ i("try start handler for peer"
+ "~n ~p", [case socket:peername(Sock) of
+ {ok, Peer} -> Peer;
+ {error, _} = E -> E
+ end]),
+ case manager_start_handler(Manager, Sock) of
+ {ok, Pid} ->
+ i("handler (~p) started - now change 'ownership'", [Pid]),
+ case socket:setopt(Sock, otp, controlling_process, Pid) of
+ ok ->
+ %% Normally we should have a msgs collection here
+ %% (of messages we receive before the control was
+ %% handled over to Handler), but since we don't
+ %% have active implemented yet...
+ i("new handler (~p) now controlling process", [Pid]),
+ handler_continue(Pid),
+ ok;
+ {error, _} = ERROR ->
+ exit(Pid, kill),
+ ERROR
+ end;
+ {error, Reason2} ->
+ e("failed starting handler: "
+ "~n (new) Socket: ~p"
+ "~n Reason: ~p", [Sock, Reason2]),
+ exit({failed_starting_handler, Reason2})
+ end.
+
+
+
+%% =========================================================================
+
+handler_start(ID, Sock, UseMsg, Peek) ->
+ Self = self(),
+ H = {Pid, _} = spawn_monitor(fun() ->
+ handler_init(Self, ID, UseMsg, Peek, Sock)
+ end),
+ receive
+ {handler, Pid, ok} ->
+ {ok, H};
+ {handler, Pid, {error, _} = ERROR} ->
+ exit(Pid, kill), % Just in case
+ ERROR
+ end.
+
+handler_stop(Pid, _Reason) ->
+ %% handler_request(Pid, {stop, Reason}).
+ exit(Pid, kill).
+
+handler_continue(Pid) ->
+ handler_request(Pid, continue).
+
+handler_request(Pid, Request) ->
+ ?LIB:request(handler, Pid, Request).
+
+handler_reply(Pid, Ref, Reply) ->
+ ?LIB:reply(handler, Pid, Ref, Reply).
+
+
+handler_init(Manager, ID, Msg, Peek, Sock) ->
+ put(sname, f("handler:~w", [ID])),
+ i("starting"),
+ Manager ! {handler, self(), ok},
+ receive
+ {handler, Pid, Ref, continue} ->
+ i("got continue"),
+ handler_reply(Pid, Ref, ok),
+ G = fun(L, O) -> case socket:getopt(Sock, L, O) of
+ {ok, Val} ->
+ f("~p", [Val]);
+ {error, R} when is_atom(R) ->
+ f("error: ~w", [R]);
+ {error, {T, R}} when is_atom(T) ->
+ f("error: ~w, ~p", [T, R]);
+ {error, R} ->
+ f("error: ~p", [R])
+ end
+ end,
+ GSO = fun(O) -> G(socket, O) end,
+ GIP4 = fun(O) -> G(ip, O) end,
+ GIP6 = fun(O) -> G(ipv6, O) end,
+ {ok, Domain} = socket:getopt(Sock, socket, domain),
+ {ok, Type} = socket:getopt(Sock, socket, type),
+ {ok, Proto} = socket:getopt(Sock, socket, protocol),
+ B2D = GSO(bindtodevice),
+ RA = GSO(reuseaddr),
+ RP = GSO(reuseport),
+ OOBI = GSO(oobinline),
+ RcvBuf = GSO(rcvbuf),
+ RcvLW = GSO(rcvlowat),
+ RcvTO = GSO(rcvtimeo),
+ SndBuf = GSO(sndbuf),
+ SndLW = GSO(sndlowat),
+ SndTO = GSO(sndtimeo),
+ Linger = GSO(linger),
+ Timestamp = GSO(timestamp),
+ FreeBind = GIP4(freebind),
+ MTU = GIP4(mtu),
+ MTUDisc = GIP4(mtu_discover),
+ MALL = GIP4(multicast_all),
+ MIF4 = GIP4(multicast_if),
+ MLoop4 = GIP4(multicast_loop),
+ MTTL = GIP4(multicast_ttl),
+ NF = GIP4(nodefrag), % raw only
+ PktInfo = GIP4(pktinfo), % dgram only
+ RecvErr4 = GIP4(recverr),
+ RecvIF = GIP4(recvif), % Only dgram and raw (and FreeBSD)
+ RecvOPTS = GIP4(recvopts), % Not stream
+ RecvOrigDstAddr = GIP4(recvorigdstaddr),
+ RecvTOS = GIP4(recvtos),
+ RecvTTL = GIP4(recvttl), % not stream
+ RetOpts = GIP4(retopts), % not stream
+ SendSrcAddr = GIP4(sendsrcaddr),
+ TOS = GIP4(tos),
+ Transparent = GIP4(transparent),
+ TTL = GIP4(ttl),
+ MHops = GIP6(multicast_hops),
+ MIF6 = GIP6(multicast_if), % Only dgram and raw
+ MLoop6 = GIP6(multicast_loop),
+ RecvErr6 = GIP6(recverr),
+ RecvPktInfo = GIP6(recvpktinfo),
+ RtHdr = GIP6(rthdr),
+ AuthHdr = GIP6(authhdr),
+ HopLimit = GIP6(hoplimit),
+ HopOpts = GIP6(hopopts),
+ DstOpts = GIP6(dstopts),
+ FlowInfo = GIP6(flowinfo),
+ UHops = GIP6(unicast_hops),
+ i("got continue when: "
+ "~n (socket) Domain: ~p"
+ "~n (socket) Type: ~p"
+ "~n (socket) Protocol: ~p"
+ "~n (socket) Reuse Address: ~s"
+ "~n (socket) Reuse Port: ~s"
+ "~n (socket) Bind To Device: ~s"
+ "~n (socket) OOBInline: ~s"
+ "~n (socket) RcvBuf: ~s"
+ "~n (socket) RcvLW: ~s"
+ "~n (socket) RcvTO: ~s"
+ "~n (socket) SndBuf: ~s"
+ "~n (socket) SndLW: ~s"
+ "~n (socket) SndTO: ~s"
+ "~n (socket) Linger: ~s"
+ "~n (socket) Timestamp: ~s"
+ "~n (ip) FreeBind: ~s"
+ "~n (ip) MTU: ~s"
+ "~n (ip) MTU Discovery: ~s"
+ "~n (ip) Multicast ALL: ~s"
+ "~n (ip) Multicast IF: ~s"
+ "~n (ip) Multicast Loop: ~s"
+ "~n (ip) Multicast TTL: ~s"
+ "~n (ip) Node Frag: ~s"
+ "~n (ip) Pkt Info: ~s"
+ "~n (ip) Recv Err: ~s"
+ "~n (ip) Recv IF: ~s"
+ "~n (ip) Recv OPTS: ~s"
+ "~n (ip) Recv Orig Dst Addr: ~s"
+ "~n (ip) Recv TOS: ~s"
+ "~n (ip) Recv TTL: ~s"
+ "~n (ip) Ret Opts: ~s"
+ "~n (ip) Send Src Addr: ~s"
+ "~n (ip) TOS: ~s"
+ "~n (ip) Transparent: ~s"
+ "~n (ip) TTL: ~s"
+ "~n (ipv6) Multicast Hops: ~s"
+ "~n (ipv6) Multicast IF: ~s"
+ "~n (ipv6) Multicast Loop: ~s"
+ "~n (ipv6) Recv Err: ~s"
+ "~n (ipv6) Recv Pkt Info: ~s"
+ "~n (ipv6) RT Hdr: ~s"
+ "~n (ipv6) Auth Hdr: ~s"
+ "~n (ipv6) Hop Limit: ~s"
+ "~n (ipv6) Hop Opts: ~s"
+ "~n (ipv6) Dst Opts: ~s"
+ "~n (ipv6) Flow Info: ~s"
+ "~n (ipv6) Unicast Hops: ~s",
+ [Domain, Type, Proto,
+ RA, RP, B2D, OOBI,
+ RcvBuf, RcvLW, RcvTO, SndBuf, SndLW, SndTO,
+ Linger, Timestamp,
+ FreeBind, MTU, MTUDisc, MALL, MIF4, MLoop4, MTTL,
+ NF, PktInfo,RecvErr4,
+ RecvIF, RecvOPTS, RecvOrigDstAddr, RecvTOS, RecvTTL, RetOpts,
+ SendSrcAddr, TOS, Transparent, TTL,
+ MHops, MIF6, MLoop6, RecvErr6, RecvPktInfo,
+ RtHdr, AuthHdr, HopLimit, HopOpts, DstOpts, FlowInfo,
+ UHops]),
+
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ %% case socket:getopt(Sock, 0, {13, int}) of
+ %% {ok, Val} ->
+ %% i("PktOpts ok: ~p", [Val]);
+ %% {error, Reason} ->
+ %% e("PktOpts err: ~p", [Reason])
+ %% end,
+ %% ok = socket:setopt(Sock, otp, debug, false),
+ SSO = fun(O, V) -> soso(Sock, O, V) end,
+ SIP4 =
+ fun(O, V) ->
+ if
+ (Type =:= dgram) ->
+ ok = soip(Sock, O, V);
+ true ->
+ ok
+ end
+ end,
+ SSO(timestamp, true),
+ SIP4(pktinfo, true),
+ ok = soip(Sock, recvtos, true),
+ SIP4(recvttl, true),
+ ok = soip(Sock, recvorigdstaddr, true),
+
+ handler_loop(#handler{msg = Msg,
+ peek = Peek,
+ manager = Manager,
+ type = Type,
+ socket = Sock})
+ end.
+
+so(Sock, Lvl, Opt, Val) ->
+ ok = socket:setopt(Sock, Lvl, Opt, Val).
+
+soso(Sock, Opt, Val) ->
+ so(Sock, socket, Opt, Val).
+
+soip(Sock, Opt, Val) ->
+ so(Sock, ip, Opt, Val).
+
+%% soipv6(Sock, Opt, Val) ->
+%% so(Sock, ipv6, Opt, Val).
+
+handler_loop(H) ->
+ i("try read message"),
+ case recv(H) of
+ {ok, {Source, Msg}} ->
+ i("received ~w bytes of data~s",
+ [size(Msg), case Source of
+ undefined -> "";
+ _ -> f(" from:~n ~p", [Source])
+ end]),
+ case ?LIB:dec_msg(Msg) of
+ {request, N, Req} ->
+ i("received request ~w: "
+ "~n ~p", [N, Req]),
+ Reply = ?LIB:enc_rep_msg(N, "hoppsan"),
+ case send(H, Reply, Source) of
+ ok ->
+ i("successfully sent reply ~w", [N]),
+ handler_loop(H);
+ {error, SReason} ->
+ e("failed sending reply ~w:"
+ "~n ~p", [N, SReason]),
+ exit({failed_sending_reply, SReason})
+ end
+ end;
+
+ {error, closed} ->
+ i("closed when"
+ "~n ~p", [socket:info()]),
+ exit(normal);
+
+ {error, RReason} ->
+ e("failed reading request: "
+ "~n ~p", [RReason]),
+ exit({failed_reading_request, RReason})
+ end.
+
+
+recv(#handler{peek = true, socket = Sock, type = stream}) ->
+ peek_recv(Sock);
+recv(#handler{socket = Sock, msg = true, type = stream}) ->
+ case socket:recvmsg(Sock) of
+ {ok, #{addr := undefined = Source,
+ iov := [Data],
+ ctrl := CMsgHdrs,
+ flags := Flags}} ->
+ i("received message: "
+ "~n CMsgHdrs: ~p"
+ "~n Flags: ~p", [CMsgHdrs, Flags]),
+ {ok, {Source, Data}};
+ {ok, X} ->
+ e("received *unexpected* message: "
+ "~n ~p", [X]),
+ {error, {unexpected, X}};
+ {error, _} = ERROR ->
+ ERROR
+ end;
+recv(#handler{socket = Sock, msg = true, type = dgram}) ->
+ case socket:recvmsg(Sock) of
+ {ok, #{addr := Source,
+ iov := [Data],
+ ctrl := CMsgHdrs,
+ flags := Flags}} ->
+ i("received message: "
+ "~n CMsgHdrs: ~p"
+ "~n Flags: ~p", [CMsgHdrs, Flags]),
+ {ok, {Source, Data}};
+ {ok, X} ->
+ {error, {unexpected, X}};
+ {error, _} = ERROR ->
+ ERROR
+ end;
+recv(#handler{peek = false, socket = Sock, type = stream}) ->
+ do_recv(Sock);
+recv(#handler{peek = Peek, socket = Sock, type = dgram})
+ when (Peek =:= true) ->
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ RES = peek_recvfrom(Sock, 5),
+ %% ok = socket:setopt(Sock, otp, debug, false),
+ RES;
+recv(#handler{peek = Peek, socket = Sock, type = dgram})
+ when (Peek =:= false) ->
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ socket:recvfrom(Sock).
+
+do_recv(Sock) ->
+ case socket:recv(Sock) of
+ {ok, Msg} ->
+ {ok, {undefined, Msg}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+peek_recv(Sock) ->
+ i("try peek on the message type (expect request)"),
+ Type = ?LIB:req(),
+ case socket:recv(Sock, 4, [peek]) of
+ {ok, <<Type:32>>} ->
+ i("was request - do proper recv"),
+ do_recv(Sock);
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+peek_recvfrom(Sock, BufSz) ->
+ i("try peek recvfrom with buffer size ~w", [BufSz]),
+ case socket:recvfrom(Sock, BufSz, [peek]) of
+ {ok, {_Source, Msg}} when (BufSz =:= size(Msg)) ->
+ %% i("we filled the buffer: "
+ %% "~n ~p", [Msg]),
+ %% It *may not* fit => try again with double size
+ peek_recvfrom(Sock, BufSz*2);
+ {ok, _} ->
+ %% It fits => read for real
+ i("we did *not* fill the buffer - do the 'real' read"),
+ socket:recvfrom(Sock);
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+send(#handler{socket = Sock, msg = true, type = stream, stimeout = Timeout},
+ Msg, _) ->
+ CMsgHdr = #{level => ip, type => tos, data => reliability},
+ CMsgHdrs = [CMsgHdr],
+ MsgHdr = #{iov => [Msg], ctrl => CMsgHdrs},
+ %% socket:setopt(Sock, otp, debug, true),
+ Res = socket:sendmsg(Sock, MsgHdr, Timeout),
+ %% socket:setopt(Sock, otp, debug, false),
+ Res;
+send(#handler{socket = Sock, type = stream, stimeout = Timeout}, Msg, _) ->
+ socket:send(Sock, Msg, Timeout);
+send(#handler{socket = Sock, msg = true, type = dgram, stimeout = Timeout},
+ Msg, Dest) ->
+ CMsgHdr = #{level => ip, type => tos, data => reliability},
+ CMsgHdrs = [CMsgHdr],
+ MsgHdr = #{addr => Dest,
+ ctrl => CMsgHdrs,
+ iov => [Msg]},
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ Res = socket:sendmsg(Sock, MsgHdr, Timeout),
+ %% ok = socket:setopt(Sock, otp, debug, false),
+ Res;
+send(#handler{socket = Sock, type = dgram, stimeout = Timeout}, Msg, Dest) ->
+ socket:sendto(Sock, Msg, Dest, Timeout).
+
+%% filler() ->
+%% list_to_binary(lists:duplicate(2048, " FILLER ")).
+
+
+
+%% =========================================================================
+
+f(F, A) ->
+ ?LIB:f(F, A).
+
+e(F) ->
+ e(F, []).
+e(F, A) ->
+ ?LIB:e(F, A).
+
+i(F) ->
+ ?LIB:i(F).
+
+i(F, A) ->
+ ?LIB:i(F, A).
+
diff --git a/erts/emulator/test/esock_ttest/.gitignore b/erts/emulator/test/esock_ttest/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/erts/emulator/test/esock_ttest/.gitignore
diff --git a/erts/emulator/test/esock_ttest/esock-ttest b/erts/emulator/test/esock_ttest/esock-ttest
new file mode 100755
index 0000000000..f0d363ab30
--- /dev/null
+++ b/erts/emulator/test/esock_ttest/esock-ttest
@@ -0,0 +1,352 @@
+#!/usr/bin/env escript
+
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% ==========================================================================
+%%
+%% This is a simple wrapper escript on top of the socket ttest program(s).
+%% The idea is to make it simple to run in a normal shell (bash).
+%%
+%% ==========================================================================
+
+-define(SECS(I), timer:seconds(I)).
+
+-define(CLIENT_MSG_1_MAX_OUTSTANDING, 100).
+-define(CLIENT_MSG_2_MAX_OUTSTANDING, 10).
+-define(CLIENT_MSG_3_MAX_OUTSTANDING, 1).
+
+main(Args) ->
+ State = process_args(Args),
+ exec(State),
+ ok.
+
+usage(ErrorString) when is_list(ErrorString) ->
+ eprint(ErrorString),
+ usage(),
+ erlang:halt(0).
+
+usage() ->
+ io:format("usage: ~s [options]"
+ "~n"
+ "~n This erlang script is used to start the (e)socket ttest "
+ "~n units (server or client)."
+ "~n"
+ "~n options: "
+ "~n --help Display this info and exit. "
+ "~n --server [server-options] Start a server. "
+ "~n There are no mandatory server options."
+ "~n --client client-options Start a client"
+ "~n Some client options are mandatory and"
+ "~n others optional."
+ "~n --active <active> boolean() | once."
+ "~n Valid for both client and server."
+ "~n Defaults to: false"
+ "~n --transport <transport> Which transport to use: gen|sock[:plain|msg]"
+ "~n gen: gen_tcp"
+ "~n sock: socket"
+ "~n plain: recv/send (default)"
+ "~n msg: recvmsg/sendmsg"
+ "~n Defaults to: sock:plain"
+ "~n --scon <addr>:<port> Address and port of the server."
+ "~n The address part is in the standard form:"
+ "~n \"a.b.c.d\"."
+ "~n Only valid for client."
+ "~n Mandatory."
+ "~n --msg-id <1|2|3> Choose which message to use during the test."
+ "~n Basically: "
+ "~n 1: small"
+ "~n 2: medium"
+ "~n 3: large"
+ "~n Defaults to: 1"
+ "~n --max-outstanding <Num> How many messages to send before waiting for"
+ "~n a reply."
+ "~n Valid only for client."
+ "~n Defaults to: "
+ "~n MsgID 1: 100"
+ "~n MsgID 2: 10"
+ "~n MsgID 3: 1"
+ "~n --runtime <Time> Time of the test in seconds."
+ "~n Only valid for client."
+ "~n Mandatory."
+ "~n Defaults to: 60 (seconds)"
+ "~n"
+ "~n"
+ "~n",
+ [scriptname()]),
+ ok.
+
+process_args(["--help"|_]) ->
+ usage();
+process_args(["--server"|ServerArgs]) ->
+ process_server_args(ServerArgs);
+process_args(["--client"|ClientArgs]) ->
+ process_client_args(ClientArgs);
+process_args(Args) ->
+ usage(f("Invalid Args: "
+ "~n ~p", [Args])).
+
+
+process_server_args(Args) ->
+ Defaults = #{role => server,
+ active => false,
+ transport => {sock, plain}},
+ process_server_args(Args, Defaults).
+
+process_server_args([], State) ->
+ State;
+
+process_server_args(["--active", Active|Args], State)
+ when ((Active =:= "false") orelse
+ (Active =:= "once") orelse
+ (Active =:= "true")) ->
+ process_server_args(Args, State#{active => list_to_atom(Active)});
+
+process_server_args(["--transport", "gen" | Args], State) ->
+ process_server_args(Args, State#{transport => gen});
+process_server_args(["--transport", "sock" | Args], State) ->
+ process_server_args(Args, State#{transport => {sock, plain}});
+process_server_args(["--transport", "sock:plain" | Args], State) ->
+ process_server_args(Args, State#{transport => {sock, plain}});
+process_server_args(["--transport", "sock:msg" | Args], State) ->
+ process_server_args(Args, State#{transport => {sock, msg}});
+
+process_server_args([Arg|_], _State) ->
+ usage(f("Invalid Server arg: ~s", [Arg])).
+
+
+process_client_args(Args) ->
+ Defaults = #{role => client,
+ active => false,
+ transport => {sock, plain},
+ %% Will cause error if not provided
+ %% Should be "addr:port"
+ server => undefined,
+ msg_id => 1,
+ %% Will be filled in based on msg_id if not provided
+ max_outstanding => undefined,
+ runtime => ?SECS(60)},
+ process_client_args(Args, Defaults).
+
+process_client_args([], State) ->
+ process_client_args_ensure_max_outstanding(State);
+
+process_client_args(["--active", Active|Args], State)
+ when ((Active =:= "false") orelse
+ (Active =:= "once") orelse
+ (Active =:= "true")) ->
+ process_client_args(Args, State#{active => list_to_atom(Active)});
+
+process_client_args(["--transport", "gen" | Args], State) ->
+ process_client_args(Args, State#{transport => gen});
+process_client_args(["--transport", "sock" | Args], State) ->
+ process_client_args(Args, State#{transport => {sock, plain}});
+process_client_args(["--transport", "sock:plain" | Args], State) ->
+ process_client_args(Args, State#{transport => {sock, plain}});
+process_client_args(["--transport", "sock:msg" | Args], State) ->
+ process_client_args(Args, State#{transport => {sock, msg}});
+
+process_client_args(["--msg-id", MsgID|Args], State)
+ when ((MsgID =:= "1") orelse
+ (MsgID =:= "2") orelse
+ (MsgID =:= "3")) ->
+ process_client_args(Args, State#{msg_id => list_to_integer(MsgID)});
+
+process_client_args(["--max-outstanding", Max|Args], State) ->
+ try list_to_integer(Max) of
+ I when (I > 0) ->
+ process_client_args(Args, State#{max_outstanding => I});
+ _ ->
+ usage(f("Invalid Max Outstanding: ~s", [Max]))
+ catch
+ _:_:_ ->
+ usage(f("Invalid Max Outstanding: ~s", [Max]))
+ end;
+
+process_client_args(["--scon", Server|Args], State) ->
+ case string:tokens(Server, [$:]) of
+ [AddrStr,PortStr] ->
+ Addr = case inet:parse_address(AddrStr) of
+ {ok, A} ->
+ A;
+ {error, _} ->
+ usage(f("Invalid Server Address: ~s", [AddrStr]))
+ end,
+ Port = try list_to_integer(PortStr) of
+ I when (I > 0) ->
+ I;
+ _ ->
+ usage(f("Invalid Server Port: ~s", [PortStr]))
+ catch
+ _:_:_ ->
+ usage(f("Invalid Server Port: ~s", [PortStr]))
+ end,
+ process_client_args(Args, State#{server => {Addr, Port}});
+ _ ->
+ usage(f("Invalid Server: ~s", [Server]))
+ end;
+
+process_client_args(["--runtime", T|Args], State) ->
+ try list_to_integer(T) of
+ I when (I > 0) ->
+ process_client_args(Args, State#{runtime => ?SECS(I)});
+ _ ->
+ usage(f("Invalid Run Time: ~s", [T]))
+ catch
+ _:_:_ ->
+ usage(f("Invalid Run Time: ~s", [T]))
+ end;
+
+process_client_args([Arg|_], _State) ->
+ usage(f("Invalid Client arg: ~s", [Arg])).
+
+
+process_client_args_ensure_max_outstanding(
+ #{msg_id := 1,
+ max_outstanding := undefined} = State) ->
+ State#{max_outstanding => ?CLIENT_MSG_1_MAX_OUTSTANDING};
+process_client_args_ensure_max_outstanding(
+ #{msg_id := 2,
+ max_outstanding := undefined} = State) ->
+ State#{max_outstanding => ?CLIENT_MSG_2_MAX_OUTSTANDING};
+process_client_args_ensure_max_outstanding(
+ #{msg_id := 3,
+ max_outstanding := undefined} = State) ->
+ State#{max_outstanding => ?CLIENT_MSG_3_MAX_OUTSTANDING};
+process_client_args_ensure_max_outstanding(
+ #{msg_id := MsgID,
+ max_outstanding := MaxOutstanding} = State)
+ when ((MsgID =:= 1) orelse
+ (MsgID =:= 2) orelse
+ (MsgID =:= 3)) andalso
+ (is_integer(MaxOutstanding) andalso (MaxOutstanding > 0)) ->
+ State;
+process_client_args_ensure_max_outstanding(
+ #{msg_id := MsgID,
+ max_outstanding := MaxOutstanding}) ->
+ usage(f("Invalid Msg ID (~w) and Max Outstanding (~w)",
+ [MsgID, MaxOutstanding])).
+
+
+
+%% ==========================================================================
+
+exec(#{role := server,
+ active := Active,
+ transport := gen}) ->
+ case socket_test_ttest_tcp_server_gen:start(Active) of
+ {ok, {Pid, _}} ->
+ MRef = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', MRef, process, Pid, Info} ->
+ Info
+ end;
+ {error, Reason} ->
+ eprint(f("Failed starting server: "
+ "~n ~p", [Reason])),
+ error
+ end;
+exec(#{role := server,
+ active := Active,
+ transport := {sock, Method}}) ->
+ case socket_test_ttest_tcp_server_socket:start(Method, Active) of
+ {ok, {Pid, _}} ->
+ MRef = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', MRef, process, Pid, Info} ->
+ Info
+ end;
+ {error, Reason} ->
+ eprint(f("Failed starting server: "
+ "~n ~p", [Reason])),
+ error
+ end;
+
+exec(#{role := client,
+ server := undefined}) ->
+ usage("Mandatory option 'server' not provided");
+exec(#{role := client,
+ server := {Addr, Port},
+ active := Active,
+ transport := gen,
+ msg_id := MsgID,
+ max_outstanding := MaxOutstanding,
+ runtime := RunTime}) ->
+ case socket_test_ttest_tcp_client_gen:start(true,
+ Active,
+ Addr, Port,
+ MsgID, MaxOutstanding,
+ RunTime) of
+ {ok, Pid} ->
+ MRef = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', MRef, process, Pid, Info} ->
+ Info
+ end;
+ {error, Reason} ->
+ eprint(f("Failed starting server: "
+ "~n ~p", [Reason])),
+ error
+ end;
+exec(#{role := client,
+ server := {Addr, Port},
+ active := Active,
+ transport := {sock, Method},
+ msg_id := MsgID,
+ max_outstanding := MaxOutstanding,
+ runtime := RunTime}) ->
+ case socket_test_ttest_tcp_client_socket:start(true,
+ Method,
+ Active,
+ Addr, Port,
+ MsgID, MaxOutstanding,
+ RunTime) of
+ {ok, Pid} ->
+ MRef = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', MRef, process, Pid, Info} ->
+ Info
+ end;
+ {error, Reason} ->
+ eprint(f("Failed starting server: "
+ "~n ~p", [Reason])),
+ error
+ end;
+exec(_) ->
+ usage("Unexpected option combo"),
+ ok.
+
+
+
+%% ==========================================================================
+
+f(F, A) ->
+ socket_test_ttest_lib:format(F, A).
+
+eprint(ErrorString) when is_list(ErrorString) ->
+ print("<ERROR> " ++ ErrorString ++ "~n", []).
+
+print(F, A) ->
+ io:format(F ++ "~n", A).
+
+scriptname() ->
+ FullName = escript:script_name(),
+ filename:basename(FullName).
+
diff --git a/erts/emulator/test/esock_ttest/esock-ttest-client b/erts/emulator/test/esock_ttest/esock-ttest-client
new file mode 100755
index 0000000000..1ab56f2d44
--- /dev/null
+++ b/erts/emulator/test/esock_ttest/esock-ttest-client
@@ -0,0 +1,72 @@
+#!/bin/sh
+
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2019-2019. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+
+EMU=$ERL_TOP/erts/emulator
+EMU_TEST=$EMU/test
+ESOCK_TTEST=$EMU_TEST/esock_ttest
+
+RUNTIME=30
+
+MSGID=$1
+SERVER_ADDR=$2
+SERVER_PORT=$3
+
+# ---------------------------------------------------------------------------
+
+ITERATIONS="\
+ gen false $MSGID
+ gen true $MSGID
+ gen once $MSGID
+ sock false $MSGID
+ sock true $MSGID
+ sock once $MSGID"
+
+# gen false 2
+# gen true 2
+# gen once 2
+# sock false 2
+# sock true 2
+# sock once 2
+# gen false 3
+# gen true 3
+# gen once 3
+# sock false 3
+# sock true 3
+# sock once 3
+#
+
+# ---------------------------------------------------------------------------
+
+echo "$ITERATIONS" |
+ while read TRANSPORT ACTIVE MSG_ID; do
+
+ echo ""
+ echo "=========== transport = $TRANSPORT, active = $ACTIVE, msg-id = $MSG_ID ==========="
+ # The /dev/null at the end is necessary because erlang "does things" with stdin
+ # and this case would cause the 'while read' to "fail" so that we only would
+ # loop one time
+ $ESOCK_TTEST/esock-ttest --client --transport $TRANSPORT --active $ACTIVE --msg-id $MSG_ID --scon $SERVER_ADDR:$SERVER_PORT --runtime $RUNTIME </dev/null
+ echo ""
+
+ done
+
+
diff --git a/erts/emulator/test/esock_ttest/esock-ttest-server-gen b/erts/emulator/test/esock_ttest/esock-ttest-server-gen
new file mode 100755
index 0000000000..c29184772e
--- /dev/null
+++ b/erts/emulator/test/esock_ttest/esock-ttest-server-gen
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2019-2019. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+
+EMU=$ERL_TOP/erts/emulator
+EMU_TEST=$EMU/test
+ESOCK_TTEST=$EMU_TEST/esock_ttest
+
+if [ $# = 1 ]; then
+ ACTIVE="--active $1"
+fi
+
+$ESOCK_TTEST/esock-ttest --server --transport gen $ACTIVE
+
diff --git a/erts/emulator/test/esock_ttest/esock-ttest-server-sock b/erts/emulator/test/esock_ttest/esock-ttest-server-sock
new file mode 100755
index 0000000000..4ec0d335d9
--- /dev/null
+++ b/erts/emulator/test/esock_ttest/esock-ttest-server-sock
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2019-2019. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+
+EMU=$ERL_TOP/erts/emulator
+EMU_TEST=$EMU/test
+ESOCK_TTEST=$EMU_TEST/esock_ttest
+
+if [ $# = 1 ]; then
+ ACTIVE="--active $1"
+fi
+
+$ESOCK_TTEST/esock-ttest --server --transport sock $ACTIVE
+
diff --git a/erts/emulator/test/net_SUITE.erl b/erts/emulator/test/net_SUITE.erl
new file mode 100644
index 0000000000..1a973cacb2
--- /dev/null
+++ b/erts/emulator/test/net_SUITE.erl
@@ -0,0 +1,481 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2019-2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% This test suite is basically a "placeholder" for a proper test suite...
+%%
+
+%% Run the entire test suite:
+%% ts:run(emulator, net_SUITE, [batch]).
+%%
+%% Run a specific group:
+%% ts:run(emulator, net_SUITE, {group, foo}, [batch]).
+%%
+%% Run a specific test case:
+%% ts:run(emulator, net_SUITE, foo, [batch]).
+
+-module(net_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+%% Suite exports
+-export([suite/0, all/0, groups/0]).
+-export([init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2]).
+
+%% Test cases
+-export([
+ %% *** API Basic ***
+ api_b_gethostname/1,
+ api_b_name_and_addr_info/1,
+
+ api_b_name_and_index/1
+
+ %% Tickets
+ ]).
+
+
+%% -include("socket_test_evaluator.hrl").
+
+%% Internal exports
+%% -export([]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(SLEEP(T), receive after T -> ok end).
+
+-define(FAIL(R), exit(R)).
+
+-define(MINS(M), timer:minutes(M)).
+-define(SECS(S), timer:seconds(S)).
+
+-define(TT(T), ct:timetrap(T)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,1}}].
+
+all() ->
+ Groups = [{api, "ENET_TEST_API", include}],
+ [use_group(Group, Env, Default) || {Group, Env, Default} <- Groups].
+
+use_group(Group, Env, Default) ->
+ case os:getenv(Env) of
+ false when (Default =:= include) ->
+ [{group, Group}];
+ false ->
+ [];
+ Val ->
+ case list_to_atom(string:to_lower(Val)) of
+ Use when (Use =:= include) orelse
+ (Use =:= enable) orelse
+ (Use =:= true) ->
+ [{group, Group}];
+ _ ->
+ []
+ end
+ end.
+
+
+groups() ->
+ [{api, [], api_cases()},
+ {api_basic, [], api_basic_cases()}
+
+ %% {tickets, [], ticket_cases()}
+ ].
+
+api_cases() ->
+ [
+ {group, api_basic}
+ ].
+
+api_basic_cases() ->
+ [
+ api_b_gethostname,
+ api_b_name_and_addr_info,
+ api_b_name_and_index
+ ].
+
+%% ticket_cases() ->
+%% [].
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+init_per_suite(Config) ->
+ case os:type() of
+ {win32, _} ->
+ not_yet_implemented();
+ _ ->
+ %% ?LOGGER:start(),
+ Config
+ end.
+
+end_per_suite(_) ->
+ %% ?LOGGER:stop(),
+ ok.
+
+init_per_group(_Group, Config) ->
+ Config.
+
+end_per_group(_Group, Config) ->
+ Config.
+
+
+init_per_testcase(_TC, Config) ->
+ Config.
+
+end_per_testcase(_TC, Config) ->
+ Config.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% API BASIC %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Get the hostname of the host.
+api_b_gethostname(suite) ->
+ [];
+api_b_gethostname(doc) ->
+ [];
+api_b_gethostname(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_b_gethostname,
+ fun() ->
+ ok = api_b_gethostname()
+ end).
+
+
+api_b_gethostname() ->
+ case net:gethostname() of
+ {ok, Hostname} ->
+ i("hostname: ~s", [Hostname]),
+ ok;
+ {error, Reason} ->
+ ?FAIL(Reason)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Get name and address info.
+api_b_name_and_addr_info(suite) ->
+ [];
+api_b_name_and_addr_info(doc) ->
+ [];
+api_b_name_and_addr_info(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_b_name_and_addr_info,
+ fun() ->
+ ok = api_b_name_and_addr_info()
+ end).
+
+
+api_b_name_and_addr_info() ->
+ Domain = inet,
+ Addr = which_local_addr(Domain),
+ SA = #{family => Domain, addr => Addr},
+ Hostname =
+ case net:getnameinfo(SA) of
+ {ok, #{host := Name, service := Service} = NameInfo}
+ when is_list(Name) andalso is_list(Service) ->
+ i("getnameinfo: "
+ "~n ~p", [NameInfo]),
+ Name;
+ {ok, BadNameInfo} ->
+ ?FAIL({getnameinfo, SA, BadNameInfo});
+ {error, Reason1} ->
+ ?FAIL({getnameinfo, SA, Reason1})
+ end,
+ case net:getaddrinfo(Hostname) of
+ {ok, AddrInfos} when is_list(AddrInfos) ->
+ i("getaddrinfo: "
+ "~n ~p", [AddrInfos]),
+ verify_addr_info(AddrInfos, Domain);
+ {ok, BadAddrInfo} ->
+ ?FAIL({getaddrinfo, Hostname, BadAddrInfo});
+ {error, Reason2} ->
+ ?FAIL({getaddrinfo, Hostname, Reason2})
+ end.
+
+
+verify_addr_info(AddrInfos, Domain) when (AddrInfos =/= []) ->
+ verify_addr_info2(AddrInfos, Domain).
+
+verify_addr_info2([], _Domain) ->
+ ok;
+verify_addr_info2([#{addr := #{addr := Addr,
+ family := Domain,
+ port := Port},
+ family := Domain,
+ type := _Type,
+ protocol := _Proto}|T], Domain)
+ when is_integer(Port) andalso
+ (((Domain =:= inet) andalso is_tuple(Addr) andalso (size(Addr) =:= 4)) orelse
+ ((Domain =:= inet6) andalso is_tuple(Addr) andalso (size(Addr) =:= 8))) ->
+ verify_addr_info2(T, Domain);
+verify_addr_info2([#{family := DomainA}|T], DomainB)
+ when (DomainA =/= DomainB) ->
+ %% Ignore entries for other domains
+ verify_addr_info2(T, DomainB);
+verify_addr_info2([BadAddrInfo|_], Domain) ->
+ ?FAIL({bad_address_info, BadAddrInfo, Domain}).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Verify (interface) name and index functions.
+%% if_names/0,
+%% if_name2index/1
+%% if_index2name/1
+api_b_name_and_index(suite) ->
+ [];
+api_b_name_and_index(doc) ->
+ [];
+api_b_name_and_index(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_b_name_and_index,
+ fun() ->
+ ok = api_b_name_and_index()
+ end).
+
+
+api_b_name_and_index() ->
+ Names =
+ case net:if_names() of
+ {ok, N} when is_list(N) andalso (N =/= []) ->
+ N;
+ {error, Reason} ->
+ ?FAIL({if_names, Reason})
+ end,
+ verify_if_names(Names).
+
+verify_if_names([]) ->
+ ok;
+verify_if_names([{Index, Name}|T]) ->
+ case net:if_name2index(Name) of
+ {ok, Index} ->
+ ok;
+ {ok, BadIndex} ->
+ ?FAIL({name2index, Name, Index, BadIndex});
+ {error, ReasonN2I} ->
+ ?FAIL({name2index, Name, ReasonN2I})
+ end,
+ case net:if_index2name(Index) of
+ {ok, Name} ->
+ ok;
+ {ok, BadName} ->
+ ?FAIL({index2name, Index, Name, BadName});
+ {error, ReasonI2N} ->
+ ?FAIL({index2name, Index, ReasonI2N})
+ end,
+ verify_if_names(T).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% local_host() ->
+%% try net_adm:localhost() of
+%% Host when is_list(Host) ->
+%% %% Convert to shortname if long
+%% case string:tokens(Host, [$.]) of
+%% [H|_] ->
+%% list_to_atom(H)
+%% end
+%% catch
+%% C:E:S ->
+%% erlang:raise(C, E, S)
+%% end.
+
+
+%% This gets the local address (not 127.0...)
+%% We should really implement this using the (new) net module,
+%% but until that gets the necessary functionality...
+which_local_addr(Domain) ->
+ case inet:getifaddrs() of
+ {ok, IFL} ->
+ which_addr(Domain, IFL);
+ {error, Reason} ->
+ ?FAIL({inet, getifaddrs, Reason})
+ end.
+
+which_addr(_Domain, []) ->
+ skip(no_address);
+which_addr(Domain, [{"lo" ++ _, _}|IFL]) ->
+ which_addr(Domain, IFL);
+which_addr(Domain, [{_Name, IFO}|IFL]) ->
+ case which_addr2(Domain, IFO) of
+ {ok, Addr} ->
+ Addr;
+ {error, no_address} ->
+ which_addr(Domain, IFL)
+ end;
+which_addr(Domain, [_|IFL]) ->
+ which_addr(Domain, IFL).
+
+which_addr2(_Domain, []) ->
+ {error, no_address};
+which_addr2(inet = _Domain, [{addr, Addr}|_IFO]) when (size(Addr) =:= 4) ->
+ {ok, Addr};
+which_addr2(inet6 = _Domain, [{addr, Addr}|_IFO]) when (size(Addr) =:= 8) ->
+ {ok, Addr};
+which_addr2(Domain, [_|IFO]) ->
+ which_addr2(Domain, IFO).
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+not_yet_implemented() ->
+ skip("not yet implemented").
+
+skip(Reason) ->
+ throw({skip, Reason}).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% t() ->
+%% os:timestamp().
+
+
+%% tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) ->
+%% T1 = A1*1000000000+B1*1000+(C1 div 1000),
+%% T2 = A2*1000000000+B2*1000+(C2 div 1000),
+%% T2 - T1.
+
+
+formated_timestamp() ->
+ format_timestamp(os:timestamp()).
+
+format_timestamp({_N1, _N2, _N3} = TS) ->
+ {_Date, Time} = calendar:now_to_local_time(TS),
+ %% {YYYY,MM,DD} = Date,
+ {Hour,Min,Sec} = Time,
+ %% FormatTS =
+ %% io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w.~w",
+ %% [YYYY, MM, DD, Hour, Min, Sec, N3]),
+ FormatTS = io_lib:format("~.2.0w:~.2.0w:~.2.0w", [Hour, Min, Sec]),
+ lists:flatten(FormatTS).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+set_tc_name(N) when is_atom(N) ->
+ set_tc_name(atom_to_list(N));
+set_tc_name(N) when is_list(N) ->
+ put(tc_name, N).
+
+%% get_tc_name() ->
+%% get(tc_name).
+
+tc_begin(TC) ->
+ set_tc_name(TC),
+ tc_print("begin ***",
+ "~n----------------------------------------------------~n", "").
+
+tc_end(Result) when is_list(Result) ->
+ tc_print("done: ~s", [Result],
+ "", "----------------------------------------------------~n~n"),
+ ok.
+
+
+tc_try(Case, Fun) when is_atom(Case) andalso is_function(Fun, 0) ->
+ tc_begin(Case),
+ try
+ begin
+ Fun(),
+ ?SLEEP(?SECS(1)),
+ tc_end("ok")
+ end
+ catch
+ throw:{skip, _} = SKIP ->
+ tc_end("skipping"),
+ SKIP;
+ Class:Error:Stack ->
+ tc_end("failed"),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+
+tc_print(F, Before, After) ->
+ tc_print(F, [], Before, After).
+
+tc_print(F, A, Before, After) ->
+ Name = tc_which_name(),
+ FStr = f("*** [~s][~s][~p] " ++ F ++ "~n",
+ [formated_timestamp(),Name,self()|A]),
+ io:format(user, Before ++ FStr ++ After, []).
+
+tc_which_name() ->
+ case get(tc_name) of
+ undefined ->
+ case get(sname) of
+ undefined ->
+ "";
+ SName when is_list(SName) ->
+ SName
+ end;
+ Name when is_list(Name) ->
+ Name
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% l2a(S) when is_list(S) ->
+%% list_to_atom(S).
+
+%% l2b(L) when is_list(L) ->
+%% list_to_binary(L).
+
+%% b2l(B) when is_binary(B) ->
+%% binary_to_list(B).
+
+f(F, A) ->
+ lists:flatten(io_lib:format(F, A)).
+
+
+%% i(F) ->
+%% i(F, []).
+
+i(F, A) ->
+ FStr = f("[~s] " ++ F, [formated_timestamp()|A]),
+ io:format(user, FStr ++ "~n", []),
+ io:format(FStr, []).
+
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index 0d0930e124..2309f844b9 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -64,7 +64,9 @@
nif_phash2/1,
nif_whereis/1, nif_whereis_parallel/1,
nif_whereis_threaded/1, nif_whereis_proxy/1,
- nif_ioq/1
+ nif_ioq/1,
+ pid/1,
+ nif_term_type/1
]).
-export([many_args_100/100]).
@@ -103,7 +105,9 @@ all() ->
nif_internal_hash_salted,
nif_phash2,
nif_whereis, nif_whereis_parallel, nif_whereis_threaded,
- nif_ioq].
+ nif_ioq,
+ pid,
+ nif_term_type].
groups() ->
[{G, [], api_repeaters()} || G <- api_groups()]
@@ -822,8 +826,11 @@ demonitor_process(Config) ->
end),
R_ptr = alloc_monitor_resource_nif(),
{0,MonBin1} = monitor_process_nif(R_ptr, Pid, true, self()),
+ MonTerm1 = make_monitor_term_nif(MonBin1),
[R_ptr] = monitored_by(Pid),
{0,MonBin2} = monitor_process_nif(R_ptr, Pid, true, self()),
+ MonTerm2 = make_monitor_term_nif(MonBin2),
+ true = (MonTerm1 =/= MonTerm2),
[R_ptr, R_ptr] = monitored_by(Pid),
0 = demonitor_process_nif(R_ptr, MonBin1),
[R_ptr] = monitored_by(Pid),
@@ -837,6 +844,10 @@ demonitor_process(Config) ->
{R_ptr, _, 1} = last_resource_dtor_call(),
[] = monitored_by(Pid),
Pid ! return,
+
+ erlang:garbage_collect(),
+ true = (MonTerm1 =/= MonTerm2),
+ io:format("MonTerm1 = ~p\nMonTerm2 = ~p\n", [MonTerm1, MonTerm2]),
ok.
@@ -1208,6 +1219,15 @@ maps(Config) when is_list(Config) ->
M2 = maps_from_list_nif(maps:to_list(M2)),
M3 = maps_from_list_nif(maps:to_list(M3)),
+ %% Test different map sizes (OTP-15567)
+ repeat_while(fun({35,_}) -> false;
+ ({K,Map}) ->
+ Map = maps_from_list_nif(maps:to_list(Map)),
+ Map = maps:filter(fun(K,V) -> V =:= K*100 end, Map),
+ {K+1, maps:put(K,K*100,Map)}
+ end,
+ {1,#{}}),
+
has_duplicate_keys = maps_from_list_nif([{1,1},{1,1}]),
verify_tmpmem(TmpMem),
@@ -2504,6 +2524,13 @@ repeat(0, _, Arg) ->
repeat(N, Fun, Arg0) ->
repeat(N-1, Fun, Fun(Arg0)).
+repeat_while(Fun, Acc0) ->
+ case Fun(Acc0) of
+ false -> ok;
+ Acc1 ->
+ repeat_while(Fun, Acc1)
+ end.
+
check(Exp,Got,Line) ->
case Got of
Exp -> Exp;
@@ -3344,6 +3371,65 @@ make_unaligned_binary(Bin0) ->
<<0:3,Bin:Size/binary,31:5>> = id(<<0:3,Bin0/binary,31:5>>),
Bin.
+pid(Config) ->
+ ensure_lib_loaded(Config),
+ Self = self(),
+ {true, ErlNifPid} = get_local_pid_nif(Self),
+ false = is_pid_undefined_nif(ErlNifPid),
+ Self = make_pid_nif(ErlNifPid),
+
+ UndefPid = set_pid_undefined_nif(),
+ true = is_pid_undefined_nif(UndefPid),
+ undefined = make_pid_nif(UndefPid),
+ 0 = send_term(UndefPid, message),
+
+ Other = spawn(fun() -> ok end),
+ {true,OtherNifPid} = get_local_pid_nif(Other),
+ Cmp = compare_pids_nif(ErlNifPid, OtherNifPid),
+ true = if Cmp < 0 -> Self < Other;
+ Cmp > 0 -> Self > Other
+ end,
+ 0 = compare_pids_nif(ErlNifPid, ErlNifPid),
+
+ {false, _} = get_local_pid_nif(undefined),
+ ok.
+
+nif_term_type(Config) ->
+ ensure_lib_loaded(Config),
+
+ atom = term_type_nif(atom),
+
+ bitstring = term_type_nif(<<1:1>>),
+ bitstring = term_type_nif(<<1:8>>),
+
+ float = term_type_nif(0.0),
+
+ 'fun' = term_type_nif(fun external:function/1),
+ 'fun' = term_type_nif(fun(A) -> A end),
+ 'fun' = term_type_nif(fun id/1),
+
+ integer = term_type_nif(1 bsl 1024), %Bignum.
+ integer = term_type_nif(1),
+
+ list = term_type_nif([list]),
+ list = term_type_nif([]),
+
+ LargeMap = maps:from_list([{N, N} || N <- lists:seq(1, 256)]),
+ map = term_type_nif(LargeMap),
+ map = term_type_nif(#{ small => map }),
+
+ pid = term_type_nif(self()),
+
+ Port = open_port({spawn,echo_drv},[eof]),
+ port = term_type_nif(Port),
+ port_close(Port),
+
+ reference = term_type_nif(make_ref()),
+
+ tuple = term_type_nif({}),
+
+ ok.
+
id(I) -> I.
%% The NIFs:
@@ -3421,6 +3507,7 @@ alloc_monitor_resource_nif() -> ?nif_stub.
monitor_process_nif(_,_,_,_) -> ?nif_stub.
demonitor_process_nif(_,_) -> ?nif_stub.
compare_monitors_nif(_,_) -> ?nif_stub.
+make_monitor_term_nif(_) -> ?nif_stub.
monitor_frenzy_nif(_,_,_,_) -> ?nif_stub.
ioq_nif(_) -> ?nif_stub.
ioq_nif(_,_) -> ?nif_stub.
@@ -3451,5 +3538,13 @@ convert_time_unit(_,_,_) -> ?nif_stub.
now_time() -> ?nif_stub.
cpu_time() -> ?nif_stub.
+get_local_pid_nif(_) -> ?nif_stub.
+make_pid_nif(_) -> ?nif_stub.
+set_pid_undefined_nif() -> ?nif_stub.
+is_pid_undefined_nif(_) -> ?nif_stub.
+compare_pids_nif(_, _) -> ?nif_stub.
+
+term_type_nif(_) -> ?nif_stub.
+
nif_stub_error(Line) ->
exit({nif_not_loaded,module,?MODULE,line,Line}).
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index 21af4b05b3..1906384af4 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -1882,12 +1882,23 @@ static ERL_NIF_TERM copy_blob(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
return enif_make_copy(env, mti.p->blob);
}
+static int get_pidbin(ErlNifEnv* env, ERL_NIF_TERM pidbin, ErlNifPid* pid)
+{
+ ErlNifBinary bin;
+
+ if (!enif_inspect_binary(env, pidbin, &bin) || bin.size != sizeof(ErlNifPid))
+ return 0;
+
+ memcpy(pid, bin.data, bin.size);
+ return 1;
+}
+
static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
ErlNifEnv* menv;
ErlNifPid pid;
int ret;
- if (!enif_get_local_pid(env, argv[0], &pid)) {
+ if (!enif_get_local_pid(env, argv[0], &pid) && !get_pidbin(env, argv[0], &pid)) {
return enif_make_badarg(env);
}
menv = enif_alloc_env();
@@ -2847,6 +2858,16 @@ static ERL_NIF_TERM compare_monitors_nif(ErlNifEnv* env, int argc, const ERL_NIF
return enif_make_int(env, enif_compare_monitors(&m1, &m2));
}
+static ERL_NIF_TERM make_monitor_term_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifMonitor m;
+ if (!get_monitor(env, argv[0], &m)) {
+ return enif_make_badarg(env);
+ }
+
+ return enif_make_monitor_term(env, &m);
+}
+
/*********** monitor_frenzy ************/
@@ -3503,6 +3524,95 @@ static ERL_NIF_TERM ioq(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
return enif_make_badarg(env);
}
+static ERL_NIF_TERM make_bool(ErlNifEnv* env, int bool)
+{
+ return bool ? atom_true : atom_false;
+}
+
+static ERL_NIF_TERM get_local_pid_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid pid;
+ ERL_NIF_TERM pid_bin;
+ int ret = enif_get_local_pid(env, argv[0], &pid);
+
+ memcpy(enif_make_new_binary(env, sizeof(ErlNifPid), &pid_bin),
+ &pid, sizeof(ErlNifPid));
+
+ return enif_make_tuple2(env, make_bool(env, ret), pid_bin);
+}
+
+static ERL_NIF_TERM make_pid_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid pid;
+
+ if (!get_pidbin(env, argv[0], &pid))
+ return enif_make_badarg(env);
+
+ return enif_make_pid(env, &pid);
+}
+
+static ERL_NIF_TERM set_pid_undefined_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid pid;
+ ERL_NIF_TERM pid_bin;
+
+ enif_set_pid_undefined(&pid);
+ memcpy(enif_make_new_binary(env, sizeof(ErlNifPid), &pid_bin),
+ &pid, sizeof(ErlNifPid));
+
+ return pid_bin;
+}
+
+static ERL_NIF_TERM is_pid_undefined_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid pid;
+
+ if (!get_pidbin(env, argv[0], &pid))
+ return enif_make_badarg(env);
+
+ return make_bool(env, enif_is_pid_undefined(&pid));
+}
+
+static ERL_NIF_TERM compare_pids_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifPid a, b;
+
+ if (!get_pidbin(env, argv[0], &a) || !get_pidbin(env, argv[1], &b))
+ return enif_make_badarg(env);
+
+ return enif_make_int(env, enif_compare_pids(&a, &b));
+}
+
+static ERL_NIF_TERM term_type_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ switch (enif_term_type(env, argv[0])) {
+ case ERL_NIF_TERM_TYPE_ATOM:
+ return enif_make_atom(env, "atom");
+ case ERL_NIF_TERM_TYPE_BITSTRING:
+ return enif_make_atom(env, "bitstring");
+ case ERL_NIF_TERM_TYPE_FLOAT:
+ return enif_make_atom(env, "float");
+ case ERL_NIF_TERM_TYPE_FUN:
+ return enif_make_atom(env, "fun");
+ case ERL_NIF_TERM_TYPE_INTEGER:
+ return enif_make_atom(env, "integer");
+ case ERL_NIF_TERM_TYPE_LIST:
+ return enif_make_atom(env, "list");
+ case ERL_NIF_TERM_TYPE_MAP:
+ return enif_make_atom(env, "map");
+ case ERL_NIF_TERM_TYPE_PID:
+ return enif_make_atom(env, "pid");
+ case ERL_NIF_TERM_TYPE_PORT:
+ return enif_make_atom(env, "port");
+ case ERL_NIF_TERM_TYPE_REFERENCE:
+ return enif_make_atom(env, "reference");
+ case ERL_NIF_TERM_TYPE_TUPLE:
+ return enif_make_atom(env, "tuple");
+ default:
+ return enif_make_badarg(env);
+ }
+}
+
static ErlNifFunc nif_funcs[] =
{
{"lib_version", 0, lib_version},
@@ -3596,6 +3706,7 @@ static ErlNifFunc nif_funcs[] =
{"monitor_process_nif", 4, monitor_process_nif},
{"demonitor_process_nif", 2, demonitor_process_nif},
{"compare_monitors_nif", 2, compare_monitors_nif},
+ {"make_monitor_term_nif", 1, make_monitor_term_nif},
{"monitor_frenzy_nif", 4, monitor_frenzy_nif},
{"whereis_send", 3, whereis_send},
{"whereis_term", 2, whereis_term},
@@ -3604,7 +3715,13 @@ static ErlNifFunc nif_funcs[] =
{"ioq_nif", 1, ioq},
{"ioq_nif", 2, ioq},
{"ioq_nif", 3, ioq},
- {"ioq_nif", 4, ioq}
+ {"ioq_nif", 4, ioq},
+ {"get_local_pid_nif", 1, get_local_pid_nif},
+ {"make_pid_nif", 1, make_pid_nif},
+ {"set_pid_undefined_nif", 0, set_pid_undefined_nif},
+ {"is_pid_undefined_nif", 1, is_pid_undefined_nif},
+ {"compare_pids_nif", 2, compare_pids_nif},
+ {"term_type_nif", 1, term_type_nif}
};
ERL_NIF_INIT(nif_SUITE,nif_funcs,load,NULL,upgrade,unload)
diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl
index b3d8f9584d..ef4635a6f5 100644
--- a/erts/emulator/test/node_container_SUITE.erl
+++ b/erts/emulator/test/node_container_SUITE.erl
@@ -71,25 +71,10 @@ init_per_suite(Config) ->
end_per_suite(_Config) ->
erts_debug:set_internal_state(available_internal_state, true),
erts_debug:set_internal_state(node_tab_delayed_delete, -1), %% restore original value
- available_internal_state(false).
-
-available_internal_state(Bool) when Bool == true; Bool == false ->
- case {Bool,
- (catch erts_debug:get_internal_state(available_internal_state))} of
- {true, true} ->
- true;
- {false, true} ->
- erts_debug:set_internal_state(available_internal_state, false),
- true;
- {true, _} ->
- erts_debug:set_internal_state(available_internal_state, true),
- false;
- {false, _} ->
- false
- end.
+ erts_test_utils:available_internal_state(false).
init_per_testcase(_Case, Config) when is_list(Config) ->
- available_internal_state(true),
+ erts_test_utils:available_internal_state(true),
Config.
end_per_testcase(_Case, Config) when is_list(Config) ->
@@ -928,9 +913,9 @@ id(X) ->
-define(ND_REFS, erts_debug:get_internal_state(node_and_dist_references)).
node_container_refc_check(Node) when is_atom(Node) ->
- AIS = available_internal_state(true),
+ AIS = erts_test_utils:available_internal_state(true),
nc_refc_check(Node),
- available_internal_state(AIS).
+ erts_test_utils:available_internal_state(AIS).
nc_refc_check(Node) when is_atom(Node) ->
Ref = make_ref(),
diff --git a/erts/emulator/test/persistent_term_SUITE.erl b/erts/emulator/test/persistent_term_SUITE.erl
index 58038e24b7..93eb026ced 100644
--- a/erts/emulator/test/persistent_term_SUITE.erl
+++ b/erts/emulator/test/persistent_term_SUITE.erl
@@ -6,7 +6,7 @@
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
-%5
+%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
@@ -60,7 +60,8 @@ basic(_Config) ->
Key = {?MODULE,{key,I}},
true = persistent_term:erase(Key),
false = persistent_term:erase(Key),
- {'EXIT',{badarg,_}} = (catch persistent_term:get(Key))
+ {'EXIT',{badarg,_}} = (catch persistent_term:get(Key)),
+ {not_present,Key} = persistent_term:get(Key, {not_present,Key})
end || I <- Seq],
[] = [P || {{?MODULE,_},_}=P <- pget(Chk)],
chk(Chk).
diff --git a/erts/emulator/test/socket_SUITE.erl b/erts/emulator/test/socket_SUITE.erl
new file mode 100644
index 0000000000..8a32efcd85
--- /dev/null
+++ b/erts/emulator/test/socket_SUITE.erl
@@ -0,0 +1,17992 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% There are some environment variables that can be used to "manipulate"
+%% the test suite:
+%%
+%% Variable that controls which 'groups' are to run (with default values)
+%%
+%% ESOCK_TEST_API: include
+%% ESOCK_TEST_SOCK_CLOSE: include
+%% ESOCK_TEST_TRAFFIC: include
+%% ESOCK_TEST_TTEST: exclude
+%%
+%% Defines the runtime of the ttest cases
+%% (This is the time during which "measurement" is performed.
+%% the actual time it takes for the test case to complete
+%% will be longer)
+%%
+%% ESOCK_TEST_TTEST_RUNTIME: 10 seconds
+%% Format of values: <integer>[<unit>]
+%% Where unit is: ms | s | m
+%% ms - milli seconds
+%% s - seconds (default)
+%% m - minutes
+%%
+
+%% Run the entire test suite:
+%% ts:run(emulator, socket_SUITE, [batch]).
+%%
+%% Run a specific group:
+%% ts:run(emulator, socket_SUITE, {group, foo}, [batch]).
+%%
+%% Run a specific test case:
+%% ts:run(emulator, socket_SUITE, foo, [batch]).
+
+-module(socket_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+%% Suite exports
+-export([suite/0, all/0, groups/0]).
+-export([init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ init_per_testcase/2, end_per_testcase/2]).
+
+%% Test cases
+-export([
+ %% *** API Basic ***
+ api_b_open_and_close_udp4/1,
+ api_b_open_and_close_tcp4/1,
+ api_b_sendto_and_recvfrom_udp4/1,
+ api_b_sendmsg_and_recvmsg_udp4/1,
+ api_b_send_and_recv_tcp4/1,
+ api_b_sendmsg_and_recvmsg_tcp4/1,
+
+ %% *** API Options ***
+ api_opt_simple_otp_options/1,
+ api_opt_simple_otp_rcvbuf_option/1,
+ api_opt_simple_otp_controlling_process/1,
+
+ %% *** API Operation Timeout ***
+ api_to_connect_tcp4/1,
+ api_to_connect_tcp6/1,
+ api_to_accept_tcp4/1,
+ api_to_accept_tcp6/1,
+ api_to_maccept_tcp4/1,
+ api_to_maccept_tcp6/1,
+ api_to_send_tcp4/1,
+ api_to_send_tcp6/1,
+ api_to_sendto_udp4/1,
+ api_to_sendto_udp6/1,
+ api_to_sendmsg_tcp4/1,
+ api_to_sendmsg_tcp6/1,
+ api_to_recv_udp4/1,
+ api_to_recv_udp6/1,
+ api_to_recv_tcp4/1,
+ api_to_recv_tcp6/1,
+ api_to_recvfrom_udp4/1,
+ api_to_recvfrom_udp6/1,
+ api_to_recvmsg_udp4/1,
+ api_to_recvmsg_udp6/1,
+ api_to_recvmsg_tcp4/1,
+ api_to_recvmsg_tcp6/1,
+
+ %% *** Socket Closure ***
+ sc_cpe_socket_cleanup_tcp4/1,
+ sc_cpe_socket_cleanup_tcp6/1,
+ sc_cpe_socket_cleanup_udp4/1,
+ sc_cpe_socket_cleanup_udp6/1,
+
+ sc_lc_recv_response_tcp4/1,
+ sc_lc_recv_response_tcp6/1,
+ sc_lc_recvfrom_response_udp4/1,
+ sc_lc_recvfrom_response_udp6/1,
+ sc_lc_recvmsg_response_tcp4/1,
+ sc_lc_recvmsg_response_tcp6/1,
+ sc_lc_recvmsg_response_udp4/1,
+ sc_lc_recvmsg_response_udp6/1,
+ sc_lc_acceptor_response_tcp4/1,
+ sc_lc_acceptor_response_tcp6/1,
+
+ sc_rc_recv_response_tcp4/1,
+ sc_rc_recv_response_tcp6/1,
+ sc_rc_recvmsg_response_tcp4/1,
+ sc_rc_recvmsg_response_tcp6/1,
+
+ sc_rs_recv_send_shutdown_receive_tcp4/1,
+ sc_rs_recv_send_shutdown_receive_tcp6/1,
+ sc_rs_recvmsg_send_shutdown_receive_tcp4/1,
+ sc_rs_recvmsg_send_shutdown_receive_tcp6/1,
+
+ %% *** Traffic ***
+ traffic_send_and_recv_chunks_tcp4/1,
+ traffic_send_and_recv_chunks_tcp6/1,
+
+ traffic_ping_pong_small_send_and_recv_tcp4/1,
+ traffic_ping_pong_small_send_and_recv_tcp6/1,
+ traffic_ping_pong_medium_send_and_recv_tcp4/1,
+ traffic_ping_pong_medium_send_and_recv_tcp6/1,
+ traffic_ping_pong_large_send_and_recv_tcp4/1,
+ traffic_ping_pong_large_send_and_recv_tcp6/1,
+
+ traffic_ping_pong_small_sendto_and_recvfrom_udp4/1,
+ traffic_ping_pong_small_sendto_and_recvfrom_udp6/1,
+ traffic_ping_pong_medium_sendto_and_recvfrom_udp4/1,
+ traffic_ping_pong_medium_sendto_and_recvfrom_udp6/1,
+
+ traffic_ping_pong_small_sendmsg_and_recvmsg_tcp4/1,
+ traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6/1,
+ traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp4/1,
+ traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6/1,
+ traffic_ping_pong_large_sendmsg_and_recvmsg_tcp4/1,
+ traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6/1,
+
+ traffic_ping_pong_small_sendmsg_and_recvmsg_udp4/1,
+ traffic_ping_pong_small_sendmsg_and_recvmsg_udp6/1,
+ traffic_ping_pong_medium_sendmsg_and_recvmsg_udp4/1,
+ traffic_ping_pong_medium_sendmsg_and_recvmsg_udp6/1,
+
+ %% *** Time Test ***
+ %% Server: transport = gen_tcp, active = false
+ %% Client: transport = gen_tcp
+ ttest_sgenf_cgenf_small_tcp4/1,
+ ttest_sgenf_cgenf_small_tcp6/1,
+ ttest_sgenf_cgenf_medium_tcp4/1,
+ ttest_sgenf_cgenf_medium_tcp6/1,
+ ttest_sgenf_cgenf_large_tcp4/1,
+ ttest_sgenf_cgenf_large_tcp6/1,
+
+ ttest_sgenf_cgeno_small_tcp4/1,
+ ttest_sgenf_cgeno_small_tcp6/1,
+ ttest_sgenf_cgeno_medium_tcp4/1,
+ ttest_sgenf_cgeno_medium_tcp6/1,
+ ttest_sgenf_cgeno_large_tcp4/1,
+ ttest_sgenf_cgeno_large_tcp6/1,
+
+ ttest_sgenf_cgent_small_tcp4/1,
+ ttest_sgenf_cgent_small_tcp6/1,
+ ttest_sgenf_cgent_medium_tcp4/1,
+ ttest_sgenf_cgent_medium_tcp6/1,
+ ttest_sgenf_cgent_large_tcp4/1,
+ ttest_sgenf_cgent_large_tcp6/1,
+
+ %% Server: transport = gen_tcp, active = false
+ %% Client: transport = socket(tcp)
+ ttest_sgenf_csockf_small_tcp4/1,
+ ttest_sgenf_csockf_small_tcp6/1,
+ ttest_sgenf_csockf_medium_tcp4/1,
+ ttest_sgenf_csockf_medium_tcp6/1,
+ ttest_sgenf_csockf_large_tcp4/1,
+ ttest_sgenf_csockf_large_tcp6/1,
+
+ ttest_sgenf_csocko_small_tcp4/1,
+ ttest_sgenf_csocko_small_tcp6/1,
+ ttest_sgenf_csocko_medium_tcp4/1,
+ ttest_sgenf_csocko_medium_tcp6/1,
+ ttest_sgenf_csocko_large_tcp4/1,
+ ttest_sgenf_csocko_large_tcp6/1,
+
+ ttest_sgenf_csockt_small_tcp4/1,
+ ttest_sgenf_csockt_small_tcp6/1,
+ ttest_sgenf_csockt_medium_tcp4/1,
+ ttest_sgenf_csockt_medium_tcp6/1,
+ ttest_sgenf_csockt_large_tcp4/1,
+ ttest_sgenf_csockt_large_tcp6/1,
+
+ %% Server: transport = gen_tcp, active = once
+ %% Client: transport = gen_tcp
+ ttest_sgeno_cgenf_small_tcp4/1,
+ ttest_sgeno_cgenf_small_tcp6/1,
+ ttest_sgeno_cgenf_medium_tcp4/1,
+ ttest_sgeno_cgenf_medium_tcp6/1,
+ ttest_sgeno_cgenf_large_tcp4/1,
+ ttest_sgeno_cgenf_large_tcp6/1,
+
+ ttest_sgeno_cgeno_small_tcp4/1,
+ ttest_sgeno_cgeno_small_tcp6/1,
+ ttest_sgeno_cgeno_medium_tcp4/1,
+ ttest_sgeno_cgeno_medium_tcp6/1,
+ ttest_sgeno_cgeno_large_tcp4/1,
+ ttest_sgeno_cgeno_large_tcp6/1,
+
+ ttest_sgeno_cgent_small_tcp4/1,
+ ttest_sgeno_cgent_small_tcp6/1,
+ ttest_sgeno_cgent_medium_tcp4/1,
+ ttest_sgeno_cgent_medium_tcp6/1,
+ ttest_sgeno_cgent_large_tcp4/1,
+ ttest_sgeno_cgent_large_tcp6/1,
+
+ %% Server: transport = gen_tcp, active = once
+ %% Client: transport = socket(tcp)
+ ttest_sgeno_csockf_small_tcp4/1,
+ ttest_sgeno_csockf_small_tcp6/1,
+ ttest_sgeno_csockf_medium_tcp4/1,
+ ttest_sgeno_csockf_medium_tcp6/1,
+ ttest_sgeno_csockf_large_tcp4/1,
+ ttest_sgeno_csockf_large_tcp6/1,
+
+ ttest_sgeno_csocko_small_tcp4/1,
+ ttest_sgeno_csocko_small_tcp6/1,
+ ttest_sgeno_csocko_medium_tcp4/1,
+ ttest_sgeno_csocko_medium_tcp6/1,
+ ttest_sgeno_csocko_large_tcp4/1,
+ ttest_sgeno_csocko_large_tcp6/1,
+
+ ttest_sgeno_csockt_small_tcp4/1,
+ ttest_sgeno_csockt_small_tcp6/1,
+ ttest_sgeno_csockt_medium_tcp4/1,
+ ttest_sgeno_csockt_medium_tcp6/1,
+ ttest_sgeno_csockt_large_tcp4/1,
+ ttest_sgeno_csockt_large_tcp6/1,
+
+ %% Server: transport = gen_tcp, active = true
+ %% Client: transport = gen_tcp
+ ttest_sgent_cgenf_small_tcp4/1,
+ ttest_sgent_cgenf_small_tcp6/1,
+ ttest_sgent_cgenf_medium_tcp4/1,
+ ttest_sgent_cgenf_medium_tcp6/1,
+ ttest_sgent_cgenf_large_tcp4/1,
+ ttest_sgent_cgenf_large_tcp6/1,
+
+ ttest_sgent_cgeno_small_tcp4/1,
+ ttest_sgent_cgeno_small_tcp6/1,
+ ttest_sgent_cgeno_medium_tcp4/1,
+ ttest_sgent_cgeno_medium_tcp6/1,
+ ttest_sgent_cgeno_large_tcp4/1,
+ ttest_sgent_cgeno_large_tcp6/1,
+
+ ttest_sgent_cgent_small_tcp4/1,
+ ttest_sgent_cgent_small_tcp6/1,
+ ttest_sgent_cgent_medium_tcp4/1,
+ ttest_sgent_cgent_medium_tcp6/1,
+ ttest_sgent_cgent_large_tcp4/1,
+ ttest_sgent_cgent_large_tcp6/1,
+
+ %% Server: transport = gen_tcp, active = true
+ %% Client: transport = socket(tcp)
+ ttest_sgent_csockf_small_tcp4/1,
+ ttest_sgent_csockf_small_tcp6/1,
+ ttest_sgent_csockf_medium_tcp4/1,
+ ttest_sgent_csockf_medium_tcp6/1,
+ ttest_sgent_csockf_large_tcp4/1,
+ ttest_sgent_csockf_large_tcp6/1,
+
+ ttest_sgent_csocko_small_tcp4/1,
+ ttest_sgent_csocko_small_tcp6/1,
+ ttest_sgent_csocko_medium_tcp4/1,
+ ttest_sgent_csocko_medium_tcp6/1,
+ ttest_sgent_csocko_large_tcp4/1,
+ ttest_sgent_csocko_large_tcp6/1,
+
+ ttest_sgent_csockt_small_tcp4/1,
+ ttest_sgent_csockt_small_tcp6/1,
+ ttest_sgent_csockt_medium_tcp4/1,
+ ttest_sgent_csockt_medium_tcp6/1,
+ ttest_sgent_csockt_large_tcp4/1,
+ ttest_sgent_csockt_large_tcp6/1,
+
+ %% Server: transport = socket(tcp), active = false
+ %% Client: transport = gen_tcp
+ ttest_ssockf_cgenf_small_tcp4/1,
+ ttest_ssockf_cgenf_small_tcp6/1,
+ ttest_ssockf_cgenf_medium_tcp4/1,
+ ttest_ssockf_cgenf_medium_tcp6/1,
+ ttest_ssockf_cgenf_large_tcp4/1,
+ ttest_ssockf_cgenf_large_tcp6/1,
+
+ ttest_ssockf_cgeno_small_tcp4/1,
+ ttest_ssockf_cgeno_small_tcp6/1,
+ ttest_ssockf_cgeno_medium_tcp4/1,
+ ttest_ssockf_cgeno_medium_tcp6/1,
+ ttest_ssockf_cgeno_large_tcp4/1,
+ ttest_ssockf_cgeno_large_tcp6/1,
+
+ ttest_ssockf_cgent_small_tcp4/1,
+ ttest_ssockf_cgent_small_tcp6/1,
+ ttest_ssockf_cgent_medium_tcp4/1,
+ ttest_ssockf_cgent_medium_tcp6/1,
+ ttest_ssockf_cgent_large_tcp4/1,
+ ttest_ssockf_cgent_large_tcp6/1,
+
+ %% Server: transport = socket(tcp), active = false
+ %% Client: transport = socket(tcp)
+ ttest_ssockf_csockf_small_tcp4/1,
+ ttest_ssockf_csockf_small_tcp6/1,
+ ttest_ssockf_csockf_medium_tcp4/1,
+ ttest_ssockf_csockf_medium_tcp6/1,
+ ttest_ssockf_csockf_large_tcp4/1,
+ ttest_ssockf_csockf_large_tcp6/1,
+
+ ttest_ssockf_csocko_small_tcp4/1,
+ ttest_ssockf_csocko_small_tcp6/1,
+ ttest_ssockf_csocko_medium_tcp4/1,
+ ttest_ssockf_csocko_medium_tcp6/1,
+ ttest_ssockf_csocko_large_tcp4/1,
+ ttest_ssockf_csocko_large_tcp6/1,
+
+ ttest_ssockf_csockt_small_tcp4/1,
+ ttest_ssockf_csockt_small_tcp6/1,
+ ttest_ssockf_csockt_medium_tcp4/1,
+ ttest_ssockf_csockt_medium_tcp6/1,
+ ttest_ssockf_csockt_large_tcp4/1,
+ ttest_ssockf_csockt_large_tcp6/1,
+
+ %% Server: transport = socket(tcp), active = once
+ %% Client: transport = gen_tcp
+ ttest_ssocko_cgenf_small_tcp4/1,
+ ttest_ssocko_cgenf_small_tcp6/1,
+ ttest_ssocko_cgenf_medium_tcp4/1,
+ ttest_ssocko_cgenf_medium_tcp6/1,
+ ttest_ssocko_cgenf_large_tcp4/1,
+ ttest_ssocko_cgenf_large_tcp6/1,
+
+ ttest_ssocko_cgeno_small_tcp4/1,
+ ttest_ssocko_cgeno_small_tcp6/1,
+ ttest_ssocko_cgeno_medium_tcp4/1,
+ ttest_ssocko_cgeno_medium_tcp6/1,
+ ttest_ssocko_cgeno_large_tcp4/1,
+ ttest_ssocko_cgeno_large_tcp6/1,
+
+ ttest_ssocko_cgent_small_tcp4/1,
+ ttest_ssocko_cgent_small_tcp6/1,
+ ttest_ssocko_cgent_medium_tcp4/1,
+ ttest_ssocko_cgent_medium_tcp6/1,
+ ttest_ssocko_cgent_large_tcp4/1,
+ ttest_ssocko_cgent_large_tcp6/1,
+
+ %% Server: transport = socket(tcp), active = once
+ %% Client: transport = socket(tcp)
+ ttest_ssocko_csockf_small_tcp4/1,
+ ttest_ssocko_csockf_small_tcp6/1,
+ ttest_ssocko_csockf_medium_tcp4/1,
+ ttest_ssocko_csockf_medium_tcp6/1,
+ ttest_ssocko_csockf_large_tcp4/1,
+ ttest_ssocko_csockf_large_tcp6/1,
+
+ ttest_ssocko_csocko_small_tcp4/1,
+ ttest_ssocko_csocko_small_tcp6/1,
+ ttest_ssocko_csocko_medium_tcp4/1,
+ ttest_ssocko_csocko_medium_tcp6/1,
+ ttest_ssocko_csocko_large_tcp4/1,
+ ttest_ssocko_csocko_large_tcp6/1,
+
+ ttest_ssocko_csockt_small_tcp4/1,
+ ttest_ssocko_csockt_small_tcp6/1,
+ ttest_ssocko_csockt_medium_tcp4/1,
+ ttest_ssocko_csockt_medium_tcp6/1,
+ ttest_ssocko_csockt_large_tcp4/1,
+ ttest_ssocko_csockt_large_tcp6/1,
+
+ %% Server: transport = socket(tcp), active = true
+ %% Client: transport = gen_tcp
+ ttest_ssockt_cgenf_small_tcp4/1,
+ ttest_ssockt_cgenf_small_tcp6/1,
+ ttest_ssockt_cgenf_medium_tcp4/1,
+ ttest_ssockt_cgenf_medium_tcp6/1,
+ ttest_ssockt_cgenf_large_tcp4/1,
+ ttest_ssockt_cgenf_large_tcp6/1,
+
+ ttest_ssockt_cgeno_small_tcp4/1,
+ ttest_ssockt_cgeno_small_tcp6/1,
+ ttest_ssockt_cgeno_medium_tcp4/1,
+ ttest_ssockt_cgeno_medium_tcp6/1,
+ ttest_ssockt_cgeno_large_tcp4/1,
+ ttest_ssockt_cgeno_large_tcp6/1,
+
+ ttest_ssockt_cgent_small_tcp4/1,
+ ttest_ssockt_cgent_small_tcp6/1,
+ ttest_ssockt_cgent_medium_tcp4/1,
+ ttest_ssockt_cgent_medium_tcp6/1,
+ ttest_ssockt_cgent_large_tcp4/1,
+ ttest_ssockt_cgent_large_tcp6/1,
+
+ %% Server: transport = socket(tcp), active = true
+ %% Client: transport = socket(tcp)
+ ttest_ssockt_csockf_small_tcp4/1,
+ ttest_ssockt_csockf_small_tcp6/1,
+ ttest_ssockt_csockf_medium_tcp4/1,
+ ttest_ssockt_csockf_medium_tcp6/1,
+ ttest_ssockt_csockf_large_tcp4/1,
+ ttest_ssockt_csockf_large_tcp6/1,
+
+ ttest_ssockt_csocko_small_tcp4/1,
+ ttest_ssockt_csocko_small_tcp6/1,
+ ttest_ssockt_csocko_medium_tcp4/1,
+ ttest_ssockt_csocko_medium_tcp6/1,
+ ttest_ssockt_csocko_large_tcp4/1,
+ ttest_ssockt_csocko_large_tcp6/1,
+
+ ttest_ssockt_csockt_small_tcp4/1,
+ ttest_ssockt_csockt_small_tcp6/1,
+ ttest_ssockt_csockt_medium_tcp4/1,
+ ttest_ssockt_csockt_medium_tcp6/1,
+ ttest_ssockt_csockt_large_tcp4/1,
+ ttest_ssockt_csockt_large_tcp6/1
+
+ %% Tickets
+ ]).
+
+
+-include("socket_test_evaluator.hrl").
+
+%% Internal exports
+%% -export([]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-define(BASIC_REQ, <<"hejsan">>).
+-define(BASIC_REP, <<"hoppsan">>).
+
+-define(DATA, <<"HOPPSAN">>). % Temporary
+-define(FAIL(R), exit(R)).
+
+-define(SLEEP(T), receive after T -> ok end).
+
+-define(MINS(M), timer:minutes(M)).
+-define(SECS(S), timer:seconds(S)).
+
+-define(TT(T), ct:timetrap(T)).
+
+-define(LIB, socket_test_lib).
+-define(TTEST_LIB, socket_test_ttest_lib).
+-define(LOGGER, socket_test_logger).
+
+-define(TPP_SMALL, lists:seq(1, 8)).
+-define(TPP_MEDIUM, lists:flatten(lists:duplicate(1024, ?TPP_SMALL))).
+-define(TPP_LARGE, lists:flatten(lists:duplicate(1024, ?TPP_MEDIUM))).
+
+-define(TPP_SMALL_NUM, 10000).
+-define(TPP_MEDIUM_NUM, 1000).
+-define(TPP_LARGE_NUM, 100).
+
+-define(TTEST_RUNTIME, ?SECS(10)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,1}}].
+
+all() ->
+ Groups = [{api, "ESOCK_TEST_API", include},
+ {socket_closure, "ESOCK_TEST_SOCK_CLOSE", include},
+ {traffic, "ESOCK_TEST_TRAFFIC", include},
+ {ttest, "ESOCK_TEST_TTEST", exclude}],
+ [use_group(Group, Env, Default) || {Group, Env, Default} <- Groups].
+
+use_group(Group, Env, Default) ->
+ case os:getenv(Env) of
+ false when (Default =:= include) ->
+ [{group, Group}];
+ false ->
+ [];
+ Val ->
+ case list_to_atom(string:to_lower(Val)) of
+ Use when (Use =:= include) orelse
+ (Use =:= enable) orelse
+ (Use =:= true) ->
+ [{group, Group}];
+ _ ->
+ []
+ end
+ end.
+
+
+groups() ->
+ [{api, [], api_cases()},
+ {api_basic, [], api_basic_cases()},
+ {api_options, [], api_options_cases()},
+ {api_op_with_timeout, [], api_op_with_timeout_cases()},
+ {socket_closure, [], socket_closure_cases()},
+ {sc_ctrl_proc_exit, [], sc_cp_exit_cases()},
+ {sc_local_close, [], sc_lc_cases()},
+ {sc_remote_close, [], sc_rc_cases()},
+ {sc_remote_shutdown, [], sc_rs_cases()},
+ {traffic, [], traffic_cases()},
+ {ttest, [], ttest_cases()},
+ {ttest_sgenf, [], ttest_sgenf_cases()},
+ {ttest_sgenf_cgen, [], ttest_sgenf_cgen_cases()},
+ {ttest_sgenf_cgenf, [], ttest_sgenf_cgenf_cases()},
+ {ttest_sgenf_cgeno, [], ttest_sgenf_cgeno_cases()},
+ {ttest_sgenf_cgent, [], ttest_sgenf_cgent_cases()},
+ {ttest_sgenf_csock, [], ttest_sgenf_csock_cases()},
+ {ttest_sgenf_csockf, [], ttest_sgenf_csockf_cases()},
+ {ttest_sgenf_csocko, [], ttest_sgenf_csocko_cases()},
+ {ttest_sgenf_csockt, [], ttest_sgenf_csockt_cases()},
+ {ttest_sgeno, [], ttest_sgeno_cases()},
+ {ttest_sgeno_cgen, [], ttest_sgeno_cgen_cases()},
+ {ttest_sgeno_cgenf, [], ttest_sgeno_cgenf_cases()},
+ {ttest_sgeno_cgeno, [], ttest_sgeno_cgeno_cases()},
+ {ttest_sgeno_cgent, [], ttest_sgeno_cgent_cases()},
+ {ttest_sgeno_csock, [], ttest_sgeno_csock_cases()},
+ {ttest_sgeno_csockf, [], ttest_sgeno_csockf_cases()},
+ {ttest_sgeno_csocko, [], ttest_sgeno_csocko_cases()},
+ {ttest_sgeno_csockt, [], ttest_sgeno_csockt_cases()},
+ {ttest_sgent, [], ttest_sgent_cases()},
+ {ttest_sgent_cgen, [], ttest_sgent_cgen_cases()},
+ {ttest_sgent_cgenf, [], ttest_sgent_cgenf_cases()},
+ {ttest_sgent_cgeno, [], ttest_sgent_cgeno_cases()},
+ {ttest_sgent_cgent, [], ttest_sgent_cgent_cases()},
+ {ttest_sgent_csock, [], ttest_sgent_csock_cases()},
+ {ttest_sgent_csockf, [], ttest_sgent_csockf_cases()},
+ {ttest_sgent_csocko, [], ttest_sgent_csocko_cases()},
+ {ttest_sgent_csockt, [], ttest_sgent_csockt_cases()},
+ {ttest_ssockf, [], ttest_ssockf_cases()},
+ {ttest_ssockf_cgen, [], ttest_ssockf_cgen_cases()},
+ {ttest_ssockf_cgenf, [], ttest_ssockf_cgenf_cases()},
+ {ttest_ssockf_cgeno, [], ttest_ssockf_cgeno_cases()},
+ {ttest_ssockf_cgent, [], ttest_ssockf_cgent_cases()},
+ {ttest_ssockf_csock, [], ttest_ssockf_csock_cases()},
+ {ttest_ssockf_csockf, [], ttest_ssockf_csockf_cases()},
+ {ttest_ssockf_csocko, [], ttest_ssockf_csocko_cases()},
+ {ttest_ssockf_csockt, [], ttest_ssockf_csockt_cases()},
+ {ttest_ssocko, [], ttest_ssocko_cases()},
+ {ttest_ssocko_cgen, [], ttest_ssocko_cgen_cases()},
+ {ttest_ssocko_cgenf, [], ttest_ssocko_cgenf_cases()},
+ {ttest_ssocko_cgeno, [], ttest_ssocko_cgeno_cases()},
+ {ttest_ssocko_cgent, [], ttest_ssocko_cgent_cases()},
+ {ttest_ssocko_csock, [], ttest_ssocko_csock_cases()},
+ {ttest_ssocko_csockf, [], ttest_ssocko_csockf_cases()},
+ {ttest_ssocko_csocko, [], ttest_ssocko_csocko_cases()},
+ {ttest_ssocko_csockt, [], ttest_ssocko_csockt_cases()},
+ {ttest_ssockt, [], ttest_ssockt_cases()},
+ {ttest_ssockt_cgen, [], ttest_ssockt_cgen_cases()},
+ {ttest_ssockt_cgenf, [], ttest_ssockt_cgenf_cases()},
+ {ttest_ssockt_cgeno, [], ttest_ssockt_cgeno_cases()},
+ {ttest_ssockt_cgent, [], ttest_ssockt_cgent_cases()},
+ {ttest_ssockt_csock, [], ttest_ssockt_csock_cases()},
+ {ttest_ssockt_csockf, [], ttest_ssockt_csockf_cases()},
+ {ttest_ssockt_csocko, [], ttest_ssockt_csocko_cases()},
+ {ttest_ssockt_csockt, [], ttest_ssockt_csockt_cases()}
+
+ %% {tickets, [], ticket_cases()}
+ ].
+
+api_cases() ->
+ [
+ {group, api_basic},
+ {group, api_options},
+ {group, api_op_with_timeout}
+ ].
+
+api_basic_cases() ->
+ [
+ api_b_open_and_close_udp4,
+ api_b_open_and_close_tcp4,
+ api_b_sendto_and_recvfrom_udp4,
+ api_b_sendmsg_and_recvmsg_udp4,
+ api_b_send_and_recv_tcp4,
+ api_b_sendmsg_and_recvmsg_tcp4
+ ].
+
+api_options_cases() ->
+ [
+ api_opt_simple_otp_options,
+ api_opt_simple_otp_rcvbuf_option,
+ api_opt_simple_otp_controlling_process
+ ].
+
+api_op_with_timeout_cases() ->
+ [
+ api_to_connect_tcp4,
+ api_to_connect_tcp6,
+ api_to_accept_tcp4,
+ api_to_accept_tcp6,
+ api_to_maccept_tcp4,
+ api_to_maccept_tcp6,
+ api_to_send_tcp4,
+ api_to_send_tcp6,
+ api_to_sendto_udp4,
+ api_to_sendto_udp6,
+ api_to_sendmsg_tcp4,
+ api_to_sendmsg_tcp6,
+ api_to_recv_udp4,
+ api_to_recv_udp6,
+ api_to_recv_tcp4,
+ api_to_recv_tcp6,
+ api_to_recvfrom_udp4,
+ api_to_recvfrom_udp6,
+ api_to_recvmsg_udp4,
+ api_to_recvmsg_udp6,
+ api_to_recvmsg_tcp4,
+ api_to_recvmsg_tcp6
+ ].
+
+%% These cases tests what happens when the socket is closed/shutdown,
+%% locally or remotely.
+socket_closure_cases() ->
+ [
+ {group, sc_ctrl_proc_exit},
+ {group, sc_local_close},
+ {group, sc_remote_close},
+ {group, sc_remote_shutdown}
+ ].
+
+%% These cases are all about socket cleanup after the controlling process
+%% exits *without* calling socket:close/1.
+sc_cp_exit_cases() ->
+ [
+ sc_cpe_socket_cleanup_tcp4,
+ sc_cpe_socket_cleanup_tcp6,
+ sc_cpe_socket_cleanup_udp4,
+ sc_cpe_socket_cleanup_udp6
+ ].
+
+%% These cases tests what happens when the socket is closed locally.
+sc_lc_cases() ->
+ [
+ sc_lc_recv_response_tcp4,
+ sc_lc_recv_response_tcp6,
+
+ sc_lc_recvfrom_response_udp4,
+ sc_lc_recvfrom_response_udp6,
+
+ sc_lc_recvmsg_response_tcp4,
+ sc_lc_recvmsg_response_tcp6,
+ sc_lc_recvmsg_response_udp4,
+ sc_lc_recvmsg_response_udp6,
+
+ sc_lc_acceptor_response_tcp4,
+ sc_lc_acceptor_response_tcp6
+ ].
+
+%% These cases tests what happens when the socket is closed remotely.
+sc_rc_cases() ->
+ [
+ sc_rc_recv_response_tcp4,
+ sc_rc_recv_response_tcp6,
+
+ sc_rc_recvmsg_response_tcp4,
+ sc_rc_recvmsg_response_tcp6
+ ].
+
+%% These cases tests what happens when the socket is shutdown/closed remotely
+%% after writing and reading is ongoing.
+sc_rs_cases() ->
+ [
+ sc_rs_recv_send_shutdown_receive_tcp4,
+ sc_rs_recv_send_shutdown_receive_tcp6,
+
+ sc_rs_recvmsg_send_shutdown_receive_tcp4,
+ sc_rs_recvmsg_send_shutdown_receive_tcp6
+ ].
+
+
+traffic_cases() ->
+ [
+ traffic_send_and_recv_chunks_tcp4,
+ traffic_send_and_recv_chunks_tcp6,
+
+ traffic_ping_pong_small_send_and_recv_tcp4,
+ traffic_ping_pong_small_send_and_recv_tcp6,
+ traffic_ping_pong_medium_send_and_recv_tcp4,
+ traffic_ping_pong_medium_send_and_recv_tcp6,
+ traffic_ping_pong_large_send_and_recv_tcp4,
+ traffic_ping_pong_large_send_and_recv_tcp6,
+
+ traffic_ping_pong_small_sendto_and_recvfrom_udp4,
+ traffic_ping_pong_small_sendto_and_recvfrom_udp6,
+ traffic_ping_pong_medium_sendto_and_recvfrom_udp4,
+ traffic_ping_pong_medium_sendto_and_recvfrom_udp6,
+
+ traffic_ping_pong_small_sendmsg_and_recvmsg_tcp4,
+ traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6,
+ traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp4,
+ traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6,
+ traffic_ping_pong_large_sendmsg_and_recvmsg_tcp4,
+ traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6,
+
+ traffic_ping_pong_small_sendmsg_and_recvmsg_udp4,
+ traffic_ping_pong_small_sendmsg_and_recvmsg_udp6,
+ traffic_ping_pong_medium_sendmsg_and_recvmsg_udp4,
+ traffic_ping_pong_medium_sendmsg_and_recvmsg_udp6
+ ].
+
+
+ttest_cases() ->
+ [
+ %% Server: transport = gen_tcp, active = false
+ {group, ttest_sgenf},
+
+ %% Server: transport = gen_tcp, active = once
+ {group, ttest_sgeno},
+
+ %% Server: transport = gen_tcp, active = true
+ {group, ttest_sgent},
+
+ %% Server: transport = socket(tcp), active = false
+ {group, ttest_ssockf},
+
+ %% Server: transport = socket(tcp), active = once
+ {group, ttest_ssocko},
+
+ %% Server: transport = socket(tcp), active = true
+ {group, ttest_ssockt}
+
+ ].
+
+
+%% Server: transport = gen_tcp, active = false
+ttest_sgenf_cases() ->
+ [
+ {group, ttest_sgenf_cgen},
+ {group, ttest_sgenf_csock}
+ ].
+
+%% Server: transport = gen_tcp, active = false
+%% Client: transport = gen_tcp
+ttest_sgenf_cgen_cases() ->
+ [
+ {group, ttest_sgenf_cgenf},
+ {group, ttest_sgenf_cgeno},
+ {group, ttest_sgenf_cgent}
+ ].
+
+%% Server: transport = gen_tcp, active = false
+%% Client: transport = gen_tcp, active = false
+ttest_sgenf_cgenf_cases() ->
+ [
+ ttest_sgenf_cgenf_small_tcp4,
+ ttest_sgenf_cgenf_small_tcp6,
+
+ ttest_sgenf_cgenf_medium_tcp4,
+ ttest_sgenf_cgenf_medium_tcp6,
+
+ ttest_sgenf_cgenf_large_tcp4,
+ ttest_sgenf_cgenf_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = false
+%% Client: transport = gen_tcp, active = once
+ttest_sgenf_cgeno_cases() ->
+ [
+ ttest_sgenf_cgeno_small_tcp4,
+ ttest_sgenf_cgeno_small_tcp6,
+
+ ttest_sgenf_cgeno_medium_tcp4,
+ ttest_sgenf_cgeno_medium_tcp6,
+
+ ttest_sgenf_cgeno_large_tcp4,
+ ttest_sgenf_cgeno_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = false
+%% Client: transport = gen_tcp, active = true
+ttest_sgenf_cgent_cases() ->
+ [
+ ttest_sgenf_cgent_small_tcp4,
+ ttest_sgenf_cgent_small_tcp6,
+
+ ttest_sgenf_cgent_medium_tcp4,
+ ttest_sgenf_cgent_medium_tcp6,
+
+ ttest_sgenf_cgent_large_tcp4,
+ ttest_sgenf_cgent_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = false
+%% Client: transport = socket(tcp)
+ttest_sgenf_csock_cases() ->
+ [
+ {group, ttest_sgenf_csockf},
+ {group, ttest_sgenf_csocko},
+ {group, ttest_sgenf_csockt}
+ ].
+
+ttest_sgenf_csockf_cases() ->
+ [
+ ttest_sgenf_csockf_small_tcp4,
+ ttest_sgenf_csockf_small_tcp6,
+
+ ttest_sgenf_csockf_medium_tcp4,
+ ttest_sgenf_csockf_medium_tcp6,
+
+ ttest_sgenf_csockf_large_tcp4,
+ ttest_sgenf_csockf_large_tcp6
+ ].
+
+ttest_sgenf_csocko_cases() ->
+ [
+ ttest_sgenf_csocko_small_tcp4,
+ ttest_sgenf_csocko_small_tcp6,
+
+ ttest_sgenf_csocko_medium_tcp4,
+ ttest_sgenf_csocko_medium_tcp6,
+
+ ttest_sgenf_csocko_large_tcp4,
+ ttest_sgenf_csocko_large_tcp6
+ ].
+
+ttest_sgenf_csockt_cases() ->
+ [
+ ttest_sgenf_csockt_small_tcp4,
+ ttest_sgenf_csockt_small_tcp6,
+
+ ttest_sgenf_csockt_medium_tcp4,
+ ttest_sgenf_csockt_medium_tcp6,
+
+ ttest_sgenf_csockt_large_tcp4,
+ ttest_sgenf_csockt_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = once
+ttest_sgeno_cases() ->
+ [
+ {group, ttest_sgeno_cgen},
+ {group, ttest_sgeno_csock}
+ ].
+
+%% Server: transport = gen_tcp, active = once
+%% Client: transport = gen_tcp
+ttest_sgeno_cgen_cases() ->
+ [
+ {group, ttest_sgeno_cgenf},
+ {group, ttest_sgeno_cgeno},
+ {group, ttest_sgeno_cgent}
+ ].
+
+%% Server: transport = gen_tcp, active = once
+%% Client: transport = gen_tcp, active = false
+ttest_sgeno_cgenf_cases() ->
+ [
+ ttest_sgeno_cgenf_small_tcp4,
+ ttest_sgeno_cgenf_small_tcp6,
+
+ ttest_sgeno_cgenf_medium_tcp4,
+ ttest_sgeno_cgenf_medium_tcp6,
+
+ ttest_sgeno_cgenf_large_tcp4,
+ ttest_sgeno_cgenf_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = once
+%% Client: transport = gen_tcp, active = once
+ttest_sgeno_cgeno_cases() ->
+ [
+ ttest_sgeno_cgeno_small_tcp4,
+ ttest_sgeno_cgeno_small_tcp6,
+
+ ttest_sgeno_cgeno_medium_tcp4,
+ ttest_sgeno_cgeno_medium_tcp6,
+
+ ttest_sgeno_cgeno_large_tcp4,
+ ttest_sgeno_cgeno_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = once
+%% Client: transport = gen_tcp, active = true
+ttest_sgeno_cgent_cases() ->
+ [
+ ttest_sgeno_cgent_small_tcp4,
+ ttest_sgeno_cgent_small_tcp6,
+
+ ttest_sgeno_cgent_medium_tcp4,
+ ttest_sgeno_cgent_medium_tcp6,
+
+ ttest_sgeno_cgent_large_tcp4,
+ ttest_sgeno_cgent_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = once
+%% Client: transport = socket(tcp)
+ttest_sgeno_csock_cases() ->
+ [
+ {group, ttest_sgeno_csockf},
+ {group, ttest_sgeno_csocko},
+ {group, ttest_sgeno_csockt}
+ ].
+
+ttest_sgeno_csockf_cases() ->
+ [
+ ttest_sgeno_csockf_small_tcp4,
+ ttest_sgeno_csockf_small_tcp6,
+
+ ttest_sgeno_csockf_medium_tcp4,
+ ttest_sgeno_csockf_medium_tcp6,
+
+ ttest_sgeno_csockf_large_tcp4,
+ ttest_sgeno_csockf_large_tcp6
+ ].
+
+ttest_sgeno_csocko_cases() ->
+ [
+ ttest_sgeno_csocko_small_tcp4,
+ ttest_sgeno_csocko_small_tcp6,
+
+ ttest_sgeno_csocko_medium_tcp4,
+ ttest_sgeno_csocko_medium_tcp6,
+
+ ttest_sgeno_csocko_large_tcp4,
+ ttest_sgeno_csocko_large_tcp6
+ ].
+
+ttest_sgeno_csockt_cases() ->
+ [
+ ttest_sgeno_csockt_small_tcp4,
+ ttest_sgeno_csockt_small_tcp6,
+
+ ttest_sgeno_csockt_medium_tcp4,
+ ttest_sgeno_csockt_medium_tcp6,
+
+ ttest_sgeno_csockt_large_tcp4,
+ ttest_sgeno_csockt_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = true
+ttest_sgent_cases() ->
+ [
+ {group, ttest_sgent_cgen},
+ {group, ttest_sgent_csock}
+ ].
+
+%% Server: transport = gen_tcp, active = true
+%% Client: transport = gen_tcp
+ttest_sgent_cgen_cases() ->
+ [
+ {group, ttest_sgent_cgenf},
+ {group, ttest_sgent_cgeno},
+ {group, ttest_sgent_cgent}
+ ].
+
+%% Server: transport = gen_tcp, active = true
+%% Client: transport = gen_tcp, active = false
+ttest_sgent_cgenf_cases() ->
+ [
+ ttest_sgent_cgenf_small_tcp4,
+ ttest_sgent_cgenf_small_tcp6,
+
+ ttest_sgent_cgenf_medium_tcp4,
+ ttest_sgent_cgenf_medium_tcp6,
+
+ ttest_sgent_cgenf_large_tcp4,
+ ttest_sgent_cgenf_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = true
+%% Client: transport = gen_tcp, active = once
+ttest_sgent_cgeno_cases() ->
+ [
+ ttest_sgent_cgeno_small_tcp4,
+ ttest_sgent_cgeno_small_tcp6,
+
+ ttest_sgent_cgeno_medium_tcp4,
+ ttest_sgent_cgeno_medium_tcp6,
+
+ ttest_sgent_cgeno_large_tcp4,
+ ttest_sgent_cgeno_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = true
+%% Client: transport = gen_tcp, active = true
+ttest_sgent_cgent_cases() ->
+ [
+ ttest_sgent_cgent_small_tcp4,
+ ttest_sgent_cgent_small_tcp6,
+
+ ttest_sgent_cgent_medium_tcp4,
+ ttest_sgent_cgent_medium_tcp6,
+
+ ttest_sgent_cgent_large_tcp4,
+ ttest_sgent_cgent_large_tcp6
+ ].
+
+%% Server: transport = gen_tcp, active = true
+%% Client: transport = socket(tcp)
+ttest_sgent_csock_cases() ->
+ [
+ {group, ttest_sgent_csockf},
+ {group, ttest_sgent_csocko},
+ {group, ttest_sgent_csockt}
+ ].
+
+ttest_sgent_csockf_cases() ->
+ [
+ ttest_sgent_csockf_small_tcp4,
+ ttest_sgent_csockf_small_tcp6,
+
+ ttest_sgent_csockf_medium_tcp4,
+ ttest_sgent_csockf_medium_tcp6,
+
+ ttest_sgent_csockf_large_tcp4,
+ ttest_sgent_csockf_large_tcp6
+ ].
+
+ttest_sgent_csocko_cases() ->
+ [
+ ttest_sgent_csocko_small_tcp4,
+ ttest_sgent_csocko_small_tcp6,
+
+ ttest_sgent_csocko_medium_tcp4,
+ ttest_sgent_csocko_medium_tcp6,
+
+ ttest_sgent_csocko_large_tcp4,
+ ttest_sgent_csocko_large_tcp6
+ ].
+
+ttest_sgent_csockt_cases() ->
+ [
+ ttest_sgent_csockt_small_tcp4,
+ ttest_sgent_csockt_small_tcp6,
+
+ ttest_sgent_csockt_medium_tcp4,
+ ttest_sgent_csockt_medium_tcp6,
+
+ ttest_sgent_csockt_large_tcp4,
+ ttest_sgent_csockt_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = false
+ttest_ssockf_cases() ->
+ [
+ {group, ttest_ssockf_cgen},
+ {group, ttest_ssockf_csock}
+ ].
+
+%% Server: transport = socket(tcp), active = false
+%% Client: transport = gen_tcp
+ttest_ssockf_cgen_cases() ->
+ [
+ {group, ttest_ssockf_cgenf},
+ {group, ttest_ssockf_cgeno},
+ {group, ttest_ssockf_cgent}
+ ].
+
+%% Server: transport = socket(tcp), active = false
+%% Client: transport = gen_tcp, active = false
+ttest_ssockf_cgenf_cases() ->
+ [
+ ttest_ssockf_cgenf_small_tcp4,
+ ttest_ssockf_cgenf_small_tcp6,
+
+ ttest_ssockf_cgenf_medium_tcp4,
+ ttest_ssockf_cgenf_medium_tcp6,
+
+ ttest_ssockf_cgenf_large_tcp4,
+ ttest_ssockf_cgenf_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = false
+%% Client: transport = gen_tcp, active = once
+ttest_ssockf_cgeno_cases() ->
+ [
+ ttest_ssockf_cgeno_small_tcp4,
+ ttest_ssockf_cgeno_small_tcp6,
+
+ ttest_ssockf_cgeno_medium_tcp4,
+ ttest_ssockf_cgeno_medium_tcp6,
+
+ ttest_ssockf_cgeno_large_tcp4,
+ ttest_ssockf_cgeno_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = false
+%% Client: transport = gen_tcp, active = true
+ttest_ssockf_cgent_cases() ->
+ [
+ ttest_ssockf_cgent_small_tcp4,
+ ttest_ssockf_cgent_small_tcp6,
+
+ ttest_ssockf_cgent_medium_tcp4,
+ ttest_ssockf_cgent_medium_tcp6,
+
+ ttest_ssockf_cgent_large_tcp4,
+ ttest_ssockf_cgent_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = false
+%% Client: transport = socket(tcp)
+ttest_ssockf_csock_cases() ->
+ [
+ {group, ttest_ssockf_csockf},
+ {group, ttest_ssockf_csocko},
+ {group, ttest_ssockf_csockt}
+ ].
+
+%% Server: transport = socket(tcp), active = false
+%% Client: transport = socket(tcp), active = false
+ttest_ssockf_csockf_cases() ->
+ [
+ ttest_ssockf_csockf_small_tcp4,
+ ttest_ssockf_csockf_small_tcp6,
+
+ ttest_ssockf_csockf_medium_tcp4,
+ ttest_ssockf_csockf_medium_tcp6,
+
+ ttest_ssockf_csockf_large_tcp4,
+ ttest_ssockf_csockf_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = false
+%% Client: transport = socket(tcp), active = once
+ttest_ssockf_csocko_cases() ->
+ [
+ ttest_ssockf_csocko_small_tcp4,
+ ttest_ssockf_csocko_small_tcp6,
+
+ ttest_ssockf_csocko_medium_tcp4,
+ ttest_ssockf_csocko_medium_tcp6,
+
+ ttest_ssockf_csocko_large_tcp4,
+ ttest_ssockf_csocko_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = false
+%% Client: transport = socket(tcp), active = true
+ttest_ssockf_csockt_cases() ->
+ [
+ ttest_ssockf_csockt_small_tcp4,
+ ttest_ssockf_csockt_small_tcp6,
+
+ ttest_ssockf_csockt_medium_tcp4,
+ ttest_ssockf_csockt_medium_tcp6,
+
+ ttest_ssockf_csockt_large_tcp4,
+ ttest_ssockf_csockt_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = once
+ttest_ssocko_cases() ->
+ [
+ {group, ttest_ssocko_cgen},
+ {group, ttest_ssocko_csock}
+ ].
+
+%% Server: transport = socket(tcp), active = once
+%% Client: transport = gen_tcp
+ttest_ssocko_cgen_cases() ->
+ [
+ {group, ttest_ssocko_cgenf},
+ {group, ttest_ssocko_cgeno},
+ {group, ttest_ssocko_cgent}
+ ].
+
+%% Server: transport = socket(tcp), active = once
+%% Client: transport = gen_tcp, active = false
+ttest_ssocko_cgenf_cases() ->
+ [
+ ttest_ssocko_cgenf_small_tcp4,
+ ttest_ssocko_cgenf_small_tcp6,
+
+ ttest_ssocko_cgenf_medium_tcp4,
+ ttest_ssocko_cgenf_medium_tcp6,
+
+ ttest_ssocko_cgenf_large_tcp4,
+ ttest_ssocko_cgenf_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = once
+%% Client: transport = gen_tcp, active = once
+ttest_ssocko_cgeno_cases() ->
+ [
+ ttest_ssocko_cgeno_small_tcp4,
+ ttest_ssocko_cgeno_small_tcp6,
+
+ ttest_ssocko_cgeno_medium_tcp4,
+ ttest_ssocko_cgeno_medium_tcp6,
+
+ ttest_ssocko_cgeno_large_tcp4,
+ ttest_ssocko_cgeno_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = once
+%% Client: transport = gen_tcp, active = true
+ttest_ssocko_cgent_cases() ->
+ [
+ ttest_ssocko_cgent_small_tcp4,
+ ttest_ssocko_cgent_small_tcp6,
+
+ ttest_ssocko_cgent_medium_tcp4,
+ ttest_ssocko_cgent_medium_tcp6,
+
+ ttest_ssocko_cgent_large_tcp4,
+ ttest_ssocko_cgent_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = once
+%% Client: transport = socket(tcp)
+ttest_ssocko_csock_cases() ->
+ [
+ {group, ttest_ssocko_csockf},
+ {group, ttest_ssocko_csocko},
+ {group, ttest_ssocko_csockt}
+ ].
+
+%% Server: transport = socket(tcp), active = once
+%% Client: transport = socket(tcp), active = false
+ttest_ssocko_csockf_cases() ->
+ [
+ ttest_ssocko_csockf_small_tcp4,
+ ttest_ssocko_csockf_small_tcp6,
+
+ ttest_ssocko_csockf_medium_tcp4,
+ ttest_ssocko_csockf_medium_tcp6,
+
+ ttest_ssocko_csockf_large_tcp4,
+ ttest_ssocko_csockf_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = once
+%% Client: transport = socket(tcp), active = once
+ttest_ssocko_csocko_cases() ->
+ [
+ ttest_ssocko_csocko_small_tcp4,
+ ttest_ssocko_csocko_small_tcp6,
+
+ ttest_ssocko_csocko_medium_tcp4,
+ ttest_ssocko_csocko_medium_tcp6,
+
+ ttest_ssocko_csocko_large_tcp4,
+ ttest_ssocko_csocko_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = once
+%% Client: transport = socket(tcp), active = true
+ttest_ssocko_csockt_cases() ->
+ [
+ ttest_ssocko_csockt_small_tcp4,
+ ttest_ssocko_csockt_small_tcp6,
+
+ ttest_ssocko_csockt_medium_tcp4,
+ ttest_ssocko_csockt_medium_tcp6,
+
+ ttest_ssocko_csockt_large_tcp4,
+ ttest_ssocko_csockt_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = true
+ttest_ssockt_cases() ->
+ [
+ {group, ttest_ssockt_cgen},
+ {group, ttest_ssockt_csock}
+ ].
+
+%% Server: transport = socket(tcp), active = true
+%% Client: transport = gen_tcp
+ttest_ssockt_cgen_cases() ->
+ [
+ {group, ttest_ssockt_cgenf},
+ {group, ttest_ssockt_cgeno},
+ {group, ttest_ssockt_cgent}
+ ].
+
+%% Server: transport = socket(tcp), active = true
+%% Client: transport = gen_tcp, active = false
+ttest_ssockt_cgenf_cases() ->
+ [
+ ttest_ssockt_cgenf_small_tcp4,
+ ttest_ssockt_cgenf_small_tcp6,
+
+ ttest_ssockt_cgenf_medium_tcp4,
+ ttest_ssockt_cgenf_medium_tcp6,
+
+ ttest_ssockt_cgenf_large_tcp4,
+ ttest_ssockt_cgenf_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = true
+%% Client: transport = gen_tcp, active = once
+ttest_ssockt_cgeno_cases() ->
+ [
+ ttest_ssockt_cgeno_small_tcp4,
+ ttest_ssockt_cgeno_small_tcp6,
+
+ ttest_ssockt_cgeno_medium_tcp4,
+ ttest_ssockt_cgeno_medium_tcp6,
+
+ ttest_ssockt_cgeno_large_tcp4,
+ ttest_ssockt_cgeno_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = true
+%% Client: transport = gen_tcp, active = true
+ttest_ssockt_cgent_cases() ->
+ [
+ ttest_ssockt_cgent_small_tcp4,
+ ttest_ssockt_cgent_small_tcp6,
+
+ ttest_ssockt_cgent_medium_tcp4,
+ ttest_ssockt_cgent_medium_tcp6,
+
+ ttest_ssockt_cgent_large_tcp4,
+ ttest_ssockt_cgent_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = true
+%% Client: transport = socket(tcp)
+ttest_ssockt_csock_cases() ->
+ [
+ {group, ttest_ssockt_csockf},
+ {group, ttest_ssockt_csocko},
+ {group, ttest_ssockt_csockt}
+ ].
+
+%% Server: transport = socket(tcp), active = true
+%% Client: transport = socket(tcp), active = false
+ttest_ssockt_csockf_cases() ->
+ [
+ ttest_ssockt_csockf_small_tcp4,
+ ttest_ssockt_csockf_small_tcp6,
+
+ ttest_ssockt_csockf_medium_tcp4,
+ ttest_ssockt_csockf_medium_tcp6,
+
+ ttest_ssockt_csockf_large_tcp4,
+ ttest_ssockt_csockf_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = true
+%% Client: transport = socket(tcp), active = once
+ttest_ssockt_csocko_cases() ->
+ [
+ ttest_ssockt_csocko_small_tcp4,
+ ttest_ssockt_csocko_small_tcp6,
+
+ ttest_ssockt_csocko_medium_tcp4,
+ ttest_ssockt_csocko_medium_tcp6,
+
+ ttest_ssockt_csocko_large_tcp4,
+ ttest_ssockt_csocko_large_tcp6
+ ].
+
+%% Server: transport = socket(tcp), active = true
+%% Client: transport = socket(tcp), active = true
+ttest_ssockt_csockt_cases() ->
+ [
+ ttest_ssockt_csockt_small_tcp4,
+ ttest_ssockt_csockt_small_tcp6,
+
+ ttest_ssockt_csockt_medium_tcp4,
+ ttest_ssockt_csockt_medium_tcp6,
+
+ ttest_ssockt_csockt_large_tcp4,
+ ttest_ssockt_csockt_large_tcp6
+ ].
+
+%% ticket_cases() ->
+%% [].
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+init_per_suite(Config) ->
+ case os:type() of
+ {win32, _} ->
+ not_yet_implemented();
+ _ ->
+ case quiet_mode(Config) of
+ default ->
+ ?LOGGER:start(),
+ Config;
+ Quiet ->
+ ?LOGGER:start(Quiet),
+ [{esock_test_quiet, Quiet}|Config]
+ end
+ end.
+
+end_per_suite(_) ->
+ ?LOGGER:stop(),
+ ok.
+
+
+init_per_group(ttest = _GroupName, Config) ->
+ io:format("init_per_group(~w) -> entry with"
+ "~n Config: ~p"
+ "~n", [_GroupName, Config]),
+ case lists:keysearch(esock_test_ttest_runtime, 1, Config) of
+ {value, _} ->
+ Config;
+ false ->
+ [{esock_test_ttest_runtime, which_ttest_runtime_env()}|Config]
+ end;
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(ttest = _GroupName, Config) ->
+ io:format("init_per_group(~w) -> entry with"
+ "~n Config: ~p"
+ "~n", [_GroupName, Config]),
+ lists:keydelete(esock_test_ttest_runtime, 1, Config);
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+init_per_testcase(_TC, Config) ->
+ io:format("init_per_testcase(~w) -> entry with"
+ "~n Config: ~p"
+ "~n", [_TC, Config]),
+ case quiet_mode(Config) of
+ default ->
+ ?LOGGER:start();
+ Quiet ->
+ ?LOGGER:start(Quiet)
+ end,
+ Config.
+
+end_per_testcase(_TC, Config) ->
+ ?LOGGER:stop(),
+ Config.
+
+
+quiet_mode(Config) ->
+ case lists:keysearch(esock_test_quiet, 1, Config) of
+ {value, {esock_test_quiet, Quiet}} ->
+ Quiet;
+ false ->
+ case os:getenv("ESOCK_TEST_QUIET") of
+ "true" -> true;
+ "false" -> false;
+ _ -> default
+ end
+ end.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% API BASIC %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Basically open (create) and close an IPv4 UDP (dgram) socket.
+%% With some extra checks...
+api_b_open_and_close_udp4(suite) ->
+ [];
+api_b_open_and_close_udp4(doc) ->
+ [];
+api_b_open_and_close_udp4(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_b_open_and_close_udp4,
+ fun() ->
+ InitState = #{domain => inet,
+ type => dgram,
+ protocol => udp},
+ ok = api_b_open_and_close(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Basically open (create) and close an IPv4 TCP (stream) socket.
+%% With some extra checks...
+api_b_open_and_close_tcp4(suite) ->
+ [];
+api_b_open_and_close_tcp4(doc) ->
+ [];
+api_b_open_and_close_tcp4(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_b_open_and_close_tcp4,
+ fun() ->
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp},
+ ok = api_b_open_and_close(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+api_b_open_and_close(InitState) ->
+ Seq =
+ [
+ #{desc => "open",
+ cmd => fun(#{domain := Domain,
+ type := Type,
+ protocol := Protocol} = S) ->
+ Res = socket:open(Domain, Type, Protocol),
+ {ok, {S, Res}}
+ end},
+ #{desc => "validate open",
+ cmd => fun({S, {ok, Sock}}) ->
+ NewS = S#{socket => Sock},
+ {ok, NewS};
+ ({_, {error, _} = ERROR}) ->
+ ERROR
+ end},
+ #{desc => "get domain (maybe)",
+ cmd => fun(#{socket := Sock} = S) ->
+ Res = socket:getopt(Sock, socket, domain),
+ {ok, {S, Res}}
+ end},
+ #{desc => "validate domain (maybe)",
+ cmd => fun({#{domain := Domain} = S, {ok, Domain}}) ->
+ {ok, S};
+ ({#{domain := ExpDomain}, {ok, Domain}}) ->
+ {error, {unexpected_domain, ExpDomain, Domain}};
+ %% Some platforms do not support this option
+ ({S, {error, einval}}) ->
+ {ok, S};
+ ({_, {error, _} = ERROR}) ->
+ ERROR
+ end},
+ #{desc => "get type",
+ cmd => fun(#{socket := Sock} = State) ->
+ Res = socket:getopt(Sock, socket, type),
+ {ok, {State, Res}}
+ end},
+ #{desc => "validate type",
+ cmd => fun({#{type := Type} = State, {ok, Type}}) ->
+ {ok, State};
+ ({#{type := ExpType}, {ok, Type}}) ->
+ {error, {unexpected_type, ExpType, Type}};
+ ({_, {error, _} = ERROR}) ->
+ ERROR
+ end},
+ #{desc => "get protocol",
+ cmd => fun(#{socket := Sock} = State) ->
+ case socket:supports(options, socket, protocol) of
+ true ->
+ Res = socket:getopt(Sock, socket, protocol),
+ {ok, {State, Res}};
+ false ->
+ {ok, {State, not_supported}}
+ end
+ end},
+ #{desc => "validate protocol",
+ cmd => fun({State, not_supported}) ->
+ ?SEV_IPRINT("socket option 'protocol' "
+ "not supported"),
+ {ok, State};
+ ({#{protocol := Protocol} = State, {ok, Protocol}}) ->
+ {ok, State};
+ ({#{protocol := ExpProtocol}, {ok, Protocol}}) ->
+ {error, {unexpected_type, ExpProtocol, Protocol}};
+ ({_, {error, _} = ERROR}) ->
+ ERROR
+ end},
+ #{desc => "get controlling-process",
+ cmd => fun(#{socket := Sock} = State) ->
+ Res = socket:getopt(Sock, otp, controlling_process),
+ {ok, {State, Res}}
+ end},
+ #{desc => "validate controlling-process",
+ cmd => fun({State, {ok, Pid}}) ->
+ case self() of
+ Pid ->
+ {ok, State};
+ _ ->
+ {error, {unexpected_owner, Pid}}
+ end;
+ ({_, {error, _} = ERROR}) ->
+ ERROR
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{socket := Sock} = State) ->
+ Res = socket:close(Sock),
+ {ok, {State, Res}}
+ end},
+ #{desc => "validate socket close",
+ cmd => fun({_, ok}) ->
+ ok;
+ ({_, {error, _} = ERROR}) ->
+ ERROR
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+ Evaluator = ?SEV_START("tester", Seq, InitState),
+ ok = ?SEV_AWAIT_FINISH([Evaluator]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Basically send and receive on an IPv4 UDP (dgram) socket using
+%% sendto and recvfrom..
+api_b_sendto_and_recvfrom_udp4(suite) ->
+ [];
+api_b_sendto_and_recvfrom_udp4(doc) ->
+ [];
+api_b_sendto_and_recvfrom_udp4(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_b_sendto_and_recvfrom_udp4,
+ fun() ->
+ Send = fun(Sock, Data, Dest) ->
+ socket:sendto(Sock, Data, Dest)
+ end,
+ Recv = fun(Sock) ->
+ socket:recvfrom(Sock)
+ end,
+ InitState = #{domain => inet,
+ send => Send,
+ recv => Recv},
+ ok = api_b_send_and_recv_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Basically send and receive on an IPv4 UDP (dgram) socket
+%% using sendmsg and recvmsg.
+api_b_sendmsg_and_recvmsg_udp4(suite) ->
+ [];
+api_b_sendmsg_and_recvmsg_udp4(doc) ->
+ [];
+api_b_sendmsg_and_recvmsg_udp4(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_b_sendmsg_and_recvmsg_udp4,
+ fun() ->
+ Send = fun(Sock, Data, Dest) ->
+ %% CMsgHdr = #{level => ip,
+ %% type => tos,
+ %% data => reliability},
+ %% CMsgHdrs = [CMsgHdr],
+ MsgHdr = #{addr => Dest,
+ %% ctrl => CMsgHdrs,
+ iov => [Data]},
+ socket:sendmsg(Sock, MsgHdr)
+ end,
+ Recv = fun(Sock) ->
+ case socket:recvmsg(Sock) of
+ {ok, #{addr := Source,
+ iov := [Data]}} ->
+ {ok, {Source, Data}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end,
+ InitState = #{domain => inet,
+ send => Send,
+ recv => Recv},
+ ok = api_b_send_and_recv_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+api_b_send_and_recv_udp(InitState) ->
+ Seq =
+ [
+ #{desc => "local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{lsa => LSA}}
+ end},
+ #{desc => "open src socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ Sock = sock_open(Domain, dgram, udp),
+ SASrc = sock_sockname(Sock),
+ {ok, State#{sock_src => Sock, sa_src => SASrc}}
+ end},
+ #{desc => "bind src",
+ cmd => fun(#{sock_src := Sock, lsa := LSA}) ->
+ sock_bind(Sock, LSA),
+ ok
+ end},
+ #{desc => "sockname src socket",
+ cmd => fun(#{sock_src := Sock} = State) ->
+ SASrc = sock_sockname(Sock),
+ %% ei("src sockaddr: ~p", [SASrc]),
+ {ok, State#{sa_src => SASrc}}
+ end},
+ #{desc => "open dst socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ Sock = sock_open(Domain, dgram, udp),
+ {ok, State#{sock_dst => Sock}}
+ end},
+ #{desc => "bind dst",
+ cmd => fun(#{sock_dst := Sock, lsa := LSA}) ->
+ sock_bind(Sock, LSA),
+ ok
+ end},
+ #{desc => "sockname dst socket",
+ cmd => fun(#{sock_dst := Sock} = State) ->
+ SADst = sock_sockname(Sock),
+ %% ei("dst sockaddr: ~p", [SADst]),
+ {ok, State#{sa_dst => SADst}}
+ end},
+ #{desc => "send req (to dst)",
+ cmd => fun(#{sock_src := Sock, sa_dst := Dst, send := Send}) ->
+ ok = Send(Sock, ?BASIC_REQ, Dst)
+ end},
+ #{desc => "recv req (from src)",
+ cmd => fun(#{sock_dst := Sock, sa_src := Src, recv := Recv}) ->
+ {ok, {Src, ?BASIC_REQ}} = Recv(Sock),
+ ok
+ end},
+ #{desc => "send rep (to src)",
+ cmd => fun(#{sock_dst := Sock, sa_src := Src, send := Send}) ->
+ ok = Send(Sock, ?BASIC_REP, Src)
+ end},
+ #{desc => "recv rep (from dst)",
+ cmd => fun(#{sock_src := Sock, sa_dst := Dst, recv := Recv}) ->
+ {ok, {Dst, ?BASIC_REP}} = Recv(Sock),
+ ok
+ end},
+ #{desc => "close src socket",
+ cmd => fun(#{sock_src := Sock}) ->
+ ok = socket:close(Sock)
+ end},
+ #{desc => "close dst socket",
+ cmd => fun(#{sock_dst := Sock}) ->
+ ok = socket:close(Sock)
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+ Evaluator = ?SEV_START("tester", Seq, InitState),
+ ok = ?SEV_AWAIT_FINISH([Evaluator]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Basically send and receive using the "common" functions (send and recv)
+%% on an IPv4 TCP (stream) socket.
+api_b_send_and_recv_tcp4(suite) ->
+ [];
+api_b_send_and_recv_tcp4(doc) ->
+ [];
+api_b_send_and_recv_tcp4(_Config) when is_list(_Config) ->
+ ?TT(?SECS(10)),
+ tc_try(api_b_send_and_recv_tcp4,
+ fun() ->
+ Send = fun(Sock, Data) ->
+ socket:send(Sock, Data)
+ end,
+ Recv = fun(Sock) ->
+ socket:recv(Sock)
+ end,
+ InitState = #{domain => inet,
+ send => Send,
+ recv => Recv},
+ ok = api_b_send_and_recv_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Basically send and receive using the msg functions (sendmsg and recvmsg)
+%% on an IPv4 TCP (stream) socket.
+api_b_sendmsg_and_recvmsg_tcp4(suite) ->
+ [];
+api_b_sendmsg_and_recvmsg_tcp4(doc) ->
+ [];
+api_b_sendmsg_and_recvmsg_tcp4(_Config) when is_list(_Config) ->
+ ?TT(?SECS(10)),
+ tc_try(api_b_sendmsg_and_recvmsg_tcp4,
+ fun() ->
+ Send = fun(Sock, Data) ->
+ MsgHdr = #{iov => [Data]},
+ socket:sendmsg(Sock, MsgHdr)
+ end,
+ Recv = fun(Sock) ->
+ case socket:recvmsg(Sock) of
+ {ok, #{addr := undefined,
+ iov := [Data]}} ->
+ {ok, Data};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end,
+ InitState = #{domain => inet,
+ send => Send,
+ recv => Recv},
+ ok = api_b_send_and_recv_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+api_b_send_and_recv_tcp(InitState) ->
+ process_flag(trap_exit, true),
+ ServerSeq =
+ [
+ %% *** Wait for start order ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester}) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{lsa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, lsa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, lport := Port}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, Port),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "await connection",
+ cmd => fun(#{lsock := LSock} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ ?SEV_IPRINT("accepted: ~n ~p", [Sock]),
+ {ok, State#{csock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (accept)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+ #{desc => "await (recv) request",
+ cmd => fun(#{csock := Sock, recv := Recv}) ->
+ case Recv(Sock) of
+ {ok, ?BASIC_REQ} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv request)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv_req),
+ ok
+ end},
+ #{desc => "await continue (with send reply)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, send_reply)
+ end},
+ #{desc => "send reply",
+ cmd => fun(#{csock := Sock, send := Send}) ->
+ Send(Sock, ?BASIC_REP)
+ end},
+ #{desc => "announce ready (send reply)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send_reply),
+ ok
+ end},
+
+ %% *** Termination ***
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close connection socket",
+ cmd => fun(#{csock := Sock}) ->
+ socket:close(Sock)
+ end},
+ #{desc => "close listen socket",
+ cmd => fun(#{lsock := Sock}) ->
+ socket:close(Sock)
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ {Tester, Port} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester, server_port => Port}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester}) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** The init part ***
+ #{desc => "which server (local) address",
+ cmd => fun(#{domain := Domain, server_port := Port} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain,
+ addr => LAddr},
+ SSA = LSA#{port => Port},
+ {ok, State#{local_sa => LSA, server_sa => SSA}}
+ end},
+ #{desc => "create socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{sock := Sock, local_sa := LSA} = _State) ->
+ case socket:bind(Sock, LSA) of
+ {ok, _Port} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% *** The actual test ***
+ #{desc => "await continue (connect)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, connect)
+ end},
+ #{desc => "connect to server",
+ cmd => fun(#{sock := Sock, server_sa := SSA}) ->
+ socket:connect(Sock, SSA)
+ end},
+ #{desc => "announce ready (connect)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, connect),
+ ok
+ end},
+ #{desc => "await continue (send request)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, send_req)
+ end},
+ #{desc => "send request (to server)",
+ cmd => fun(#{sock := Sock, send := Send}) ->
+ Send(Sock, ?BASIC_REQ)
+ end},
+ #{desc => "announce ready (send request)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send_req),
+ ok
+ end},
+ #{desc => "await recv reply (from server)",
+ cmd => fun(#{sock := Sock, recv := Recv}) ->
+ {ok, ?BASIC_REP} = Recv(Sock),
+ ok
+ end},
+ #{desc => "announce ready (recv reply)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv_reply),
+ ok
+ end},
+
+ %% *** Termination ***
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock}) ->
+ socket:close(Sock)
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the server
+ #{desc => "order server start",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Pid} = State) ->
+ {ok, Port} = ?SEV_AWAIT_READY(Pid, server, init),
+ {ok, State#{server_port => Port}}
+ end},
+
+ %% Start the client
+ #{desc => "order client start",
+ cmd => fun(#{client := Pid, server_port := Port} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Port),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client, init)
+ end},
+
+ %% *** The actual test ***
+ #{desc => "order server to continue (with accept)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Server, accept),
+ ok
+ end},
+ #{desc => "sleep",
+ cmd => fun(_) ->
+ ?SLEEP(?SECS(1)),
+ ok
+ end},
+ #{desc => "order client to continue (with connect)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, connect),
+ ok
+ end},
+ #{desc => "await client ready (connect)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, connect)
+ end},
+ #{desc => "await server ready (accept)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, accept)
+ end},
+ #{desc => "order client to continue (with send request)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, send_req),
+ ok
+ end},
+ #{desc => "await client ready (with send request)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, send_req)
+ end},
+ #{desc => "await server ready (request recv)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, recv_req)
+ end},
+ #{desc => "order server to continue (with send reply)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Server, send_reply),
+ ok
+ end},
+ #{desc => "await server ready (with reply sent)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, send_reply)
+ end},
+ #{desc => "await client ready (reply recv)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, recv_reply)
+ end},
+
+
+ %% *** Termination ***
+ #{desc => "order client to terminate",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await client termination",
+ cmd => fun(#{client := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ State1 = maps:remove(client, State),
+ {ok, State1}
+ end},
+ #{desc => "order server to terminate",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Server),
+ ok
+ end},
+ #{desc => "await server termination",
+ cmd => fun(#{server := Server} = State) ->
+ ?SEV_AWAIT_TERMINATION(Server),
+ State1 = maps:remove(server, State),
+ {ok, State1}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start server evaluator"),
+ Server = ?SEV_START("server", ServerSeq, InitState),
+
+ i("start client evaluator"),
+ Client = ?SEV_START("client", ClientSeq, InitState),
+ i("await evaluator(s)"),
+
+ i("start tester evaluator"),
+ TesterInitState = #{server => Server#ev.pid,
+ client => Client#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% API OPTIONS %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Perform some simple getopt and setopt with the level = otp options
+api_opt_simple_otp_options(suite) ->
+ [];
+api_opt_simple_otp_options(doc) ->
+ [];
+api_opt_simple_otp_options(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_opt_simple_otp_options,
+ fun() -> api_opt_simple_otp_options() end).
+
+api_opt_simple_otp_options() ->
+ Get = fun(S, Key) ->
+ socket:getopt(S, otp, Key)
+ end,
+ Set = fun(S, Key, Val) ->
+ socket:setopt(S, otp, Key, Val)
+ end,
+
+ Seq =
+ [
+ %% *** Init part ***
+ #{desc => "create socket",
+ cmd => fun(#{domain := Domain,
+ type := Type,
+ protocol := Protocol} = State) ->
+ Sock = sock_open(Domain, Type, Protocol),
+ {ok, State#{sock => Sock}}
+ end},
+ #{desc => "create dummy process",
+ cmd => fun(State) ->
+ Pid = spawn_link(fun() ->
+ put(sname, "dummy"),
+ receive
+ die ->
+ exit(normal)
+ end
+ end),
+ {ok, State#{dummy => Pid}}
+ end},
+
+ %% *** Check iow part ***
+ #{desc => "get iow",
+ cmd => fun(#{sock := Sock} = State) ->
+ case Get(Sock, iow) of
+ {ok, IOW} when is_boolean(IOW) ->
+ {ok, State#{iow => IOW}};
+ {ok, InvalidIOW} ->
+ {error, {invalid, InvalidIOW}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% #{desc => "enable debug",
+ %% cmd => fun(#{sock := Sock}) ->
+ %% ok = socket:setopt(Sock, otp, debug, true)
+ %% end},
+
+ #{desc => "set (new) iow",
+ cmd => fun(#{sock := Sock, iow := OldIOW} = State) ->
+ NewIOW = not OldIOW,
+ case Set(Sock, iow, NewIOW) of
+ ok ->
+ {ok, State#{iow => NewIOW}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "get (new) iow",
+ cmd => fun(#{sock := Sock, iow := IOW}) ->
+ case Get(Sock, iow) of
+ {ok, IOW} ->
+ ok;
+ {ok, InvalidIOW} ->
+ {error, {invalid, InvalidIOW}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** Check rcvbuf part ***
+ #{desc => "get rcvbuf",
+ cmd => fun(#{sock := Sock} = State) ->
+ case Get(Sock, rcvbuf) of
+ {ok, RcvBuf} when is_integer(RcvBuf) ->
+ {ok, State#{rcvbuf => RcvBuf}};
+ {ok, {N, RcvBuf} = V} when is_integer(N) andalso
+ is_integer(RcvBuf) ->
+ {ok, State#{rcvbuf => V}};
+ {ok, InvalidRcvBuf} ->
+ {error, {invalid, InvalidRcvBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "set (new) rcvbuf",
+ cmd => fun(#{sock := Sock, rcvbuf := {OldN, OldRcvBuf}} = State) ->
+ NewRcvBuf = {OldN+2, OldRcvBuf + 1024},
+ case Set(Sock, rcvbuf, NewRcvBuf) of
+ ok ->
+ {ok, State#{rcvbuf => NewRcvBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end;
+ (#{sock := Sock, rcvbuf := OldRcvBuf} = State) when is_integer(OldRcvBuf) ->
+ NewRcvBuf = 2 * OldRcvBuf,
+ case Set(Sock, rcvbuf, NewRcvBuf) of
+ ok ->
+ {ok, State#{rcvbuf => NewRcvBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end;
+ (#{sock := Sock, rcvbuf := OldRcvBuf,
+ type := stream,
+ protocol := tcp} = State) when is_integer(OldRcvBuf) ->
+ NewRcvBuf = {2, OldRcvBuf},
+ case Set(Sock, rcvbuf, NewRcvBuf) of
+ ok ->
+ {ok, State#{rcvbuf => NewRcvBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "get (new) rcvbuf",
+ cmd => fun(#{sock := Sock, rcvbuf := RcvBuf}) ->
+ case Get(Sock, rcvbuf) of
+ {ok, RcvBuf} ->
+ ok;
+ {ok, InvalidRcvBuf} ->
+ {error, {invalid, InvalidRcvBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** Check rcvctrlbuf part ***
+ #{desc => "get rcvctrlbuf",
+ cmd => fun(#{sock := Sock} = State) ->
+ case Get(Sock, rcvctrlbuf) of
+ {ok, RcvCtrlBuf} when is_integer(RcvCtrlBuf) ->
+ {ok, State#{rcvctrlbuf => RcvCtrlBuf}};
+ {ok, InvalidRcvCtrlBuf} ->
+ {error, {invalid, InvalidRcvCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "set (new) rcvctrlbuf",
+ cmd => fun(#{sock := Sock, rcvctrlbuf := OldRcvCtrlBuf} = State) ->
+ NewRcvCtrlBuf = 2 * OldRcvCtrlBuf,
+ case Set(Sock, rcvctrlbuf, NewRcvCtrlBuf) of
+ ok ->
+ {ok, State#{rcvctrlbuf => NewRcvCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "get (new) rcvctrlbuf",
+ cmd => fun(#{sock := Sock, rcvctrlbuf := RcvCtrlBuf}) ->
+ case Get(Sock, rcvctrlbuf) of
+ {ok, RcvCtrlBuf} ->
+ ok;
+ {ok, InvalidRcvCtrlBuf} ->
+ {error, {invalid, InvalidRcvCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ %% *** Check rcvctrlbuf part ***
+ #{desc => "get rcvctrlbuf",
+ cmd => fun(#{sock := Sock} = State) ->
+ case Get(Sock, rcvctrlbuf) of
+ {ok, RcvCtrlBuf} when is_integer(RcvCtrlBuf) ->
+ {ok, State#{rcvctrlbuf => RcvCtrlBuf}};
+ {ok, InvalidRcvCtrlBuf} ->
+ {error, {invalid, InvalidRcvCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "set (new) rcvctrlbuf",
+ cmd => fun(#{sock := Sock, rcvctrlbuf := OldRcvCtrlBuf} = State) ->
+ NewRcvCtrlBuf = 2 * OldRcvCtrlBuf,
+ case Set(Sock, rcvctrlbuf, NewRcvCtrlBuf) of
+ ok ->
+ {ok, State#{rcvctrlbuf => NewRcvCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "get (new) rcvctrlbuf",
+ cmd => fun(#{sock := Sock, rcvctrlbuf := RcvCtrlBuf}) ->
+ case Get(Sock, rcvctrlbuf) of
+ {ok, RcvCtrlBuf} ->
+ ok;
+ {ok, InvalidRcvCtrlBuf} ->
+ {error, {invalid, InvalidRcvCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** Check sndctrlbuf part ***
+ #{desc => "get sndctrlbuf",
+ cmd => fun(#{sock := Sock} = State) ->
+ case Get(Sock, sndctrlbuf) of
+ {ok, SndCtrlBuf} when is_integer(SndCtrlBuf) ->
+ {ok, State#{sndctrlbuf => SndCtrlBuf}};
+ {ok, InvalidSndCtrlBuf} ->
+ {error, {invalid, InvalidSndCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "set (new) sndctrlbuf",
+ cmd => fun(#{sock := Sock, sndctrlbuf := OldSndCtrlBuf} = State) ->
+ NewSndCtrlBuf = 2 * OldSndCtrlBuf,
+ case Set(Sock, sndctrlbuf, NewSndCtrlBuf) of
+ ok ->
+ {ok, State#{sndctrlbuf => NewSndCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "get (new) sndctrlbuf",
+ cmd => fun(#{sock := Sock, sndctrlbuf := SndCtrlBuf}) ->
+ case Get(Sock, sndctrlbuf) of
+ {ok, SndCtrlBuf} ->
+ ok;
+ {ok, InvalidSndCtrlBuf} ->
+ {error, {invalid, InvalidSndCtrlBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** Check controlling-process part ***
+ #{desc => "verify self as controlling-process",
+ cmd => fun(#{sock := Sock}) ->
+ Self = self(),
+ case Get(Sock, controlling_process) of
+ {ok, Self} ->
+ ok;
+ {ok, InvalidPid} ->
+ {error, {invalid, InvalidPid}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "set dummy as controlling-process",
+ cmd => fun(#{sock := Sock, dummy := Dummy}) ->
+ Set(Sock, controlling_process, Dummy)
+ end},
+ #{desc => "verify dummy as controlling-process",
+ cmd => fun(#{sock := Sock, dummy := Dummy}) ->
+ case Get(Sock, controlling_process) of
+ {ok, Dummy} ->
+ ok;
+ {ok, InvalidPid} ->
+ {error, {invalid, InvalidPid}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ #{desc => "finish",
+ cmd => fun(_) ->
+ {ok, normal}
+ end}
+ ],
+
+ i("start tcp (stream) evaluator"),
+ InitState1 = #{domain => inet, type => stream, protocol => tcp},
+ Tester1 = ?SEV_START("tcp-tester", Seq, InitState1),
+ i("await tcp evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Tester1]),
+
+ i("start udp (dgram) socket"),
+ InitState2 = #{domain => inet, type => dgram, protocol => udp},
+ Tester2 = ?SEV_START("udp-tester", Seq, InitState2),
+ i("await udp evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Tester2]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Perform some simple operations with the rcvbuf otp option
+%% The operations we test here are only for type = stream and
+%% protocol = tcp.
+api_opt_simple_otp_rcvbuf_option(suite) ->
+ [];
+api_opt_simple_otp_rcvbuf_option(doc) ->
+ [];
+api_opt_simple_otp_rcvbuf_option(_Config) when is_list(_Config) ->
+ ?TT(?SECS(15)),
+ tc_try(api_opt_simple_otp_rcvbuf_option,
+ fun() -> api_opt_simple_otp_rcvbuf_option() end).
+
+api_opt_simple_otp_rcvbuf_option() ->
+ Get = fun(S) ->
+ socket:getopt(S, otp, rcvbuf)
+ end,
+ Set = fun(S, Val) ->
+ socket:setopt(S, otp, rcvbuf, Val)
+ end,
+
+ ServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, local_sa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester,
+ local_sa := LocalSA,
+ lport := Port}) ->
+ ServerSA = LocalSA#{port => Port},
+ ?SEV_ANNOUNCE_READY(Tester, init, ServerSA),
+ ok
+ end},
+
+
+ %% *** The actual test part ***
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "attempt to accept",
+ cmd => fun(#{lsock := LSock} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (accept)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+
+ %% Recv with default size for (otp) rcvbuf
+ #{desc => "await continue (recv initial)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, recv) of
+ {ok, MsgSz} ->
+ ?SEV_IPRINT("MsgSz: ~p", [MsgSz]),
+ {ok, State#{msg_sz => MsgSz}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt to recv",
+ cmd => fun(#{sock := Sock, msg_sz := MsgSz} = _State) ->
+ ?SEV_IPRINT("try recv ~w bytes when rcvbuf is ~s",
+ [MsgSz,
+ case Get(Sock) of
+ {ok, RcvBuf} -> f("~w", [RcvBuf]);
+ {error, _} -> "-"
+ end]),
+ case socket:recv(Sock) of
+ {ok, Data} when (size(Data) =:= MsgSz) ->
+ ok;
+ {ok, Data} ->
+ {error, {invalid_msg_sz, MsgSz, size(Data)}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv initial)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv),
+ ok
+ end},
+
+ %% Recv with new size (1) for (otp) rcvbuf
+ #{desc => "await continue (recv 1)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, recv) of
+ {ok, NewRcvBuf} ->
+ ?SEV_IPRINT("set new rcvbuf: ~p", [NewRcvBuf]),
+ {ok, State#{rcvbuf => NewRcvBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt to setopt rcvbuf",
+ cmd => fun(#{sock := Sock, rcvbuf := NewRcvBuf} = _State) ->
+ case Set(Sock, NewRcvBuf) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt to recv",
+ cmd => fun(#{sock := Sock, msg_sz := MsgSz} = _State) ->
+ case socket:recv(Sock) of
+ {ok, Data} when (size(Data) =:= MsgSz) ->
+ ok;
+ {ok, Data} ->
+ {error, {invalid_msg_sz, MsgSz, size(Data)}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv 1)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv),
+ ok
+ end},
+
+ %% Recv with new size (2) for (otp) rcvbuf
+ #{desc => "await continue (recv 2)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, recv) of
+ {ok, NewRcvBuf} ->
+ ?SEV_IPRINT("set new rcvbuf: ~p", [NewRcvBuf]),
+ {ok, State#{rcvbuf => NewRcvBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt to setopt rcvbuf",
+ cmd => fun(#{sock := Sock, rcvbuf := NewRcvBuf} = _State) ->
+ case Set(Sock, NewRcvBuf) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt to recv",
+ cmd => fun(#{sock := Sock, msg_sz := MsgSz} = _State) ->
+ case socket:recv(Sock) of
+ {ok, Data} when (size(Data) =:= MsgSz) ->
+ ok;
+ {ok, Data} ->
+ {error, {invalid_msg_sz, MsgSz, size(Data)}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv 2)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv),
+ ok
+ end},
+
+ %% Recv with new size (3) for (otp) rcvbuf
+ #{desc => "await continue (recv 3, truncated)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, recv) of
+ {ok, {ExpSz, NewRcvBuf}} ->
+ {ok, State#{msg_sz => ExpSz,
+ rcvbuf => NewRcvBuf}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt to setopt rcvbuf",
+ cmd => fun(#{sock := Sock, rcvbuf := NewRcvBuf} = _State) ->
+ case Set(Sock, NewRcvBuf) of
+ ok ->
+ ?SEV_IPRINT("set new rcvbuf: ~p", [NewRcvBuf]),
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt to recv",
+ cmd => fun(#{sock := Sock, msg_sz := MsgSz} = _State) ->
+ ?SEV_IPRINT("try recv ~w bytes of data", [MsgSz]),
+ case socket:recv(Sock) of
+ {ok, Data} when (size(Data) =:= MsgSz) ->
+ ok;
+ {ok, Data} ->
+ {error, {invalid_msg_sz, MsgSz, size(Data)}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv),
+ ok
+ end},
+
+
+ %% Termination
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close socket(s)",
+ cmd => fun(#{lsock := LSock, sock := Sock} = State) ->
+ sock_close(Sock),
+ sock_close(LSock),
+ State1 = maps:remove(sock, State),
+ State2 = maps:remove(lport, State1),
+ State3 = maps:remove(lsock, State2),
+ {ok, State3}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, ServerSA} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ server_sa => ServerSA}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{sock := Sock, local_sa := LSA} = _State) ->
+ case socket:bind(Sock, LSA) of
+ {ok, _Port} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (connect)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, connect)
+ end},
+ #{desc => "connect to server",
+ cmd => fun(#{sock := Sock, server_sa := SSA}) ->
+ socket:connect(Sock, SSA)
+ end},
+ #{desc => "announce ready (connect)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, connect),
+ ok
+ end},
+
+ #{desc => "await continue (send initial)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, send) of
+ {ok, Data} ->
+ {ok, State#{data => Data}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "send (initial) data to server",
+ cmd => fun(#{sock := Sock, data := Data} = _State) ->
+ ?SEV_IPRINT("try send ~w bytes", [size(Data)]),
+ socket:send(Sock, Data)
+ end},
+ #{desc => "announce ready (send initial)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send),
+ ok
+ end},
+
+ #{desc => "await continue (send 1)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, send)
+ end},
+ #{desc => "send (1) data to server",
+ cmd => fun(#{sock := Sock, data := Data}) ->
+ ?SEV_IPRINT("try send ~w bytes", [size(Data)]),
+ socket:send(Sock, Data)
+ end},
+ #{desc => "announce ready (send 1)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send),
+ ok
+ end},
+
+ #{desc => "await continue (send 2)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, send)
+ end},
+ #{desc => "send (2) data to server",
+ cmd => fun(#{sock := Sock, data := Data}) ->
+ ?SEV_IPRINT("try send ~w bytes", [size(Data)]),
+ socket:send(Sock, Data)
+ end},
+ #{desc => "announce ready (send 2)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send),
+ ok
+ end},
+
+ #{desc => "await continue (send 3)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, send)
+ end},
+ #{desc => "send (3) data to server",
+ cmd => fun(#{sock := Sock, data := Data}) ->
+ ?SEV_IPRINT("try send ~w bytes", [size(Data)]),
+ socket:send(Sock, Data)
+ end},
+ #{desc => "announce ready (send 3)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send),
+ ok
+ end},
+
+
+ %% Termination
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock}) ->
+ socket:close(Sock)
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Server} = _State) ->
+ _MRef = erlang:monitor(process, Server),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Client} = _State) ->
+ _MRef = erlang:monitor(process, Client),
+ ok
+ end},
+ #{desc => "order server start",
+ cmd => fun(#{server := Server}) ->
+ ?SEV_ANNOUNCE_START(Server)
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Server} = State) ->
+ {ok, ServerSA} = ?SEV_AWAIT_READY(Server, server, init),
+ {ok, State#{server_sa => ServerSA}}
+ end},
+ #{desc => "order client start",
+ cmd => fun(#{client := Client,
+ server_sa := ServerSA}) ->
+ ?SEV_ANNOUNCE_START(Client, ServerSA),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, init)
+ end},
+
+
+ %% The actual test (connecting)
+ #{desc => "order server accept (accept)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Server, accept),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client continue (connect)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, connect),
+ ok
+ end},
+ #{desc => "await client ready (connect)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, connect)
+ end},
+ #{desc => "await server ready (accept)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, accept)
+ end},
+
+ %% The actual test (initial part)
+ #{desc => "order client continue (send initial)",
+ cmd => fun(#{client := Client, data := Data} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Data),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order server continue (recv initial)",
+ cmd => fun(#{server := Server, data := Data} = _State) ->
+ ExpMsgSz = size(Data),
+ ?SEV_ANNOUNCE_CONTINUE(Server, recv, ExpMsgSz),
+ ok
+ end},
+ #{desc => "await client ready (send initial)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, client, send,
+ [{server, Server}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await server ready (recv initial)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Server, client, recv,
+ [{client, Client}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% The actual test (part 1)
+ #{desc => "order client continue (send 1)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, send),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order server continue (recv 1)",
+ cmd => fun(#{server := Server, data := Data} = _State) ->
+ MsgSz = size(Data),
+ NewRcvBuf = {2 + (MsgSz div 1024), 1024},
+ ?SEV_ANNOUNCE_CONTINUE(Server, recv, NewRcvBuf),
+ ok
+ end},
+ #{desc => "await client ready (send 1)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, client, send,
+ [{server, Server}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await server ready (recv 1)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Server, client, recv,
+ [{client, Client}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% The actual test (part 2)
+ #{desc => "order client continue (send 2)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, send),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order server continue (recv 2)",
+ cmd => fun(#{server := Server, data := Data} = _State) ->
+ MsgSz = size(Data),
+ NewRcvBuf = {2 + (MsgSz div 2048), 2048},
+ ?SEV_ANNOUNCE_CONTINUE(Server, recv, NewRcvBuf),
+ ok
+ end},
+ #{desc => "await client ready (send 2)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, client, send,
+ [{server, Server}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await server ready (recv 2)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Server, client, recv,
+ [{client, Client}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% The actual test (part 3)
+ #{desc => "order client continue (send 3)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, send),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order server continue (recv 3)",
+ cmd => fun(#{server := Server, data := Data} = _State) ->
+ MsgSz = size(Data),
+ BufSz = 2048,
+ N = MsgSz div BufSz - 1,
+ NewRcvBuf = {N, BufSz},
+ ?SEV_ANNOUNCE_CONTINUE(Server, recv,
+ {N*BufSz, NewRcvBuf})
+ end},
+ #{desc => "await client ready (send 3)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, client, send,
+ [{server, Server}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await server ready (recv 3)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Server, client, recv,
+ [{client, Client}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ ?SEV_SLEEP(?SECS(1)),
+
+ %% *** Terminate server ***
+ #{desc => "order client terminate",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await client down",
+ cmd => fun(#{client := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ State1 = maps:remove(client, State),
+ {ok, State1}
+ end},
+ #{desc => "order server terminate",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Server),
+ ok
+ end},
+ #{desc => "await server down",
+ cmd => fun(#{server := Server} = State) ->
+ ?SEV_AWAIT_TERMINATION(Server),
+ State1 = maps:remove(server, State),
+ State2 = maps:remove(server_sa, State1),
+ {ok, State2}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ %% Create a data binary of 6*1024 bytes
+ Data = list_to_binary(lists:duplicate(6*4, lists:seq(0, 255))),
+ InitState = #{domain => inet,
+ data => Data},
+
+ i("create server evaluator"),
+ ServerInitState = #{domain => maps:get(domain, InitState)},
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("create client evaluator"),
+ ClientInitState = #{host => local_host(),
+ domain => maps:get(domain, InitState)},
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("create tester evaluator"),
+ TesterInitState = InitState#{server => Server#ev.pid,
+ client => Client#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator(s)"),
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Perform some simple getopt and setopt with the level = otp options
+api_opt_simple_otp_controlling_process(suite) ->
+ [];
+api_opt_simple_otp_controlling_process(doc) ->
+ [];
+api_opt_simple_otp_controlling_process(_Config) when is_list(_Config) ->
+ ?TT(?SECS(5)),
+ tc_try(api_opt_simple_otp_controlling_process,
+ fun() -> api_opt_simple_otp_controlling_process() end).
+
+api_opt_simple_otp_controlling_process() ->
+ Get = fun(S, Key) ->
+ socket:getopt(S, otp, Key)
+ end,
+ Set = fun(S, Key, Val) ->
+ socket:setopt(S, otp, Key, Val)
+ end,
+
+ ClientSeq =
+ [
+ %% *** Init part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, Sock} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ sock => Sock}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester}) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** The actual test ***
+ #{desc => "verify tester as controlling-process",
+ cmd => fun(#{tester := Tester, sock := Sock} = _State) ->
+ case Get(Sock, controlling_process) of
+ {ok, Tester} ->
+ ok;
+ {ok, InvalidPid} ->
+ {error, {invalid, InvalidPid}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt invalid controlling-process transfer (to self)",
+ cmd => fun(#{sock := Sock} = _State) ->
+ case Set(Sock, controlling_process, self()) of
+ {error, not_owner} ->
+ ok;
+ ok ->
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (not owner)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, not_owner),
+ ok
+ end},
+ #{desc => "await continue (owner)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, owner)
+ end},
+ #{desc => "verify self as controlling-process",
+ cmd => fun(#{sock := Sock} = _State) ->
+ Self = self(),
+ case Get(Sock, controlling_process) of
+ {ok, Self} ->
+ ok;
+ {ok, InvalidPid} ->
+ {error, {invalid, InvalidPid}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt controlling-process transfer to tester",
+ cmd => fun(#{tester := Tester, sock := Sock} = _State) ->
+ Set(Sock, controlling_process, Tester)
+ end},
+ #{desc => "attempt invalid controlling-process transfer (to self)",
+ cmd => fun(#{sock := Sock} = _State) ->
+ case Set(Sock, controlling_process, self()) of
+ {error, not_owner} ->
+ ok;
+ ok ->
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (owner)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, owner),
+ ok
+
+ end},
+
+ %% *** Termination ***
+ #{desc => "await termination",
+ cmd => fun(#{tester := Tester} = State) ->
+ ?SEV_AWAIT_TERMINATE(Tester, tester),
+ State1 = maps:remove(tester, State),
+ State2 = maps:remove(sock, State1),
+ {ok, State2}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "create socket",
+ cmd => fun(#{domain := Domain,
+ type := Type,
+ protocol := Protocol} = State) ->
+ Sock = sock_open(Domain, Type, Protocol),
+ {ok, State#{sock => Sock}}
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Client} = _State) ->
+ _MRef = erlang:monitor(process, Client),
+ ok
+ end},
+
+ %% *** The actual test ***
+ #{desc => "verify self as controlling-process",
+ cmd => fun(#{sock := Sock} = _State) ->
+ Self = self(),
+ case Get(Sock, controlling_process) of
+ {ok, Self} ->
+ ok;
+ {ok, InvalidPid} ->
+ {error, {invalid, InvalidPid}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order (client) start",
+ cmd => fun(#{client := Client, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_START(Client, Sock),
+ ok
+ end},
+ #{desc => "await (client) ready (not owner)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, not_owner)
+ end},
+ #{desc => "attempt controlling-process transfer to client",
+ cmd => fun(#{client := Client, sock := Sock} = _State) ->
+ Set(Sock, controlling_process, Client)
+ end},
+ #{desc => "verify client as controlling-process",
+ cmd => fun(#{client := Client, sock := Sock} = _State) ->
+ case Get(Sock, controlling_process) of
+ {ok, Client} ->
+ ok;
+ {ok, InvalidPid} ->
+ {error, {invalid, InvalidPid}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt invalid controlling-process transfer (to self)",
+ cmd => fun(#{sock := Sock} = _State) ->
+ case Set(Sock, controlling_process, self()) of
+ {error, not_owner} ->
+ ok;
+ ok ->
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order (client) continue (owner)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, owner),
+ ok
+ end},
+ #{desc => "await (client) ready (2)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, owner),
+ ok
+ end},
+ #{desc => "verify self as controlling-process",
+ cmd => fun(#{sock := Sock} = _State) ->
+ Self = self(),
+ case Get(Sock, controlling_process) of
+ {ok, Self} ->
+ ok;
+ {ok, InvalidPid} ->
+ {error, {invalid, InvalidPid}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** Termination ***
+ #{desc => "order (client) terminate",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await client termination",
+ cmd => fun(#{client := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ {ok, maps:remove(client, State)}
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock} = State) ->
+ sock_close(Sock),
+ {ok, maps:remove(sock, State)}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start tcp (stream) client evaluator"),
+ ClientInitState1 = #{},
+ Client1 = ?SEV_START("tcp-client", ClientSeq, ClientInitState1),
+
+ i("start tcp (stream) tester evaluator"),
+ TesterInitState1 = #{domain => inet,
+ type => stream,
+ protocol => tcp,
+ client => Client1#ev.pid},
+ Tester1 = ?SEV_START("tcp-tester", TesterSeq, TesterInitState1),
+
+ i("await tcp evaluator(s)"),
+ ok = ?SEV_AWAIT_FINISH([Tester1, Client1]),
+
+ i("start udp (dgram) client evaluator"),
+ ClientInitState2 = #{},
+ Client2 = ?SEV_START("udp-client", ClientSeq, ClientInitState2),
+
+ i("start udp (dgram) tester evaluator"),
+ TesterInitState2 = #{domain => inet,
+ type => dgram,
+ protocol => udp,
+ client => Client2#ev.pid},
+ Tester2 = ?SEV_START("udp-tester", TesterSeq, TesterInitState2),
+
+ i("await udp evaluator(s)"),
+ ok = ?SEV_AWAIT_FINISH([Tester2, Client2]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% API OPERATIONS WITH TIMEOUT %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the connect timeout option
+%% on an IPv4 TCP (stream) socket.
+api_to_connect_tcp4(suite) ->
+ [];
+api_to_connect_tcp4(doc) ->
+ [];
+api_to_connect_tcp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_connect_tcp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ InitState = #{domain => inet,
+ backlog => 1,
+ timeout => 5000,
+ connect_limit => 3},
+ ok = api_to_connect_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the connect timeout option
+%% on an IPv6 TCP (stream) socket.
+api_to_connect_tcp6(suite) ->
+ [];
+api_to_connect_tcp6(doc) ->
+ [];
+api_to_connect_tcp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_connect_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ InitState = #{domain => inet6,
+ backlog => 1,
+ timeout => 5000,
+ connect_limit => 3},
+ ok = api_to_connect_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% We use the backlog (listen) argument to test this.
+%% Note that the behaviour of the TCP "server side" can vary when
+%% a client connect to a "busy" server (full backlog).
+%% For instance, on FreeBSD (11.2) the reponse when the backlog is full
+%% is a econreset.
+
+api_to_connect_tcp(InitState) ->
+ process_flag(trap_exit, true),
+
+ ServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ {Tester, Backlog} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ backlog => Backlog}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, local_sa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket (with backlog = 1)",
+ cmd => fun(#{lsock := LSock, backlog := Backlog}) ->
+ socket:listen(LSock, Backlog)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, lport := Port}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, Port),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{lsock := Sock} = State) ->
+ sock_close(Sock),
+ State1 = maps:remove(lport, State),
+ State2 = maps:remove(sock, State1),
+ {ok, State2}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, ServerSA} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ server_sa => ServerSA}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create node",
+ cmd => fun(#{host := Host} = State) ->
+ ?SEV_IPRINT("try create node on ~p", [Host]),
+ case start_node(Host, client) of
+ {ok, Node} ->
+ ?SEV_IPRINT("client node ~p started",
+ [Node]),
+ {ok, State#{node => Node}};
+ {error, Reason, _} ->
+ {error, Reason}
+ end
+ end},
+ #{desc => "monitor client node",
+ cmd => fun(#{node := Node} = _State) ->
+ true = erlang:monitor_node(Node, true),
+ ok
+ end},
+ #{desc => "start remote client on client node",
+ cmd => fun(#{node := Node} = State) ->
+ Pid = api_toc_tcp_client_start(Node),
+ ?SEV_IPRINT("remote client ~p started", [Pid]),
+ {ok, State#{rclient => Pid}}
+ end},
+ #{desc => "monitor remote client",
+ cmd => fun(#{rclient := Pid}) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "order remote client to start",
+ cmd => fun(#{rclient := Client,
+ server_sa := ServerSA}) ->
+ ?SEV_ANNOUNCE_START(Client, ServerSA),
+ ok
+ end},
+ #{desc => "await remote client ready",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, init,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, connect,
+ [{rclient, Client}]) of
+ {ok, {ConTimeout, ConLimit}} ->
+ {ok, State#{connect_timeout => ConTimeout,
+ connect_limit => ConLimit}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (connect)",
+ cmd => fun(#{rclient := RClient,
+ connect_timeout := ConTimeout,
+ connect_limit := ConLimit}) ->
+ ?SEV_ANNOUNCE_CONTINUE(RClient, connect,
+ {ConTimeout, ConLimit}),
+ ok
+ end},
+ #{desc => "await remote client ready (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = State) ->
+ case ?SEV_AWAIT_READY(RClient, rclient, connect,
+ [{tester, Tester}]) of
+ {ok, ok = _Result} ->
+ {ok, maps:remove(connect_limit, State)};
+ {ok, {error, {connect_limit_reached,R,L}}} ->
+ {skip,
+ ?LIB:f("Connect limit reached ~w: ~w",
+ [L, R])};
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ #{desc => "announce ready (connect)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, connect),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester,
+ [{rclient, RClient}]) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "kill remote client",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await remote client termination",
+ cmd => fun(#{rclient := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ State1 = maps:remove(rclient, State),
+ {ok, State1}
+ end},
+ #{desc => "stop client node",
+ cmd => fun(#{node := Node} = _State) ->
+ stop_node(Node)
+ end},
+ #{desc => "await client node termination",
+ cmd => fun(#{node := Node} = State) ->
+ receive
+ {nodedown, Node} ->
+ State1 = maps:remove(node_id, State),
+ State2 = maps:remove(node, State1),
+ {ok, State2}
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Server} = _State) ->
+ _MRef = erlang:monitor(process, Server),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Client} = _State) ->
+ _MRef = erlang:monitor(process, Client),
+ ok
+ end},
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "order server start",
+ cmd => fun(#{server := Server,
+ backlog := Backlog}) ->
+ ?SEV_ANNOUNCE_START(Server, Backlog),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Server, local_sa := LSA} = State) ->
+ {ok, Port} = ?SEV_AWAIT_READY(Server, server, init),
+ ServerSA = LSA#{port => Port},
+ {ok, State#{server_sa => ServerSA}}
+ end},
+ #{desc => "order client start",
+ cmd => fun(#{client := Client,
+ server_sa := ServerSA}) ->
+ ?SEV_ANNOUNCE_START(Client, ServerSA),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, init),
+ ok
+ end},
+
+ %% The actual test
+ %% The server does nothing (this is the point), no accept,
+ %% the client tries to connect.
+ #{desc => "order client continue (connect)",
+ cmd => fun(#{client := Client,
+ timeout := Timeout,
+ connect_limit := ConLimit} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, connect,
+ {Timeout, ConLimit}),
+ ok
+ end},
+ #{desc => "await client ready (connect)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, client, connect,
+ [{server, Server}]) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** Terminate server ***
+ #{desc => "order client terminate",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await client down",
+ cmd => fun(#{client := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ State1 = maps:remove(client, State),
+ {ok, State1}
+ end},
+ #{desc => "order server terminate",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Server),
+ ok
+ end},
+ #{desc => "await server down",
+ cmd => fun(#{server := Server} = State) ->
+ ?SEV_AWAIT_TERMINATION(Server),
+ State1 = maps:remove(server, State),
+ State2 = maps:remove(server_sa, State1),
+ {ok, State2}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("create server evaluator"),
+ ServerInitState = #{domain => maps:get(domain, InitState)},
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("create client evaluator"),
+ ClientInitState = #{host => local_host(),
+ domain => maps:get(domain, InitState)},
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("create tester evaluator"),
+ TesterInitState = InitState#{server => Server#ev.pid,
+ client => Client#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator(s)"),
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+api_toc_tcp_client_start(Node) ->
+ Self = self(),
+ Fun = fun() -> api_toc_tcp_client(Self) end,
+ erlang:spawn(Node, Fun).
+
+api_toc_tcp_client(Parent) ->
+ api_toc_tcp_client_init(Parent),
+ ServerSA = api_toc_tcp_client_await_start(Parent),
+ Domain = maps:get(family, ServerSA),
+ api_toc_tcp_client_announce_ready(Parent, init),
+ {To, ConLimit} = api_toc_tcp_client_await_continue(Parent, connect),
+ Result = api_to_connect_tcp_await_timeout(To, ServerSA, Domain, ConLimit),
+ ?SEV_IPRINT("result: ~p", [Result]),
+ api_toc_tcp_client_announce_ready(Parent, connect, Result),
+ Reason = api_toc_tcp_client_await_terminate(Parent),
+ exit(Reason).
+
+api_toc_tcp_client_init(Parent) ->
+ put(sname, "rclient"),
+ %% i("api_toc_tcp_client_init -> entry"),
+ _MRef = erlang:monitor(process, Parent),
+ ok.
+
+api_toc_tcp_client_await_start(Parent) ->
+ %% i("api_toc_tcp_client_await_start -> entry"),
+ ?SEV_AWAIT_START(Parent).
+
+api_toc_tcp_client_announce_ready(Parent, Slogan) ->
+ ?SEV_ANNOUNCE_READY(Parent, Slogan).
+api_toc_tcp_client_announce_ready(Parent, Slogan, Result) ->
+ ?SEV_ANNOUNCE_READY(Parent, Slogan, Result).
+
+api_toc_tcp_client_await_continue(Parent, Slogan) ->
+ %% i("api_toc_tcp_client_await_continue -> entry"),
+ case ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan) of
+ ok ->
+ ok;
+ {ok, Extra} ->
+ Extra;
+ {error, Reason} ->
+ exit({await_continue, Slogan, Reason})
+ end.
+
+api_toc_tcp_client_await_terminate(Parent) ->
+ %% i("api_toc_tcp_client_await_terminate -> entry"),
+ case ?SEV_AWAIT_TERMINATE(Parent, parent) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ Reason
+ end.
+
+api_to_connect_tcp_await_timeout(To, ServerSA, Domain, ConLimit) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain,
+ addr => LAddr},
+ NewSock = fun() ->
+ S = case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ Sock;
+ {error, OReason} ->
+ ?FAIL({open, OReason})
+ end,
+ case socket:bind(S, LSA) of
+ {ok, _} ->
+ S;
+ {error, BReason} ->
+ ?FAIL({bind, BReason})
+ end
+ end,
+ api_to_connect_tcp_await_timeout(1, ConLimit, To, ServerSA, NewSock, []).
+
+api_to_connect_tcp_await_timeout(ID, ConLimit, _To, _ServerSA, _NewSock, Acc)
+ when (ID > ConLimit) ->
+ api_to_connect_tcp_await_timeout3(Acc),
+ {error, {connect_limit_reached, ID, ConLimit}};
+api_to_connect_tcp_await_timeout(ID, ConLimit, To, ServerSA, NewSock, Acc) ->
+ case api_to_connect_tcp_await_timeout2(ID, To, ServerSA, NewSock) of
+ ok ->
+ %% ?SEV_IPRINT("success when number of socks: ~w", [length(Acc)]),
+ api_to_connect_tcp_await_timeout3(Acc),
+ ok;
+ {ok, Sock} ->
+ %% ?SEV_IPRINT("~w: unexpected success (connect)", [ID]),
+ api_to_connect_tcp_await_timeout(ID+1, ConLimit,
+ To, ServerSA, NewSock,
+ [Sock|Acc]);
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+api_to_connect_tcp_await_timeout2(_ID, To, ServerSA, NewSock) ->
+ Sock = NewSock(),
+ %% ?SEV_IPRINT("~w: try connect", [ID]),
+ Start = t(),
+ case socket:connect(Sock, ServerSA, To) of
+ {error, timeout} ->
+ Stop = t(),
+ TDiff = tdiff(Start, Stop),
+ if
+ (TDiff >= To) ->
+ (catch socket:close(Sock)),
+ ok;
+ true ->
+ (catch socket:close(Sock)),
+ ?FAIL({unexpected_timeout, TDiff, To})
+ end;
+ {error, econnreset = _Reason} ->
+ (catch socket:close(Sock)),
+ ok;
+ {error, Reason} ->
+ (catch socket:close(Sock)),
+ ?FAIL({connect, Reason});
+ ok ->
+ {ok, Sock}
+ end.
+
+api_to_connect_tcp_await_timeout3([]) ->
+ ok;
+api_to_connect_tcp_await_timeout3([Sock|Socka]) ->
+ (catch socket:close(Sock)),
+ api_to_connect_tcp_await_timeout3(Socka).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the accept timeout option
+%% on an IPv4 TCP (stream) socket.
+api_to_accept_tcp4(suite) ->
+ [];
+api_to_accept_tcp4(doc) ->
+ [];
+api_to_accept_tcp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_accept_tcp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ InitState = #{domain => inet, timeout => 5000},
+ ok = api_to_accept_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the accept timeout option
+%% on an IPv6 TCP (stream) socket.
+api_to_accept_tcp6(suite) ->
+ [];
+api_to_accept_tcp6(doc) ->
+ [];
+api_to_accept_tcp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_accept_tcp4,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ InitState = #{domain => inet6, timeout => 5000},
+ ok = api_to_accept_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+api_to_accept_tcp(InitState) ->
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{lsa => LSA}}
+ end},
+ #{desc => "create (listen) socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, lsa := LSA} = _State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+
+ %% *** The actual test part ***
+ #{desc => "attempt to accept (without success)",
+ cmd => fun(#{lsock := LSock, timeout := To} = State) ->
+ Start = t(),
+ case socket:accept(LSock, To) of
+ {error, timeout} ->
+ {ok, State#{start => Start, stop => t()}};
+ {ok, Sock} ->
+ (catch socket:close(Sock)),
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "validate timeout time",
+ cmd => fun(#{start := Start, stop := Stop, timeout := To} = _State) ->
+ TDiff = tdiff(Start, Stop),
+ if
+ (TDiff >= To) ->
+ ok;
+ true ->
+ {error, {unexpected_timeout, TDiff, To}}
+ end
+ end},
+
+ %% *** Close (listen) socket ***
+ #{desc => "close (listen) socket",
+ cmd => fun(#{lsock := LSock} = State) ->
+ sock_close(LSock),
+ {ok, maps:remove(sock3, State)}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("create tester evaluator"),
+ Tester = ?SEV_START("tester", TesterSeq, InitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the multi accept timeout option
+%% on an IPv4 TCP (stream) socket with multiple acceptor processes
+%% (three in this case).
+api_to_maccept_tcp4(suite) ->
+ [];
+api_to_maccept_tcp4(doc) ->
+ [];
+api_to_maccept_tcp4(_Config) when is_list(_Config) ->
+ ?TT(?SECS(20)),
+ tc_try(api_to_maccept_tcp4,
+ fun() ->
+ InitState = #{domain => inet, timeout => 5000},
+ ok = api_to_maccept_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the accept timeout option
+%% on an IPv6 TCP (stream) socket.
+api_to_maccept_tcp6(suite) ->
+ [];
+api_to_maccept_tcp6(doc) ->
+ [];
+api_to_maccept_tcp6(_Config) when is_list(_Config) ->
+ ?TT(?SECS(20)),
+ tc_try(api_to_maccept_tcp4,
+ fun() ->
+ not_yet_implemented(),
+ InitState = #{domain => inet6, timeout => 5000},
+ ok = api_to_maccept_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+api_to_maccept_tcp(InitState) ->
+ PrimAcceptorSeq =
+ [
+ %% *** Init part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{lsa => LSA}}
+ end},
+ #{desc => "create (listen) socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, lsa := LSA} = _State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{lsock := LSock, tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, LSock),
+ ok
+ end},
+
+ %% *** The actual test ***
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "attempt to accept (without success)",
+ cmd => fun(#{lsock := LSock, timeout := To} = State) ->
+ Start = t(),
+ case socket:accept(LSock, To) of
+ {error, timeout} ->
+ {ok, State#{start => Start, stop => t()}};
+ {ok, Sock} ->
+ ?SEV_EPRINT("Unexpected accept success: "
+ "~n ~p", [Sock]),
+ (catch socket:close(Sock)),
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "validate timeout time",
+ cmd => fun(#{start := Start, stop := Stop, timeout := To} = _State) ->
+ TDiff = tdiff(Start, Stop),
+ if
+ (TDiff >= To) ->
+ ok;
+ true ->
+ {error, {unexpected_timeout, TDiff, To}}
+ end
+ end},
+ #{desc => "announce ready (accept)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+
+ %% *** Terminate ***
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_TERMINATE(Tester, tester),
+ ok
+ end},
+ %% *** Close (listen) socket ***
+ #{desc => "close (listen) socket",
+ cmd => fun(#{lsock := LSock} = State) ->
+ sock_close(LSock),
+ {ok, maps:remove(lsock, State)}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+
+ SecAcceptorSeq =
+ [
+ %% *** Init part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, LSock} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ lsock => LSock}}
+
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% *** The actual test part ***
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "attempt to accept (without success)",
+ cmd => fun(#{lsock := LSock, timeout := To} = State) ->
+ Start = t(),
+ case socket:accept(LSock, To) of
+ {error, timeout} ->
+ {ok, State#{start => Start, stop => t()}};
+ {ok, Sock} ->
+ (catch socket:close(Sock)),
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "validate timeout time",
+ cmd => fun(#{start := Start, stop := Stop, timeout := To} = State) ->
+ TDiff = tdiff(Start, Stop),
+ if
+ (TDiff >= To) ->
+ State1 = maps:remove(start, State),
+ State2 = maps:remove(stop, State1),
+ {ok, State2};
+ true ->
+ {error, {unexpected_timeout, TDiff, To}}
+ end
+ end},
+ #{desc => "announce ready (accept)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+
+ %% *** Terminate ***
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+
+ TesterSeq =
+ [
+ %% Init part
+ #{desc => "monitor prim-acceptor",
+ cmd => fun(#{prim_acceptor := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor sec-acceptor 1",
+ cmd => fun(#{sec_acceptor1 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor sec-acceptor 2",
+ cmd => fun(#{sec_acceptor2 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+
+ %% Start the prim-acceptor
+ #{desc => "start prim-acceptor",
+ cmd => fun(#{prim_acceptor := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await prim-acceptor ready (init)",
+ cmd => fun(#{prim_acceptor := Pid} = State) ->
+ {ok, Sock} = ?SEV_AWAIT_READY(Pid, prim_acceptor, init),
+ {ok, State#{lsock => Sock}}
+ end},
+
+ %% Start sec-acceptor-1
+ #{desc => "start sec-acceptor 1",
+ cmd => fun(#{sec_acceptor1 := Pid, lsock := LSock} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, LSock),
+ ok
+ end},
+ #{desc => "await sec-acceptor 1 ready (init)",
+ cmd => fun(#{sec_acceptor1 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, sec_acceptor1, init)
+ end},
+
+ %% Start sec-acceptor-2
+ #{desc => "start sec-acceptor 2",
+ cmd => fun(#{sec_acceptor2 := Pid, lsock := LSock} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, LSock),
+ ok
+ end},
+ #{desc => "await sec-acceptor 2 ready (init)",
+ cmd => fun(#{sec_acceptor2 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, sec_acceptor2, init)
+ end},
+
+ %% Activate the acceptor(s)
+ #{desc => "active prim-acceptor",
+ cmd => fun(#{prim_acceptor := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ #{desc => "active sec-acceptor 1",
+ cmd => fun(#{sec_acceptor1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ #{desc => "active sec-acceptor 2",
+ cmd => fun(#{sec_acceptor2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+
+ %% Await acceptor(s) completions
+ #{desc => "await prim-acceptor ready (accept)",
+ cmd => fun(#{prim_acceptor := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, prim_acceptor, accept)
+ end},
+ #{desc => "await sec-acceptor 1 ready (accept)",
+ cmd => fun(#{sec_acceptor1 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, sec_acceptor1, accept)
+ end},
+ #{desc => "await sec-acceptor 2 ready (accept)",
+ cmd => fun(#{sec_acceptor2 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, sec_acceptor2, accept)
+ end},
+
+ %% Terminate
+ #{desc => "order prim-acceptor to terminate",
+ cmd => fun(#{prim_acceptor := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await prim-acceptor termination",
+ cmd => fun(#{prim_acceptor := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(prim_acceptor, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order sec-acceptor 1 to terminate",
+ cmd => fun(#{sec_acceptor1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await sec-acceptor 1 termination",
+ cmd => fun(#{sec_acceptor1 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(sec_acceptor1, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order sec-acceptor 2 to terminate",
+ cmd => fun(#{sec_acceptor2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await sec-acceptor 2 termination",
+ cmd => fun(#{sec_acceptor2 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(sec_acceptor2, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("create prim-acceptor evaluator"),
+ PrimAInitState = InitState,
+ PrimAcceptor = ?SEV_START("prim-acceptor", PrimAcceptorSeq, PrimAInitState),
+
+ i("create sec-acceptor 1 evaluator"),
+ SecAInitState1 = maps:remove(domain, InitState),
+ SecAcceptor1 = ?SEV_START("sec-acceptor-1", SecAcceptorSeq, SecAInitState1),
+
+ i("create sec-acceptor 2 evaluator"),
+ SecAInitState2 = SecAInitState1,
+ SecAcceptor2 = ?SEV_START("sec-acceptor-2", SecAcceptorSeq, SecAInitState2),
+
+ i("create tester evaluator"),
+ TesterInitState = #{prim_acceptor => PrimAcceptor#ev.pid,
+ sec_acceptor1 => SecAcceptor1#ev.pid,
+ sec_acceptor2 => SecAcceptor2#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator(s)"),
+ ok = ?SEV_AWAIT_FINISH([PrimAcceptor, SecAcceptor1, SecAcceptor2, Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the send timeout option
+%% on an IPv4 TCP (stream) socket.
+api_to_send_tcp4(suite) ->
+ [];
+api_to_send_tcp4(doc) ->
+ [];
+api_to_send_tcp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_send_tcp4,
+ fun() ->
+ not_yet_implemented()%% ,
+ %% ok = api_to_send_tcp(inet)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the send timeout option
+%% on an IPv6 TCP (stream) socket.
+api_to_send_tcp6(suite) ->
+ [];
+api_to_send_tcp6(doc) ->
+ [];
+api_to_send_tcp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_send_tcp6,
+ fun() ->
+ not_yet_implemented()%% ,
+ %% ok = api_to_send_tcp(inet6)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the sendto timeout option
+%% on an IPv4 UDP (dgram) socket.
+api_to_sendto_udp4(suite) ->
+ [];
+api_to_sendto_udp4(doc) ->
+ [];
+api_to_sendto_udp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_sendto_udp4,
+ fun() ->
+ not_yet_implemented()%% ,
+ %% ok = api_to_sendto_to_udp(inet)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the sendto timeout option
+%% on an IPv6 UDP (dgram) socket.
+api_to_sendto_udp6(suite) ->
+ [];
+api_to_sendto_udp6(doc) ->
+ [];
+api_to_sendto_udp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_sendto_udp6,
+ fun() ->
+ not_yet_implemented()%% ,
+ %% ok = api_to_sendto_to_udp(inet6)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the sendmsg timeout option
+%% on an IPv4 TCP (stream) socket.
+api_to_sendmsg_tcp4(suite) ->
+ [];
+api_to_sendmsg_tcp4(doc) ->
+ [];
+api_to_sendmsg_tcp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_sendmsg_tcp4,
+ fun() ->
+ not_yet_implemented()%% ,
+ %% ok = api_to_sendmsg_tcp(inet)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the sendmsg timeout option
+%% on an IPv6 TCP (stream) socket.
+api_to_sendmsg_tcp6(suite) ->
+ [];
+api_to_sendmsg_tcp6(doc) ->
+ [];
+api_to_sendmsg_tcp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_sendmsg_tcp6,
+ fun() ->
+ not_yet_implemented()%% ,
+ %% ok = api_to_sendmsg_tcp(inet6)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recv timeout option
+%% on an IPv4 UDP (dgram) socket. To test this we must connect
+%% the socket.
+api_to_recv_udp4(suite) ->
+ [];
+api_to_recv_udp4(doc) ->
+ [];
+api_to_recv_udp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_recv_udp4,
+ fun() ->
+ not_yet_implemented()%%,
+ %%ok = api_to_recv_udp(inet)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recv timeout option
+%% on an IPv6 UDP (dgram) socket. To test this we must connect
+%% the socket.
+api_to_recv_udp6(suite) ->
+ [];
+api_to_recv_udp6(doc) ->
+ [];
+api_to_recv_udp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_recv_udp6,
+ fun() ->
+ not_yet_implemented()%% ,
+ %% ok = api_to_recv_udp(inet6)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recv timeout option
+%% on an IPv4 TCP (stream) socket.
+api_to_recv_tcp4(suite) ->
+ [];
+api_to_recv_tcp4(doc) ->
+ [];
+api_to_recv_tcp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_recv_tcp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recv(Sock, 0, To) end,
+ InitState = #{domain => inet,
+ recv => Recv,
+ timeout => 2000},
+ ok = api_to_receive_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recv timeout option
+%% on an IPv6 TCP (stream) socket.
+api_to_recv_tcp6(suite) ->
+ [];
+api_to_recv_tcp6(doc) ->
+ [];
+api_to_recv_tcp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_recv_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ case socket:supports(ipv6) of
+ true ->
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) ->
+ socket:recv(Sock, 0, To)
+ end,
+ InitState = #{domain => inet6,
+ recv => Recv,
+ timeout => 2000},
+ ok = api_to_receive_tcp(InitState);
+ false ->
+ skip("ipv6 not supported")
+ end
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+api_to_receive_tcp(InitState) ->
+ process_flag(trap_exit, true),
+
+ ServerSeq =
+ [
+ %% *** Wait for start order ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester}) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, local_sa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket (with backlog = 1)",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock, 1)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, lport := Port}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, Port),
+ ok
+ end},
+
+ %% *** The actual test ***
+ #{desc => "await continue (accept and recv)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, accept_recv)
+ end},
+ #{desc => "attempt accept",
+ cmd => fun(#{lsock := LSock} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "attempt to recv (without success)",
+ cmd => fun(#{sock := Sock, recv := Recv, timeout := To} = State) ->
+ Start = t(),
+ case Recv(Sock, To) of
+ {error, timeout} ->
+ {ok, State#{start => Start, stop => t()}};
+ {ok, _Data} ->
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "validate timeout time",
+ cmd => fun(#{start := Start, stop := Stop, timeout := To} = State) ->
+ TDiff = tdiff(Start, Stop),
+ if
+ (TDiff >= To) ->
+ State1 = maps:remove(start, State),
+ State2 = maps:remove(stop, State1),
+ {ok, State2};
+ true ->
+ {error, {unexpected_timeout, TDiff, To}}
+ end
+ end},
+ #{desc => "announce ready (recv timeout success)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept_recv),
+ ok
+ end},
+
+ %% *** Termination ***
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close (traffic) socket",
+ cmd => fun(#{sock := Sock} = State) ->
+ sock_close(Sock),
+ {ok, maps:remove(sock, State)}
+ end},
+ #{desc => "close (listen) socket",
+ cmd => fun(#{lsock := LSock} = State) ->
+ sock_close(LSock),
+ {ok, maps:remove(lsock, State)}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ {Tester, Port} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ server_port => Port}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain, server_port := Port} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain,
+ addr => LAddr},
+ SSA = LSA#{port => Port},
+ {ok, State#{local_sa => LSA, server_sa => SSA}}
+ end},
+ #{desc => "create socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{sock := Sock, local_sa := LSA} = _State) ->
+ case socket:bind(Sock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% *** The actual test ***
+ #{desc => "await continue (with connect)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, connect)
+ end},
+ #{desc => "connect",
+ cmd => fun(#{sock := Sock, server_sa := SSA}) ->
+ sock_connect(Sock, SSA),
+ ok
+ end},
+
+ %% *** Termination ***
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock} = State) ->
+ sock_close(Sock),
+ {ok, maps:remove(sock, State)}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Server} = _State) ->
+ _MRef = erlang:monitor(process, Server),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Client} = _State) ->
+ _MRef = erlang:monitor(process, Client),
+ ok
+ end},
+
+ %% *** Activate server ***
+ #{desc => "start server",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_START(Server),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Server} = State) ->
+ {ok, Port} = ?SEV_AWAIT_READY(Server, server, init),
+ {ok, State#{server_port => Port}}
+ end},
+ #{desc => "order server to continue (with accept)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Server, accept_recv),
+ ok
+ end},
+
+ %% *** Activate client ***
+ #{desc => "start client",
+ cmd => fun(#{client := Client, server_port := Port} = _State) ->
+ ?SEV_ANNOUNCE_START(Client, Port),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, init)
+ end},
+
+ %% *** The actual test ***
+ #{desc => "order client to continue (with connect)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, connect),
+ ok
+ end},
+ #{desc => "await server ready (accept/recv)",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, accept_recv)
+ end},
+
+ %% *** Termination ***
+ #{desc => "order client to terminate",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await client termination",
+ cmd => fun(#{client := Client} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Client) of
+ ok ->
+ State1 = maps:remove(client, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order server to terminate",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Server),
+ ok
+ end},
+ #{desc => "await server termination",
+ cmd => fun(#{server := Server} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Server) of
+ ok ->
+ State1 = maps:remove(server, State),
+ State2 = maps:remove(server_port, State1),
+ {ok, State2};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+
+ i("start server evaluator"),
+ ServerInitState = InitState,
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("start client evaluator"),
+ ClientInitState = InitState,
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("start tester evaluator"),
+ TesterInitState = #{server => Server#ev.pid,
+ client => Client#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator(s)"),
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recvfrom timeout option
+%% on an IPv4 UDP (dgram) socket.
+api_to_recvfrom_udp4(suite) ->
+ [];
+api_to_recvfrom_udp4(doc) ->
+ [];
+api_to_recvfrom_udp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_recvfrom_udp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recvfrom(Sock, 0, To) end,
+ InitState = #{domain => inet,
+ recv => Recv,
+ timeout => 2000},
+ ok = api_to_receive_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recvfrom timeout option
+%% on an IPv6 UDP (dgram) socket.
+api_to_recvfrom_udp6(suite) ->
+ [];
+api_to_recvfrom_udp6(doc) ->
+ [];
+api_to_recvfrom_udp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_recvfrom_udp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recvfrom(Sock, 0, To) end,
+ InitState = #{domain => inet6,
+ recv => Recv,
+ timeout => 2000},
+ ok = api_to_receive_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+api_to_receive_udp(InitState) ->
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{lsa => LSA}}
+ end},
+ #{desc => "create socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, dgram, udp) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{sock := Sock, lsa := LSA} = _State) ->
+ case socket:bind(Sock, LSA) of
+ {ok, _Port} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** The actual test ***
+ #{desc => "attempt to read (without success)",
+ cmd => fun(#{sock := Sock, recv := Recv, timeout := To} = State) ->
+ Start = t(),
+ case Recv(Sock, To) of
+ {error, timeout} ->
+ {ok, State#{start => Start, stop => t()}};
+ {ok, _} ->
+ {error, unexpected_sucsess};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "validate timeout time",
+ cmd => fun(#{start := Start, stop := Stop, timeout := To} = _State) ->
+ TDiff = tdiff(Start, Stop),
+ if
+ (TDiff >= To) ->
+ ok;
+ true ->
+ {error, {unexpected_timeout, TDiff, To}}
+ end
+ end},
+
+ %% *** Termination ***
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock} = _State) ->
+ socket:setopt(Sock, otp, debug, true),
+ sock_close(Sock),
+ ok
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start tester evaluator"),
+ Tester = ?SEV_START("tester", TesterSeq, InitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recvmsg timeout option
+%% on an IPv4 UDP (dgram) socket.
+api_to_recvmsg_udp4(suite) ->
+ [];
+api_to_recvmsg_udp4(doc) ->
+ [];
+api_to_recvmsg_udp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_recvmsg_udp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end,
+ InitState = #{domain => inet,
+ recv => Recv,
+ timeout => 2000},
+ ok = api_to_receive_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recvmsg timeout option
+%% on an IPv6 UDP (dgram) socket.
+api_to_recvmsg_udp6(suite) ->
+ [];
+api_to_recvmsg_udp6(doc) ->
+ [];
+api_to_recvmsg_udp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_recvmsg_udp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end,
+ InitState = #{domain => inet6,
+ recv => Recv,
+ timeout => 2000},
+ ok = api_to_receive_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recvmsg timeout option
+%% on an IPv4 TCP (stream) socket.
+api_to_recvmsg_tcp4(suite) ->
+ [];
+api_to_recvmsg_tcp4(doc) ->
+ [];
+api_to_recvmsg_tcp4(_Config) when is_list(_Config) ->
+ tc_try(api_to_recvmsg_tcp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end,
+ InitState = #{domain => inet,
+ recv => Recv,
+ timeout => 2000},
+ ok = api_to_receive_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% This test case is intended to test the recvmsg timeout option
+%% on an IPv6 TCP (stream) socket.
+api_to_recvmsg_tcp6(suite) ->
+ [];
+api_to_recvmsg_tcp6(doc) ->
+ [];
+api_to_recvmsg_tcp6(_Config) when is_list(_Config) ->
+ tc_try(api_to_recvmsg_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end,
+ InitState = #{domain => inet6,
+ recv => Recv,
+ timeout => 2000},
+ ok = api_to_receive_tcp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% SOCKET CLOSURE %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sockets are cleaned up
+%% ("removed") when the controlling process terminates (without explicitly
+%% calling the close function). For a IPv4 TCP (stream) socket.
+
+sc_cpe_socket_cleanup_tcp4(suite) ->
+ [];
+sc_cpe_socket_cleanup_tcp4(doc) ->
+ [];
+sc_cpe_socket_cleanup_tcp4(_Config) when is_list(_Config) ->
+ tc_try(sc_cpe_socket_cleanup_tcp4,
+ fun() ->
+ %% not_yet_implemented(),
+ ?TT(?SECS(5)),
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp},
+ ok = sc_cpe_socket_cleanup(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sockets are cleaned up
+%% ("removed") when the controlling process terminates (without explicitly
+%% calling the close function). For a IPv6 TCP (stream) socket.
+
+sc_cpe_socket_cleanup_tcp6(suite) ->
+ [];
+sc_cpe_socket_cleanup_tcp6(doc) ->
+ [];
+sc_cpe_socket_cleanup_tcp6(_Config) when is_list(_Config) ->
+ tc_try(sc_cpe_socket_cleanup_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(5)),
+ InitState = #{domain => inet6,
+ type => stream,
+ protocol => tcp},
+ ok = sc_cpe_socket_cleanup(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sockets are cleaned up
+%% ("removed") when the controlling process terminates (without explicitly
+%% calling the close function). For a IPv4 UDP (dgram) socket.
+
+sc_cpe_socket_cleanup_udp4(suite) ->
+ [];
+sc_cpe_socket_cleanup_udp4(doc) ->
+ [];
+sc_cpe_socket_cleanup_udp4(_Config) when is_list(_Config) ->
+ tc_try(sc_cpe_socket_cleanup_udp4,
+ fun() ->
+ ?TT(?SECS(5)),
+ InitState = #{domain => inet,
+ type => dgram,
+ protocol => udp},
+ ok = sc_cpe_socket_cleanup(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sockets are cleaned up
+%% (removed) when the controlling process terminates (without explicitly
+%% calling the close function). For a IPv6 UDP (dgram) socket.
+
+sc_cpe_socket_cleanup_udp6(suite) ->
+ [];
+sc_cpe_socket_cleanup_udp6(doc) ->
+ [];
+sc_cpe_socket_cleanup_udp6(_Config) when is_list(_Config) ->
+ tc_try(sc_cpe_socket_cleanup_udp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(5)),
+ InitState = #{domain => inet6,
+ type => dgram,
+ protocol => udp},
+ ok = sc_cpe_socket_cleanup(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+sc_cpe_socket_cleanup(InitState) ->
+ OwnerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "create socket",
+ cmd => fun(#{domain := Domain,
+ type := Type,
+ protocol := Proto} = State) ->
+ case socket:open(Domain, Type, Proto) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, Sock),
+ ok
+ end},
+
+ %% *** The actual test ***
+ %% We *intentially* leave the socket "as is", no explicit close
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor owner",
+ cmd => fun(#{owner := Owner} = _State) ->
+ _MRef = erlang:monitor(process, Owner),
+ ok
+ end},
+ #{desc => "order (owner) start",
+ cmd => fun(#{owner := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await (owner) ready",
+ cmd => fun(#{owner := Pid} = State) ->
+ {ok, Sock} = ?SEV_AWAIT_READY(Pid, owner, init),
+ {ok, State#{sock => Sock}}
+ end},
+ #{desc => "verify owner as controlling-process",
+ cmd => fun(#{owner := Pid, sock := Sock} = _State) ->
+ case socket:getopt(Sock, otp, controlling_process) of
+ {ok, Pid} ->
+ ok;
+ {ok, Other} ->
+ {error, {unexpected_owner, Other}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order (owner) terminate",
+ cmd => fun(#{owner := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await (owner) termination",
+ cmd => fun(#{owner := Pid} = _State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ %% The reason we get closed, is that as long as there is a ref to
+ %% the resource (socket), then it will not be garbage collected.
+ #{desc => "verify no socket (closed)",
+ cmd => fun(#{owner := Pid, sock := Sock} = _State) ->
+ case socket:getopt(Sock, otp, controlling_process) of
+ {ok, OtherPid} ->
+ {error, {unexpected_success, Pid, OtherPid}};
+ {error, closed} ->
+ ok;
+ {error, Reason} ->
+ ?SEV_IPRINT("expected failure: ~p", [Reason]),
+ {error, {unexpected_failure, Reason}}
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start (socket) owner evaluator"),
+ Owner = ?SEV_START("owner", OwnerSeq, InitState),
+
+ i("start tester evaluator"),
+ TesterInitState = #{owner => Owner#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Owner, Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while a process is calling the recv function.
+%% Socket is IPv4.
+%%
+%% <KOLLA>
+%%
+%% We should really have a similar test cases for when the controlling
+%% process exits and there are other processes in recv, accept, and
+%% all the other functions.
+%%
+%% </KOLLA>
+
+sc_lc_recv_response_tcp4(suite) ->
+ [];
+sc_lc_recv_response_tcp4(doc) ->
+ [];
+sc_lc_recv_response_tcp4(_Config) when is_list(_Config) ->
+ tc_try(sc_lc_recv_response_tcp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ Recv = fun(Sock) -> socket:recv(Sock) end,
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp,
+ recv => Recv},
+ ok = sc_lc_receive_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while the process is calling the recv function.
+%% Socket is IPv6.
+
+sc_lc_recv_response_tcp6(suite) ->
+ [];
+sc_lc_recv_response_tcp6(doc) ->
+ [];
+sc_lc_recv_response_tcp6(_Config) when is_list(_Config) ->
+ tc_try(sc_lc_recv_response_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ Recv = fun(Sock) -> socket:recv(Sock) end,
+ InitState = #{domain => inet6,
+ type => stream,
+ protocol => tcp,
+ recv => Recv},
+ ok = sc_lc_receive_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+sc_lc_receive_response_tcp(InitState) ->
+ %% This (acceptor) is the server that accepts connections.
+ %% But it is also suppose to close the connection socket,
+ %% and trigger the read failure (=closed) for the handler process.
+ AcceptorSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create (listen) socket",
+ cmd => fun(#{domain := Domain,
+ type := Type,
+ protocol := Proto} = State) ->
+ case socket:open(Domain, Type, Proto) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, local_sa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, lport := Port}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, Port),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, accept) of
+ {ok, {H1, H2, H3}} ->
+ {ok, State#{handler1 => H1,
+ handler2 => H2,
+ handler3 => H3}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await accept",
+ cmd => fun(#{lsock := LSock} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ ?SEV_IPRINT("connection accepted"),
+ {ok, State#{csock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (accept)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+ #{desc => "transfer connection to handler 1",
+ cmd => fun(#{handler1 := Handler, csock := Sock}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Handler, transfer, Sock),
+ ok
+ end},
+ #{desc => "transfer connection to handler 2",
+ cmd => fun(#{handler2 := Handler, csock := Sock}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Handler, transfer, Sock),
+ ok
+ end},
+ #{desc => "transfer connection to handler 3",
+ cmd => fun(#{handler3 := Handler, csock := Sock}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Handler, transfer, Sock),
+ ok
+ end},
+ #{desc => "await continue (close)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, close),
+ ok
+ end},
+ #{desc => "close the connection socket",
+ cmd => fun(#{csock := Sock} = State) ->
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ case socket:close(Sock) of
+ ok ->
+ {ok, maps:remove(csock, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (close)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, close),
+ ok
+ end},
+
+ %% *** Terminate ***
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{lsock := Sock} = State) ->
+ case socket:close(Sock) of
+ ok ->
+ State1 = maps:remove(lsock, State),
+ State2 = maps:remove(lport, State1),
+ {ok, State2};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ %% The point of this is to perform the recv for which
+ %% we are testing the reponse.
+ HandlerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ {Tester, Acceptor} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ acceptor => Acceptor}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+ #{desc => "monitor acceptor",
+ cmd => fun(#{acceptor := Acceptor} = _State) ->
+ _MRef = erlang:monitor(process, Acceptor),
+ ok
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (transfer)",
+ cmd => fun(#{acceptor := Pid} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Pid, acceptor, transfer) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (transfer)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, transfer),
+ ok
+ end},
+ #{desc => "attempt recv (=> closed)",
+ cmd => fun(#{sock := Sock, recv := Recv} = State) ->
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ case Recv(Sock) of
+ {ok, _Data} ->
+ ?SEV_EPRINT("Unexpected data received"),
+ {error, unexpected_success};
+ {error, closed} ->
+ ?SEV_IPRINT("received expected 'closed' "
+ "result"),
+ State1 = maps:remove(sock, State),
+ {ok, State1};
+ {error, Reason} = ERROR ->
+ ?SEV_EPRINT("Unexpected read faulure: "
+ "~n ~p", [Reason]),
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv closed)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv_closed),
+ ok
+ end},
+
+ %% *** Terminate ***
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ %% The point of this is basically just to create the connection.
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create socket",
+ cmd => fun(#{domain := Domain,
+ type := Type,
+ protocol := Proto} = State) ->
+ case socket:open(Domain, Type, Proto) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind socket to local address",
+ cmd => fun(#{sock := Sock, local_sa := LSA} = _State) ->
+ case socket:bind(Sock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (connect)",
+ cmd => fun(#{tester := Tester, local_sa := LSA} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, connect) of
+ {ok, Port} ->
+ ServerSA = LSA#{port => Port},
+ {ok, State#{server_sa => ServerSA}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "connect to server",
+ cmd => fun(#{sock := Sock, server_sa := ServerSA}) ->
+ socket:connect(Sock, ServerSA)
+ end},
+ #{desc => "announce ready (connect)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, connect),
+ ok
+ end},
+
+ %% *** Terminate ***
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock} = State) ->
+ sock_close(Sock),
+ {ok, maps:remove(sock, State)}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor acceptor",
+ cmd => fun(#{acceptor := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor handler 1",
+ cmd => fun(#{handler1 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor handler 2",
+ cmd => fun(#{handler2 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor handler 3",
+ cmd => fun(#{handler3 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the acceptor
+ #{desc => "order acceptor start",
+ cmd => fun(#{acceptor := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await acceptor ready (init)",
+ cmd => fun(#{acceptor := Pid} = State) ->
+ case ?SEV_AWAIT_READY(Pid, acceptor, init) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% Start the handler(s)
+ #{desc => "order handler 1 start",
+ cmd => fun(#{acceptor := Acceptor, handler1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Acceptor),
+ ok
+ end},
+ #{desc => "await handler 1 ready (init)",
+ cmd => fun(#{handler1 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, handler1, init)
+ end},
+ #{desc => "order handler 2 start",
+ cmd => fun(#{acceptor := Acceptor, handler2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Acceptor),
+ ok
+ end},
+ #{desc => "await handler 2 ready (init)",
+ cmd => fun(#{handler2 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, handler2, init)
+ end},
+ #{desc => "order handler 3 start",
+ cmd => fun(#{acceptor := Acceptor, handler3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Acceptor),
+ ok
+ end},
+ #{desc => "await handler 3 ready (init)",
+ cmd => fun(#{handler3 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, handler3, init)
+ end},
+
+ %% Start the client
+ #{desc => "order client start",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, client, init)
+ end},
+
+ %% The actual test
+ #{desc => "order acceptor to continue (accept)",
+ cmd => fun(#{acceptor := Pid,
+ handler1 := H1,
+ handler2 := H2,
+ handler3 := H3} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept, {H1, H2, H3}),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client to continue (connect)",
+ cmd => fun(#{client := Pid, lport := Port} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, connect, Port),
+ ok
+ end},
+ #{desc => "await acceptor ready (accept)",
+ cmd => fun(#{acceptor := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, acceptor, accept)
+ end},
+ #{desc => "await client ready (connect)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client, connect)
+ end},
+ #{desc => "await handler 1 ready (transfer)",
+ cmd => fun(#{handler1 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, handler1, transfer)
+ end},
+ #{desc => "await handler 2 ready (transfer)",
+ cmd => fun(#{handler2 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, handler2, transfer)
+ end},
+ #{desc => "await handler 3 ready (transfer)",
+ cmd => fun(#{handler3 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, handler3, transfer)
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order acceptor to continue (close connection socket)",
+ cmd => fun(#{acceptor := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, close),
+ ok
+ end},
+ #{desc => "await acceptor ready (close)",
+ cmd => fun(#{acceptor := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, acceptor, close)
+ end},
+ #{desc => "await handler 1 ready (recv closed)",
+ cmd => fun(#{handler1 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, handler1, recv_closed)
+ end},
+ #{desc => "await handler 2 ready (recv closed)",
+ cmd => fun(#{handler2 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, handler2, recv_closed)
+ end},
+ #{desc => "await handler 3 ready (recv closed)",
+ cmd => fun(#{handler3 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, handler3, recv_closed)
+ end},
+
+ %% Terminations
+ #{desc => "order client to terminate",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await client termination",
+ cmd => fun(#{client := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(client, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order handler 1 to terminate",
+ cmd => fun(#{handler1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await handler 1 termination",
+ cmd => fun(#{handler1 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(handler1, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order handler 2 to terminate",
+ cmd => fun(#{handler2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await handler 2 termination",
+ cmd => fun(#{handler2 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(handler2, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order handler 3 to terminate",
+ cmd => fun(#{handler3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await handler 3 termination",
+ cmd => fun(#{handler3 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(handler3, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order acceptor to terminate",
+ cmd => fun(#{acceptor := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await acceptor termination",
+ cmd => fun(#{acceptor := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(acceptor, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start acceptor evaluator"),
+ AccInitState = InitState,
+ Acceptor = ?SEV_START("acceptor", AcceptorSeq, AccInitState),
+
+ i("start handler 1 evaluator"),
+ HandlerInitState = #{recv => maps:get(recv, InitState)},
+ Handler1 = ?SEV_START("handler-1", HandlerSeq, HandlerInitState),
+
+ i("start handler 2 evaluator"),
+ Handler2 = ?SEV_START("handler-2", HandlerSeq, HandlerInitState),
+
+ i("start handler 3 evaluator"),
+ Handler3 = ?SEV_START("handler-3", HandlerSeq, HandlerInitState),
+
+ i("start client evaluator"),
+ ClientInitState = InitState,
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("start tester evaluator"),
+ TesterInitState = #{acceptor => Acceptor#ev.pid,
+ handler1 => Handler1#ev.pid,
+ handler2 => Handler2#ev.pid,
+ handler3 => Handler3#ev.pid,
+ client => Client#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Acceptor,
+ Handler1, Handler2, Handler3,
+ Client, Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while a process is calling the recvfrom function.
+%% Socket is IPv4.
+%%
+
+sc_lc_recvfrom_response_udp4(suite) ->
+ [];
+sc_lc_recvfrom_response_udp4(doc) ->
+ [];
+sc_lc_recvfrom_response_udp4(_Config) when is_list(_Config) ->
+ tc_try(sc_lc_recvfrom_response_udp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ Recv = fun(Sock, To) -> socket:recvfrom(Sock, [], To) end,
+ InitState = #{domain => inet,
+ type => dgram,
+ protocol => udp,
+ recv => Recv},
+ ok = sc_lc_receive_response_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while the process is calling the recv function.
+%% Socket is IPv6.
+
+sc_lc_recvfrom_response_udp6(suite) ->
+ [];
+sc_lc_recvfrom_response_udp6(doc) ->
+ [];
+sc_lc_recvfrom_response_udp6(_Config) when is_list(_Config) ->
+ tc_try(sc_lc_recvfrom_response_udp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(30)),
+ Recv = fun(Sock, To) -> socket:recvfrom(Sock, [], To) end,
+ InitState = #{domain => inet6,
+ recv => Recv},
+ ok = sc_lc_receive_response_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+sc_lc_receive_response_udp(InitState) ->
+ PrimServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "open socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ Sock = sock_open(Domain, dgram, udp),
+ SA = sock_sockname(Sock),
+ {ok, State#{sock => Sock, sa => SA}}
+ end},
+ #{desc => "bind socket",
+ cmd => fun(#{sock := Sock, local_sa := LSA}) ->
+ sock_bind(Sock, LSA),
+ ok
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, sock := Sock}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, Sock),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (recv, with timeout)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, recv) of
+ {ok, Timeout} ->
+ {ok, State#{timeout => Timeout}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "receive, with timeout",
+ cmd => fun(#{sock := Sock, recv := Recv, timeout := Timeout}) ->
+ case Recv(Sock, Timeout) of
+ {error, timeout} ->
+ ok;
+ {ok, _} ->
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv, with timeout)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv),
+ ok
+ end},
+ #{desc => "await continue (close)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ok = ?SEV_AWAIT_CONTINUE(Tester, tester, close)
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock} = State) ->
+ case socket:close(Sock) of
+ ok ->
+ {ok, maps:remove(sock, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (close)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, close),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, terminate) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ SecServerSeq =
+ [
+ %% *** Init part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, Sock} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester, sock => Sock}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (recv)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ok = ?SEV_AWAIT_CONTINUE(Tester, tester, recv)
+
+ end},
+ #{desc => "receive",
+ cmd => fun(#{sock := Sock, recv := Recv} = State) ->
+ case Recv(Sock, infinity) of
+ {error, closed} ->
+ {ok, maps:remove(sock, State)};
+ {ok, _} ->
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv closed)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv_closed),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor primary server",
+ cmd => fun(#{prim_server := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor secondary server 1",
+ cmd => fun(#{sec_server1 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor secondary server 2",
+ cmd => fun(#{sec_server2 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor secondary server 3",
+ cmd => fun(#{sec_server3 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the primary server
+ #{desc => "order 'primary server' start",
+ cmd => fun(#{prim_server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await 'primary server' ready (init)",
+ cmd => fun(#{prim_server := Pid} = State) ->
+ {ok, Sock} = ?SEV_AWAIT_READY(Pid, prim_server, init),
+ {ok, State#{sock => Sock}}
+ end},
+
+ %% Start the secondary server 1
+ #{desc => "order 'secondary server 1' start",
+ cmd => fun(#{sec_server1 := Pid, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Sock),
+ ok
+ end},
+ #{desc => "await 'secondary server 1' ready (init)",
+ cmd => fun(#{sec_server1 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_server1, init)
+ end},
+
+ %% Start the secondary server 2
+ #{desc => "order 'secondary server 2' start",
+ cmd => fun(#{sec_server2 := Pid, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Sock),
+ ok
+ end},
+ #{desc => "await 'secondary server 2' ready (init)",
+ cmd => fun(#{sec_server2 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_server2, init)
+ end},
+
+ %% Start the secondary server 3
+ #{desc => "order 'secondary server 3' start",
+ cmd => fun(#{sec_server3 := Pid, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Sock),
+ ok
+ end},
+ #{desc => "await 'secondary server 3' ready (init)",
+ cmd => fun(#{sec_server3 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_server3, init)
+ end},
+
+
+ %% The actual test
+ %% Make all the seondary servers continue, with an infinit recvfrom
+ %% and then the prim-server with a timed recvfrom.
+ %% After the prim server notifies us (about the timeout) we order it
+ %% to close the socket, which should cause the all the secondary
+ %% server to return with error-closed.
+
+ #{desc => "order 'secondary server 1' to continue (recv)",
+ cmd => fun(#{sec_server1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order 'secondary server 2' to continue (recv)",
+ cmd => fun(#{sec_server2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order 'secondary server 3' to continue (recv)",
+ cmd => fun(#{sec_server3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order 'primary server' to continue (recv, with timeout)",
+ cmd => fun(#{prim_server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv, ?SECS(5)),
+ ok
+ end},
+ #{desc => "await 'primary server' ready (recv, with timeout)",
+ cmd => fun(#{prim_server := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, prim_server, recv)
+ end},
+ #{desc => "order 'primary server' to continue (close)",
+ cmd => fun(#{prim_server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, close),
+ ok
+ end},
+ #{desc => "await 'primary server' ready (close)",
+ cmd => fun(#{prim_server := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, prim_server, close)
+ end},
+ #{desc => "await 'secondary server 1' ready (closed)",
+ cmd => fun(#{sec_server1 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, sec_server1, recv_closed)
+ end},
+ #{desc => "await 'secondary server 2' ready (closed)",
+ cmd => fun(#{sec_server2 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, sec_server2, recv_closed)
+ end},
+ #{desc => "await 'secondary server 3' ready (closed)",
+ cmd => fun(#{sec_server3 := Pid} = _State) ->
+ ?SEV_AWAIT_READY(Pid, sec_server3, recv_closed)
+ end},
+
+ %% Terminations
+ #{desc => "order 'secondary server 3' to terminate",
+ cmd => fun(#{sec_server3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await 'secondary server 3' termination",
+ cmd => fun(#{sec_server3 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(sec_server3, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order 'secondary server 2' to terminate",
+ cmd => fun(#{sec_server2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await 'secondary server 2' termination",
+ cmd => fun(#{sec_server2 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(sec_server2, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order 'secondary server 1' to terminate",
+ cmd => fun(#{sec_server1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await 'secondary server 1' termination",
+ cmd => fun(#{sec_server1 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(sec_server1, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order 'primary server' to terminate",
+ cmd => fun(#{prim_server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await 'primary server' termination",
+ cmd => fun(#{prim_server := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(prim_server, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+
+ i("start 'primary server' evaluator"),
+ PrimSrvInitState = InitState,
+ PrimServer = ?SEV_START("prim-server", PrimServerSeq, PrimSrvInitState),
+
+ i("start 'secondary server 1' evaluator"),
+ SecSrvInitState = #{recv => maps:get(recv, InitState)},
+ SecServer1 = ?SEV_START("sec-server-1", SecServerSeq, SecSrvInitState),
+
+ i("start 'secondary server 2' evaluator"),
+ SecServer2 = ?SEV_START("sec-server-2", SecServerSeq, SecSrvInitState),
+
+ i("start 'secondary server 3' evaluator"),
+ SecServer3 = ?SEV_START("sec-server-3", SecServerSeq, SecSrvInitState),
+
+ i("start 'tester' evaluator"),
+ TesterInitState = #{prim_server => PrimServer#ev.pid,
+ sec_server1 => SecServer1#ev.pid,
+ sec_server2 => SecServer2#ev.pid,
+ sec_server3 => SecServer3#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([PrimServer,
+ SecServer1, SecServer2, SecServer3,
+ Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while the process is calling the recvmsg function.
+%% Socket is IPv4.
+
+sc_lc_recvmsg_response_tcp4(suite) ->
+ [];
+sc_lc_recvmsg_response_tcp4(doc) ->
+ [];
+sc_lc_recvmsg_response_tcp4(_Config) when is_list(_Config) ->
+ tc_try(sc_lc_recvmsg_response_tcp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ Recv = fun(Sock) -> socket:recvmsg(Sock) end,
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp,
+ recv => Recv},
+ ok = sc_lc_receive_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while the process is calling the recvmsg function.
+%% Socket is IPv6.
+
+sc_lc_recvmsg_response_tcp6(suite) ->
+ [];
+sc_lc_recvmsg_response_tcp6(doc) ->
+ [];
+sc_lc_recvmsg_response_tcp6(_Config) when is_list(_Config) ->
+ tc_try(sc_recvmsg_response_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ Recv = fun(Sock) -> socket:recvmsg(Sock) end,
+ InitState = #{domain => inet6,
+ type => stream,
+ protocol => tcp,
+ recv => Recv},
+ ok = sc_lc_receive_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while the process is calling the recvmsg function.
+%% Socket is IPv4.
+
+sc_lc_recvmsg_response_udp4(suite) ->
+ [];
+sc_lc_recvmsg_response_udp4(doc) ->
+ [];
+sc_lc_recvmsg_response_udp4(_Config) when is_list(_Config) ->
+ tc_try(sc_lc_recvmsg_response_udp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end,
+ InitState = #{domain => inet,
+ recv => Recv},
+ ok = sc_lc_receive_response_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while the process is calling the recvmsg function.
+%% Socket is IPv6.
+
+sc_lc_recvmsg_response_udp6(suite) ->
+ [];
+sc_lc_recvmsg_response_udp6(doc) ->
+ [];
+sc_lc_recvmsg_response_udp6(_Config) when is_list(_Config) ->
+ tc_try(sc_recvmsg_response_udp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ Recv = fun(Sock, To) -> socket:recvmsg(Sock, To) end,
+ InitState = #{domain => inet6,
+ recv => Recv},
+ ok = sc_lc_receive_response_udp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while the process is calling the accept function.
+%% We test what happens with a non-controlling_process also, since we
+%% git the setup anyway.
+%% Socket is IPv4.
+
+sc_lc_acceptor_response_tcp4(suite) ->
+ [];
+sc_lc_acceptor_response_tcp4(doc) ->
+ [];
+sc_lc_acceptor_response_tcp4(_Config) when is_list(_Config) ->
+ tc_try(sc_lc_acceptor_response_tcp4,
+ fun() ->
+ ?TT(?SECS(10)),
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp},
+ ok = sc_lc_acceptor_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% locally closed while the process is calling the accept function.
+%% We test what happens with a non-controlling_process also, since we
+%% git the setup anyway.
+%% Socket is IPv6.
+
+sc_lc_acceptor_response_tcp6(suite) ->
+ [];
+sc_lc_acceptor_response_tcp6(doc) ->
+ [];
+sc_lc_acceptor_response_tcp6(_Config) when is_list(_Config) ->
+ tc_try(sc_lc_acceptor_response_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp},
+ ok = sc_lc_acceptor_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+sc_lc_acceptor_response_tcp(InitState) ->
+ PrimAcceptorSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start (from tester)",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{lsa => LSA}}
+ end},
+ #{desc => "create (listen) socket",
+ cmd => fun(#{domain := Domain,
+ type := Type,
+ protocol := Proto} = State) ->
+ case socket:open(Domain, Type, Proto) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{sock := Sock, lsa := LSA} = _State) ->
+ case socket:bind(Sock, LSA) of
+ {ok, _Port} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{sock := Sock}) ->
+ socket:listen(Sock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, Sock),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, accept) of
+ {ok, Timeout} ->
+ {ok, State#{timeout => Timeout}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await connection",
+ cmd => fun(#{sock := Sock, timeout := Timeout} = _State) ->
+ case socket:accept(Sock, Timeout) of
+ {error, timeout} ->
+ ok;
+ {ok, Sock} ->
+ ?SEV_EPRINT("unexpected success"),
+ (catch socket:close(Sock)),
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (accept timeout)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept_timeout),
+ ok
+ end},
+ #{desc => "await continue (close)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ok = ?SEV_AWAIT_CONTINUE(Tester, tester, close)
+ end},
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock} = State) ->
+ case socket:close(Sock) of
+ ok ->
+ {ok, maps:remove(sock, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (close)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, close),
+ ok
+ end},
+
+ % Termination
+ #{desc => "await terminate",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ SecAcceptorSeq =
+ [
+ %% *** Init part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, Sock} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester, sock => Sock}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init)
+ end},
+
+ %% The actual test
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ok = ?SEV_AWAIT_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "accept",
+ cmd => fun(#{sock := Sock} = State) ->
+ case socket:accept(Sock) of
+ {error, closed} ->
+ {ok, maps:remove(sock, State)};
+ {ok, _} ->
+ {error, unexpected_success};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (accept closed)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept_closed)
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor 'primary acceptor'",
+ cmd => fun(#{prim_acc := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor 'secondary acceptor 1'",
+ cmd => fun(#{sec_acc1 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor secondary acceptor 2",
+ cmd => fun(#{sec_acc2 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor secondary acceptor 3",
+ cmd => fun(#{sec_acc3 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the primary server
+ #{desc => "order 'primary acceptor' start",
+ cmd => fun(#{prim_acc := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await 'primary acceptor' ready (init)",
+ cmd => fun(#{prim_acc := Pid} = State) ->
+ {ok, Sock} = ?SEV_AWAIT_READY(Pid, prim_acc, init),
+ {ok, State#{sock => Sock}}
+ end},
+
+ %% Start the secondary acceptor 1
+ #{desc => "order 'secondary acceptor 1' start",
+ cmd => fun(#{sec_acc1 := Pid, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Sock),
+ ok
+ end},
+ #{desc => "await 'secondary acceptor 1' ready (init)",
+ cmd => fun(#{sec_acc1 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_acc1, init)
+ end},
+
+ %% Start the secondary acceptor 2
+ #{desc => "order 'secondary acceptor 2' start",
+ cmd => fun(#{sec_acc2 := Pid, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Sock),
+ ok
+ end},
+ #{desc => "await 'secondary acceptor 2' ready (init)",
+ cmd => fun(#{sec_acc2 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_acc2, init)
+ end},
+
+ %% Start the secondary acceptor 3
+ #{desc => "order 'secondary acceptor 3' start",
+ cmd => fun(#{sec_acc3 := Pid, sock := Sock} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, Sock),
+ ok
+ end},
+ #{desc => "await 'secondary acceptor 3' ready (init)",
+ cmd => fun(#{sec_acc3 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_acc3, init)
+ end},
+
+
+ %% The actual test
+ %% Make all the seondary servers continue, with an infinit recvfrom
+ %% and then the prim-server with a timed recvfrom.
+ %% After the prim server notifies us (about the timeout) we order it
+ %% to close the socket, which should cause the all the secondary
+ %% server to return with error-closed.
+
+ #{desc => "order 'secondary acceptor 1' to continue (accept)",
+ cmd => fun(#{sec_acc1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order 'secondary acceptor 2' to continue (accept)",
+ cmd => fun(#{sec_acc2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order 'secondary acceptor 3' to continue (accept)",
+ cmd => fun(#{sec_acc3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order 'primary acceptor' to continue",
+ cmd => fun(#{prim_acc := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept, ?SECS(5)),
+ ok
+ end},
+ #{desc => "await 'primary acceptor' ready (accept timeout)",
+ cmd => fun(#{prim_acc := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, prim_acc, accept_timeout)
+ end},
+ #{desc => "order 'primary acceptor' to continue (close)",
+ cmd => fun(#{prim_acc := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, close),
+ ok
+ end},
+ #{desc => "await 'primary acceptor' ready (close)",
+ cmd => fun(#{prim_acc := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, prim_acc, close)
+ end},
+ #{desc => "await 'secondary acceptor 1' ready (accept closed)",
+ cmd => fun(#{sec_acc1 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_acc1, accept_closed)
+ end},
+ #{desc => "await 'secondary acceptor 2' ready (accept closed)",
+ cmd => fun(#{sec_acc2 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_acc2, accept_closed)
+ end},
+ #{desc => "await 'secondary acceptor 3' ready (accept closed)",
+ cmd => fun(#{sec_acc3 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, sec_acc3, accept_closed)
+ end},
+
+
+ %% Terminations
+ #{desc => "order 'secondary acceptor 3' to terminate",
+ cmd => fun(#{sec_acc3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await 'secondary acceptor 3' termination",
+ cmd => fun(#{sec_acc3 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(sec_acc3, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order 'secondary acceptor 2' to terminate",
+ cmd => fun(#{sec_acc2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await 'secondary acceptor 2' termination",
+ cmd => fun(#{sec_acc2 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(sec_acc2, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order 'secondary acceptor 1' to terminate",
+ cmd => fun(#{sec_acc1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await 'secondary acceptor 1' termination",
+ cmd => fun(#{sec_acc1 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(sec_acc1, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order 'primary acceptor' to terminate",
+ cmd => fun(#{prim_acc := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await 'primary acceptor' termination",
+ cmd => fun(#{prim_acc := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ {ok, maps:remove(prim_acc, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+
+ i("start 'primary acceptor' evaluator"),
+ PrimAccInitState = InitState,
+ PrimAcc = ?SEV_START("prim-acceptor", PrimAcceptorSeq, PrimAccInitState),
+
+ i("start 'secondary acceptor 1' evaluator"),
+ SecAccInitState = #{},
+ SecAcc1 = ?SEV_START("sec-acceptor-1", SecAcceptorSeq, SecAccInitState),
+
+ i("start 'secondary acceptor 2' evaluator"),
+ SecAcc2 = ?SEV_START("sec-acceptor-2", SecAcceptorSeq, SecAccInitState),
+
+ i("start 'secondary acceptor 3' evaluator"),
+ SecAcc3 = ?SEV_START("sec-acceptor-3", SecAcceptorSeq, SecAccInitState),
+
+ i("start 'tester' evaluator"),
+ TesterInitState = #{prim_acc => PrimAcc#ev.pid,
+ sec_acc1 => SecAcc1#ev.pid,
+ sec_acc2 => SecAcc2#ev.pid,
+ sec_acc3 => SecAcc3#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([PrimAcc, SecAcc1, SecAcc2, SecAcc3, Tester]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% remotely closed while the process is calling the recv function.
+%% Socket is IPv4.
+%%
+%% To minimize the chance of "weirdness", we should really have test cases
+%% where the two sides of the connection is on different machines. But for
+%% now, we will make do with different VMs on the same host.
+%%
+
+sc_rc_recv_response_tcp4(suite) ->
+ [];
+sc_rc_recv_response_tcp4(doc) ->
+ [];
+sc_rc_recv_response_tcp4(_Config) when is_list(_Config) ->
+ tc_try(sc_rc_recv_response_tcp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ Recv = fun(Sock) -> socket:recv(Sock) end,
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp,
+ recv => Recv},
+ ok = sc_rc_receive_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% remotely closed while the process is calling the recv function.
+%% Socket is IPv6.
+
+sc_rc_recv_response_tcp6(suite) ->
+ [];
+sc_rc_recv_response_tcp6(doc) ->
+ [];
+sc_rc_recv_response_tcp6(_Config) when is_list(_Config) ->
+ tc_try(sc_rc_recv_response_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ Recv = fun(Sock) -> socket:recv(Sock) end,
+ InitState = #{domain => inet6,
+ type => stream,
+ protocol => tcp,
+ recv => Recv},
+ ok = sc_rc_receive_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+sc_rc_receive_response_tcp(InitState) ->
+ %% Each connection are handled by handler processes.
+ %% These are created (on the fly) and handled internally
+ %% by the server!
+ ServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, local_sa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, local_sa := LSA, lport := Port}) ->
+ ServerSA = LSA#{port => Port},
+ ?SEV_ANNOUNCE_READY(Tester, init, ServerSA),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (accept all three connections)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "accept 1",
+ cmd => fun(#{lsock := LSock, recv := Recv} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ ?SEV_IPRINT("accepted: try start handler"),
+ Handler = sc_rc_tcp_handler_start(1, Recv, Sock),
+ ?SEV_IPRINT("handler started"),
+ {ok, State#{csock1 => Sock,
+ handler1 => Handler}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await handler 1 ready (init)",
+ cmd => fun(#{tester := Tester,
+ handler1 := Handler1} = _State) ->
+ ?SEV_AWAIT_READY(Handler1, handler1, init,
+ [{tester, Tester}])
+ end},
+ #{desc => "accept 2",
+ cmd => fun(#{lsock := LSock, recv := Recv} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ ?SEV_IPRINT("accepted: try start handler"),
+ Handler = sc_rc_tcp_handler_start(2, Recv, Sock),
+ ?SEV_IPRINT("handler started"),
+ {ok, State#{csock2 => Sock,
+ handler2 => Handler}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await handler 2 ready (init)",
+ cmd => fun(#{tester := Tester,
+ handler1 := Handler1,
+ handler2 := Handler2} = _State) ->
+ ?SEV_AWAIT_READY(Handler2, handler2, init,
+ [{tester, Tester},
+ {handler1, Handler1}])
+ end},
+ #{desc => "accept 3",
+ cmd => fun(#{lsock := LSock, recv := Recv} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ ?SEV_IPRINT("accepted: try start handler"),
+ Handler = sc_rc_tcp_handler_start(3, Recv, Sock),
+ ?SEV_IPRINT("handler started"),
+ {ok, State#{csock3 => Sock,
+ handler3 => Handler}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await handler 3 ready (init)",
+ cmd => fun(#{tester := Tester,
+ handler1 := Handler1,
+ handler2 := Handler2,
+ handler3 := Handler3} = _State) ->
+ ?SEV_AWAIT_READY(Handler3, handler3, init,
+ [{tester, Tester},
+ {handler1, Handler1},
+ {handler2, Handler2}])
+ end},
+ #{desc => "announce ready (accept all three connections)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+ #{desc => "await continue (recv)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, recv)
+ end},
+ #{desc => "order handler 1 to receive",
+ cmd => fun(#{handler1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ #{desc => "order handler 2 to receive",
+ cmd => fun(#{handler2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ #{desc => "order handler 3 to receive",
+ cmd => fun(#{handler3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ #{desc => "await ready from handler 1 (recv)",
+ cmd => fun(#{tester := Tester, handler1 := Pid} = _State) ->
+ case ?SEV_AWAIT_READY(Pid, handler1, recv,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await ready from handler 2 (recv)",
+ cmd => fun(#{tester := Tester, handler2 := Pid} = _State) ->
+ case ?SEV_AWAIT_READY(Pid, handler2, recv,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await ready from handler 3 (recv)",
+ cmd => fun(#{tester := Tester, handler3 := Pid} = _State) ->
+ case ?SEV_AWAIT_READY(Pid, handler3, recv,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv closed from all handlers)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv_closed),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order handler 1 to terminate",
+ cmd => fun(#{handler1 := Pid} = _State) ->
+ %% Pid ! {terminate, self(), ok},
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await handler 1 termination",
+ cmd => fun(#{handler1 := Pid} = State) ->
+ ?SEV_AWAIT_TERMINATION(Pid),
+ State1 = maps:remove(csock1, State),
+ State2 = maps:remove(handler1, State1),
+ {ok, State2}
+ end},
+ #{desc => "order handler 2 to terminate",
+ cmd => fun(#{handler2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await handler 2 termination",
+ cmd => fun(#{handler2 := Pid} = State) ->
+ ?SEV_AWAIT_TERMINATION(Pid),
+ State1 = maps:remove(csock2, State),
+ State2 = maps:remove(handler2, State1),
+ {ok, State2}
+ end},
+ #{desc => "order handler 3 to terminate",
+ cmd => fun(#{handler3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await handler 3 termination",
+ cmd => fun(#{handler3 := Pid} = State) ->
+ ?SEV_AWAIT_TERMINATION(Pid),
+ State1 = maps:remove(csock3, State),
+ State2 = maps:remove(handler3, State1),
+ {ok, State2}
+ end},
+ #{desc => "close listen socket",
+ cmd => fun(#{lsock := LSock} = State) ->
+ case socket:close(LSock) of
+ ok ->
+ {ok, maps:remove(lsock, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, {NodeID, ServerSA}} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ node_id => NodeID,
+ server_sa => ServerSA}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "create node",
+ cmd => fun(#{host := Host, node_id := NodeID} = State) ->
+ case start_node(Host, l2a(f("client_~w", [NodeID]))) of
+ {ok, Node} ->
+ ?SEV_IPRINT("client node ~p started", [Node]),
+ {ok, State#{node => Node}};
+ {error, Reason, _} ->
+ {error, Reason}
+ end
+ end},
+ #{desc => "monitor client node 1",
+ cmd => fun(#{node := Node} = _State) ->
+ true = erlang:monitor_node(Node, true),
+ ok
+ end},
+ #{desc => "start remote client on client node",
+ cmd => fun(#{node := Node} = State) ->
+ Pid = sc_rc_tcp_client_start(Node),
+ ?SEV_IPRINT("client ~p started", [Pid]),
+ {ok, State#{rclient => Pid}}
+ end},
+ #{desc => "monitor remote client",
+ cmd => fun(#{rclient := Pid}) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "order remote client to start",
+ cmd => fun(#{rclient := Client, server_sa := ServerSA}) ->
+ ?SEV_ANNOUNCE_START(Client, ServerSA),
+ ok
+ end},
+ #{desc => "await remote client ready",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, init,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, connect,
+ [{rclient, Client}]),
+ ok
+ end},
+ #{desc => "order remote client to continue (connect)",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, connect),
+ ok
+ end},
+ #{desc => "await client process ready (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, connect,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (connected)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, connect),
+ ok
+ end},
+ #{desc => "await continue (close)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, close,
+ [{rclient, Client}]),
+ ok
+ end},
+ #{desc => "order remote client to close",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, close),
+ ok
+ end},
+ #{desc => "await remote client ready (closed)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, close,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (close)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, close),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester,
+ [{rclient, Client}]) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "kill remote client",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await remote client termination",
+ cmd => fun(#{rclient := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ State1 = maps:remove(rclient, State),
+ {ok, State1}
+ end},
+ #{desc => "stop client node",
+ cmd => fun(#{node := Node} = _State) ->
+ stop_node(Node)
+ end},
+ #{desc => "await client node termination",
+ cmd => fun(#{node := Node} = State) ->
+ receive
+ {nodedown, Node} ->
+ State1 = maps:remove(node_id, State),
+ State2 = maps:remove(node, State1),
+ {ok, State2}
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client 1",
+ cmd => fun(#{client1 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client 2",
+ cmd => fun(#{client2 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client 3",
+ cmd => fun(#{client3 := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the server
+ #{desc => "order server start",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Pid} = State) ->
+ {ok, ServerSA} = ?SEV_AWAIT_READY(Pid, server, init),
+ {ok, State#{server_sa => ServerSA}}
+ end},
+
+ %% Start the client(s)
+ #{desc => "order client 1 start",
+ cmd => fun(#{client1 := Pid,
+ server_sa := ServerSA} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, {1, ServerSA}),
+ ok
+ end},
+ #{desc => "await client 1 ready (init)",
+ cmd => fun(#{client1 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client1, init)
+ end},
+ #{desc => "order client 2 start",
+ cmd => fun(#{client2 := Pid,
+ server_sa := ServerSA} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, {2, ServerSA}),
+ ok
+ end},
+ #{desc => "await client 2 ready (init)",
+ cmd => fun(#{client2 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client2, init)
+ end},
+ #{desc => "order client 3 start",
+ cmd => fun(#{client3 := Pid,
+ server_sa := ServerSA} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, {3, ServerSA}),
+ ok
+ end},
+ #{desc => "await client 3 ready (init)",
+ cmd => fun(#{client3 := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client3, init)
+ end},
+
+ %% The actual test
+ #{desc => "order server continue (accept)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client 1 continue (connect)",
+ cmd => fun(#{client1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, connect),
+ ok
+ end},
+ #{desc => "await client 1 ready (connect)",
+ cmd => fun(#{server := Server,
+ client1 := Client1,
+ client2 := Client2,
+ client3 := Client3} = _State) ->
+ ?SEV_AWAIT_READY(Client1, client1, connect,
+ [{server, Server},
+ {client2, Client2},
+ {client3, Client3}]),
+ ok
+ end},
+ #{desc => "order client 2 continue (connect)",
+ cmd => fun(#{client2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, connect),
+ ok
+ end},
+ #{desc => "await client 2 ready (connect)",
+ cmd => fun(#{server := Server,
+ client1 := Client1,
+ client2 := Client2,
+ client3 := Client3} = _State) ->
+ ?SEV_AWAIT_READY(Client2, client2, connect,
+ [{server, Server},
+ {client1, Client1},
+ {client3, Client3}]),
+ ok
+ end},
+ #{desc => "order client 3 continue (connect)",
+ cmd => fun(#{client3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, connect),
+ ok
+ end},
+ #{desc => "await client 3 ready (connect)",
+ cmd => fun(#{server := Server,
+ client1 := Client1,
+ client2 := Client2,
+ client3 := Client3} = _State) ->
+ ?SEV_AWAIT_READY(Client3, client3, connect,
+ [{server, Server},
+ {client1, Client1},
+ {client2, Client2}]),
+ ok
+ end},
+ #{desc => "await server ready (accept from all connections)",
+ cmd => fun(#{server := Server,
+ client1 := Client1,
+ client2 := Client2,
+ client3 := Client3} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, accept,
+ [{client1, Client1},
+ {client2, Client2},
+ {client3, Client3}]),
+ ok
+ end},
+ #{desc => "order server continue (recv for all connections)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client 1 continue (close)",
+ cmd => fun(#{client1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, close),
+ ok
+ end},
+ #{desc => "await client 1 ready (close)",
+ cmd => fun(#{server := Server,
+ client1 := Client1,
+ client2 := Client2,
+ client3 := Client3} = _State) ->
+ ?SEV_AWAIT_READY(Client1, client1, close,
+ [{server, Server},
+ {client2, Client2},
+ {client3, Client3}]),
+ ok
+ end},
+ #{desc => "order client 2 continue (close)",
+ cmd => fun(#{client2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, close),
+ ok
+ end},
+ #{desc => "await client 2 ready (close)",
+ cmd => fun(#{server := Server,
+ client1 := Client1,
+ client2 := Client2,
+ client3 := Client3} = _State) ->
+ ?SEV_AWAIT_READY(Client2, client2, close,
+ [{server, Server},
+ {client1, Client1},
+ {client3, Client3}]),
+ ok
+ end},
+ #{desc => "order client 3 continue (close)",
+ cmd => fun(#{client3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, close),
+ ok
+ end},
+ #{desc => "await client 3 ready (close)",
+ cmd => fun(#{server := Server,
+ client1 := Client1,
+ client2 := Client2,
+ client3 := Client3} = _State) ->
+ ?SEV_AWAIT_READY(Client3, client1, close,
+ [{server, Server},
+ {client1, Client1},
+ {client2, Client2}]),
+ ok
+ end},
+ #{desc => "await server ready (close for all connections)",
+ cmd => fun(#{server := Server,
+ client1 := Client1,
+ client2 := Client2,
+ client3 := Client3} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, recv_closed,
+ [{client1, Client1},
+ {client2, Client2},
+ {client3, Client3}]),
+ ok
+ end},
+
+ %% Terminations
+ #{desc => "order client 1 to terminate",
+ cmd => fun(#{client1 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await client 1 termination",
+ cmd => fun(#{client1 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(client1, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order client 2 to terminate",
+ cmd => fun(#{client2 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await client 2 termination",
+ cmd => fun(#{client2 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(client2, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order client 3 to terminate",
+ cmd => fun(#{client3 := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await client 3 termination",
+ cmd => fun(#{client3 := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(client3, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order server to terminate",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await server termination",
+ cmd => fun(#{server := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(server, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start server evaluator"),
+ ServerInitState = InitState,
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("start client evaluator(s)"),
+ ClientInitState = InitState#{host => local_host()},
+ Client1 = ?SEV_START("client-1", ClientSeq, ClientInitState),
+ Client2 = ?SEV_START("client-2", ClientSeq, ClientInitState),
+ Client3 = ?SEV_START("client-3", ClientSeq, ClientInitState),
+
+ i("start 'tester' evaluator"),
+ TesterInitState = #{server => Server#ev.pid,
+ client1 => Client1#ev.pid,
+ client2 => Client2#ev.pid,
+ client3 => Client3#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Server,
+ Client1, Client2, Client3,
+ Tester]).
+
+
+sc_rc_tcp_client_start(Node) ->
+ Self = self(),
+ Fun = fun() -> sc_rc_tcp_client(Self) end,
+ erlang:spawn(Node, Fun).
+
+
+sc_rc_tcp_client(Parent) ->
+ sc_rc_tcp_client_init(Parent),
+ ServerSA = sc_rc_tcp_client_await_start(Parent),
+ Domain = maps:get(family, ServerSA),
+ Sock = sc_rc_tcp_client_create(Domain),
+ sc_rc_tcp_client_bind(Sock, Domain),
+ sc_rc_tcp_client_announce_ready(Parent, init),
+ sc_rc_tcp_client_await_continue(Parent, connect),
+ sc_rc_tcp_client_connect(Sock, ServerSA),
+ sc_rc_tcp_client_announce_ready(Parent, connect),
+ sc_rc_tcp_client_await_continue(Parent, close),
+ sc_rc_tcp_client_close(Sock),
+ sc_rc_tcp_client_announce_ready(Parent, close),
+ Reason = sc_rc_tcp_client_await_terminate(Parent),
+ ?SEV_IPRINT("terminate"),
+ exit(Reason).
+
+sc_rc_tcp_client_init(Parent) ->
+ put(sname, "rclient"),
+ ?SEV_IPRINT("init"),
+ _MRef = erlang:monitor(process, Parent),
+ ok.
+
+sc_rc_tcp_client_await_start(Parent) ->
+ i("sc_rc_tcp_client_await_start -> entry"),
+ ?SEV_AWAIT_START(Parent).
+
+sc_rc_tcp_client_create(Domain) ->
+ i("sc_rc_tcp_client_create -> entry"),
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ case socket:getopt(Sock, otp, fd) of
+ {ok, FD} ->
+ put(sname, f("rclient-~w", [FD])); % Update SName
+ _ ->
+ ok
+ end,
+ Sock;
+ {error, Reason} ->
+ exit({open_failed, Reason})
+ end.
+
+sc_rc_tcp_client_bind(Sock, Domain) ->
+ i("sc_rc_tcp_client_bind -> entry"),
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain,
+ addr => LAddr},
+ case socket:bind(Sock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, Reason} ->
+ exit({bind, Reason})
+ end.
+
+sc_rc_tcp_client_announce_ready(Parent, Slogan) ->
+ ?SEV_IPRINT("ready ~w", [Slogan]),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan).
+
+sc_rc_tcp_client_await_continue(Parent, Slogan) ->
+ ?SEV_IPRINT("await ~w continue", [Slogan]),
+ ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan).
+
+sc_rc_tcp_client_connect(Sock, ServerSA) ->
+ i("sc_rc_tcp_client_connect -> entry"),
+ case socket:connect(Sock, ServerSA) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({connect, Reason})
+ end.
+
+sc_rc_tcp_client_close(Sock) ->
+ i("sc_rc_tcp_client_close -> entry"),
+ case socket:close(Sock) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({close, Reason})
+ end.
+
+sc_rc_tcp_client_await_terminate(Parent) ->
+ i("sc_rc_tcp_client_await_terminate -> entry"),
+ case ?SEV_AWAIT_TERMINATE(Parent, parent) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ Reason
+ end.
+
+
+%% The handlers run on the same node as the server (the local node).
+
+sc_rc_tcp_handler_start(ID, Recv, Sock) ->
+ Self = self(),
+ Fun = fun() -> sc_rc_tcp_handler(ID, Self, Recv, Sock) end,
+ {Pid, _} = erlang:spawn_monitor(Fun),
+ Pid.
+
+sc_rc_tcp_handler(ID, Parent, Recv, Sock) ->
+ sc_rc_tcp_handler_init(ID, socket:getopt(Sock, otp, fd), Parent),
+ sc_rc_tcp_handler_await(Parent, recv),
+ RecvRes = sc_rc_tcp_handler_recv(Recv, Sock),
+ sc_rc_tcp_handler_announce_ready(Parent, recv, RecvRes),
+ Reason = sc_rc_tcp_handler_await(Parent, terminate),
+ exit(Reason).
+
+sc_rc_tcp_handler_init(ID, {ok, FD}, Parent) ->
+ put(sname, f("handler-~w:~w", [ID, FD])),
+ _MRef = erlang:monitor(process, Parent),
+ ?SEV_IPRINT("started"),
+ ?SEV_ANNOUNCE_READY(Parent, init),
+ ok.
+
+sc_rc_tcp_handler_await(Parent, terminate) ->
+ ?SEV_IPRINT("await terminate"),
+ ?SEV_AWAIT_TERMINATE(Parent, tester);
+sc_rc_tcp_handler_await(Parent, Slogan) ->
+ ?SEV_IPRINT("await ~w", [Slogan]),
+ ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan).
+
+sc_rc_tcp_handler_recv(Recv, Sock) ->
+ ?SEV_IPRINT("recv"),
+ try Recv(Sock) of
+ {error, closed} ->
+ ok;
+ {ok, _} ->
+ ?SEV_IPRINT("unexpected success"),
+ {error, unexpected_success};
+ {error, Reason} = ERROR ->
+ ?SEV_IPRINT("receive error: "
+ "~n ~p", [Reason]),
+ ERROR
+ catch
+ C:E:S ->
+ ?SEV_IPRINT("receive failure: "
+ "~n Class: ~p"
+ "~n Error: ~p"
+ "~n Stack: ~p", [C, E, S]),
+ {error, {recv, C, E, S}}
+ end.
+
+sc_rc_tcp_handler_announce_ready(Parent, Slogan, Result) ->
+ ?SEV_IPRINT("announce ready"),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan, Result),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% remotely closed while the process is calling the recvmsg function.
+%% Socket is IPv4.
+
+sc_rc_recvmsg_response_tcp4(suite) ->
+ [];
+sc_rc_recvmsg_response_tcp4(doc) ->
+ [];
+sc_rc_recvmsg_response_tcp4(_Config) when is_list(_Config) ->
+ tc_try(sc_rc_recvmsg_response_tcp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ Recv = fun(Sock) -> socket:recvmsg(Sock) end,
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp,
+ recv => Recv},
+ ok = sc_rc_receive_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% remotely closed while the process is calling the recvmsg function.
+%% Socket is IPv6.
+
+sc_rc_recvmsg_response_tcp6(suite) ->
+ [];
+sc_rc_recvmsg_response_tcp6(doc) ->
+ [];
+sc_rc_recvmsg_response_tcp6(_Config) when is_list(_Config) ->
+ tc_try(sc_rc_recvmsg_response_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ Recv = fun(Sock) -> socket:recvmsg(Sock) end,
+ InitState = #{domain => inet6,
+ type => stream,
+ protocol => tcp,
+ recv => Recv},
+ ok = sc_rc_receive_response_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% remotely closed while the process is calling the recv function.
+%% The remote client sends data, then shutdown(write) and then the
+%% reader attempts a recv.
+%% Socket is IPv4.
+%%
+%% To minimize the chance of "weirdness", we should really have test cases
+%% where the two sides of the connection is on different machines. But for
+%% now, we will make do with different VMs on the same host.
+%%
+
+sc_rs_recv_send_shutdown_receive_tcp4(suite) ->
+ [];
+sc_rs_recv_send_shutdown_receive_tcp4(doc) ->
+ [];
+sc_rs_recv_send_shutdown_receive_tcp4(_Config) when is_list(_Config) ->
+ tc_try(sc_rs_recv_send_shutdown_receive_tcp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ MsgData = ?DATA,
+ Recv = fun(Sock) ->
+ socket:recv(Sock)
+ end,
+ Send = fun(Sock, Data) ->
+ socket:send(Sock, Data)
+ end,
+ InitState = #{domain => inet,
+ recv => Recv,
+ send => Send,
+ data => MsgData},
+ ok = sc_rs_send_shutdown_receive_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% remotely closed while the process is calling the recv function.
+%% The remote client sends data, then shutdown(write) and then the
+%% reader attempts a recv.
+%% Socket is IPv6.
+
+sc_rs_recv_send_shutdown_receive_tcp6(suite) ->
+ [];
+sc_rs_recv_send_shutdown_receive_tcp6(doc) ->
+ [];
+sc_rs_recv_send_shutdown_receive_tcp6(_Config) when is_list(_Config) ->
+ tc_try(sc_rs_recv_send_shutdown_receive_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ MsgData = ?DATA,
+ Recv = fun(Sock) ->
+ socket:recv(Sock)
+ end,
+ Send = fun(Sock, Data) ->
+ socket:send(Sock, Data)
+ end,
+ InitState = #{domain => inet6,
+ recv => Recv,
+ send => Send,
+ data => MsgData},
+ ok = sc_rs_send_shutdown_receive_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+sc_rs_send_shutdown_receive_tcp(InitState) ->
+ %% The connection is handled by a handler processes.
+ %% This are created (on the fly) and handled internally
+ %% by the server!
+ ServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ i("get local address for ~p", [Domain]),
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, local_sa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, local_sa := LSA, lport := Port}) ->
+ ServerSA = LSA#{port => Port},
+ ?SEV_ANNOUNCE_READY(Tester, init, ServerSA),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "accept",
+ cmd => fun(#{lsock := LSock, recv := Recv} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ ?SEV_IPRINT("accepted: try start handler"),
+ Handler =
+ sc_rs_tcp_handler_start(Recv, Sock),
+ ?SEV_IPRINT("handler started"),
+ {ok, State#{csock => Sock,
+ handler => Handler}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await handler ready (init)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = _State) ->
+ ?SEV_AWAIT_READY(Handler, handler, init,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (accept)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+
+ #{desc => "await continue (first recv)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, recv)
+ end},
+ #{desc => "order handler to receive (first)",
+ cmd => fun(#{handler := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ #{desc => "await ready from handler (first recv)",
+ cmd => fun(#{tester := Tester, handler := Pid} = _State) ->
+ case ?SEV_AWAIT_READY(Pid, handler, recv,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ ?SEV_IPRINT("first recv: ~p", [Result]),
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (first recv)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv),
+ ok
+ end},
+ #{desc => "await continue (second recv)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, recv)
+ end},
+ #{desc => "order handler to receive (second)",
+ cmd => fun(#{handler := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ #{desc => "await ready from handler (second recv)",
+ cmd => fun(#{tester := Tester, handler := Pid} = _State) ->
+ case ?SEV_AWAIT_READY(Pid, handler, recv,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ ?SEV_IPRINT("second recv: ~p", [Result]),
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (second recv)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order handler to terminate",
+ cmd => fun(#{handler := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await handler termination",
+ cmd => fun(#{handler := Pid} = State) ->
+ ?SEV_AWAIT_TERMINATION(Pid),
+ State1 = maps:remove(csock, State),
+ State2 = maps:remove(handler, State1),
+ {ok, State2}
+ end},
+ #{desc => "close listen socket",
+ cmd => fun(#{lsock := LSock} = State) ->
+ case socket:close(LSock) of
+ ok ->
+ {ok, maps:remove(lsock, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, ServerSA} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ server_sa => ServerSA}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "create node",
+ cmd => fun(#{host := Host} = State) ->
+ case start_node(Host, client) of
+ {ok, Node} ->
+ ?SEV_IPRINT("client node ~p started",
+ [Node]),
+ {ok, State#{node => Node}};
+ {error, Reason, _} ->
+ {error, Reason}
+ end
+ end},
+ #{desc => "monitor client node",
+ cmd => fun(#{node := Node} = _State) ->
+ true = erlang:monitor_node(Node, true),
+ ok
+ end},
+ #{desc => "start remote client on client node",
+ cmd => fun(#{node := Node,
+ send := Send} = State) ->
+ Pid = sc_rs_tcp_client_start(Node, Send),
+ ?SEV_IPRINT("client ~p started", [Pid]),
+ {ok, State#{rclient => Pid}}
+ end},
+ #{desc => "monitor remote client",
+ cmd => fun(#{rclient := Pid}) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "order remote client to start",
+ cmd => fun(#{rclient := Client, server_sa := ServerSA}) ->
+ ?SEV_ANNOUNCE_START(Client, ServerSA),
+ ok
+ end},
+ #{desc => "await remote client ready",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, init,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, connect,
+ [{rclient, Client}]),
+ ok
+ end},
+ #{desc => "order remote client to continue (connect)",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, connect),
+ ok
+ end},
+ #{desc => "await client process ready (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, connect,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (connect)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, connect),
+ ok
+ end},
+
+ #{desc => "await continue (send)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, send,
+ [{rclient, Client}]) of
+ {ok, Data} ->
+ {ok, State#{rclient_data => Data}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to send",
+ cmd => fun(#{rclient := Client,
+ rclient_data := Data}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Data),
+ ok
+ end},
+ #{desc => "await remote client ready (closed)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (send)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send),
+ ok
+ end},
+
+
+ #{desc => "await continue (shutdown)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, shutdown,
+ [{rclient, Client}]),
+ ok
+ end},
+ #{desc => "order remote client to shutdown",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, shutdown),
+ ok
+ end},
+ #{desc => "await remote client ready (shiutdown)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, shutdown,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (shutdown)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, shutdown),
+ ok
+ end},
+
+ #{desc => "await continue (close)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, close,
+ [{rclient, Client}]),
+ ok
+ end},
+ #{desc => "order remote client to close",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, close),
+ ok
+ end},
+ #{desc => "await remote client ready (closed)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, close,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (close)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, close),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester,
+ [{rclient, Client}]) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "kill remote client",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await remote client termination",
+ cmd => fun(#{rclient := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ State1 = maps:remove(rclient, State),
+ {ok, State1}
+ end},
+ #{desc => "stop client node",
+ cmd => fun(#{node := Node} = _State) ->
+ stop_node(Node)
+ end},
+ #{desc => "await client node termination",
+ cmd => fun(#{node := Node} = State) ->
+ receive
+ {nodedown, Node} ->
+ State1 = maps:remove(node_id, State),
+ State2 = maps:remove(node, State1),
+ {ok, State2}
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the server
+ #{desc => "order server start",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Pid} = State) ->
+ {ok, ServerSA} = ?SEV_AWAIT_READY(Pid, server, init),
+ {ok, State#{server_sa => ServerSA}}
+ end},
+
+ %% Start the client(s)
+ #{desc => "order client start",
+ cmd => fun(#{client := Pid,
+ server_sa := ServerSA} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, ServerSA),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client, init)
+ end},
+
+ %% The actual test
+ #{desc => "order server continue (accept)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client continue (connect)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, connect),
+ ok
+ end},
+ #{desc => "await client ready (connect)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, connect,
+ [{server, Server}]),
+ ok
+ end},
+ #{desc => "await server ready (accept)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, accept,
+ [{client, Client}]),
+ ok
+ end},
+
+ #{desc => "order client continue (send)",
+ cmd => fun(#{client := Pid,
+ data := Data} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, send, Data),
+ ok
+ end},
+ #{desc => "await client ready (send)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, send,
+ [{server, Server}]),
+ ok
+ end},
+
+ #{desc => "order client continue (shutdown)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, shutdown),
+ ok
+ end},
+ #{desc => "await client ready (shutdown)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, shutdown,
+ [{server, Server}]),
+ ok
+ end},
+
+ #{desc => "order server continue (first recv)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ #{desc => "await server ready (first recv)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, recv,
+ [{client, Client}]),
+ ok
+ end},
+
+ #{desc => "order server continue (second recv)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ #{desc => "await server ready (second recv)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, recv,
+ [{client, Client}]),
+ ok
+ end},
+
+ ?SEV_SLEEP(?SECS(1)),
+
+ #{desc => "order client continue (close)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, close),
+ ok
+ end},
+ #{desc => "await client ready (close)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, close,
+ [{server, Server}]),
+ ok
+ end},
+
+ %% Terminations
+ #{desc => "order client to terminate",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await client termination",
+ cmd => fun(#{client := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(client, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order server to terminate",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await server termination",
+ cmd => fun(#{server := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(server, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start server evaluator"),
+ ServerInitState = #{domain => maps:get(domain, InitState),
+ recv => maps:get(recv, InitState)},
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("start client evaluator"),
+ ClientInitState = #{host => local_host(),
+ domain => maps:get(domain, InitState),
+ send => maps:get(send, InitState)},
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("start 'tester' evaluator"),
+ TesterInitState = #{server => Server#ev.pid,
+ client => Client#ev.pid,
+ data => maps:get(data, InitState)},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+sc_rs_tcp_client_start(Node, Send) ->
+ Self = self(),
+ Fun = fun() -> sc_rs_tcp_client(Self, Send) end,
+ erlang:spawn(Node, Fun).
+
+
+sc_rs_tcp_client(Parent, Send) ->
+ sc_rs_tcp_client_init(Parent),
+ ServerSA = sc_rs_tcp_client_await_start(Parent),
+ Domain = maps:get(family, ServerSA),
+ Sock = sc_rs_tcp_client_create(Domain),
+ sc_rs_tcp_client_bind(Sock, Domain),
+ sc_rs_tcp_client_announce_ready(Parent, init),
+ sc_rs_tcp_client_await_continue(Parent, connect),
+ sc_rs_tcp_client_connect(Sock, ServerSA),
+ sc_rs_tcp_client_announce_ready(Parent, connect),
+ Data = sc_rs_tcp_client_await_continue(Parent, send),
+ sc_rs_tcp_client_send(Sock, Send, Data),
+ sc_rs_tcp_client_announce_ready(Parent, send),
+ sc_rs_tcp_client_await_continue(Parent, shutdown),
+ sc_rs_tcp_client_shutdown(Sock),
+ sc_rs_tcp_client_announce_ready(Parent, shutdown),
+ sc_rs_tcp_client_await_continue(Parent, close),
+ sc_rs_tcp_client_close(Sock),
+ sc_rs_tcp_client_announce_ready(Parent, close),
+ Reason = sc_rs_tcp_client_await_terminate(Parent),
+ ?SEV_IPRINT("terminate"),
+ exit(Reason).
+
+sc_rs_tcp_client_init(Parent) ->
+ put(sname, "rclient"),
+ ?SEV_IPRINT("init"),
+ _MRef = erlang:monitor(process, Parent),
+ ok.
+
+sc_rs_tcp_client_await_start(Parent) ->
+ i("sc_rs_tcp_client_await_start -> entry"),
+ ?SEV_AWAIT_START(Parent).
+
+sc_rs_tcp_client_create(Domain) ->
+ i("sc_rs_tcp_client_create -> entry"),
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ Sock;
+ {error, Reason} ->
+ exit({open_failed, Reason})
+ end.
+
+sc_rs_tcp_client_bind(Sock, Domain) ->
+ i("sc_rs_tcp_client_bind -> entry"),
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain,
+ addr => LAddr},
+ case socket:bind(Sock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, Reason} ->
+ exit({bind, Reason})
+ end.
+
+sc_rs_tcp_client_announce_ready(Parent, Slogan) ->
+ ?SEV_ANNOUNCE_READY(Parent, Slogan).
+
+sc_rs_tcp_client_await_continue(Parent, Slogan) ->
+ i("sc_rs_tcp_client_await_continue -> entry"),
+ case ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan) of
+ ok ->
+ ok;
+ {ok, Extra} ->
+ Extra;
+ {error, Reason} ->
+ exit({await_continue, Slogan, Reason})
+ end.
+
+
+sc_rs_tcp_client_connect(Sock, ServerSA) ->
+ i("sc_rs_tcp_client_connect -> entry"),
+ case socket:connect(Sock, ServerSA) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({connect, Reason})
+ end.
+
+sc_rs_tcp_client_send(Sock, Send, Data) ->
+ i("sc_rs_tcp_client_send -> entry"),
+ case Send(Sock, Data) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({send, Reason})
+ end.
+
+sc_rs_tcp_client_shutdown(Sock) ->
+ i("sc_rs_tcp_client_shutdown -> entry"),
+ case socket:shutdown(Sock, write) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({shutdown, Reason})
+ end.
+
+sc_rs_tcp_client_close(Sock) ->
+ i("sc_rs_tcp_client_close -> entry"),
+ case socket:close(Sock) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({close, Reason})
+ end.
+
+sc_rs_tcp_client_await_terminate(Parent) ->
+ i("sc_rs_tcp_client_await_terminate -> entry"),
+ case ?SEV_AWAIT_TERMINATE(Parent, parent) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ Reason
+ end.
+
+
+%% The handlers run on the same node as the server (the local node).
+
+sc_rs_tcp_handler_start(Recv, Sock) ->
+ Self = self(),
+ Fun = fun() -> sc_rs_tcp_handler(Self, Recv, Sock) end,
+ {Pid, _} = erlang:spawn_monitor(Fun),
+ Pid.
+
+sc_rs_tcp_handler(Parent, Recv, Sock) ->
+ sc_rs_tcp_handler_init(Parent),
+ sc_rs_tcp_handler_await(Parent, recv),
+ ok = sc_rs_tcp_handler_recv(Recv, Sock, true),
+ sc_rs_tcp_handler_announce_ready(Parent, recv, received),
+ sc_rs_tcp_handler_await(Parent, recv),
+ ok = sc_rs_tcp_handler_recv(Recv, Sock, false),
+ sc_rs_tcp_handler_announce_ready(Parent, recv, closed),
+ Reason = sc_rs_tcp_handler_await(Parent, terminate),
+ exit(Reason).
+
+sc_rs_tcp_handler_init(Parent) ->
+ put(sname, "handler"),
+ _MRef = erlang:monitor(process, Parent),
+ ?SEV_IPRINT("started"),
+ ?SEV_ANNOUNCE_READY(Parent, init),
+ ok.
+
+sc_rs_tcp_handler_await(Parent, terminate) ->
+ ?SEV_IPRINT("await terminate"),
+ ?SEV_AWAIT_TERMINATE(Parent, tester);
+sc_rs_tcp_handler_await(Parent, Slogan) ->
+ ?SEV_IPRINT("await ~w", [Slogan]),
+ ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan).
+
+%% This hould actually work - we leave it for now
+sc_rs_tcp_handler_recv(Recv, Sock, First) ->
+ ?SEV_IPRINT("recv"),
+ try Recv(Sock) of
+ {ok, _} when (First =:= true) ->
+ ok;
+ {error, closed} when (First =:= false) ->
+ ok;
+ {ok, _} ->
+ ?SEV_IPRINT("unexpected success"),
+ {error, unexpected_success};
+ {error, Reason} = ERROR ->
+ ?SEV_IPRINT("receive error: "
+ "~n ~p", [Reason]),
+ ERROR
+ catch
+ C:E:S ->
+ ?SEV_IPRINT("receive failure: "
+ "~n Class: ~p"
+ "~n Error: ~p"
+ "~n Stack: ~p", [C, E, S]),
+ {error, {recv, C, E, S}}
+ end.
+
+sc_rs_tcp_handler_announce_ready(Parent, Slogan, Result) ->
+ ?SEV_IPRINT("announce ready"),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan, Result),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% remotely closed while the process is calling the recvmsg function.
+%% The remote client sends data, then shutdown(write) and then the
+%% reader attempts a recv.
+%% Socket is IPv4.
+
+sc_rs_recvmsg_send_shutdown_receive_tcp4(suite) ->
+ [];
+sc_rs_recvmsg_send_shutdown_receive_tcp4(doc) ->
+ [];
+sc_rs_recvmsg_send_shutdown_receive_tcp4(_Config) when is_list(_Config) ->
+ tc_try(sc_rs_recvmsg_send_shutdown_receive_tcp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ MsgData = ?DATA,
+ Recv = fun(Sock) ->
+ case socket:recvmsg(Sock) of
+ {ok, #{addr := undefined,
+ iov := [Data]}} ->
+ {ok, Data};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end,
+ Send = fun(Sock, Data) when is_binary(Data) ->
+ MsgHdr = #{iov => [Data]},
+ socket:sendmsg(Sock, MsgHdr)
+ end,
+ InitState = #{domain => inet,
+ type => stream,
+ protocol => tcp,
+ recv => Recv,
+ send => Send,
+ data => MsgData},
+ ok = sc_rs_send_shutdown_receive_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test what happens when a socket is
+%% remotely closed while the process is calling the recvmsg function.
+%% The remote client sends data, then shutdown(write) and then the
+%% reader attempts a recv.
+%% Socket is IPv6.
+
+sc_rs_recvmsg_send_shutdown_receive_tcp6(suite) ->
+ [];
+sc_rs_recvmsg_send_shutdown_receive_tcp6(doc) ->
+ [];
+sc_rs_recvmsg_send_shutdown_receive_tcp6(_Config) when is_list(_Config) ->
+ tc_try(sc_rs_recvmsg_send_shutdown_receive_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(10)),
+ MsgData = ?DATA,
+ Recv = fun(Sock) ->
+ case socket:recvmsg(Sock) of
+ {ok, #{addr := undefined,
+ iov := [Data]}} ->
+ {ok, Data};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end,
+ Send = fun(Sock, Data) when is_binary(Data) ->
+ MsgHdr = #{iov => [Data]},
+ socket:sendmsg(Sock, MsgHdr)
+ end,
+ InitState = #{domain => inet6,
+ type => stream,
+ protocol => tcp,
+ recv => Recv,
+ send => Send,
+ data => MsgData},
+ ok = sc_rs_send_shutdown_receive_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the send and recv functions
+%% behave as expected when sending and/or reading chunks.
+%% First send data in one "big" chunk, and read it in "small" chunks.
+%% Second, send in a bunch of "small" chunks, and read in one "big" chunk.
+%% Socket is IPv4.
+
+traffic_send_and_recv_chunks_tcp4(suite) ->
+ [];
+traffic_send_and_recv_chunks_tcp4(doc) ->
+ [];
+traffic_send_and_recv_chunks_tcp4(_Config) when is_list(_Config) ->
+ tc_try(traffic_send_and_recv_chunks_tcp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ InitState = #{domain => inet},
+ ok = traffic_send_and_recv_chunks_tcp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the send and recv functions
+%% behave as expected when sending and/or reading chunks.
+%% First send data in one "big" chunk, and read it in "small" chunks.
+%% Second, send in a bunch of "small" chunks, and read in one "big" chunk.
+%% Socket is IPv6.
+
+traffic_send_and_recv_chunks_tcp6(suite) ->
+ [];
+traffic_send_and_recv_chunks_tcp6(doc) ->
+ [];
+traffic_send_and_recv_chunks_tcp6(_Config) when is_list(_Config) ->
+ tc_try(traffic_send_and_recv_chunks_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(30)),
+ InitState = #{domain => inet6},
+ ok = traffic_send_and_recv_chunks_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+traffic_send_and_recv_chunks_tcp(InitState) ->
+ ServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, local_sa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, local_sa := LSA, lport := Port}) ->
+ ServerSA = LSA#{port => Port},
+ ?SEV_ANNOUNCE_READY(Tester, init, ServerSA),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "accept",
+ cmd => fun(#{lsock := LSock} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ {ok, State#{csock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (accept)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+
+ #{desc => "await continue (recv-many-small)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, recv_many_small)
+ end},
+ #{desc => "recv chunk 1",
+ cmd => fun(#{csock := Sock} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 1 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 2",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 2 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 3",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 3 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 4",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 4 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 5",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 5 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 6",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 6 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 7",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 7 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 8",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 8 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 9",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 9 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv chunk 10",
+ cmd => fun(#{csock := Sock,
+ chunks := Chunks} = State) ->
+ case socket:recv(Sock, 100) of
+ {ok, Chunk} ->
+ ?SEV_IPRINT("recv of chunk 10 of ~p bytes",
+ [size(Chunk)]),
+ {ok, State#{chunks => [b2l(Chunk)|Chunks]}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv-many-small)",
+ cmd => fun(#{tester := Tester,
+ chunks := Chunks} = State) ->
+ Data = lists:flatten(lists:reverse(Chunks)),
+ ?SEV_ANNOUNCE_READY(Tester, recv_many_small, Data),
+ {ok, maps:remove(chunks, State)}
+ end},
+
+ #{desc => "await continue (recv-one-big)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester, recv_one_big) of
+ {ok, Size} ->
+ {ok, State#{size => Size}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "recv (one big)",
+ cmd => fun(#{tester := Tester, csock := Sock, size := Size} = _State) ->
+ case socket:recv(Sock, Size) of
+ {ok, Data} ->
+ ?SEV_ANNOUNCE_READY(Tester,
+ recv_one_big,
+ b2l(Data)),
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "close connection socket (just in case)",
+ cmd => fun(#{csock := Sock} = State) ->
+ (catch socket:close(Sock)),
+ {ok, maps:remove(csock, State)}
+ end},
+ #{desc => "close listen socket",
+ cmd => fun(#{lsock := Sock} = State) ->
+ (catch socket:close(Sock)),
+ {ok, maps:remove(lsock, State)}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, ServerSA} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ server_sa => ServerSA}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "create node",
+ cmd => fun(#{host := Host} = State) ->
+ case start_node(Host, client) of
+ {ok, Node} ->
+ ?SEV_IPRINT("(remote) client node ~p started",
+ [Node]),
+ {ok, State#{node => Node}};
+ {error, Reason, _} ->
+ {error, Reason}
+ end
+ end},
+ #{desc => "monitor client node",
+ cmd => fun(#{node := Node} = _State) ->
+ true = erlang:monitor_node(Node, true),
+ ok
+ end},
+ #{desc => "start remote client",
+ cmd => fun(#{node := Node} = State) ->
+ Pid = traffic_snr_tcp_client_start(Node),
+ ?SEV_IPRINT("client ~p started", [Pid]),
+ {ok, State#{rclient => Pid}}
+ end},
+ #{desc => "monitor remote client",
+ cmd => fun(#{rclient := Pid}) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "order remote client to start",
+ cmd => fun(#{rclient := Client, server_sa := ServerSA}) ->
+ ?SEV_ANNOUNCE_START(Client, ServerSA),
+ ok
+ end},
+ #{desc => "await remote client ready",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, init,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, connect,
+ [{rclient, Client}]),
+ ok
+ end},
+ #{desc => "order remote client to continue (connect)",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, connect),
+ ok
+ end},
+ #{desc => "await client process ready (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, rclient, connect,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (connect)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, connect),
+ ok
+ end},
+
+ #{desc => "await continue (send-one-big)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester,
+ send_one_big,
+ [{rclient, Client}]) of
+ {ok, Data} ->
+ {ok, State#{data => Data}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send)",
+ cmd => fun(#{rclient := Client, data := Data}) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Data),
+ ok
+ end},
+ #{desc => "await client process ready (send)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (send-one-big)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send_one_big),
+ ok
+ end},
+
+ #{desc => "await continue (send-many-small)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = State) ->
+ case ?SEV_AWAIT_CONTINUE(Tester, tester,
+ send_many_small,
+ [{rclient, Client}]) of
+ {ok, Data} ->
+ {ok, State#{data => Data}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 1)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 1: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 1)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 2)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 2: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 2)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 3)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 3: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 3)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 4)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 4: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 4)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 5)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 5: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 5)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 6)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 6: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 6)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 7)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 7: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 7)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 8)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 8: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 8)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 9)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, RestData} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 9: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, State#{data => RestData}}
+ end},
+ #{desc => "await client process ready (send chunk 9)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send chunk 10)",
+ cmd => fun(#{rclient := Client,
+ data := Data} = State) ->
+ {Chunk, []} = lists:split(100, Data),
+ %% ?SEV_IPRINT("order send of chunk 10: "
+ %% "~n Size: ~p"
+ %% "~n ~p", [length(Chunk), Chunk]),
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, Chunk),
+ {ok, maps:remove(data, State)}
+ end},
+ #{desc => "await client process ready (send chunk 10)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order remote client to continue (send stop)",
+ cmd => fun(#{rclient := Client} = State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, send, stop),
+ {ok, maps:remove(data, State)}
+ end},
+ #{desc => "await client process ready (send stop)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Client, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ Result;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (send-many-small)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, send_many_small),
+ ok
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester,
+ rclient := Client} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester,
+ [{rclient, Client}]) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "kill remote client",
+ cmd => fun(#{rclient := Client}) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await remote client termination",
+ cmd => fun(#{rclient := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ State1 = maps:remove(rclient, State),
+ {ok, State1}
+ end},
+ #{desc => "stop client node",
+ cmd => fun(#{node := Node} = _State) ->
+ stop_node(Node)
+ end},
+ #{desc => "await client node termination",
+ cmd => fun(#{node := Node} = State) ->
+ receive
+ {nodedown, Node} ->
+ {ok, maps:remove(node, State)}
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the server
+ #{desc => "order server start",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Pid} = State) ->
+ {ok, ServerSA} = ?SEV_AWAIT_READY(Pid, server, init),
+ {ok, State#{server_sa => ServerSA}}
+ end},
+
+ %% Start the client
+ #{desc => "order client start",
+ cmd => fun(#{client := Pid,
+ server_sa := ServerSA} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, ServerSA),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client, init)
+ end},
+
+ %% The actual test
+ #{desc => "order server continue (accept)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client continue (connect)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, connect),
+ ok
+ end},
+ #{desc => "await server ready (accept)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, accept,
+ [{client, Client}]),
+ ok
+ end},
+ #{desc => "await client ready (connect)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, connect,
+ [{server, Server}])
+ end},
+
+ #{desc => "generate data",
+ cmd => fun(State) ->
+ D1 = lists:seq(1,250),
+ D2 = lists:duplicate(4, D1),
+ D3 = lists:flatten(D2),
+ {ok, State#{data => D3}}
+ end},
+
+ %% (client) Send one big and (server) recv may small
+ #{desc => "order server continue (recv-many-small)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv_many_small),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client continue (send-one-big)",
+ cmd => fun(#{client := Pid, data := Data} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, send_one_big, Data),
+ ok
+ end},
+ #{desc => "await client ready (send-one-big)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ok = ?SEV_AWAIT_READY(Client, client, send_one_big,
+ [{server, Server}])
+ end},
+ #{desc => "await server ready (recv-many-small)",
+ cmd => fun(#{server := Server,
+ client := Client,
+ data := Data} = _State) ->
+ case ?SEV_AWAIT_READY(Server, server, recv_many_small,
+ [{client, Client}]) of
+ {ok, Data} ->
+ ok;
+ {ok, OtherData} ->
+ {error, {mismatched_data, Data, OtherData}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ #{desc => "order server continue (recv-one-big)",
+ cmd => fun(#{server := Pid, data := Data} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv_one_big, length(Data)),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client continue (send-many-small)",
+ cmd => fun(#{client := Pid, data := Data} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, send_many_small, Data),
+ ok
+ end},
+ #{desc => "await client ready (send-many-small)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ok = ?SEV_AWAIT_READY(Client, client, send_many_small,
+ [{server, Server}])
+ end},
+ #{desc => "await server ready (recv-one-big)",
+ cmd => fun(#{server := Server,
+ client := Client,
+ data := Data} = State) ->
+ case ?SEV_AWAIT_READY(Server, server, recv_one_big,
+ [{client, Client}]) of
+ {ok, Data} ->
+ {ok, maps:remove(data, State)};
+ {ok, OtherData} ->
+ {error, {mismatched_data, Data, OtherData}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+ %% Terminations
+ #{desc => "order client to terminate",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await client termination",
+ cmd => fun(#{client := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(client, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order server to terminate",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await server termination",
+ cmd => fun(#{server := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(server, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start server evaluator"),
+ ServerInitState = InitState,
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("start client evaluator(s)"),
+ ClientInitState = InitState#{host => local_host()},
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("start 'tester' evaluator"),
+ TesterInitState = #{server => Server#ev.pid,
+ client => Client#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+
+traffic_snr_tcp_client_start(Node) ->
+ Self = self(),
+ Fun = fun() -> traffic_snr_tcp_client(Self) end,
+ erlang:spawn(Node, Fun).
+
+traffic_snr_tcp_client(Parent) ->
+ {Sock, ServerSA} = traffic_snr_tcp_client_init(Parent),
+ traffic_snr_tcp_client_announce_ready(Parent, init),
+ traffic_snr_tcp_client_await_continue(Parent, connect),
+ traffic_snr_tcp_client_connect(Sock, ServerSA),
+ traffic_snr_tcp_client_announce_ready(Parent, connect),
+ traffic_snr_tcp_client_send_loop(Parent, Sock),
+ Reason = traffic_snr_tcp_client_await_terminate(Parent),
+ traffic_snr_tcp_client_close(Sock),
+ exit(Reason).
+
+
+traffic_snr_tcp_client_send_loop(Parent, Sock) ->
+ case ?SEV_AWAIT_CONTINUE(Parent, parent, send) of
+ {ok, stop} -> % Breakes the loop
+ ?SEV_ANNOUNCE_READY(Parent, send, ok),
+ ok;
+ {ok, Data} ->
+ case socket:send(Sock, Data) of
+ ok ->
+ ?SEV_ANNOUNCE_READY(Parent, send, ok),
+ traffic_snr_tcp_client_send_loop(Parent, Sock);
+ {error, Reason} = ERROR ->
+ ?SEV_ANNOUNCE_READY(Parent, send, ERROR),
+ exit({send, Reason})
+ end;
+ {error, Reason} ->
+ exit({await_continue, Reason})
+ end.
+
+traffic_snr_tcp_client_init(Parent) ->
+ put(sname, "rclient"),
+ ?SEV_IPRINT("init"),
+ _MRef = erlang:monitor(process, Parent),
+ ServerSA = traffic_snr_tcp_client_await_start(Parent),
+ Domain = maps:get(family, ServerSA),
+ Sock = traffic_snr_tcp_client_create(Domain),
+ traffic_snr_tcp_client_bind(Sock, Domain),
+ {Sock, ServerSA}.
+
+traffic_snr_tcp_client_await_start(Parent) ->
+ i("traffic_snr_tcp_client_await_start -> entry"),
+ ?SEV_AWAIT_START(Parent).
+
+traffic_snr_tcp_client_create(Domain) ->
+ i("traffic_snr_tcp_client_create -> entry"),
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ Sock;
+ {error, Reason} ->
+ exit({open_failed, Reason})
+ end.
+
+traffic_snr_tcp_client_bind(Sock, Domain) ->
+ i("traffic_snr_tcp_client_bind -> entry"),
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain,
+ addr => LAddr},
+ case socket:bind(Sock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, Reason} ->
+ exit({bind, Reason})
+ end.
+
+traffic_snr_tcp_client_announce_ready(Parent, Slogan) ->
+ ?SEV_ANNOUNCE_READY(Parent, Slogan).
+
+traffic_snr_tcp_client_await_continue(Parent, Slogan) ->
+ i("traffic_snr_tcp_client_await_continue -> entry"),
+ ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan).
+
+traffic_snr_tcp_client_connect(Sock, ServerSA) ->
+ i("traffic_snr_tcp_client_connect -> entry"),
+ case socket:connect(Sock, ServerSA) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({connect, Reason})
+ end.
+
+traffic_snr_tcp_client_close(Sock) ->
+ i("traffic_snr_tcp_client_close -> entry"),
+ case socket:close(Sock) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({close, Reason})
+ end.
+
+traffic_snr_tcp_client_await_terminate(Parent) ->
+ i("traffic_snr_tcp_client_await_terminate -> entry"),
+ case ?SEV_AWAIT_TERMINATE(Parent, parent) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ Reason
+ end.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the send and recv functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'small' message test case, for IPv4.
+
+traffic_ping_pong_small_send_and_recv_tcp4(suite) ->
+ [];
+traffic_ping_pong_small_send_and_recv_tcp4(doc) ->
+ [];
+traffic_ping_pong_small_send_and_recv_tcp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_SMALL),
+ Num = ?TPP_SMALL_NUM,
+ tc_try(traffic_ping_pong_small_send_and_recv_tcp4,
+ fun() ->
+ ?TT(?SECS(15)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_send_and_recv_tcp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the send and recv functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'small' message test case, for IPv6.
+
+traffic_ping_pong_small_send_and_recv_tcp6(suite) ->
+ [];
+traffic_ping_pong_small_send_and_recv_tcp6(doc) ->
+ [];
+traffic_ping_pong_small_send_and_recv_tcp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_SMALL),
+ Num = ?TPP_SMALL_NUM,
+ tc_try(traffic_ping_pong_small_send_and_recv_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(15)),
+ InitState = #{domain => inet6,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_send_and_recv_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the send and recv functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'medium' message test case, for IPv4.
+
+traffic_ping_pong_medium_send_and_recv_tcp4(suite) ->
+ [];
+traffic_ping_pong_medium_send_and_recv_tcp4(doc) ->
+ [];
+traffic_ping_pong_medium_send_and_recv_tcp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_MEDIUM),
+ Num = ?TPP_MEDIUM_NUM,
+ tc_try(traffic_ping_pong_medium_send_and_recv_tcp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_send_and_recv_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the send and recv functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'medium' message test case, for IPv6.
+
+traffic_ping_pong_medium_send_and_recv_tcp6(suite) ->
+ [];
+traffic_ping_pong_medium_send_and_recv_tcp6(doc) ->
+ [];
+traffic_ping_pong_medium_send_and_recv_tcp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_MEDIUM),
+ Num = ?TPP_MEDIUM_NUM,
+ tc_try(traffic_ping_pong_medium_send_and_recv_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(30)),
+ InitState = #{domain => inet6,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_send_and_recv_tcp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the send and recv functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'large' message test case, for IPv4.
+
+traffic_ping_pong_large_send_and_recv_tcp4(suite) ->
+ [];
+traffic_ping_pong_large_send_and_recv_tcp4(doc) ->
+ [];
+traffic_ping_pong_large_send_and_recv_tcp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_LARGE),
+ Num = ?TPP_LARGE_NUM,
+ tc_try(traffic_ping_pong_large_send_and_recv_tcp4,
+ fun() ->
+ ?TT(?SECS(45)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_send_and_recv_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the send and recv functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'large' message test case, for IPv6.
+
+traffic_ping_pong_large_send_and_recv_tcp6(suite) ->
+ [];
+traffic_ping_pong_large_send_and_recv_tcp6(doc) ->
+ [];
+traffic_ping_pong_large_send_and_recv_tcp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_LARGE),
+ Num = ?TPP_LARGE_NUM,
+ tc_try(traffic_ping_pong_large_send_and_recv_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(45)),
+ InitState = #{domain => inet6,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_send_and_recv_tcp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendto and recvfrom
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for two different message sizes;
+%% small (8 bytes) and medium (8K).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'small' message test case, for IPv4.
+
+traffic_ping_pong_small_sendto_and_recvfrom_udp4(suite) ->
+ [];
+traffic_ping_pong_small_sendto_and_recvfrom_udp4(doc) ->
+ [];
+traffic_ping_pong_small_sendto_and_recvfrom_udp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_SMALL),
+ Num = ?TPP_SMALL_NUM,
+ tc_try(traffic_ping_pong_small_sendto_and_recvfrom_udp4,
+ fun() ->
+ ?TT(?SECS(45)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendto_and_recvfrom_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendto and recvfrom
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for two different message sizes;
+%% small (8 bytes) and medium (8K).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'small' message test case, for IPv6.
+
+traffic_ping_pong_small_sendto_and_recvfrom_udp6(suite) ->
+ [];
+traffic_ping_pong_small_sendto_and_recvfrom_udp6(doc) ->
+ [];
+traffic_ping_pong_small_sendto_and_recvfrom_udp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_SMALL),
+ Num = ?TPP_SMALL_NUM,
+ tc_try(traffic_ping_pong_small_sendto_and_recvfrom_udp6,
+ fun() ->
+ ?TT(?SECS(45)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendto_and_recvfrom_udp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendto and recvfrom
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for two different message sizes;
+%% small (8 bytes) and medium (8K).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'medium' message test case, for IPv4.
+
+traffic_ping_pong_medium_sendto_and_recvfrom_udp4(suite) ->
+ [];
+traffic_ping_pong_medium_sendto_and_recvfrom_udp4(doc) ->
+ [];
+traffic_ping_pong_medium_sendto_and_recvfrom_udp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_MEDIUM),
+ Num = ?TPP_MEDIUM_NUM,
+ tc_try(traffic_ping_pong_medium_sendto_and_recvfrom_udp4,
+ fun() ->
+ ?TT(?SECS(45)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendto_and_recvfrom_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendto and recvfrom
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for two different message sizes;
+%% small (8 bytes) and medium (8K).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'medium' message test case, for IPv6.
+
+traffic_ping_pong_medium_sendto_and_recvfrom_udp6(suite) ->
+ [];
+traffic_ping_pong_medium_sendto_and_recvfrom_udp6(doc) ->
+ [];
+traffic_ping_pong_medium_sendto_and_recvfrom_udp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_MEDIUM),
+ Num = ?TPP_MEDIUM_NUM,
+ tc_try(traffic_ping_pong_medium_sendto_and_recvfrom_udp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(45)),
+ InitState = #{domain => inet6,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendto_and_recvfrom_udp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'small' message test case, for IPv4.
+
+traffic_ping_pong_small_sendmsg_and_recvmsg_tcp4(suite) ->
+ [];
+traffic_ping_pong_small_sendmsg_and_recvmsg_tcp4(doc) ->
+ [];
+traffic_ping_pong_small_sendmsg_and_recvmsg_tcp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_SMALL),
+ Num = ?TPP_SMALL_NUM,
+ tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_tcp4,
+ fun() ->
+ ?TT(?SECS(20)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'small' message test case, for IPv6.
+
+traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6(suite) ->
+ [];
+traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6(doc) ->
+ [];
+traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_SMALL),
+ Num = ?TPP_SMALL_NUM,
+ tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(20)),
+ InitState = #{domain => inet6,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'medium' message test case, for IPv4.
+
+traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp4(suite) ->
+ [];
+traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp4(doc) ->
+ [];
+traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_MEDIUM),
+ Num = ?TPP_MEDIUM_NUM,
+ tc_try(traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'medium' message test case, for IPv6.
+
+traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6(suite) ->
+ [];
+traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6(doc) ->
+ [];
+traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_MEDIUM),
+ Num = ?TPP_MEDIUM_NUM,
+ tc_try(traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(20)),
+ InitState = #{domain => ine6,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'large' message test case, for IPv4.
+
+traffic_ping_pong_large_sendmsg_and_recvmsg_tcp4(suite) ->
+ [];
+traffic_ping_pong_large_sendmsg_and_recvmsg_tcp4(doc) ->
+ [];
+traffic_ping_pong_large_sendmsg_and_recvmsg_tcp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_LARGE),
+ Num = ?TPP_LARGE_NUM,
+ tc_try(traffic_ping_pong_large_sendmsg_and_recvmsg_tcp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes), medium (8K) and large (8M).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'large' message test case, for IPv6.
+
+traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6(suite) ->
+ [];
+traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6(doc) ->
+ [];
+traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_LARGE),
+ Num = ?TPP_LARGE_NUM,
+ tc_try(traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(30)),
+ InitState = #{domain => inet6,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_tcp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes) and medium (8K).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'small' message test case, for IPv4.
+
+traffic_ping_pong_small_sendmsg_and_recvmsg_udp4(suite) ->
+ [];
+traffic_ping_pong_small_sendmsg_and_recvmsg_udp4(doc) ->
+ [];
+traffic_ping_pong_small_sendmsg_and_recvmsg_udp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_SMALL),
+ Num = ?TPP_SMALL_NUM,
+ tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_udp4,
+ fun() ->
+ ?TT(?SECS(20)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg functions
+%% by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes) and medium (8K).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'small' message test case, for IPv6.
+
+traffic_ping_pong_small_sendmsg_and_recvmsg_udp6(suite) ->
+ [];
+traffic_ping_pong_small_sendmsg_and_recvmsg_udp6(doc) ->
+ [];
+traffic_ping_pong_small_sendmsg_and_recvmsg_udp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_SMALL),
+ Num = ?TPP_SMALL_NUM,
+ tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_udp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(20)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes) and medium (8K).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'medium' message test case, for IPv4.
+
+traffic_ping_pong_medium_sendmsg_and_recvmsg_udp4(suite) ->
+ [];
+traffic_ping_pong_medium_sendmsg_and_recvmsg_udp4(doc) ->
+ [];
+traffic_ping_pong_medium_sendmsg_and_recvmsg_udp4(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_MEDIUM),
+ Num = ?TPP_MEDIUM_NUM,
+ tc_try(traffic_ping_pong_medium_sendmsg_and_recvmsg_udp4,
+ fun() ->
+ ?TT(?SECS(30)),
+ InitState = #{domain => inet,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_udp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case is intended to test that the sendmsg and recvmsg
+%% functions by repeatedly sending a meassage between two entities.
+%% The same basic test case is used for three different message sizes;
+%% small (8 bytes) and medium (8K).
+%% The message is sent from A to B and then back again. This is
+%% repeated a set number of times (more times the small the message).
+%% This is the 'medium' message test case, for IPv6.
+
+traffic_ping_pong_medium_sendmsg_and_recvmsg_udp6(suite) ->
+ [];
+traffic_ping_pong_medium_sendmsg_and_recvmsg_udp6(doc) ->
+ [];
+traffic_ping_pong_medium_sendmsg_and_recvmsg_udp6(_Config) when is_list(_Config) ->
+ Msg = l2b(?TPP_MEDIUM),
+ Num = ?TPP_MEDIUM_NUM,
+ tc_try(traffic_ping_pong_medium_sendmsg_and_recvmsg_udp6,
+ fun() ->
+ not_yet_implemented(),
+ ?TT(?SECS(20)),
+ InitState = #{domain => ine6,
+ msg => Msg,
+ num => Num},
+ ok = traffic_ping_pong_sendmsg_and_recvmsg_udp(InitState)
+ end).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Ping-Pong for TCP
+
+traffic_ping_pong_send_and_recv_tcp(InitState) ->
+ Send = fun(Sock, Data) -> socket:send(Sock, Data) end,
+ Recv = fun(Sock, Sz) -> socket:recv(Sock, Sz) end,
+ InitState2 = InitState#{send => Send, % Send function
+ recv => Recv % Receive function
+ },
+ traffic_ping_pong_send_and_receive_tcp(InitState2).
+
+traffic_ping_pong_sendmsg_and_recvmsg_tcp(InitState) ->
+ Send = fun(Sock, Data) when is_binary(Data) ->
+ MsgHdr = #{iov => [Data]},
+ socket:sendmsg(Sock, MsgHdr);
+ (Sock, Data) when is_list(Data) -> %% We assume iovec...
+ MsgHdr = #{iov => Data},
+ socket:sendmsg(Sock, MsgHdr)
+ end,
+ Recv = fun(Sock, Sz) ->
+ case socket:recvmsg(Sock, Sz, 0) of
+ {ok, #{addr := undefined,
+ iov := [Data]}} ->
+ {ok, Data};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end,
+ InitState2 = InitState#{send => Send, % Send function
+ recv => Recv % Receive function
+ },
+ traffic_ping_pong_send_and_receive_tcp(InitState2).
+
+
+traffic_ping_pong_send_and_receive_tcp(#{msg := Msg} = InitState) ->
+ Fun = fun(Sock) ->
+ {ok, RcvSz} = socket:getopt(Sock, socket, rcvbuf),
+ ?SEV_IPRINT("RcvBuf is ~p (needs atleast ~p)",
+ [RcvSz, 16+size(Msg)]),
+ if (RcvSz < size(Msg)) ->
+ case socket:setopt(Sock,
+ socket, rcvbuf, 1024+size(Msg)) of
+ ok ->
+ ok;
+ {error, enobufs} ->
+ skip({failed_change, rcvbuf});
+ {error, Reason1} ->
+ ?FAIL({rcvbuf, Reason1})
+ end;
+ true ->
+ ok
+ end,
+ {ok, SndSz} = socket:getopt(Sock, socket, sndbuf),
+ ?SEV_IPRINT("SndBuf is ~p (needs atleast ~p)",
+ [SndSz, 16+size(Msg)]),
+ if (SndSz < size(Msg)) ->
+ case socket:setopt(Sock,
+ socket, sndbuf, 1024+size(Msg)) of
+ ok ->
+ ok;
+ {error, enobufs} ->
+ skip({failed_change, sndbuf});
+ {error, Reason2} ->
+ ?FAIL({sndbuf, Reason2})
+ end;
+ true ->
+ ok
+ end,
+ ok = socket:setopt(Sock, otp, rcvbuf, {12, 1024})
+ end,
+ traffic_ping_pong_send_and_receive_tcp2(InitState#{buf_init => Fun}).
+
+traffic_ping_pong_send_and_receive_tcp2(InitState) ->
+ ServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ {ok, State#{lsock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{lsock := LSock, local_sa := LSA} = State) ->
+ case socket:bind(LSock, LSA) of
+ {ok, Port} ->
+ {ok, State#{lport => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "maybe init buffers",
+ cmd => fun(#{lsock := LSock, buf_init := BufInit} = _State) ->
+ BufInit(LSock)
+ end},
+ #{desc => "make listen socket",
+ cmd => fun(#{lsock := LSock}) ->
+ socket:listen(LSock)
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, local_sa := LSA, lport := Port}) ->
+ ServerSA = LSA#{port => Port},
+ ?SEV_ANNOUNCE_READY(Tester, init, ServerSA),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (accept)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, accept)
+ end},
+ #{desc => "accept",
+ cmd => fun(#{lsock := LSock} = State) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ {ok, State#{csock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "create handler",
+ cmd => fun(State) ->
+ Handler = tpp_tcp_handler_create(),
+ ?SEV_IPRINT("handler created: ~p", [Handler]),
+ {ok, State#{handler => Handler}}
+ end},
+ #{desc => "monitor handler",
+ cmd => fun(#{handler := Handler} = _State) ->
+ _MRef = erlang:monitor(process, Handler),
+ ok
+ end},
+ #{desc => "transfer connection socket ownership to handler",
+ cmd => fun(#{handler := Handler, csock := Sock} = _State) ->
+ socket:setopt(Sock, otp, controlling_process, Handler)
+ end},
+ #{desc => "start handler",
+ cmd => fun(#{handler := Handler,
+ csock := Sock,
+ send := Send,
+ recv := Recv} = _State) ->
+ ?SEV_ANNOUNCE_START(Handler, {Sock, Send, Recv}),
+ ok
+ end},
+ #{desc => "await handler ready (init)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = State) ->
+ case ?SEV_AWAIT_READY(Handler, handler, init,
+ [{tester, Tester}]) of
+ ok ->
+ {ok, maps:remove(csock, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (accept)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, accept),
+ ok
+ end},
+ #{desc => "await continue (recv)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, recv,
+ [{handler, Handler}])
+ end},
+ #{desc => "order handler to recv",
+ cmd => fun(#{handler := Handler} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Handler, recv),
+ ok
+ end},
+ #{desc => "await handler ready (recv)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = State) ->
+ case ?SEV_AWAIT_READY(Handler, handler, recv,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ %% ?SEV_IPRINT("Result: ~p", [Result]),
+ {ok, State#{result => Result}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv)",
+ cmd => fun(#{tester := Tester,
+ result := Result} = State) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv, Result),
+ {ok, maps:remove(result, State)}
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "stop handler",
+ cmd => fun(#{handler := Handler}) ->
+ ?SEV_ANNOUNCE_TERMINATE(Handler),
+ ok
+ end},
+ #{desc => "await handler termination",
+ cmd => fun(#{handler := Handler} = State) ->
+ ?SEV_AWAIT_TERMINATION(Handler),
+ State1 = maps:remove(handler, State),
+ {ok, State1}
+ end},
+ #{desc => "close listen socket",
+ cmd => fun(#{lsock := Sock} = State) ->
+ (catch socket:close(Sock)),
+ {ok, maps:remove(lsock, State)}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, ServerSA} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ server_sa => ServerSA}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "create node",
+ cmd => fun(#{host := Host} = State) ->
+ case start_node(Host, client) of
+ {ok, Node} ->
+ ?SEV_IPRINT("(remote) client node ~p started",
+ [Node]),
+ {ok, State#{node => Node}};
+ {error, Reason, _} ->
+ {error, Reason}
+ end
+ end},
+ #{desc => "monitor client node",
+ cmd => fun(#{node := Node} = _State) ->
+ true = erlang:monitor_node(Node, true),
+ ok
+ end},
+ #{desc => "create remote client",
+ cmd => fun(#{node := Node} = State) ->
+ Pid = tpp_tcp_client_create(Node),
+ ?SEV_IPRINT("remote client created: ~p", [Pid]),
+ {ok, State#{rclient => Pid}}
+ end},
+ #{desc => "monitor remote client",
+ cmd => fun(#{rclient := Pid}) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "order remote client to start",
+ cmd => fun(#{rclient := RClient,
+ server_sa := ServerSA,
+ buf_init := BufInit,
+ send := Send,
+ recv := Recv}) ->
+ ?SEV_ANNOUNCE_START(RClient,
+ {ServerSA, BufInit, Send, Recv}),
+ ok
+ end},
+ #{desc => "await remote client ready",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = _State) ->
+ ?SEV_AWAIT_READY(RClient, rclient, init,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, connect,
+ [{rclient, RClient}]),
+ ok
+ end},
+ #{desc => "order remote client to continue (connect)",
+ cmd => fun(#{rclient := RClient}) ->
+ ?SEV_ANNOUNCE_CONTINUE(RClient, connect),
+ ok
+ end},
+ #{desc => "await remote client ready (connect)",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = _State) ->
+ ?SEV_AWAIT_READY(RClient, rclient, connect,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (connect)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, connect),
+ ok
+ end},
+ #{desc => "await continue (send)",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester,
+ send,
+ [{rclient, RClient}])
+ end},
+ #{desc => "order remote client to continue (send)",
+ cmd => fun(#{rclient := RClient,
+ msg := Msg,
+ num := Num} = State) ->
+ Data = {Msg, Num},
+ ?SEV_ANNOUNCE_CONTINUE(RClient, send, Data),
+ {ok, maps:remove(data, State)}
+ end},
+ #{desc => "await remote client ready (send)",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = State) ->
+ case ?SEV_AWAIT_READY(RClient, rclient, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ %% ?SEV_IPRINT("remote client result: "
+ %% "~n ~p", [Result]),
+ {ok, State#{result => Result}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (send)",
+ cmd => fun(#{tester := Tester, result := Result} = State) ->
+ ?SEV_ANNOUNCE_READY(Tester, send, Result),
+ {ok, maps:remove(result, State)}
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester,
+ [{rclient, RClient}]) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "stop remote client",
+ cmd => fun(#{rclient := RClient}) ->
+ ?SEV_ANNOUNCE_TERMINATE(RClient),
+ ok
+ end},
+ #{desc => "await remote client termination",
+ cmd => fun(#{rclient := RClient} = State) ->
+ ?SEV_AWAIT_TERMINATION(RClient),
+ State1 = maps:remove(rclient, State),
+ {ok, State1}
+ end},
+ #{desc => "stop client node",
+ cmd => fun(#{node := Node} = _State) ->
+ stop_node(Node)
+ end},
+ #{desc => "await client node termination",
+ cmd => fun(#{node := Node} = State) ->
+ receive
+ {nodedown, Node} ->
+ {ok, maps:remove(node, State)}
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the server
+ #{desc => "order server start",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Pid} = State) ->
+ {ok, ServerSA} = ?SEV_AWAIT_READY(Pid, server, init),
+ {ok, State#{server_sa => ServerSA}}
+ end},
+
+ %% Start the client
+ #{desc => "order client start",
+ cmd => fun(#{client := Pid,
+ server_sa := ServerSA} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, ServerSA),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client, init)
+ end},
+
+ %% The actual test
+ #{desc => "order server continue (accept)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, accept),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client continue (connect)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, connect),
+ ok
+ end},
+ #{desc => "await server ready (accept)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Server, server, accept,
+ [{client, Client}]),
+ ok
+ end},
+ #{desc => "await client ready (connect)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ ?SEV_AWAIT_READY(Client, client, connect,
+ [{server, Server}])
+ end},
+ #{desc => "order server continue (recv)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client continue (send)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, send),
+ ok
+ end},
+ #{desc => "await client ready (send)",
+ cmd => fun(#{server := Server,
+ client := Client} = State) ->
+ case ?SEV_AWAIT_READY(Client, client, send,
+ [{server, Server}]) of
+ {ok, {_, _, _, _} = Result} ->
+ ?SEV_IPRINT("client result: "
+ "~n ~p", [Result]),
+ {ok, State#{client_result => Result}};
+ {ok, BadResult} ->
+ ?SEV_EPRINT("client result: "
+ "~n ~p", [BadResult]),
+ {error, {invalid_client_result, BadResult}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await server ready (recv)",
+ cmd => fun(#{server := Server,
+ client := Client,
+ num := Num} = State) ->
+ case ?SEV_AWAIT_READY(Server, server, recv,
+ [{client, Client}]) of
+ {ok, {Num, _, _, _, _} = Result} ->
+ ?SEV_IPRINT("server result: "
+ "~n ~p", [Result]),
+ Result2 = erlang:delete_element(1, Result),
+ {ok, State#{server_result => Result2}};
+ {ok, BadResult} ->
+ ?SEV_EPRINT("bad server result: "
+ "~n ~p", [BadResult]),
+ {error, {invalid_server_result, BadResult}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "present result",
+ cmd => fun(#{server_result := SRes,
+ client_result := CRes,
+ num := Num} = State) ->
+ {SSent, SReceived, SStart, SStop} = SRes,
+ {CSent, CReceived, CStart, CStop} = CRes,
+ STime = tdiff(SStart, SStop),
+ CTime = tdiff(CStart, CStop),
+ %% Note that the sizes we are counting is only
+ %% the "data" part of the messages. There is also
+ %% fixed header for each message, which of cource
+ %% is small for the large messages, but comparatively
+ %% big for the small messages!
+ ?SEV_IPRINT("Results: ~w messages exchanged"
+ "~n Server: ~w msec"
+ "~n ~.2f msec/message (roundtrip)"
+ "~n ~.2f messages/msec (roundtrip)"
+ "~n ~w bytes/msec sent"
+ "~n ~w bytes/msec received"
+ "~n Client: ~w msec"
+ "~n ~.2f msec/message (roundtrip)"
+ "~n ~.2f messages/msec (roundtrip)"
+ "~n ~w bytes/msec sent"
+ "~n ~w bytes/msec received",
+ [Num,
+ STime,
+ STime / Num,
+ Num / STime,
+ SSent div STime,
+ SReceived div STime,
+ CTime,
+ CTime / Num,
+ Num / CTime,
+ CSent div CTime,
+ CReceived div CTime]),
+ State1 = maps:remove(server_result, State),
+ State2 = maps:remove(client_result, State1),
+ {ok, State2}
+ end},
+
+ %% Terminations
+ #{desc => "order client to terminate",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await client termination",
+ cmd => fun(#{client := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(client, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order server to terminate",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await server termination",
+ cmd => fun(#{server := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(server, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start server evaluator"),
+ ServerInitState = #{domain => maps:get(domain, InitState),
+ recv => maps:get(recv, InitState),
+ send => maps:get(send, InitState),
+ buf_init => maps:get(buf_init, InitState)},
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("start client evaluator(s)"),
+ ClientInitState = InitState#{host => local_host()},
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("start 'tester' evaluator"),
+ TesterInitState = #{server => Server#ev.pid,
+ client => Client#ev.pid,
+ num => maps:get(num, InitState)},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+tpp_tcp_handler_create() ->
+ Self = self(),
+ erlang:spawn(fun() -> tpp_tcp_handler(Self) end).
+
+tpp_tcp_handler(Parent) ->
+ tpp_tcp_handler_init(Parent),
+ {Sock, Send, Recv} = tpp_tcp_handler_await_start(Parent),
+ tpp_tcp_handler_announce_ready(Parent, init),
+ tpp_tcp_handler_await_continue(Parent, recv),
+ Result = tpp_tcp_handler_msg_exchange(Sock, Send, Recv),
+ tpp_tcp_handler_announce_ready(Parent, recv, Result),
+ Reason = tpp_tcp_handler_await_terminate(Parent),
+ ?SEV_IPRINT("terminating"),
+ exit(Reason).
+
+tpp_tcp_handler_init(Parent) ->
+ put(sname, "handler"),
+ ?SEV_IPRINT("init"),
+ _MRef = erlang:monitor(process, Parent),
+ ok.
+
+tpp_tcp_handler_await_start(Parent) ->
+ ?SEV_IPRINT("await start"),
+ ?SEV_AWAIT_START(Parent).
+
+tpp_tcp_handler_announce_ready(Parent, Slogan) ->
+ ?SEV_IPRINT("announce ready (~p)", [Slogan]),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan).
+tpp_tcp_handler_announce_ready(Parent, Slogan, Extra) ->
+ ?SEV_IPRINT("announce ready (~p)", [Slogan]),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan, Extra).
+
+tpp_tcp_handler_await_continue(Parent, Slogan) ->
+ ?SEV_IPRINT("await continue (~p)", [Slogan]),
+ case ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan) of
+ ok ->
+ %% ?SEV_IPRINT("continue (~p): ok", [Slogan]),
+ ok;
+ {error, Reason} ->
+ ?SEV_EPRINT("continue (~p): error"
+ "~n ~p", [Slogan, Reason]),
+ exit({continue, Slogan, Reason})
+ end.
+
+tpp_tcp_handler_await_terminate(Parent) ->
+ ?SEV_IPRINT("await terminate"),
+ case ?SEV_AWAIT_TERMINATE(Parent, parent) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ Reason
+ end.
+
+tpp_tcp_handler_msg_exchange(Sock, Send, Recv) ->
+ tpp_tcp_handler_msg_exchange_loop(Sock, Send, Recv, 0, 0, 0, undefined).
+
+tpp_tcp_handler_msg_exchange_loop(Sock, Send, Recv, N, Sent, Received, Start) ->
+ %% ?SEV_IPRINT("[~w] try receive", [N]),
+ case tpp_tcp_recv_req(Sock, Recv) of
+ {ok, Msg, RecvSz} ->
+ NewStart = if (Start =:= undefined) -> ?LIB:timestamp();
+ true -> Start end,
+ %% ?SEV_IPRINT("[~w] received - now try send", [N]),
+ case tpp_tcp_send_rep(Sock, Send, Msg) of
+ {ok, SendSz} ->
+ tpp_tcp_handler_msg_exchange_loop(Sock, Send, Recv,
+ N+1,
+ Sent+SendSz,
+ Received+RecvSz,
+ NewStart);
+ {error, SReason} ->
+ ?SEV_EPRINT("send (~w): ~p", [N, SReason]),
+ exit({send, SReason, N})
+ end;
+ %% {error, timeout} ->
+ %% ?SEV_IPRINT("timeout(~w) - try again", [N]),
+ %% case Send(Sock, list_to_binary("ping")) of
+ %% ok ->
+ %% exit({'ping-send', ok, N});
+ %% {error, Reason} ->
+ %% exit({'ping-send', Reason, N})
+ %% end;
+ {error, closed} ->
+ ?SEV_IPRINT("closed - we are done: ~w, ~w, ~w", [N, Sent, Received]),
+ Stop = ?LIB:timestamp(),
+ {N, Sent, Received, Start, Stop};
+ {error, RReason} ->
+ ?SEV_EPRINT("recv (~w): ~p", [N, RReason]),
+ exit({recv, RReason, N})
+ end.
+
+%% The (remote) client process
+
+tpp_tcp_client_create(Node) ->
+ Self = self(),
+ Fun = fun() -> tpp_tcp_client(Self) end,
+ erlang:spawn(Node, Fun).
+
+tpp_tcp_client(Parent) ->
+ tpp_tcp_client_init(Parent),
+ {ServerSA, BufInit, Send, Recv} = tpp_tcp_client_await_start(Parent),
+ Domain = maps:get(family, ServerSA),
+ Sock = tpp_tcp_client_sock_open(Domain, BufInit),
+ tpp_tcp_client_sock_bind(Sock, Domain),
+ tpp_tcp_client_announce_ready(Parent, init),
+ tpp_tcp_client_await_continue(Parent, connect),
+ tpp_tcp_client_sock_connect(Sock, ServerSA),
+ tpp_tcp_client_announce_ready(Parent, connect),
+ {InitMsg, Num} = tpp_tcp_client_await_continue(Parent, send),
+ Result = tpp_tcp_client_msg_exchange(Sock, Send, Recv, InitMsg, Num),
+ tpp_tcp_client_announce_ready(Parent, send, Result),
+ Reason = tpp_tcp_client_await_terminate(Parent),
+ tpp_tcp_client_sock_close(Sock),
+ ?SEV_IPRINT("terminating"),
+ exit(Reason).
+
+tpp_tcp_client_init(Parent) ->
+ put(sname, "rclient"),
+ ?SEV_IPRINT("init"),
+ _MRef = erlang:monitor(process, Parent),
+ ok.
+
+tpp_tcp_client_await_start(Parent) ->
+ ?SEV_IPRINT("await start"),
+ ?SEV_AWAIT_START(Parent).
+
+tpp_tcp_client_announce_ready(Parent, Slogan) ->
+ ?SEV_IPRINT("announce ready (~p)", [Slogan]),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan).
+tpp_tcp_client_announce_ready(Parent, Slogan, Extra) ->
+ ?SEV_IPRINT("announce ready (~p): ~p", [Slogan, Extra]),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan, Extra).
+
+tpp_tcp_client_await_continue(Parent, Slogan) ->
+ ?SEV_IPRINT("await continue (~p)", [Slogan]),
+ case ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan) of
+ ok ->
+ ?SEV_IPRINT("continue (~p): ok", [Slogan]),
+ ok;
+ {ok, Data} ->
+ ?SEV_IPRINT("continue (~p): ok with data", [Slogan]),
+ Data;
+ {error, Reason} ->
+ ?SEV_EPRINT("continue (~p): error"
+ "~n ~p", [Slogan, Reason]),
+ exit({continue, Slogan, Reason})
+ end.
+
+tpp_tcp_client_await_terminate(Parent) ->
+ ?SEV_IPRINT("await terminate"),
+ case ?SEV_AWAIT_TERMINATE(Parent, parent) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ Reason
+ end.
+
+tpp_tcp_client_msg_exchange(Sock, Send, Recv, InitMsg, Num) ->
+ Start = ?LIB:timestamp(),
+ tpp_tcp_client_msg_exchange_loop(Sock, Send, Recv, InitMsg,
+ Num, 0, 0, 0, Start).
+
+tpp_tcp_client_msg_exchange_loop(Sock, _Send, _Recv, _Msg,
+ Num, Num, Sent, Received,
+ Start) ->
+ Stop = ?LIB:timestamp(),
+ case socket:close(Sock) of
+ ok ->
+ {Sent, Received, Start, Stop};
+ {error, Reason} ->
+ exit({failed_closing, Reason})
+ end;
+tpp_tcp_client_msg_exchange_loop(Sock, Send, Recv, Data,
+ Num, N, Sent, Received, Start) ->
+ %% d("tpp_tcp_client_msg_exchange_loop(~w,~w) try send", [Num,N]),
+ case tpp_tcp_send_req(Sock, Send, Data) of
+ {ok, SendSz} ->
+ %% d("tpp_tcp_client_msg_exchange_loop(~w,~w) sent - "
+ %% "now try recv", [Num,N]),
+ case tpp_tcp_recv_rep(Sock, Recv) of
+ {ok, NewData, RecvSz} ->
+ tpp_tcp_client_msg_exchange_loop(Sock, Send, Recv,
+ NewData, Num, N+1,
+ Sent+SendSz,
+ Received+RecvSz,
+ Start);
+ {error, RReason} ->
+ ?SEV_EPRINT("recv (~w of ~w): ~p", [N, Num, RReason]),
+ exit({recv, RReason, N})
+ end;
+ {error, SReason} ->
+ ?SEV_EPRINT("send (~w of ~w): ~p", [N, Num, SReason]),
+ exit({send, SReason, N})
+ end.
+
+tpp_tcp_client_sock_open(Domain, BufInit) ->
+ case socket:open(Domain, stream, tcp) of
+ {ok, Sock} ->
+ ok = BufInit(Sock),
+ Sock;
+ {error, Reason} ->
+ exit({open_failed, Reason})
+ end.
+
+tpp_tcp_client_sock_bind(Sock, Domain) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain,
+ addr => LAddr},
+ case socket:bind(Sock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, Reason} ->
+ exit({bind, Reason})
+ end.
+
+tpp_tcp_client_sock_connect(Sock, ServerSA) ->
+ case socket:connect(Sock, ServerSA) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({connect, Reason})
+ end.
+
+tpp_tcp_client_sock_close(Sock) ->
+ case socket:close(Sock) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({close, Reason})
+ end.
+
+-define(TPP_REQUEST, 1).
+-define(TPP_REPLY, 2).
+
+tpp_tcp_recv_req(Sock, Recv) ->
+ tpp_tcp_recv(Sock, Recv, ?TPP_REQUEST).
+
+tpp_tcp_recv_rep(Sock, Recv) ->
+ tpp_tcp_recv(Sock, Recv, ?TPP_REPLY).
+
+tpp_tcp_recv(Sock, Recv, Tag) ->
+ case Recv(Sock, 0) of
+ {ok, <<Tag:32/integer, Sz:32/integer, Data/binary>> = Msg}
+ when (Sz =:= size(Data)) ->
+ %% We got it all
+ {ok, Data, size(Msg)};
+ {ok, <<Tag:32/integer, Sz:32/integer, Data/binary>> = Msg} ->
+ Remains = Sz - size(Data),
+ tpp_tcp_recv(Sock, Recv, Tag, Remains, size(Msg), [Data]);
+ {ok, <<Tag:32/integer, _/binary>>} ->
+ {error, {invalid_msg_tag, Tag}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+tpp_tcp_recv(Sock, Recv, Tag, Remaining, AccSz, Acc) ->
+ case Recv(Sock, Remaining) of
+ {ok, Data} when (Remaining =:= size(Data)) ->
+ %% We got the rest
+ TotSz = AccSz + size(Data),
+ {ok, erlang:iolist_to_binary(lists:reverse([Data | Acc])), TotSz};
+ {ok, Data} when (Remaining > size(Data)) ->
+ tpp_tcp_recv(Sock, Recv, Tag,
+ Remaining - size(Data), AccSz + size(Data),
+ [Data | Acc]);
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+tpp_tcp_send_req(Sock, Send, Data) ->
+ tpp_tcp_send(Sock, Send, ?TPP_REQUEST, Data).
+
+tpp_tcp_send_rep(Sock, Send, Data) ->
+ tpp_tcp_send(Sock, Send, ?TPP_REPLY, Data).
+
+tpp_tcp_send(Sock, Send, Tag, Data) ->
+ DataSz = size(Data),
+ Msg = <<Tag:32/integer, DataSz:32/integer, Data/binary>>,
+ tpp_tcp_send_msg(Sock, Send, Msg, 0).
+
+tpp_tcp_send_msg(Sock, Send, Msg, AccSz) when is_binary(Msg) ->
+ case Send(Sock, Msg) of
+ ok ->
+ {ok, AccSz+size(Msg)};
+ {ok, Rest} -> % This is an IOVec
+ RestBin = list_to_binary(Rest),
+ tpp_tcp_send_msg(Sock, Send, RestBin, AccSz+(size(Msg)-size(RestBin)));
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+%% size_of_data(Data) when is_binary(Data) ->
+%% size(Data);
+%% size_of_data(Data) when is_list(Data) ->
+%% size_of_iovec(Data, 0).
+
+%% size_of_iovec([], Sz) ->
+%% Sz;
+%% size_of_iovec([B|IOVec], Sz) ->
+%% size_of_iovec(IOVec, Sz+size(B)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Ping-Pong for UDP
+
+traffic_ping_pong_sendto_and_recvfrom_udp(InitState) ->
+ Send = fun(Sock, Data, Dest) ->
+ socket:sendto(Sock, Data, Dest)
+ end,
+ Recv = fun(Sock, Sz) ->
+ socket:recvfrom(Sock, Sz)
+ end,
+ InitState2 = InitState#{send => Send, % Send function
+ recv => Recv % Receive function
+ },
+ traffic_ping_pong_send_and_receive_udp(InitState2).
+
+traffic_ping_pong_sendmsg_and_recvmsg_udp(InitState) ->
+ Send = fun(Sock, Data, Dest) when is_binary(Data) ->
+ MsgHdr = #{addr => Dest, iov => [Data]},
+ socket:sendmsg(Sock, MsgHdr);
+ (Sock, Data, Dest) when is_list(Data) -> %% We assume iovec...
+ MsgHdr = #{addr => Dest, iov => Data},
+ socket:sendmsg(Sock, MsgHdr)
+ end,
+ Recv = fun(Sock, Sz) ->
+ case socket:recvmsg(Sock, Sz, 0) of
+ {ok, #{addr := Source,
+ iov := [Data]}} ->
+ {ok, {Source, Data}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end,
+ InitState2 = InitState#{send => Send, % Send function
+ recv => Recv % Receive function
+ },
+ traffic_ping_pong_send_and_receive_udp(InitState2).
+
+
+traffic_ping_pong_send_and_receive_udp(#{msg := Msg} = InitState) ->
+ Fun = fun(Sock) ->
+ {ok, RcvSz} = socket:getopt(Sock, socket, rcvbuf),
+ if (RcvSz =< (8+size(Msg))) ->
+ i("adjust socket rcvbuf buffer size"),
+ ok = socket:setopt(Sock, socket, rcvbuf, 1024+size(Msg));
+ true ->
+ ok
+ end,
+ {ok, SndSz} = socket:getopt(Sock, socket, sndbuf),
+ if (SndSz =< (8+size(Msg))) ->
+ i("adjust socket sndbuf buffer size"),
+ ok = socket:setopt(Sock, socket, sndbuf, 1024+size(Msg));
+ true ->
+ ok
+ end,
+ {ok, OtpRcvBuf} = socket:getopt(Sock, otp, rcvbuf),
+ if
+ (OtpRcvBuf =< (8+size(Msg))) ->
+ i("adjust otp rcvbuf buffer size"),
+ ok = socket:setopt(Sock, otp, rcvbuf, 1024+size(Msg));
+ true ->
+ ok
+ end
+ end,
+ traffic_ping_pong_send_and_receive_udp2(InitState#{buf_init => Fun}).
+
+traffic_ping_pong_send_and_receive_udp2(InitState) ->
+ ServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "which local address",
+ cmd => fun(#{domain := Domain} = State) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain, addr => LAddr},
+ {ok, State#{local_sa => LSA}}
+ end},
+ #{desc => "create listen socket",
+ cmd => fun(#{domain := Domain} = State) ->
+ case socket:open(Domain, dgram, udp) of
+ {ok, Sock} ->
+ {ok, State#{sock => Sock}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "bind to local address",
+ cmd => fun(#{sock := Sock, local_sa := LSA} = State) ->
+ case socket:bind(Sock, LSA) of
+ {ok, Port} ->
+ {ok, State#{port => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "maybe init buffers",
+ cmd => fun(#{sock := Sock, buf_init := BufInit} = _State) ->
+ BufInit(Sock)
+ end},
+ #{desc => "create handler",
+ cmd => fun(State) ->
+ Handler = tpp_udp_server_handler_create(),
+ ?SEV_IPRINT("handler created: ~p", [Handler]),
+ {ok, State#{handler => Handler}}
+ end},
+ #{desc => "monitor handler",
+ cmd => fun(#{handler := Handler} = _State) ->
+ _MRef = erlang:monitor(process, Handler),
+ ok
+ end},
+ #{desc => "start handler",
+ cmd => fun(#{handler := Handler,
+ sock := Sock,
+ send := Send,
+ recv := Recv} = _State) ->
+ ?SEV_ANNOUNCE_START(Handler, {Sock, Send, Recv}),
+ ok
+ end},
+ #{desc => "await handler ready (init)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = State) ->
+ case ?SEV_AWAIT_READY(Handler, handler, init,
+ [{tester, Tester}]) of
+ ok ->
+ {ok, maps:remove(csock, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester, local_sa := LSA, port := Port}) ->
+ ServerSA = LSA#{port => Port},
+ ?SEV_ANNOUNCE_READY(Tester, init, ServerSA),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (recv)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, recv,
+ [{handler, Handler}])
+ end},
+ #{desc => "order handler to recv",
+ cmd => fun(#{handler := Handler} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Handler, recv),
+ ok
+ end},
+ #{desc => "await continue (close)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, close,
+ [{handler, Handler}])
+ end},
+
+ ?SEV_SLEEP(?SECS(1)),
+
+ #{desc => "close socket",
+ cmd => fun(#{sock := Sock} = State) ->
+ %% socket:setopt(Sock, otp, debug, true),
+ case socket:close(Sock) of
+ ok ->
+ {ok, maps:remove(sock, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (close)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_ANNOUNCE_READY(Tester, close),
+ ok
+ end},
+ #{desc => "await handler ready (recv)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = State) ->
+ case ?SEV_AWAIT_READY(Handler, handler, recv,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ %% ?SEV_IPRINT("Result: ~p", [Result]),
+ {ok, State#{result => Result}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (recv)",
+ cmd => fun(#{tester := Tester,
+ result := Result} = State) ->
+ ?SEV_ANNOUNCE_READY(Tester, recv, Result),
+ {ok, maps:remove(result, State)}
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "stop handler",
+ cmd => fun(#{handler := Handler}) ->
+ ?SEV_ANNOUNCE_TERMINATE(Handler),
+ ok
+ end},
+ #{desc => "await handler termination",
+ cmd => fun(#{handler := Handler} = State) ->
+ ?SEV_AWAIT_TERMINATION(Handler),
+ State1 = maps:remove(handler, State),
+ {ok, State1}
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, ServerSA} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ server_sa => ServerSA}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+ %% *** Init part ***
+ #{desc => "create node",
+ cmd => fun(#{host := Host} = State) ->
+ case start_node(Host, client) of
+ {ok, Node} ->
+ ?SEV_IPRINT("(remote) client node ~p started",
+ [Node]),
+ {ok, State#{node => Node}};
+ {error, Reason, _} ->
+ {error, Reason}
+ end
+ end},
+ #{desc => "monitor client node",
+ cmd => fun(#{node := Node} = _State) ->
+ true = erlang:monitor_node(Node, true),
+ ok
+ end},
+ #{desc => "create (remote) handler",
+ cmd => fun(#{node := Node} = State) ->
+ Pid = tpp_udp_client_handler_create(Node),
+ ?SEV_IPRINT("handler created: ~p", [Pid]),
+ {ok, State#{handler => Pid}}
+ end},
+ #{desc => "monitor remote handler",
+ cmd => fun(#{handler := Pid}) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "order remote handler to start",
+ cmd => fun(#{handler := Handler,
+ server_sa := ServerSA,
+ buf_init := BufInit,
+ send := Send,
+ recv := Recv}) ->
+ ?SEV_ANNOUNCE_START(Handler,
+ {ServerSA, BufInit, Send, Recv}),
+ ok
+ end},
+ #{desc => "await (remote) handler ready",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = _State) ->
+ ?SEV_AWAIT_READY(Handler, handler, init,
+ [{tester, Tester}])
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+ %% The actual test
+ #{desc => "await continue (send)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester,
+ send,
+ [{handler, Handler}])
+ end},
+ #{desc => "order handler to continue (send)",
+ cmd => fun(#{handler := Handler,
+ msg := Msg,
+ num := Num} = State) ->
+ Data = {Msg, Num},
+ ?SEV_ANNOUNCE_CONTINUE(Handler, send, Data),
+ {ok, maps:remove(data, State)}
+ end},
+ #{desc => "await remote handler ready (send)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = State) ->
+ case ?SEV_AWAIT_READY(Handler, handler, send,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ %% ?SEV_IPRINT("remote client result: "
+ %% "~n ~p", [Result]),
+ {ok, State#{result => Result}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (send)",
+ cmd => fun(#{tester := Tester, result := Result} = State) ->
+ ?SEV_ANNOUNCE_READY(Tester, send, Result),
+ {ok, maps:remove(result, State)}
+ end},
+
+ %% Termination
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester,
+ handler := Handler} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester,
+ [{handler, Handler}]) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "stop (remote) handler",
+ cmd => fun(#{handler := Handler}) ->
+ ?SEV_ANNOUNCE_TERMINATE(Handler),
+ ok
+ end},
+ #{desc => "await (remote) handler termination",
+ cmd => fun(#{handler := Handler} = State) ->
+ ?SEV_AWAIT_TERMINATION(Handler),
+ State1 = maps:remove(handler, State),
+ {ok, State1}
+ end},
+ #{desc => "stop client node",
+ cmd => fun(#{node := Node} = _State) ->
+ stop_node(Node)
+ end},
+ #{desc => "await client node termination",
+ cmd => fun(#{node := Node} = State) ->
+ receive
+ {nodedown, Node} ->
+ {ok, maps:remove(node, State)}
+ end
+ end},
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the server
+ #{desc => "order server start",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Pid} = State) ->
+ {ok, ServerSA} = ?SEV_AWAIT_READY(Pid, server, init),
+ {ok, State#{server_sa => ServerSA}}
+ end},
+
+ %% Start the client
+ #{desc => "order client start",
+ cmd => fun(#{client := Pid,
+ server_sa := ServerSA} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, ServerSA),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, client, init)
+ end},
+
+ %% The actual test
+ #{desc => "order server continue (recv)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, recv),
+ ok
+ end},
+ ?SEV_SLEEP(?SECS(1)),
+ #{desc => "order client continue (send)",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, send),
+ ok
+ end},
+ #{desc => "await client ready (send)",
+ cmd => fun(#{server := Server,
+ client := Client} = State) ->
+ case ?SEV_AWAIT_READY(Client, client, send,
+ [{server, Server}]) of
+ {ok, {_, _, _, _} = Result} ->
+ ?SEV_IPRINT("client result: "
+ "~n ~p", [Result]),
+ {ok, State#{client_result => Result}};
+ {ok, BadResult} ->
+ ?SEV_EPRINT("client result: "
+ "~n ~p", [BadResult]),
+ {error, {invalid_client_result, BadResult}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order server continue (close)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Pid, close),
+ ok
+ end},
+ #{desc => "await server ready (close)",
+ cmd => fun(#{server := Pid} = _State) ->
+ ok = ?SEV_AWAIT_READY(Pid, server, close)
+ end},
+ %% Because of the way we control the server, there is no real
+ %% point in collecting statistics from it (the time will include
+ %% our communication with it).
+ #{desc => "await server ready (recv)",
+ cmd => fun(#{server := Server,
+ client := Client} = _State) ->
+ case ?SEV_AWAIT_READY(Server, server, recv,
+ [{client, Client}]) of
+ {ok, _Result} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "present result",
+ cmd => fun(#{client_result := CRes,
+ num := Num} = State) ->
+ {CSent, CReceived, CStart, CStop} = CRes,
+ CTime = tdiff(CStart, CStop),
+ %% Note that the sizes we are counting is only
+ %% the "data" part of the messages. There is also
+ %% fixed header for each message, which of cource
+ %% is small for the large messages, but comparatively
+ %% big for the small messages!
+ ?SEV_IPRINT("Results: ~w messages exchanged"
+ "~n Client: ~w msec"
+ "~n ~.2f msec/message (roundtrip)"
+ "~n ~.2f messages/msec (roundtrip)"
+ "~n ~w bytes/msec sent"
+ "~n ~w bytes/msec received",
+ [Num,
+ CTime,
+ CTime / Num,
+ Num / CTime,
+ CSent div CTime,
+ CReceived div CTime]),
+ State1 = maps:remove(client_result, State),
+ {ok, State1}
+ end},
+
+ %% Terminations
+ #{desc => "order client to terminate",
+ cmd => fun(#{client := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await client termination",
+ cmd => fun(#{client := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(client, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "order server to terminate",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Pid),
+ ok
+ end},
+ #{desc => "await server termination",
+ cmd => fun(#{server := Pid} = State) ->
+ case ?SEV_AWAIT_TERMINATION(Pid) of
+ ok ->
+ State1 = maps:remove(server, State),
+ {ok, State1};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+
+ i("start server evaluator"),
+ ServerInitState = #{domain => maps:get(domain, InitState),
+ recv => maps:get(recv, InitState),
+ send => maps:get(send, InitState),
+ buf_init => maps:get(buf_init, InitState)},
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("start client evaluator(s)"),
+ ClientInitState = InitState#{host => local_host()},
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("start 'tester' evaluator"),
+ TesterInitState = #{server => Server#ev.pid,
+ client => Client#ev.pid,
+ num => maps:get(num, InitState)},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator"),
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+
+%% Server side handler process
+%% We don't actually need a separate process for this socket,
+%% but we do it anyway to simplify the sequence.
+tpp_udp_server_handler_create() ->
+ Self = self(),
+ erlang:spawn(fun() -> tpp_udp_server_handler(Self) end).
+
+tpp_udp_server_handler(Parent) ->
+ tpp_udp_server_handler_init(Parent),
+ {Sock, Send, Recv} = tpp_udp_handler_await_start(Parent),
+ tpp_udp_handler_announce_ready(Parent, init),
+ tpp_udp_handler_await_continue(Parent, recv),
+ Result = tpp_udp_server_handler_msg_exchange(Sock, Send, Recv),
+ tpp_udp_handler_announce_ready(Parent, recv, Result),
+ Reason = tpp_udp_handler_await_terminate(Parent),
+ ?SEV_IPRINT("terminating"),
+ exit(Reason).
+
+tpp_udp_server_handler_init(Parent) ->
+ put(sname, "shandler"),
+ ?SEV_IPRINT("init"),
+ _MRef = erlang:monitor(process, Parent),
+ ok.
+
+tpp_udp_server_handler_msg_exchange(Sock, Send, Recv) ->
+ tpp_udp_server_handler_msg_exchange_loop(Sock, Send, Recv,
+ 0, 0, 0, undefined).
+
+tpp_udp_server_handler_msg_exchange_loop(Sock, Send, Recv,
+ N, Sent, Received, Start) ->
+ %% ?SEV_IPRINT("[~w] try receive", [N]),
+ %% if
+ %% (N =:= (?TPP_SMALL_NUM-2)) ->
+ %% ?SEV_IPRINT("[~w] try receive", [N]),
+ %% socket:setopt(Sock, otp, debug, true);
+ %% true -> ok
+ %% end,
+ try tpp_udp_recv_req(Sock, Recv) of
+ {ok, Msg, RecvSz, From} ->
+ NewStart = if (Start =:= undefined) -> ?LIB:timestamp();
+ true -> Start end,
+ %% ?SEV_IPRINT("[~w] received - now try send", [N]),
+ try tpp_udp_send_rep(Sock, Send, Msg, From) of
+ {ok, SendSz} ->
+ tpp_udp_server_handler_msg_exchange_loop(Sock, Send, Recv,
+ N+1,
+ Sent+SendSz,
+ Received+RecvSz,
+ NewStart);
+ {error, SReason} ->
+ ?SEV_EPRINT("send (~w): ~p", [N, SReason]),
+ exit({send, SReason, N})
+ catch
+ SC:SE:SS ->
+ exit({send, {SC, SE, SS}, N})
+ end;
+ {error, closed} ->
+ ?SEV_IPRINT("closed - we are done: ~w, ~w, ~w",
+ [N, Sent, Received]),
+ Stop = ?LIB:timestamp(),
+ {N, Sent, Received, Start, Stop};
+ {error, RReason} ->
+ ?SEV_EPRINT("recv (~w): ~p", [N, RReason]),
+ exit({recv, RReason, N})
+ catch
+ RC:RE:RS ->
+ exit({recv, {RC, RE, RS}, N})
+ end.
+
+
+%% The (remote) client side handler process
+
+tpp_udp_client_handler_create(Node) ->
+ Self = self(),
+ Fun = fun() -> put(sname, "chandler"), tpp_udp_client_handler(Self) end,
+ erlang:spawn(Node, Fun).
+
+tpp_udp_client_handler(Parent) ->
+ tpp_udp_client_handler_init(Parent),
+ ?SEV_IPRINT("await start command"),
+ {ServerSA, BufInit, Send, Recv} = tpp_udp_handler_await_start(Parent),
+ ?SEV_IPRINT("start command with"
+ "~n ServerSA: ~p", [ServerSA]),
+ Domain = maps:get(family, ServerSA),
+ Sock = tpp_udp_sock_open(Domain, BufInit),
+ tpp_udp_sock_bind(Sock, Domain),
+ ?SEV_IPRINT("announce ready", []),
+ tpp_udp_handler_announce_ready(Parent, init),
+ {InitMsg, Num} = tpp_udp_handler_await_continue(Parent, send),
+ ?SEV_IPRINT("received continue with"
+ "~n Num: ~p", [Num]),
+ Result = tpp_udp_client_handler_msg_exchange(Sock, ServerSA,
+ Send, Recv, InitMsg, Num),
+ ?SEV_IPRINT("ready"),
+ tpp_udp_handler_announce_ready(Parent, send, Result),
+ ?SEV_IPRINT("await terminate"),
+ Reason = tpp_udp_handler_await_terminate(Parent),
+ ?SEV_IPRINT("terminate with ~p", [Reason]),
+ tpp_udp_sock_close(Sock),
+ ?SEV_IPRINT("terminating"),
+ exit(Reason).
+
+tpp_udp_client_handler_init(Parent) ->
+ put(sname, "chandler"),
+ ?SEV_IPRINT("init"),
+ _MRef = erlang:monitor(process, Parent),
+ ok.
+
+tpp_udp_client_handler_msg_exchange(Sock, ServerSA,
+ Send, Recv, InitMsg, Num) ->
+ Start = ?LIB:timestamp(),
+ tpp_udp_client_handler_msg_exchange_loop(Sock, ServerSA,
+ Send, Recv, InitMsg,
+ Num, 0, 0, 0, Start).
+
+tpp_udp_client_handler_msg_exchange_loop(_Sock, _Dest, _Send, _Recv, _Msg,
+ Num, Num, Sent, Received,
+ Start) ->
+ Stop = ?LIB:timestamp(),
+ {Sent, Received, Start, Stop};
+tpp_udp_client_handler_msg_exchange_loop(Sock, Dest, Send, Recv, Data,
+ Num, N, Sent, Received, Start) ->
+ case tpp_udp_send_req(Sock, Send, Data, Dest) of
+ {ok, SendSz} ->
+ case tpp_udp_recv_rep(Sock, Recv) of
+ {ok, NewData, RecvSz, Dest} ->
+ tpp_udp_client_handler_msg_exchange_loop(Sock, Dest,
+ Send, Recv,
+ NewData, Num, N+1,
+ Sent+SendSz,
+ Received+RecvSz,
+ Start);
+ {error, RReason} ->
+ ?SEV_EPRINT("recv (~w of ~w): ~p", [N, Num, RReason]),
+ exit({recv, RReason, N})
+ end;
+ {error, SReason} ->
+ ?SEV_EPRINT("send (~w of ~w): ~p", [N, Num, SReason]),
+ exit({send, SReason, N})
+ end.
+
+
+tpp_udp_recv_req(Sock, Recv) ->
+ tpp_udp_recv(Sock, Recv, ?TPP_REQUEST).
+
+tpp_udp_recv_rep(Sock, Recv) ->
+ tpp_udp_recv(Sock, Recv, ?TPP_REPLY).
+
+tpp_udp_recv(Sock, Recv, Tag) ->
+ %% ok = socket:setopt(Sock, otp, debug, true),
+ try Recv(Sock, 0) of
+ {ok, {Source, <<Tag:32/integer, Sz:32/integer, Data/binary>> = Msg}}
+ when (Sz =:= size(Data)) ->
+ %% ok = socket:setopt(Sock, otp, debug, false),
+ %% We got it all
+ %% ?SEV_IPRINT("tpp_udp_recv -> got all: "
+ %% "~n Source: ~p"
+ %% "~n Tag: ~p"
+ %% "~n Sz: ~p"
+ %% "~n size(Data): ~p",
+ %% [Source, Tag, Sz, size(Data)]),
+ {ok, Data, size(Msg), Source};
+ {ok, {_Source, <<Tag:32/integer, Sz:32/integer, Data/binary>>}} ->
+ %% ok = socket:setopt(Sock, otp, debug, false),
+ {error, {invalid_msg, Sz, size(Data)}};
+ {ok, {_, <<Tag:32/integer, _/binary>>}} ->
+ %% ok = socket:setopt(Sock, otp, debug, false),
+ {error, {invalid_msg_tag, Tag}};
+ {error, _} = ERROR ->
+ %% ok = socket:setopt(Sock, otp, debug, false),
+ ERROR
+ catch
+ C:E:S ->
+ {error, {catched, C, E, S}}
+ end.
+
+tpp_udp_send_req(Sock, Send, Data, Dest) ->
+ tpp_udp_send(Sock, Send, ?TPP_REQUEST, Data, Dest).
+
+tpp_udp_send_rep(Sock, Send, Data, Dest) ->
+ tpp_udp_send(Sock, Send, ?TPP_REPLY, Data, Dest).
+
+tpp_udp_send(Sock, Send, Tag, Data, Dest) ->
+ DataSz = size(Data),
+ Msg = <<Tag:32/integer, DataSz:32/integer, Data/binary>>,
+ tpp_udp_send_msg(Sock, Send, Msg, Dest, 0).
+
+tpp_udp_send_msg(Sock, Send, Msg, Dest, AccSz) when is_binary(Msg) ->
+ case Send(Sock, Msg, Dest) of
+ ok ->
+ {ok, AccSz+size(Msg)};
+ {ok, Rest} -> % This is an IOVec
+ RestBin = list_to_binary(Rest),
+ tpp_udp_send_msg(Sock, Send, RestBin, Dest,
+ AccSz+(size(Msg)-size(RestBin)));
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+tpp_udp_handler_await_start(Parent) ->
+ ?SEV_IPRINT("await start"),
+ ?SEV_AWAIT_START(Parent).
+
+tpp_udp_handler_announce_ready(Parent, Slogan) ->
+ ?SEV_IPRINT("announce ready (~p)", [Slogan]),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan).
+tpp_udp_handler_announce_ready(Parent, Slogan, Extra) ->
+ ?SEV_IPRINT("announce ready (~p)", [Slogan]),
+ ?SEV_ANNOUNCE_READY(Parent, Slogan, Extra).
+
+tpp_udp_handler_await_continue(Parent, Slogan) ->
+ ?SEV_IPRINT("await continue (~p)", [Slogan]),
+ case ?SEV_AWAIT_CONTINUE(Parent, parent, Slogan) of
+ ok ->
+ ?SEV_IPRINT("continue (~p): ok", [Slogan]),
+ ok;
+ {ok, Data} ->
+ ?SEV_IPRINT("continue (~p): ok with data", [Slogan]),
+ Data;
+ {error, Reason} ->
+ ?SEV_EPRINT("continue (~p): error"
+ "~n ~p", [Slogan, Reason]),
+ exit({continue, Slogan, Reason})
+ end.
+
+tpp_udp_handler_await_terminate(Parent) ->
+ ?SEV_IPRINT("await terminate"),
+ case ?SEV_AWAIT_TERMINATE(Parent, parent) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ Reason
+ end.
+
+
+tpp_udp_sock_open(Domain, BufInit) ->
+ case socket:open(Domain, dgram, udp) of
+ {ok, Sock} ->
+ ok = BufInit(Sock),
+ Sock;
+ {error, Reason} ->
+ exit({open_failed, Reason})
+ end.
+
+tpp_udp_sock_bind(Sock, Domain) ->
+ LAddr = which_local_addr(Domain),
+ LSA = #{family => Domain,
+ addr => LAddr},
+ case socket:bind(Sock, LSA) of
+ {ok, _} ->
+ ok;
+ {error, Reason} ->
+ exit({bind, Reason})
+ end.
+
+tpp_udp_sock_close(Sock) ->
+ case socket:close(Sock) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ exit({close, Reason})
+ end.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgenf_small_tcp4(suite) ->
+ [];
+ttest_sgenf_cgenf_small_tcp4(doc) ->
+ [];
+ttest_sgenf_cgenf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgenf_small_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgenf_small_tcp6(suite) ->
+ [];
+ttest_sgenf_cgenf_small_tcp6(doc) ->
+ [];
+ttest_sgenf_cgenf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgenf_small_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgenf_medium_tcp4(suite) ->
+ [];
+ttest_sgenf_cgenf_medium_tcp4(doc) ->
+ [];
+ttest_sgenf_cgenf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgenf_medium_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgenf_medium_tcp6(suite) ->
+ [];
+ttest_sgenf_cgenf_medium_tcp6(doc) ->
+ [];
+ttest_sgenf_cgenf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgenf_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgenf_large_tcp4(suite) ->
+ [];
+ttest_sgenf_cgenf_large_tcp4(doc) ->
+ [];
+ttest_sgenf_cgenf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgenf_large_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgenf_large_tcp6(suite) ->
+ [];
+ttest_sgenf_cgenf_large_tcp6(doc) ->
+ [];
+ttest_sgenf_cgenf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgenf_large_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgeno_small_tcp4(suite) ->
+ [];
+ttest_sgenf_cgeno_small_tcp4(doc) ->
+ [];
+ttest_sgenf_cgeno_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgeno_small_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgeno_small_tcp6(suite) ->
+ [];
+ttest_sgenf_cgeno_small_tcp6(doc) ->
+ [];
+ttest_sgenf_cgeno_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgeno_medium_tcp4(suite) ->
+ [];
+ttest_sgenf_cgeno_medium_tcp4(doc) ->
+ [];
+ttest_sgenf_cgeno_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgeno_medium_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgeno_medium_tcp6(suite) ->
+ [];
+ttest_sgenf_cgeno_medium_tcp6(doc) ->
+ [];
+ttest_sgenf_cgeno_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgeno_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgeno_large_tcp4(suite) ->
+ [];
+ttest_sgenf_cgeno_large_tcp4(doc) ->
+ [];
+ttest_sgenf_cgeno_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgeno_large_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgeno_large_tcp6(suite) ->
+ [];
+ttest_sgenf_cgeno_large_tcp6(doc) ->
+ [];
+ttest_sgenf_cgeno_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgeno_large_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgent_small_tcp4(suite) ->
+ [];
+ttest_sgenf_cgent_small_tcp4(doc) ->
+ [];
+ttest_sgenf_cgent_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgent_small_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgent_small_tcp6(suite) ->
+ [];
+ttest_sgenf_cgent_small_tcp6(doc) ->
+ [];
+ttest_sgenf_cgent_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgent_medium_tcp4(suite) ->
+ [];
+ttest_sgenf_cgent_medium_tcp4(doc) ->
+ [];
+ttest_sgenf_cgent_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgent_medium_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgent_medium_tcp6(suite) ->
+ [];
+ttest_sgenf_cgent_medium_tcp6(doc) ->
+ [];
+ttest_sgenf_cgent_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgent_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgenf_cgent_large_tcp4(suite) ->
+ [];
+ttest_sgenf_cgent_large_tcp4(doc) ->
+ [];
+ttest_sgenf_cgent_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgent_large_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgenf_cgent_large_tcp6(suite) ->
+ [];
+ttest_sgenf_cgent_large_tcp6(doc) ->
+ [];
+ttest_sgenf_cgent_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_cgent_large_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgenf_csockf_small_tcp4(suite) ->
+ [];
+ttest_sgenf_csockf_small_tcp4(doc) ->
+ [];
+ttest_sgenf_csockf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockf_small_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csockf_small_tcp6(suite) ->
+ [];
+ttest_sgenf_csockf_small_tcp6(doc) ->
+ [];
+ttest_sgenf_csockf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockf_small_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgenf_csockf_medium_tcp4(suite) ->
+ [];
+ttest_sgenf_csockf_medium_tcp4(doc) ->
+ [];
+ttest_sgenf_csockf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockf_medium_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csockf_medium_tcp6(suite) ->
+ [];
+ttest_sgenf_csockf_medium_tcp6(doc) ->
+ [];
+ttest_sgenf_csockf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockf_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgenf_csockf_large_tcp4(suite) ->
+ [];
+ttest_sgenf_csockf_large_tcp4(doc) ->
+ [];
+ttest_sgenf_csockf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockf_large_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csockf_large_tcp6(suite) ->
+ [];
+ttest_sgenf_csockf_large_tcp6(doc) ->
+ [];
+ttest_sgenf_csockf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockf_large_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgenf_csocko_small_tcp4(suite) ->
+ [];
+ttest_sgenf_csocko_small_tcp4(doc) ->
+ [];
+ttest_sgenf_csocko_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csocko_small_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csocko_small_tcp6(suite) ->
+ [];
+ttest_sgenf_csocko_small_tcp6(doc) ->
+ [];
+ttest_sgenf_csocko_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgenf_csocko_medium_tcp4(suite) ->
+ [];
+ttest_sgenf_csocko_medium_tcp4(doc) ->
+ [];
+ttest_sgenf_csocko_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csocko_medium_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csocko_medium_tcp6(suite) ->
+ [];
+ttest_sgenf_csocko_medium_tcp6(doc) ->
+ [];
+ttest_sgenf_csocko_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csocko_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgenf_csocko_large_tcp4(suite) ->
+ [];
+ttest_sgenf_csocko_large_tcp4(doc) ->
+ [];
+ttest_sgenf_csocko_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csocko_large_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csocko_large_tcp6(suite) ->
+ [];
+ttest_sgenf_csocko_large_tcp6(doc) ->
+ [];
+ttest_sgenf_csocko_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csocko_large_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgenf_csockt_small_tcp4(suite) ->
+ [];
+ttest_sgenf_csockt_small_tcp4(doc) ->
+ [];
+ttest_sgenf_csockt_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockt_small_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csockt_small_tcp6(suite) ->
+ [];
+ttest_sgenf_csockt_small_tcp6(doc) ->
+ [];
+ttest_sgenf_csockt_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgenf_csockt_medium_tcp4(suite) ->
+ [];
+ttest_sgenf_csockt_medium_tcp4(doc) ->
+ [];
+ttest_sgenf_csockt_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockt_medium_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csockt_medium_tcp6(suite) ->
+ [];
+ttest_sgenf_csockt_medium_tcp6(doc) ->
+ [];
+ttest_sgenf_csockt_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockt_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgenf_csockt_large_tcp4(suite) ->
+ [];
+ttest_sgenf_csockt_large_tcp4(doc) ->
+ [];
+ttest_sgenf_csockt_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockt_large_tcp4,
+ Runtime,
+ inet,
+ gen, false,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgenf_csockt_large_tcp6(suite) ->
+ [];
+ttest_sgenf_csockt_large_tcp6(doc) ->
+ [];
+ttest_sgenf_csockt_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgenf_csockt_large_tcp6,
+ Runtime,
+ inet6,
+ gen, false,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgenf_small_tcp4(suite) ->
+ [];
+ttest_sgeno_cgenf_small_tcp4(doc) ->
+ [];
+ttest_sgeno_cgenf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgenf_small_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgenf_small_tcp6(suite) ->
+ [];
+ttest_sgeno_cgenf_small_tcp6(doc) ->
+ [];
+ttest_sgeno_cgenf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgenf_small_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgenf_medium_tcp4(suite) ->
+ [];
+ttest_sgeno_cgenf_medium_tcp4(doc) ->
+ [];
+ttest_sgeno_cgenf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgenf_medium_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgenf_medium_tcp6(suite) ->
+ [];
+ttest_sgeno_cgenf_medium_tcp6(doc) ->
+ [];
+ttest_sgeno_cgenf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgenf_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgenf_large_tcp4(suite) ->
+ [];
+ttest_sgeno_cgenf_large_tcp4(doc) ->
+ [];
+ttest_sgeno_cgenf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgenf_large_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgenf_large_tcp6(suite) ->
+ [];
+ttest_sgeno_cgenf_large_tcp6(doc) ->
+ [];
+ttest_sgeno_cgenf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgenf_large_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgeno_small_tcp4(suite) ->
+ [];
+ttest_sgeno_cgeno_small_tcp4(doc) ->
+ [];
+ttest_sgeno_cgeno_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgeno_small_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgeno_small_tcp6(suite) ->
+ [];
+ttest_sgeno_cgeno_small_tcp6(doc) ->
+ [];
+ttest_sgeno_cgeno_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgeno_medium_tcp4(suite) ->
+ [];
+ttest_sgeno_cgeno_medium_tcp4(doc) ->
+ [];
+ttest_sgeno_cgeno_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgeno_medium_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgeno_medium_tcp6(suite) ->
+ [];
+ttest_sgeno_cgeno_medium_tcp6(doc) ->
+ [];
+ttest_sgeno_cgeno_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgeno_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgeno_large_tcp4(suite) ->
+ [];
+ttest_sgeno_cgeno_large_tcp4(doc) ->
+ [];
+ttest_sgeno_cgeno_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgeno_large_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgeno_large_tcp6(suite) ->
+ [];
+ttest_sgeno_cgeno_large_tcp6(doc) ->
+ [];
+ttest_sgeno_cgeno_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgeno_large_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgent_small_tcp4(suite) ->
+ [];
+ttest_sgeno_cgent_small_tcp4(doc) ->
+ [];
+ttest_sgeno_cgent_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgent_small_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgent_small_tcp6(suite) ->
+ [];
+ttest_sgeno_cgent_small_tcp6(doc) ->
+ [];
+ttest_sgeno_cgent_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgent_medium_tcp4(suite) ->
+ [];
+ttest_sgeno_cgent_medium_tcp4(doc) ->
+ [];
+ttest_sgeno_cgent_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgent_medium_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgent_medium_tcp6(suite) ->
+ [];
+ttest_sgeno_cgent_medium_tcp6(doc) ->
+ [];
+ttest_sgeno_cgent_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgent_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgeno_cgent_large_tcp4(suite) ->
+ [];
+ttest_sgeno_cgent_large_tcp4(doc) ->
+ [];
+ttest_sgeno_cgent_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgent_large_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgeno_cgent_large_tcp6(suite) ->
+ [];
+ttest_sgeno_cgent_large_tcp6(doc) ->
+ [];
+ttest_sgeno_cgent_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_cgent_large_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgeno_csockf_small_tcp4(suite) ->
+ [];
+ttest_sgeno_csockf_small_tcp4(doc) ->
+ [];
+ttest_sgeno_csockf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockf_small_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csockf_small_tcp6(suite) ->
+ [];
+ttest_sgeno_csockf_small_tcp6(doc) ->
+ [];
+ttest_sgeno_csockf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockf_small_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgeno_csockf_medium_tcp4(suite) ->
+ [];
+ttest_sgeno_csockf_medium_tcp4(doc) ->
+ [];
+ttest_sgeno_csockf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockf_medium_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csockf_medium_tcp6(suite) ->
+ [];
+ttest_sgeno_csockf_medium_tcp6(doc) ->
+ [];
+ttest_sgeno_csockf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockf_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgeno_csockf_large_tcp4(suite) ->
+ [];
+ttest_sgeno_csockf_large_tcp4(doc) ->
+ [];
+ttest_sgeno_csockf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockf_large_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csockf_large_tcp6(suite) ->
+ [];
+ttest_sgeno_csockf_large_tcp6(doc) ->
+ [];
+ttest_sgeno_csockf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockf_large_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgeno_csocko_small_tcp4(suite) ->
+ [];
+ttest_sgeno_csocko_small_tcp4(doc) ->
+ [];
+ttest_sgeno_csocko_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csocko_small_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csocko_small_tcp6(suite) ->
+ [];
+ttest_sgeno_csocko_small_tcp6(doc) ->
+ [];
+ttest_sgeno_csocko_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgeno_csocko_medium_tcp4(suite) ->
+ [];
+ttest_sgeno_csocko_medium_tcp4(doc) ->
+ [];
+ttest_sgeno_csocko_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csocko_medium_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csocko_medium_tcp6(suite) ->
+ [];
+ttest_sgeno_csocko_medium_tcp6(doc) ->
+ [];
+ttest_sgeno_csocko_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csocko_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgeno_csocko_large_tcp4(suite) ->
+ [];
+ttest_sgeno_csocko_large_tcp4(doc) ->
+ [];
+ttest_sgeno_csocko_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csocko_large_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csocko_large_tcp6(suite) ->
+ [];
+ttest_sgeno_csocko_large_tcp6(doc) ->
+ [];
+ttest_sgeno_csocko_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csocko_large_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgeno_csockt_small_tcp4(suite) ->
+ [];
+ttest_sgeno_csockt_small_tcp4(doc) ->
+ [];
+ttest_sgeno_csockt_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockt_small_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csockt_small_tcp6(suite) ->
+ [];
+ttest_sgeno_csockt_small_tcp6(doc) ->
+ [];
+ttest_sgeno_csockt_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgeno_csockt_medium_tcp4(suite) ->
+ [];
+ttest_sgeno_csockt_medium_tcp4(doc) ->
+ [];
+ttest_sgeno_csockt_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockt_medium_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csockt_medium_tcp6(suite) ->
+ [];
+ttest_sgeno_csockt_medium_tcp6(doc) ->
+ [];
+ttest_sgeno_csockt_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockt_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgeno_csockt_large_tcp4(suite) ->
+ [];
+ttest_sgeno_csockt_large_tcp4(doc) ->
+ [];
+ttest_sgeno_csockt_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockt_large_tcp4,
+ Runtime,
+ inet,
+ gen, once,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgeno_csockt_large_tcp6(suite) ->
+ [];
+ttest_sgeno_csockt_large_tcp6(doc) ->
+ [];
+ttest_sgeno_csockt_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgeno_csockt_large_tcp6,
+ Runtime,
+ inet6,
+ gen, once,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgent_cgenf_small_tcp4(suite) ->
+ [];
+ttest_sgent_cgenf_small_tcp4(doc) ->
+ [];
+ttest_sgent_cgenf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgenf_small_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgenf_small_tcp6(suite) ->
+ [];
+ttest_sgent_cgenf_small_tcp6(doc) ->
+ [];
+ttest_sgent_cgenf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgenf_small_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgent_cgenf_medium_tcp4(suite) ->
+ [];
+ttest_sgent_cgenf_medium_tcp4(doc) ->
+ [];
+ttest_sgent_cgenf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgenf_medium_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgenf_medium_tcp6(suite) ->
+ [];
+ttest_sgent_cgenf_medium_tcp6(doc) ->
+ [];
+ttest_sgent_cgenf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgenf_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgent_cgenf_large_tcp4(suite) ->
+ [];
+ttest_sgent_cgenf_large_tcp4(doc) ->
+ [];
+ttest_sgent_cgenf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgenf_large_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgenf_large_tcp6(suite) ->
+ [];
+ttest_sgent_cgenf_large_tcp6(doc) ->
+ [];
+ttest_sgent_cgenf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgenf_large_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgent_cgeno_small_tcp4(suite) ->
+ [];
+ttest_sgent_cgeno_small_tcp4(doc) ->
+ [];
+ttest_sgent_cgeno_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgeno_small_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgeno_small_tcp6(suite) ->
+ [];
+ttest_sgent_cgeno_small_tcp6(doc) ->
+ [];
+ttest_sgent_cgeno_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgent_cgeno_medium_tcp4(suite) ->
+ [];
+ttest_sgent_cgeno_medium_tcp4(doc) ->
+ [];
+ttest_sgent_cgeno_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgeno_medium_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgeno_medium_tcp6(suite) ->
+ [];
+ttest_sgent_cgeno_medium_tcp6(doc) ->
+ [];
+ttest_sgent_cgeno_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgeno_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgent_cgeno_large_tcp4(suite) ->
+ [];
+ttest_sgent_cgeno_large_tcp4(doc) ->
+ [];
+ttest_sgent_cgeno_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgeno_large_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgeno_large_tcp6(suite) ->
+ [];
+ttest_sgent_cgeno_large_tcp6(doc) ->
+ [];
+ttest_sgent_cgeno_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgeno_large_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgent_cgent_small_tcp4(suite) ->
+ [];
+ttest_sgent_cgent_small_tcp4(doc) ->
+ [];
+ttest_sgent_cgent_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgent_small_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgent_small_tcp6(suite) ->
+ [];
+ttest_sgent_cgent_small_tcp6(doc) ->
+ [];
+ttest_sgent_cgent_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgent_cgent_medium_tcp4(suite) ->
+ [];
+ttest_sgent_cgent_medium_tcp4(doc) ->
+ ["Server(gen,true), Client(gen,true), Domain=inet, msg=medium"];
+ttest_sgent_cgent_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgent_medium_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgent_medium_tcp6(suite) ->
+ [];
+ttest_sgent_cgent_medium_tcp6(doc) ->
+ ["Server(gen,true), Client(gen,true), Domain=inet6, msg=medium"];
+ttest_sgent_cgent_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgent_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgent_cgent_large_tcp4(suite) ->
+ [];
+ttest_sgent_cgent_large_tcp4(doc) ->
+ ["Server(gen,true), Client(gen,true), Domain=inet, msg=large"];
+ttest_sgent_cgent_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgent_large_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgent_cgent_large_tcp6(suite) ->
+ [];
+ttest_sgent_cgent_large_tcp6(doc) ->
+ ["Server(gen,true), Client(gen,true), Domain=inet6, msg=large"];
+ttest_sgent_cgent_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_cgent_large_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgent_csockf_small_tcp4(suite) ->
+ [];
+ttest_sgent_csockf_small_tcp4(doc) ->
+ [];
+ttest_sgent_csockf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockf_small_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgent_csockf_small_tcp6(suite) ->
+ [];
+ttest_sgent_csockf_small_tcp6(doc) ->
+ [];
+ttest_sgent_csockf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockf_small_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgent_csockf_medium_tcp4(suite) ->
+ [];
+ttest_sgent_csockf_medium_tcp4(doc) ->
+ [];
+ttest_sgent_csockf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockf_medium_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgent_csockf_medium_tcp6(suite) ->
+ [];
+ttest_sgent_csockf_medium_tcp6(doc) ->
+ [];
+ttest_sgent_csockf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockf_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgent_csockf_large_tcp4(suite) ->
+ [];
+ttest_sgent_csockf_large_tcp4(doc) ->
+ [];
+ttest_sgent_csockf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockf_large_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgent_csockf_large_tcp6(suite) ->
+ [];
+ttest_sgent_csockf_large_tcp6(doc) ->
+ [];
+ttest_sgent_csockf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockf_large_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgent_csocko_small_tcp4(suite) ->
+ [];
+ttest_sgent_csocko_small_tcp4(doc) ->
+ [];
+ttest_sgent_csocko_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csocko_small_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgent_csocko_small_tcp6(suite) ->
+ [];
+ttest_sgent_csocko_small_tcp6(doc) ->
+ [];
+ttest_sgent_csocko_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgent_csocko_medium_tcp4(suite) ->
+ [];
+ttest_sgent_csocko_medium_tcp4(doc) ->
+ [];
+ttest_sgent_csocko_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csocko_medium_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgent_csocko_medium_tcp6(suite) ->
+ [];
+ttest_sgent_csocko_medium_tcp6(doc) ->
+ [];
+ttest_sgent_csocko_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csocko_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgent_csocko_large_tcp4(suite) ->
+ [];
+ttest_sgent_csocko_large_tcp4(doc) ->
+ [];
+ttest_sgent_csocko_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csocko_large_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgent_csocko_large_tcp6(suite) ->
+ [];
+ttest_sgent_csocko_large_tcp6(doc) ->
+ [];
+ttest_sgent_csocko_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csocko_large_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_sgent_csockt_small_tcp4(suite) ->
+ [];
+ttest_sgent_csockt_small_tcp4(doc) ->
+ [];
+ttest_sgent_csockt_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockt_small_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_sgent_csockt_small_tcp6(suite) ->
+ [];
+ttest_sgent_csockt_small_tcp6(doc) ->
+ [];
+ttest_sgent_csockt_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_sgent_csockt_medium_tcp4(suite) ->
+ [];
+ttest_sgent_csockt_medium_tcp4(doc) ->
+ [];
+ttest_sgent_csockt_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockt_medium_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_sgent_csockt_medium_tcp6(suite) ->
+ [];
+ttest_sgent_csockt_medium_tcp6(doc) ->
+ [];
+ttest_sgent_csockt_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockt_medium_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_sgent_csockt_large_tcp4(suite) ->
+ [];
+ttest_sgent_csockt_large_tcp4(doc) ->
+ [];
+ttest_sgent_csockt_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockt_large_tcp4,
+ Runtime,
+ inet,
+ gen, true,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = gen_tcp, Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_sgent_csockt_large_tcp6(suite) ->
+ [];
+ttest_sgent_csockt_large_tcp6(doc) ->
+ [];
+ttest_sgent_csockt_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_sgent_csockt_large_tcp6,
+ Runtime,
+ inet6,
+ gen, true,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgenf_small_tcp4(suite) ->
+ [];
+ttest_ssockf_cgenf_small_tcp4(doc) ->
+ [];
+ttest_ssockf_cgenf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgenf_small_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgenf_small_tcp6(suite) ->
+ [];
+ttest_ssockf_cgenf_small_tcp6(doc) ->
+ [];
+ttest_ssockf_cgenf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgenf_small_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgenf_medium_tcp4(suite) ->
+ [];
+ttest_ssockf_cgenf_medium_tcp4(doc) ->
+ [];
+ttest_ssockf_cgenf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgenf_medium_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgenf_medium_tcp6(suite) ->
+ [];
+ttest_ssockf_cgenf_medium_tcp6(doc) ->
+ [];
+ttest_ssockf_cgenf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgenf_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgenf_large_tcp4(suite) ->
+ [];
+ttest_ssockf_cgenf_large_tcp4(doc) ->
+ [];
+ttest_ssockf_cgenf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgenf_large_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgenf_large_tcp6(suite) ->
+ [];
+ttest_ssockf_cgenf_large_tcp6(doc) ->
+ [];
+ttest_ssockf_cgenf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgenf_large_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgeno_small_tcp4(suite) ->
+ [];
+ttest_ssockf_cgeno_small_tcp4(doc) ->
+ [];
+ttest_ssockf_cgeno_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgeno_small_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgeno_small_tcp6(suite) ->
+ [];
+ttest_ssockf_cgeno_small_tcp6(doc) ->
+ [];
+ttest_ssockf_cgeno_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgeno_medium_tcp4(suite) ->
+ [];
+ttest_ssockf_cgeno_medium_tcp4(doc) ->
+ [];
+ttest_ssockf_cgeno_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgeno_medium_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgeno_medium_tcp6(suite) ->
+ [];
+ttest_ssockf_cgeno_medium_tcp6(doc) ->
+ [];
+ttest_ssockf_cgeno_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgeno_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgeno_large_tcp4(suite) ->
+ [];
+ttest_ssockf_cgeno_large_tcp4(doc) ->
+ [];
+ttest_ssockf_cgeno_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgeno_large_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgeno_large_tcp6(suite) ->
+ [];
+ttest_ssockf_cgeno_large_tcp6(doc) ->
+ [];
+ttest_ssockf_cgeno_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgeno_large_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgent_small_tcp4(suite) ->
+ [];
+ttest_ssockf_cgent_small_tcp4(doc) ->
+ [];
+ttest_ssockf_cgent_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgent_small_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgent_small_tcp6(suite) ->
+ [];
+ttest_ssockf_cgent_small_tcp6(doc) ->
+ [];
+ttest_ssockf_cgent_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgent_medium_tcp4(suite) ->
+ [];
+ttest_ssockf_cgent_medium_tcp4(doc) ->
+ [];
+ttest_ssockf_cgent_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgent_medium_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgent_medium_tcp6(suite) ->
+ [];
+ttest_ssockf_cgent_medium_tcp6(doc) ->
+ [];
+ttest_ssockf_cgent_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgent_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockf_cgent_large_tcp4(suite) ->
+ [];
+ttest_ssockf_cgent_large_tcp4(doc) ->
+ [];
+ttest_ssockf_cgent_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgent_large_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockf_cgent_large_tcp6(suite) ->
+ [];
+ttest_ssockf_cgent_large_tcp6(doc) ->
+ [];
+ttest_ssockf_cgent_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_cgent_large_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockf_csockf_small_tcp4(suite) ->
+ [];
+ttest_ssockf_csockf_small_tcp4(doc) ->
+ [];
+ttest_ssockf_csockf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockf_small_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csockf_small_tcp6(suite) ->
+ [];
+ttest_ssockf_csockf_small_tcp6(doc) ->
+ [];
+ttest_ssockf_csockf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockf_small_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockf_csockf_medium_tcp4(suite) ->
+ [];
+ttest_ssockf_csockf_medium_tcp4(doc) ->
+ [];
+ttest_ssockf_csockf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockf_medium_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csockf_medium_tcp6(suite) ->
+ [];
+ttest_ssockf_csockf_medium_tcp6(doc) ->
+ [];
+ttest_ssockf_csockf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockf_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockf_csockf_large_tcp4(suite) ->
+ [];
+ttest_ssockf_csockf_large_tcp4(doc) ->
+ [];
+ttest_ssockf_csockf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockf_large_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csockf_large_tcp6(suite) ->
+ [];
+ttest_ssockf_csockf_large_tcp6(doc) ->
+ [];
+ttest_ssockf_csockf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockf_large_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockf_csocko_small_tcp4(suite) ->
+ [];
+ttest_ssockf_csocko_small_tcp4(doc) ->
+ [];
+ttest_ssockf_csocko_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csocko_small_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csocko_small_tcp6(suite) ->
+ [];
+ttest_ssockf_csocko_small_tcp6(doc) ->
+ [];
+ttest_ssockf_csocko_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockf_csocko_medium_tcp4(suite) ->
+ [];
+ttest_ssockf_csocko_medium_tcp4(doc) ->
+ [];
+ttest_ssockf_csocko_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csocko_medium_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csocko_medium_tcp6(suite) ->
+ [];
+ttest_ssockf_csocko_medium_tcp6(doc) ->
+ [];
+ttest_ssockf_csocko_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csocko_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockf_csocko_large_tcp4(suite) ->
+ [];
+ttest_ssockf_csocko_large_tcp4(doc) ->
+ [];
+ttest_ssockf_csocko_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csocko_large_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csocko_large_tcp6(suite) ->
+ [];
+ttest_ssockf_csocko_large_tcp6(doc) ->
+ [];
+ttest_ssockf_csocko_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csocko_large_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockf_csockt_small_tcp4(suite) ->
+ [];
+ttest_ssockf_csockt_small_tcp4(doc) ->
+ [];
+ttest_ssockf_csockt_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockt_small_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csockt_small_tcp6(suite) ->
+ [];
+ttest_ssockf_csockt_small_tcp6(doc) ->
+ [];
+ttest_ssockf_csockt_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockf_csockt_medium_tcp4(suite) ->
+ [];
+ttest_ssockf_csockt_medium_tcp4(doc) ->
+ [];
+ttest_ssockf_csockt_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockt_medium_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csockt_medium_tcp6(suite) ->
+ [];
+ttest_ssockf_csockt_medium_tcp6(doc) ->
+ [];
+ttest_ssockf_csockt_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockt_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockf_csockt_large_tcp4(suite) ->
+ [];
+ttest_ssockf_csockt_large_tcp4(doc) ->
+ [];
+ttest_ssockf_csockt_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockt_large_tcp4,
+ Runtime,
+ inet,
+ sock, false,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockf_csockt_large_tcp6(suite) ->
+ [];
+ttest_ssockf_csockt_large_tcp6(doc) ->
+ [];
+ttest_ssockf_csockt_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockf_csockt_large_tcp6,
+ Runtime,
+ inet6,
+ sock, false,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgenf_small_tcp4(suite) ->
+ [];
+ttest_ssocko_cgenf_small_tcp4(doc) ->
+ [];
+ttest_ssocko_cgenf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgenf_small_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgenf_small_tcp6(suite) ->
+ [];
+ttest_ssocko_cgenf_small_tcp6(doc) ->
+ [];
+ttest_ssocko_cgenf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgenf_small_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgenf_medium_tcp4(suite) ->
+ [];
+ttest_ssocko_cgenf_medium_tcp4(doc) ->
+ [];
+ttest_ssocko_cgenf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgenf_medium_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgenf_medium_tcp6(suite) ->
+ [];
+ttest_ssocko_cgenf_medium_tcp6(doc) ->
+ [];
+ttest_ssocko_cgenf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgenf_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgenf_large_tcp4(suite) ->
+ [];
+ttest_ssocko_cgenf_large_tcp4(doc) ->
+ [];
+ttest_ssocko_cgenf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgenf_large_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgenf_large_tcp6(suite) ->
+ [];
+ttest_ssocko_cgenf_large_tcp6(doc) ->
+ [];
+ttest_ssocko_cgenf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgenf_large_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgeno_small_tcp4(suite) ->
+ [];
+ttest_ssocko_cgeno_small_tcp4(doc) ->
+ [];
+ttest_ssocko_cgeno_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgeno_small_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgeno_small_tcp6(suite) ->
+ [];
+ttest_ssocko_cgeno_small_tcp6(doc) ->
+ [];
+ttest_ssocko_cgeno_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgeno_medium_tcp4(suite) ->
+ [];
+ttest_ssocko_cgeno_medium_tcp4(doc) ->
+ [];
+ttest_ssocko_cgeno_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgeno_medium_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgeno_medium_tcp6(suite) ->
+ [];
+ttest_ssocko_cgeno_medium_tcp6(doc) ->
+ [];
+ttest_ssocko_cgeno_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgeno_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgeno_large_tcp4(suite) ->
+ [];
+ttest_ssocko_cgeno_large_tcp4(doc) ->
+ [];
+ttest_ssocko_cgeno_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgeno_large_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgeno_large_tcp6(suite) ->
+ [];
+ttest_ssocko_cgeno_large_tcp6(doc) ->
+ [];
+ttest_ssocko_cgeno_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgeno_large_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgent_small_tcp4(suite) ->
+ [];
+ttest_ssocko_cgent_small_tcp4(doc) ->
+ [];
+ttest_ssocko_cgent_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgent_small_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgent_small_tcp6(suite) ->
+ [];
+ttest_ssocko_cgent_small_tcp6(doc) ->
+ [];
+ttest_ssocko_cgent_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgent_small_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgent_medium_tcp4(suite) ->
+ [];
+ttest_ssocko_cgent_medium_tcp4(doc) ->
+ [];
+ttest_ssocko_cgent_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgent_medium_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgent_medium_tcp6(suite) ->
+ [];
+ttest_ssocko_cgent_medium_tcp6(doc) ->
+ [];
+ttest_ssocko_cgent_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgent_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssocko_cgent_large_tcp4(suite) ->
+ [];
+ttest_ssocko_cgent_large_tcp4(doc) ->
+ [];
+ttest_ssocko_cgent_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgent_large_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = false
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssocko_cgent_large_tcp6(suite) ->
+ [];
+ttest_ssocko_cgent_large_tcp6(doc) ->
+ [];
+ttest_ssocko_cgent_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_cgent_large_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssocko_csockf_small_tcp4(suite) ->
+ [];
+ttest_ssocko_csockf_small_tcp4(doc) ->
+ [];
+ttest_ssocko_csockf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockf_small_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csockf_small_tcp6(suite) ->
+ [];
+ttest_ssocko_csockf_small_tcp6(doc) ->
+ [];
+ttest_ssocko_csockf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockf_small_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssocko_csockf_medium_tcp4(suite) ->
+ [];
+ttest_ssocko_csockf_medium_tcp4(doc) ->
+ [];
+ttest_ssocko_csockf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockf_medium_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csockf_medium_tcp6(suite) ->
+ [];
+ttest_ssocko_csockf_medium_tcp6(doc) ->
+ [];
+ttest_ssocko_csockf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockf_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssocko_csockf_large_tcp4(suite) ->
+ [];
+ttest_ssocko_csockf_large_tcp4(doc) ->
+ [];
+ttest_ssocko_csockf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockf_large_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csockf_large_tcp6(suite) ->
+ [];
+ttest_ssocko_csockf_large_tcp6(doc) ->
+ [];
+ttest_ssocko_csockf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockf_large_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssocko_csocko_small_tcp4(suite) ->
+ [];
+ttest_ssocko_csocko_small_tcp4(doc) ->
+ [];
+ttest_ssocko_csocko_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csocko_small_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csocko_small_tcp6(suite) ->
+ [];
+ttest_ssocko_csocko_small_tcp6(doc) ->
+ [];
+ttest_ssocko_csocko_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssocko_csocko_medium_tcp4(suite) ->
+ [];
+ttest_ssocko_csocko_medium_tcp4(doc) ->
+ [];
+ttest_ssocko_csocko_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csocko_medium_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csocko_medium_tcp6(suite) ->
+ [];
+ttest_ssocko_csocko_medium_tcp6(doc) ->
+ [];
+ttest_ssocko_csocko_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csocko_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssocko_csocko_large_tcp4(suite) ->
+ [];
+ttest_ssocko_csocko_large_tcp4(doc) ->
+ [];
+ttest_ssocko_csocko_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csocko_large_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csocko_large_tcp6(suite) ->
+ [];
+ttest_ssocko_csocko_large_tcp6(doc) ->
+ [];
+ttest_ssocko_csocko_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csocko_large_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssocko_csockt_small_tcp4(suite) ->
+ [];
+ttest_ssocko_csockt_small_tcp4(doc) ->
+ [];
+ttest_ssocko_csockt_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockt_small_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csockt_small_tcp6(suite) ->
+ [];
+ttest_ssocko_csockt_small_tcp6(doc) ->
+ [];
+ttest_ssocko_csockt_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssocko_csockt_medium_tcp4(suite) ->
+ [];
+ttest_ssocko_csockt_medium_tcp4(doc) ->
+ [];
+ttest_ssocko_csockt_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockt_medium_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csockt_medium_tcp6(suite) ->
+ [];
+ttest_ssocko_csockt_medium_tcp6(doc) ->
+ [];
+ttest_ssocko_csockt_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockt_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssocko_csockt_large_tcp4(suite) ->
+ [];
+ttest_ssocko_csockt_large_tcp4(doc) ->
+ [];
+ttest_ssocko_csockt_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockt_large_tcp4,
+ Runtime,
+ inet,
+ sock, once,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = once
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssocko_csockt_large_tcp6(suite) ->
+ [];
+ttest_ssocko_csockt_large_tcp6(doc) ->
+ [];
+ttest_ssocko_csockt_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssocko_csockt_large_tcp6,
+ Runtime,
+ inet6,
+ sock, once,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgenf_small_tcp4(suite) ->
+ [];
+ttest_ssockt_cgenf_small_tcp4(doc) ->
+ [];
+ttest_ssockt_cgenf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgenf_small_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgenf_small_tcp6(suite) ->
+ [];
+ttest_ssockt_cgenf_small_tcp6(doc) ->
+ [];
+ttest_ssockt_cgenf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgenf_small_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgenf_medium_tcp4(suite) ->
+ [];
+ttest_ssockt_cgenf_medium_tcp4(doc) ->
+ [];
+ttest_ssockt_cgenf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgenf_medium_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgenf_medium_tcp6(suite) ->
+ [];
+ttest_ssockt_cgenf_medium_tcp6(doc) ->
+ [];
+ttest_ssockt_cgenf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgenf_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgenf_large_tcp4(suite) ->
+ [];
+ttest_ssockt_cgenf_large_tcp4(doc) ->
+ [];
+ttest_ssockt_cgenf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgenf_large_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgenf_large_tcp6(suite) ->
+ [];
+ttest_ssockt_cgenf_large_tcp6(doc) ->
+ [];
+ttest_ssockt_cgenf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgenf_large_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgeno_small_tcp4(suite) ->
+ [];
+ttest_ssockt_cgeno_small_tcp4(doc) ->
+ [];
+ttest_ssockt_cgeno_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgeno_small_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgeno_small_tcp6(suite) ->
+ [];
+ttest_ssockt_cgeno_small_tcp6(doc) ->
+ [];
+ttest_ssockt_cgeno_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgeno_small_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgeno_medium_tcp4(suite) ->
+ [];
+ttest_ssockt_cgeno_medium_tcp4(doc) ->
+ [];
+ttest_ssockt_cgeno_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgeno_medium_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgeno_medium_tcp6(suite) ->
+ [];
+ttest_ssockt_cgeno_medium_tcp6(doc) ->
+ [];
+ttest_ssockt_cgeno_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgeno_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgeno_large_tcp4(suite) ->
+ [];
+ttest_ssockt_cgeno_large_tcp4(doc) ->
+ [];
+ttest_ssockt_cgeno_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgeno_large_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgeno_large_tcp6(suite) ->
+ [];
+ttest_ssockt_cgeno_large_tcp6(doc) ->
+ [];
+ttest_ssockt_cgeno_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgeno_large_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgent_small_tcp4(suite) ->
+ [];
+ttest_ssockt_cgent_small_tcp4(doc) ->
+ [];
+ttest_ssockt_cgent_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgent_small_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgent_small_tcp6(suite) ->
+ [];
+ttest_ssockt_cgent_small_tcp6(doc) ->
+ [];
+ttest_ssockt_cgent_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgent_small_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgent_medium_tcp4(suite) ->
+ [];
+ttest_ssockt_cgent_medium_tcp4(doc) ->
+ [];
+ttest_ssockt_cgent_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgent_medium_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgent_medium_tcp6(suite) ->
+ [];
+ttest_ssockt_cgent_medium_tcp6(doc) ->
+ [];
+ttest_ssockt_cgent_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgent_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockt_cgent_large_tcp4(suite) ->
+ [];
+ttest_ssockt_cgent_large_tcp4(doc) ->
+ [];
+ttest_ssockt_cgent_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgent_large_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = gen_tcp, Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockt_cgent_large_tcp6(suite) ->
+ [];
+ttest_ssockt_cgent_large_tcp6(doc) ->
+ [];
+ttest_ssockt_cgent_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_cgent_large_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ gen, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockt_csockf_small_tcp4(suite) ->
+ [];
+ttest_ssockt_csockf_small_tcp4(doc) ->
+ [];
+ttest_ssockt_csockf_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockf_small_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csockf_small_tcp6(suite) ->
+ [];
+ttest_ssockt_csockf_small_tcp6(doc) ->
+ [];
+ttest_ssockt_csockf_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockf_small_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, false,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockt_csockf_medium_tcp4(suite) ->
+ [];
+ttest_ssockt_csockf_medium_tcp4(doc) ->
+ [];
+ttest_ssockt_csockf_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockf_medium_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csockf_medium_tcp6(suite) ->
+ [];
+ttest_ssockt_csockf_medium_tcp6(doc) ->
+ [];
+ttest_ssockt_csockf_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockf_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, false,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockt_csockf_large_tcp4(suite) ->
+ [];
+ttest_ssockt_csockf_large_tcp4(doc) ->
+ [];
+ttest_ssockt_csockf_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockf_large_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = false
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csockf_large_tcp6(suite) ->
+ [];
+ttest_ssockt_csockf_large_tcp6(doc) ->
+ [];
+ttest_ssockt_csockf_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockf_large_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, false,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockt_csocko_small_tcp4(suite) ->
+ [];
+ttest_ssockt_csocko_small_tcp4(doc) ->
+ [];
+ttest_ssockt_csocko_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csocko_small_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csocko_small_tcp6(suite) ->
+ [];
+ttest_ssockt_csocko_small_tcp6(doc) ->
+ [];
+ttest_ssockt_csocko_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, once,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockt_csocko_medium_tcp4(suite) ->
+ [];
+ttest_ssockt_csocko_medium_tcp4(doc) ->
+ [];
+ttest_ssockt_csocko_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csocko_medium_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csocko_medium_tcp6(suite) ->
+ [];
+ttest_ssockt_csocko_medium_tcp6(doc) ->
+ [];
+ttest_ssockt_csocko_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csocko_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, once,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockt_csocko_large_tcp4(suite) ->
+ [];
+ttest_ssockt_csocko_large_tcp4(doc) ->
+ [];
+ttest_ssockt_csocko_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csocko_large_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = once
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csocko_large_tcp6(suite) ->
+ [];
+ttest_ssockt_csocko_large_tcp6(doc) ->
+ [];
+ttest_ssockt_csocko_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csocko_large_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, once,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet
+%%
+
+ttest_ssockt_csockt_small_tcp4(suite) ->
+ [];
+ttest_ssockt_csockt_small_tcp4(doc) ->
+ [];
+ttest_ssockt_csockt_small_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockt_small_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: small (=1)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csockt_small_tcp6(suite) ->
+ [];
+ttest_ssockt_csockt_small_tcp6(doc) ->
+ [];
+ttest_ssockt_csockt_small_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csocko_small_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, true,
+ 1, 200).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet
+%%
+
+ttest_ssockt_csockt_medium_tcp4(suite) ->
+ [];
+ttest_ssockt_csockt_medium_tcp4(doc) ->
+ [];
+ttest_ssockt_csockt_medium_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockt_medium_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: medium (=2)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csockt_medium_tcp6(suite) ->
+ [];
+ttest_ssockt_csockt_medium_tcp6(doc) ->
+ [];
+ttest_ssockt_csockt_medium_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockt_medium_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, true,
+ 2, 20).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet
+%%
+
+ttest_ssockt_csockt_large_tcp4(suite) ->
+ [];
+ttest_ssockt_csockt_large_tcp4(doc) ->
+ [];
+ttest_ssockt_csockt_large_tcp4(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockt_large_tcp4,
+ Runtime,
+ inet,
+ sock, true,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This test case uses the time test (ttest) utility to implement a
+%% ping-pong like test case.
+%% Server: Transport = socket(tcp), Active = true
+%% Client: Transport = socket(tcp), Active = true
+%% Message Size: large (=3)
+%% Domain: inet6
+%%
+
+ttest_ssockt_csockt_large_tcp6(suite) ->
+ [];
+ttest_ssockt_csockt_large_tcp6(doc) ->
+ [];
+ttest_ssockt_csockt_large_tcp6(Config) when is_list(Config) ->
+ Runtime = which_ttest_runtime(Config),
+ ttest_tcp(ttest_ssockt_csockt_large_tcp6,
+ Runtime,
+ inet6,
+ sock, true,
+ sock, true,
+ 3, 2).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+which_ttest_runtime(Config) when is_list(Config) ->
+ case lists:keysearch(esock_test_ttest_runtime, 1, Config) of
+ {value, {esock_test_ttest_runtime, Runtime}} ->
+ Runtime;
+ false ->
+ which_ttest_runtime_env()
+ end.
+
+which_ttest_runtime_env() ->
+ which_ttest_runtime_env(os:getenv("ESOCK_TEST_TTEST_RUNTIME")).
+
+which_ttest_runtime_env(TStr) when is_list(TStr) ->
+ which_ttest_runtime_env2(lists:reverse(TStr));
+which_ttest_runtime_env(false) ->
+ ?TTEST_RUNTIME.
+
+
+%% The format is: <int>[unit]
+%% where the optional unit can be:
+%% ms: milliseconds
+%% s: seconds (default)
+%% m: minutes
+which_ttest_runtime_env2([$m, $s | MS]) when (length(MS) > 0) ->
+ convert_time(MS, fun(X) -> X end);
+which_ttest_runtime_env2([$m | M]) when (length(M) > 0) ->
+ convert_time(M, fun(X) -> ?MINS(X) end);
+which_ttest_runtime_env2([$s | S]) when (length(S) > 0) ->
+ convert_time(S, fun(X) -> ?SECS(X) end);
+which_ttest_runtime_env2(S) ->
+ convert_time(S, fun(X) -> ?SECS(X) end).
+
+convert_time(TStrRev, Convert) ->
+ try list_to_integer(lists:reverse(TStrRev)) of
+ I -> Convert(I)
+ catch
+ _:_ ->
+ ?TTEST_RUNTIME
+ end.
+
+ttest_tcp(TC,
+ Domain,
+ ServerMod, ServerActive,
+ ClientMod, ClientActive,
+ MsgID, MaxOutstanding) ->
+ ttest_tcp(TC,
+ ?TTEST_RUNTIME,
+ Domain,
+ ServerMod, ServerActive,
+ ClientMod, ClientActive,
+ MsgID, MaxOutstanding).
+ttest_tcp(TC,
+ Runtime,
+ Domain,
+ ServerMod, ServerActive,
+ ClientMod, ClientActive,
+ MsgID, MaxOutstanding) ->
+ tc_try(TC,
+ fun() ->
+ if (Domain =/= inet) -> not_yet_implemented(); true -> ok end,
+ %% This may be overkill, depending on the runtime,
+ %% but better safe then sorry...
+ ?TT(Runtime + ?SECS(60)),
+ InitState = #{domain => Domain,
+ msg_id => MsgID,
+ max_outstanding => MaxOutstanding,
+ runtime => Runtime,
+ server_mod => ServerMod,
+ server_active => ServerActive,
+ client_mod => ClientMod,
+ client_active => ClientActive},
+ ok = ttest_tcp(InitState)
+ end).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ttest_tcp(InitState) ->
+ ServerSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ Tester = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+
+ %% *** Init part ***
+ #{desc => "create node",
+ cmd => fun(#{host := Host} = State) ->
+ case start_node(Host, server) of
+ {ok, Node} ->
+ {ok, State#{node => Node}};
+ {error, Reason, _} ->
+ {error, Reason}
+ end
+ end},
+ #{desc => "monitor server node",
+ cmd => fun(#{node := Node} = _State) ->
+ true = erlang:monitor_node(Node, true),
+ ok
+ end},
+ #{desc => "start ttest (remote) server",
+ cmd => fun(#{mod := Mod,
+ active := Active,
+ node := Node} = State) ->
+ case ttest_tcp_server_start(Node, Mod, Active) of
+ {ok, {{Pid, _MRef}, {Addr, Port}}} ->
+ {ok, State#{rserver => Pid,
+ addr => Addr,
+ port => Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester,
+ addr := Addr,
+ port := Port}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init, {Addr, Port}),
+ ok
+ end},
+
+
+ %% *** Termination ***
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester,
+ rserver := RServer} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester,
+ [{rserver, RServer}]) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ %% The remote server is in a accept, with a timeout of 5 seconds,
+ %% so may have to wait a bit...
+ #{desc => "order (remote) ttest server terminate",
+ cmd => fun(#{node := _Node,
+ rserver := RServer}) ->
+ ttest_tcp_server_stop(RServer),
+ ok
+ end},
+ #{desc => "await ttest (remote) server termination",
+ cmd => fun(#{rserver := RServer} = State) ->
+ ?SEV_AWAIT_TERMINATION(RServer),
+ State1 = maps:remove(rserver, State),
+ {ok, State1}
+ end},
+ #{desc => "stop (server) node",
+ cmd => fun(#{node := Node} = _State) ->
+ stop_node(Node)
+ end},
+ #{desc => "await (server) node termination",
+ cmd => fun(#{node := Node} = State) ->
+ receive
+ {nodedown, Node} ->
+ {ok, maps:remove(node, State)}
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ ClientSeq =
+ [
+ %% *** Wait for start order part ***
+ #{desc => "await start",
+ cmd => fun(State) ->
+ {Tester, {ServerAddr, ServerPort}} = ?SEV_AWAIT_START(),
+ {ok, State#{tester => Tester,
+ server_addr => ServerAddr,
+ server_port => ServerPort}}
+ end},
+ #{desc => "monitor tester",
+ cmd => fun(#{tester := Tester} = _State) ->
+ _MRef = erlang:monitor(process, Tester),
+ ok
+ end},
+
+
+ %% *** Init part ***
+ #{desc => "create node",
+ cmd => fun(#{host := Host} = State) ->
+ case start_node(Host, client) of
+ {ok, Node} ->
+ {ok, State#{node => Node}};
+ {error, Reason, _} ->
+ {error, Reason}
+ end
+ end},
+ #{desc => "monitor client node",
+ cmd => fun(#{node := Node} = _State) ->
+ true = erlang:monitor_node(Node, true),
+ ok
+ end},
+ #{desc => "announce ready (init)",
+ cmd => fun(#{tester := Tester}) ->
+ ?SEV_ANNOUNCE_READY(Tester, init),
+ ok
+ end},
+
+
+ %% The actual test
+ #{desc => "await continue (ttest)",
+ cmd => fun(#{tester := Tester} = _State) ->
+ ?SEV_AWAIT_CONTINUE(Tester, tester, ttest),
+ ok
+ end},
+ #{desc => "start ttest (remote) client",
+ cmd => fun(#{node := Node,
+ mod := Mod,
+ active := Active,
+ msg_id := MsgID,
+ max_outstanding := MaxOutstanding,
+ runtime := RunTime,
+ server_addr := Addr,
+ server_port := Port} = State) ->
+ Self = self(),
+ Notify =
+ fun(Result) ->
+ ?SEV_ANNOUNCE_READY(Self, ttest, Result)
+ end,
+ case ttest_tcp_client_start(Node, Notify,
+ Mod, Active,
+ Addr, Port,
+ MsgID, MaxOutstanding,
+ RunTime) of
+ {ok, {Pid, _MRef}} ->
+ {ok, State#{rclient => Pid}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await ttest ready",
+ cmd => fun(#{tester := Tester,
+ rclient := RClient} = State) ->
+ %% TTestResult = ?SEV_AWAIT_READY(RClient, rclient, ttest,
+ %% [{tester, Tester}]),
+ case ?SEV_AWAIT_READY(RClient, rclient, ttest,
+ [{tester, Tester}]) of
+ {ok, Result} ->
+ {ok, State#{result => Result}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "await ttest (remote) client termination",
+ cmd => fun(#{rclient := RClient} = State) ->
+ ?SEV_AWAIT_TERMINATION(RClient),
+ State1 = maps:remove(rclient, State),
+ {ok, State1}
+ end},
+ #{desc => "announce ready (ttest)",
+ cmd => fun(#{tester := Tester,
+ result := Result} = State) ->
+ ?SEV_ANNOUNCE_READY(Tester, ttest, Result),
+ {ok, maps:remove(result, State)}
+ end},
+
+
+ %% *** Termination ***
+ #{desc => "await terminate (from tester)",
+ cmd => fun(#{tester := Tester} = State) ->
+ case ?SEV_AWAIT_TERMINATE(Tester, tester) of
+ ok ->
+ {ok, maps:remove(tester, State)};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+ #{desc => "stop (client) node",
+ cmd => fun(#{node := Node} = _State) ->
+ stop_node(Node)
+ end},
+ #{desc => "await (client) node termination",
+ cmd => fun(#{node := Node} = State) ->
+ receive
+ {nodedown, Node} ->
+ {ok, maps:remove(node, State)}
+ end
+ end},
+
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ TesterSeq =
+ [
+ %% *** Init part ***
+ #{desc => "monitor server",
+ cmd => fun(#{server := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+ #{desc => "monitor client",
+ cmd => fun(#{client := Pid} = _State) ->
+ _MRef = erlang:monitor(process, Pid),
+ ok
+ end},
+
+ %% Start the server
+ #{desc => "order server start",
+ cmd => fun(#{server := Pid} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid),
+ ok
+ end},
+ #{desc => "await server ready (init)",
+ cmd => fun(#{server := Pid} = State) ->
+ {ok, {Addr, Port}} = ?SEV_AWAIT_READY(Pid, server, init),
+ {ok, State#{server_addr => Addr,
+ server_port => Port}}
+ end},
+
+
+ %% Start the client
+ #{desc => "order client start",
+ cmd => fun(#{client := Pid,
+ server_addr := Addr,
+ server_port := Port} = _State) ->
+ ?SEV_ANNOUNCE_START(Pid, {Addr, Port}),
+ ok
+ end},
+ #{desc => "await client ready (init)",
+ cmd => fun(#{client := Client} = _State) ->
+ ok = ?SEV_AWAIT_READY(Client, client, init)
+ end},
+
+ %% The actual test
+ #{desc => "order client continue (ttest)",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_CONTINUE(Client, ttest),
+ ok
+ end},
+ #{desc => "await client ready (ttest)",
+ cmd => fun(#{server := Server,
+ client := Client} = State) ->
+ case ?SEV_AWAIT_READY(Client, client, ttest,
+ [{server, Server}]) of
+ {ok, Result} ->
+ {ok, State#{result => Result}};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end},
+
+
+ %% *** Terminate server ***
+ #{desc => "order client terminate",
+ cmd => fun(#{client := Client} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Client),
+ ok
+ end},
+ #{desc => "await client down",
+ cmd => fun(#{client := Client} = State) ->
+ ?SEV_AWAIT_TERMINATION(Client),
+ State1 = maps:remove(client, State),
+ {ok, State1}
+ end},
+ #{desc => "order server terminate",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_ANNOUNCE_TERMINATE(Server),
+ ok
+ end},
+ #{desc => "await server down",
+ cmd => fun(#{server := Server} = _State) ->
+ ?SEV_AWAIT_TERMINATION(Server),
+ ok
+ end},
+
+
+ %% Present the results
+ #{desc => "present the results",
+ cmd => fun(#{result := Result} = State) ->
+ case Result of
+ #{status := ok,
+ runtime := RunTime,
+ cnt := Cnt,
+ bcnt := BCnt} ->
+ ?SEV_IPRINT(
+ "TTest results: "
+ "~n Run Time: ~s"
+ "~n Byte Count: ~s"
+ "~n Number of message exchanges: ~s"
+ "~n~n",
+ [
+ ?TTEST_LIB:format_time(RunTime),
+ if ((BCnt =:= 0) orelse (RunTime =:= 0)) ->
+ ?TTEST_LIB:format("~w, ~w",
+ [BCnt, RunTime]);
+ true ->
+ ?TTEST_LIB:format("~p => ~p byte / ms",
+ [BCnt, BCnt div RunTime])
+ end,
+ if (RunTime =:= 0) ->
+ "-";
+ true ->
+ ?TTEST_LIB:format("~p => ~p iterations / ms",
+ [Cnt, Cnt div RunTime])
+ end
+ ]),
+ {ok, maps:remove(result, State)};
+
+ #{status := Failure,
+ runtime := RunTime,
+ sid := SID,
+ rid := RID,
+ scnt := SCnt,
+ rcnt := RCnt,
+ bcnt := BCnt,
+ num := Num} ->
+ ?SEV_EPRINT("Time Test failed: "
+ "~n ~p"
+ "~n"
+ "~nwhen"
+ "~n"
+ "~n Run Time: ~s"
+ "~n Send ID: ~p"
+ "~n Recv ID: ~p"
+ "~n Send Count: ~p"
+ "~n Recv Count: ~p"
+ "~n Byte Count: ~p"
+ "~n Num Iterations: ~p",
+ [Failure,
+ ?TTEST_LIB:format_time(RunTime),
+ SID, RID, SCnt, RCnt, BCnt, Num]),
+ {error, Failure}
+ end
+ end},
+
+ %% This is just so that the printout above shall have time to come
+ %% out before then end of the test case.
+ ?SEV_SLEEP(?SECS(1)),
+
+ %% *** We are done ***
+ ?SEV_FINISH_NORMAL
+ ],
+
+ i("start server evaluator"),
+ ServerInitState = #{host => local_host(),
+ domain => maps:get(domain, InitState),
+ mod => maps:get(server_mod, InitState),
+ active => maps:get(server_active, InitState)},
+ Server = ?SEV_START("server", ServerSeq, ServerInitState),
+
+ i("start client evaluator"),
+ ClientInitState = #{host => local_host(),
+ domain => maps:get(domain, InitState),
+ mod => maps:get(client_mod, InitState),
+ active => maps:get(client_active, InitState),
+ msg_id => maps:get(msg_id, InitState),
+ max_outstanding => maps:get(max_outstanding, InitState),
+ runtime => maps:get(runtime, InitState)},
+ Client = ?SEV_START("client", ClientSeq, ClientInitState),
+
+ i("start 'tester' evaluator"),
+ TesterInitState = #{server => Server#ev.pid,
+ client => Client#ev.pid},
+ Tester = ?SEV_START("tester", TesterSeq, TesterInitState),
+
+ i("await evaluator(s)"),
+ ok = ?SEV_AWAIT_FINISH([Server, Client, Tester]).
+
+
+
+ttest_tcp_server_start(Node, gen, Active) ->
+ Transport = socket_test_ttest_tcp_gen,
+ socket_test_ttest_tcp_server:start_monitor(Node, Transport, Active);
+ttest_tcp_server_start(Node, sock, Active) ->
+ TransportMod = socket_test_ttest_tcp_socket,
+ Transport = {TransportMod, #{method => plain}},
+ socket_test_ttest_tcp_server:start_monitor(Node, Transport, Active).
+
+ttest_tcp_server_stop(Pid) ->
+ socket_test_ttest_tcp_server:stop(Pid).
+
+ttest_tcp_client_start(Node,
+ Notify,
+ gen,
+ Active, Addr, Port, MsgID, MaxOutstanding, RunTime) ->
+ Transport = socket_test_ttest_tcp_gen,
+ socket_test_ttest_tcp_client:start_monitor(Node,
+ Notify,
+ Transport,
+ Active,
+ Addr, Port,
+ MsgID, MaxOutstanding, RunTime);
+ttest_tcp_client_start(Node,
+ Notify,
+ sock,
+ Active, Addr, Port, MsgID, MaxOutstanding, RunTime) ->
+ TransportMod = socket_test_ttest_tcp_socket,
+ Transport = {TransportMod, #{method => plain}},
+ socket_test_ttest_tcp_client:start_monitor(Node,
+ Notify,
+ Transport,
+ Active,
+ Addr, Port,
+ MsgID, MaxOutstanding, RunTime).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+start_node(Host, NodeName) ->
+ UniqueNodeName = f("~w_~w", [NodeName, erlang:system_time(millisecond)]),
+ case do_start_node(Host, UniqueNodeName) of
+ {ok, _} = OK ->
+ global:sync(),
+ %% i("Node ~p started: "
+ %% "~n Nodes: ~p"
+ %% "~n Logger: ~p"
+ %% "~n Global Names: ~p",
+ %% [NodeName, nodes(),
+ %% global:whereis_name(socket_test_logger),
+ %% global:registered_names()]),
+ OK;
+ {error, Reason, _} ->
+ {error, Reason}
+ end.
+
+do_start_node(Host, NodeName) when is_list(NodeName) ->
+ do_start_node(Host, list_to_atom(NodeName));
+do_start_node(Host, NodeName) when is_atom(NodeName) ->
+ Dir = filename:dirname(code:which(?MODULE)),
+ Flags = "-pa " ++ Dir,
+ Opts = [{monitor_master, true}, {erl_flags, Flags}],
+ ct_slave:start(Host, NodeName, Opts).
+
+
+stop_node(Node) ->
+ case ct_slave:stop(Node) of
+ {ok, _} ->
+ ok;
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+sock_open(Domain, Type, Proto) ->
+ try socket:open(Domain, Type, Proto) of
+ {ok, Socket} ->
+ Socket;
+ {error, Reason} ->
+ ?FAIL({open, Reason})
+ catch
+ C:E:S ->
+ ?FAIL({open, C, E, S})
+ end.
+
+
+sock_bind(Sock, SockAddr) ->
+ try socket:bind(Sock, SockAddr) of
+ {ok, Port} ->
+ Port;
+ {error, Reason} ->
+ i("sock_bind -> error: ~p", [Reason]),
+ ?FAIL({bind, Reason})
+ catch
+ C:E:S ->
+ i("sock_bind -> failed: ~p, ~p, ~p", [C, E, S]),
+ ?FAIL({bind, C, E, S})
+ end.
+
+sock_connect(Sock, SockAddr) ->
+ try socket:connect(Sock, SockAddr) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ ?FAIL({connect, Reason})
+ catch
+ C:E:S ->
+ ?FAIL({connect, C, E, S})
+ end.
+
+sock_sockname(Sock) ->
+ try socket:sockname(Sock) of
+ {ok, SockAddr} ->
+ SockAddr;
+ {error, Reason} ->
+ ?FAIL({sockname, Reason})
+ catch
+ C:E:S ->
+ ?FAIL({sockname, C, E, S})
+ end.
+
+
+%% sock_listen(Sock) ->
+%% sock_listen2(fun() -> socket:listen(Sock) end).
+
+%% sock_listen(Sock, BackLog) ->
+%% sock_listen2(fun() -> socket:listen(Sock, BackLog) end).
+
+%% sock_listen2(Listen) ->
+%% try Listen() of
+%% ok ->
+%% ok;
+%% {error, Reason} ->
+%% ?FAIL({listen, Reason})
+%% catch
+%% C:E:S ->
+%% ?FAIL({listen, C, E, S})
+%% end.
+
+
+%% sock_accept(LSock) ->
+%% try socket:accept(LSock) of
+%% {ok, Sock} ->
+%% Sock;
+%% {error, Reason} ->
+%% i("sock_accept -> error: ~p", [Reason]),
+%% ?FAIL({accept, Reason})
+%% catch
+%% C:E:S ->
+%% i("sock_accept -> failed: ~p, ~p, ~p", [C, E, S]),
+%% ?FAIL({accept, C, E, S})
+%% end.
+
+
+sock_close(Sock) ->
+ try socket:close(Sock) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ i("sock_close -> error: ~p", [Reason]),
+ ?FAIL({close, Reason})
+ catch
+ C:E:S ->
+ i("sock_close -> failed: ~p, ~p, ~p", [C, E, S]),
+ ?FAIL({close, C, E, S})
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+local_host() ->
+ try net_adm:localhost() of
+ Host when is_list(Host) ->
+ %% Convert to shortname if long
+ case string:tokens(Host, [$.]) of
+ [H|_] ->
+ list_to_atom(H)
+ end
+ catch
+ C:E:S ->
+ erlang:raise(C, E, S)
+ end.
+
+
+%% This gets the local address (not 127.0...)
+%% We should really implement this using the (new) net module,
+%% but until that gets the necessary functionality...
+which_local_addr(Domain) ->
+ case inet:getifaddrs() of
+ {ok, IFL} ->
+ which_addr(Domain, IFL);
+ {error, Reason} ->
+ ?FAIL({inet, getifaddrs, Reason})
+ end.
+
+which_addr(_Domain, []) ->
+ ?FAIL(no_address);
+which_addr(Domain, [{"lo" ++ _, _}|IFL]) ->
+ which_addr(Domain, IFL);
+which_addr(Domain, [{_Name, IFO}|IFL]) ->
+ case which_addr2(Domain, IFO) of
+ {ok, Addr} ->
+ Addr;
+ {error, no_address} ->
+ which_addr(Domain, IFL)
+ end;
+which_addr(Domain, [_|IFL]) ->
+ which_addr(Domain, IFL).
+
+which_addr2(_Domain, []) ->
+ {error, no_address};
+which_addr2(inet = _Domain, [{addr, Addr}|_IFO]) when (size(Addr) =:= 4) ->
+ {ok, Addr};
+which_addr2(inet6 = _Domain, [{addr, Addr}|_IFO]) when (size(Addr) =:= 8) ->
+ {ok, Addr};
+which_addr2(Domain, [_|IFO]) ->
+ which_addr2(Domain, IFO).
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+not_yet_implemented() ->
+ skip("not yet implemented").
+
+skip(Reason) ->
+ throw({skip, Reason}).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+t() ->
+ os:timestamp().
+
+
+tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) ->
+ T1 = A1*1000000000+B1*1000+(C1 div 1000),
+ T2 = A2*1000000000+B2*1000+(C2 div 1000),
+ T2 - T1.
+
+
+formated_timestamp() ->
+ format_timestamp(os:timestamp()).
+
+format_timestamp({_N1, _N2, _N3} = TS) ->
+ {_Date, Time} = calendar:now_to_local_time(TS),
+ %% {YYYY,MM,DD} = Date,
+ {Hour,Min,Sec} = Time,
+ %% FormatTS =
+ %% io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w.~w",
+ %% [YYYY, MM, DD, Hour, Min, Sec, N3]),
+ FormatTS = io_lib:format("~.2.0w:~.2.0w:~.2.0w", [Hour, Min, Sec]),
+ lists:flatten(FormatTS).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+set_tc_name(N) when is_atom(N) ->
+ set_tc_name(atom_to_list(N));
+set_tc_name(N) when is_list(N) ->
+ put(tc_name, N).
+
+%% get_tc_name() ->
+%% get(tc_name).
+
+tc_begin(TC) ->
+ set_tc_name(TC),
+ tc_print("begin ***",
+ "~n----------------------------------------------------~n", "").
+
+tc_end(Result) when is_list(Result) ->
+ tc_print("done: ~s", [Result],
+ "", "----------------------------------------------------~n~n"),
+ ok.
+
+
+tc_try(Case, Fun) when is_atom(Case) andalso is_function(Fun, 0) ->
+ tc_begin(Case),
+ try
+ begin
+ Fun(),
+ ?SLEEP(?SECS(1)),
+ tc_end("ok")
+ end
+ catch
+ throw:{skip, _} = SKIP ->
+ tc_end("skipping"),
+ SKIP;
+ Class:Error:Stack ->
+ tc_end("failed"),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+
+tc_print(F, Before, After) ->
+ tc_print(F, [], Before, After).
+
+tc_print(F, A, Before, After) ->
+ Name = tc_which_name(),
+ FStr = f("*** [~s][~s][~p] " ++ F ++ "~n",
+ [formated_timestamp(),Name,self()|A]),
+ io:format(user, Before ++ FStr ++ After, []).
+
+tc_which_name() ->
+ case get(tc_name) of
+ undefined ->
+ case get(sname) of
+ undefined ->
+ "";
+ SName when is_list(SName) ->
+ SName
+ end;
+ Name when is_list(Name) ->
+ Name
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+l2a(S) when is_list(S) ->
+ list_to_atom(S).
+
+l2b(L) when is_list(L) ->
+ list_to_binary(L).
+
+b2l(B) when is_binary(B) ->
+ binary_to_list(B).
+
+f(F, A) ->
+ lists:flatten(io_lib:format(F, A)).
+
+%% p(F) ->
+%% p(F, []).
+
+%% p(F, A) ->
+%% p(F, A, "", "").
+
+%% p(F, A, Before, After) when is_list(Before) andalso is_list(After) ->
+%% TcName =
+%% case get(tc_name) of
+%% undefined ->
+%% case get(sname) of
+%% undefined ->
+%% "";
+%% SName when is_list(SName) ->
+%% SName
+%% end;
+%% Name when is_list(Name) ->
+%% Name
+%% end,
+%% FStr = f("*** [~s][~s][~p] " ++ F ++ "~n",
+%% [formated_timestamp(),TcName,self()|A]),
+%% i(Before ++ FStr ++ After, []).
+
+
+%% d(F, A) ->
+%% d(get(dbg_fd), F, A).
+
+%% d(undefined, F, A) ->
+%% [NodeNameStr|_] = string:split(atom_to_list(node()), [$@]),
+%% DbgFileName = f("~s-dbg.txt", [NodeNameStr]),
+%% case file:open(DbgFileName, [write]) of
+%% {ok, FD} ->
+%% put(dbg_fd, FD),
+%% d(FD, F, A);
+%% {error, Reason} ->
+%% exit({failed_open_dbg_file, Reason})
+%% end;
+%% d(FD, F, A) ->
+%% io:format(FD, "~s~n", [f("[~s] " ++ F, [formated_timestamp()|A])]).
+
+i(F) ->
+ i(F, []).
+
+i(F, A) ->
+ FStr = f("[~s] " ++ F, [formated_timestamp()|A]),
+ io:format(user, FStr ++ "~n", []),
+ io:format(FStr, []).
+
diff --git a/erts/emulator/test/socket_test_evaluator.erl b/erts/emulator/test/socket_test_evaluator.erl
new file mode 100644
index 0000000000..c5748ac21b
--- /dev/null
+++ b/erts/emulator/test/socket_test_evaluator.erl
@@ -0,0 +1,563 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_evaluator).
+
+%% Evaluator control functions
+-export([
+ start/3,
+ await_finish/1
+ ]).
+
+%% Functions used by evaluators to interact with eachother
+-export([
+ %% Announce functions
+ %% (Send an announcement from one evaluator to another)
+ announce_start/1, announce_start/2,
+ announce_continue/2, announce_continue/3,
+ announce_ready/2, announce_ready/3,
+ announce_terminate/1,
+
+ %% Await functions
+ %% (Wait for an announcement from another evaluator)
+ await_start/0, await_start/1,
+ await_continue/3, await_continue/4,
+ await_ready/3, await_ready/4,
+ await_terminate/2, await_terminate/3,
+ await_termination/1, await_termination/2
+ ]).
+
+%% Utility functions
+-export([
+ iprint/2, % Info printouts
+ eprint/2 % Error printouts
+ ]).
+
+-export_type([
+ ev/0,
+ initial_evaluator_state/0,
+ evaluator_state/0,
+ command_fun/0,
+ command/0
+ ]).
+
+
+-include("socket_test_evaluator.hrl").
+
+-type ev() :: #ev{}.
+-type initial_evaluator_state() :: map().
+-type evaluator_state() :: term().
+-type command_fun() ::
+ fun((State :: evaluator_state()) -> ok) |
+ fun((State :: evaluator_state()) -> {ok, evaluator_state()}) |
+ fun((State :: evaluator_state()) -> {error, term()}).
+
+-type command() :: #{desc := string(),
+ cmd := command_fun()}.
+
+
+%% ============================================================================
+
+-define(LIB, socket_test_lib).
+-define(LOGGER, socket_test_logger).
+
+-define(EXTRA_NOTHING, '$nothing').
+-define(ANNOUNCEMENT_START, '$start').
+-define(ANNOUNCEMENT_READY, '$ready').
+-define(ANNOUNCEMENT_CONTINUE, '$continue').
+-define(ANNOUNCEMENT_TERMINATE, '$terminate').
+
+-define(START_NAME_NONE, '$no-name').
+-define(START_SLOGAN, ?ANNOUNCEMENT_START).
+-define(TERMINATE_SLOGAN, ?ANNOUNCEMENT_TERMINATE).
+
+
+%% ============================================================================
+
+-spec start(Name, Seq, Init) -> ev() when
+ Name :: string(),
+ Seq :: [command()],
+ Init :: initial_evaluator_state().
+
+start(Name, Seq, InitState)
+ when is_list(Name) andalso is_list(Seq) andalso (Seq =/= []) ->
+ %% Make sure 'parent' is not already used
+ case maps:find(parent, InitState) of
+ {ok, _} ->
+ erlang:error({already_used, parent});
+ error ->
+ InitState2 = InitState#{parent => self()},
+ Pid = erlang:spawn_link(
+ fun() -> init(Name, Seq, InitState2) end),
+ MRef = erlang:monitor(process, Pid),
+ #ev{name = Name, pid = Pid, mref = MRef}
+ end.
+
+init(Name, Seq, Init) ->
+ put(sname, Name),
+ loop(1, Seq, Init).
+
+loop(_ID, [], FinalState) ->
+ exit(FinalState);
+loop(ID, [#{desc := Desc,
+ cmd := Cmd}|Cmds], State) when is_function(Cmd, 1) ->
+ iprint("evaluate command ~2w: ~s", [ID, Desc]),
+ try Cmd(State) of
+ ok ->
+ loop(ID + 1, Cmds, State);
+ {ok, NewState} ->
+ loop(ID + 1, Cmds, NewState);
+ {skip, Reason} ->
+ exit({skip, Reason});
+ {error, Reason} ->
+ eprint("command ~w failed: "
+ "~n Reason: ~p", [ID, Reason]),
+ exit({command_failed, ID, Reason, State})
+ catch
+ throw:{skip, R} = E:_ ->
+ eprint("command ~w skip: "
+ "~n Skip Reason: ~p", [ID, R]),
+ exit(E);
+ C:E:S ->
+ eprint("command ~w crashed: "
+ "~n Class: ~p"
+ "~n Error: ~p"
+ "~n Call Stack: ~p", [ID, C, E, S]),
+ exit({command_crashed, ID, {C,E,S}, State})
+ end.
+
+
+%% ============================================================================
+
+-spec await_finish(Evs) -> term() when
+ Evs :: [ev()].
+
+await_finish(Evs) ->
+ await_finish(Evs, [], []).
+
+await_finish([], _, []) ->
+ ok;
+await_finish([], _OK, Fails) ->
+ ?SEV_EPRINT("Fails: "
+ "~n ~p", [Fails]),
+ Fails;
+await_finish(Evs, OK, Fails) ->
+ receive
+ %% Successfull termination of evaluator
+ {'DOWN', _MRef, process, Pid, normal} ->
+ {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails),
+ await_finish(Evs2, OK2, Fails2);
+ {'EXIT', Pid, normal} ->
+ {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails),
+ await_finish(Evs2, OK2, Fails2);
+
+ %% The evaluator can skip the teat case:
+ {'DOWN', _MRef, process, Pid, {skip, Reason}} ->
+ await_finish_skip(Pid, Reason, Evs, OK);
+ {'EXIT', Pid, {skip, Reason}} ->
+ await_finish_skip(Pid, Reason, Evs, OK);
+
+ %% Evaluator failed
+ {'DOWN', _MRef, process, Pid, Reason} ->
+ {Evs2, OK2, Fails2} = await_finish_fail(Pid, Reason, Evs, OK, Fails),
+ await_finish(Evs2, OK2, Fails2);
+ {'EXIT', Pid, Reason} ->
+ {Evs2, OK2, Fails2} = await_finish_fail(Pid, Reason, Evs, OK, Fails),
+ await_finish(Evs2, OK2, Fails2)
+ end.
+
+
+await_finish_normal(Pid, Evs, OK, Fails) ->
+ case lists:keysearch(Pid, #ev.pid, Evs) of
+ {value, #ev{name = Name}} ->
+ iprint("evaluator '~s' (~p) success", [Name, Pid]),
+ NewEvs = lists:keydelete(Pid, #ev.pid, Evs),
+ {NewEvs, [Pid|OK], Fails};
+ false ->
+ case lists:member(Pid, OK) of
+ true ->
+ ok;
+ false ->
+ iprint("unknown process ~p died (normal)", [Pid]),
+ ok
+ end,
+ {Evs, OK, Fails}
+ end.
+
+await_finish_skip(Pid, Reason, Evs, OK) ->
+ case lists:keysearch(Pid, #ev.pid, Evs) of
+ {value, #ev{name = Name}} ->
+ iprint("evaluator '~s' (~p) issued SKIP: "
+ "~n ~p", [Name, Pid, Reason]);
+ false ->
+ case lists:member(Pid, OK) of
+ true ->
+ ok;
+ false ->
+ iprint("unknown process ~p issued SKIP: "
+ "~n ~p", [Pid, Reason])
+ end
+ end,
+ ?LIB:skip(Reason).
+
+
+await_finish_fail(Pid, Reason, Evs, OK, Fails) ->
+ case lists:keysearch(Pid, #ev.pid, Evs) of
+ {value, #ev{name = Name}} ->
+ iprint("evaluator '~s' (~p) failed", [Name, Pid]),
+ NewEvs = lists:keydelete(Pid, #ev.pid, Evs),
+ {NewEvs, OK, [{Pid, Reason}|Fails]};
+ false ->
+ case lists:member(Pid, OK) of
+ true ->
+ ok;
+ false ->
+ iprint("unknown process ~p died: "
+ "~n ~p", [Pid, Reason])
+ end,
+ {Evs, OK, Fails}
+ end.
+
+
+
+%% ============================================================================
+
+-spec announce_start(To) -> ok when
+ To :: pid().
+
+announce_start(To) ->
+ announce(To, ?ANNOUNCEMENT_START, ?START_SLOGAN).
+
+-spec announce_start(To, Extra) -> ok when
+ To :: pid(),
+ Extra :: term().
+
+announce_start(To, Extra) ->
+ announce(To, ?ANNOUNCEMENT_START, ?START_SLOGAN, Extra).
+
+
+%% ============================================================================
+
+-spec announce_continue(To, Slogan) -> ok when
+ To :: pid(),
+ Slogan :: atom().
+
+announce_continue(To, Slogan) ->
+ announce_continue(To, Slogan, ?EXTRA_NOTHING).
+
+-spec announce_continue(To, Slogan, Extra) -> ok when
+ To :: pid(),
+ Slogan :: atom(),
+ Extra :: term().
+
+announce_continue(To, Slogan, Extra) ->
+ announce(To, ?ANNOUNCEMENT_CONTINUE, Slogan, Extra).
+
+
+%% ============================================================================
+
+-spec announce_ready(To, Slogan) -> ok when
+ To :: pid(),
+ Slogan :: atom().
+
+announce_ready(To, Slogan) ->
+ announce_ready(To, Slogan, ?EXTRA_NOTHING).
+
+-spec announce_ready(To, Slogan, Extra) -> ok when
+ To :: pid(),
+ Slogan :: atom(),
+ Extra :: term().
+
+announce_ready(To, Slogan, Extra) ->
+ announce(To, ?ANNOUNCEMENT_READY, Slogan, Extra).
+
+
+%% ============================================================================
+
+-spec announce_terminate(To) -> ok when
+ To :: pid().
+
+announce_terminate(To) ->
+ announce(To, ?ANNOUNCEMENT_TERMINATE, ?TERMINATE_SLOGAN).
+
+
+%% ============================================================================
+
+-spec announce(To, Announcement, Slogan) -> ok when
+ To :: pid(),
+ Announcement :: atom(),
+ Slogan :: atom().
+
+announce(To, Announcement, Slogan) ->
+ announce(To, Announcement, Slogan, ?EXTRA_NOTHING).
+
+-spec announce(To, Announcement, Slogan, Extra) -> ok when
+ To :: pid(),
+ Announcement :: atom(),
+ Slogan :: atom(),
+ Extra :: term().
+
+announce(To, Announcement, Slogan, Extra)
+ when is_pid(To) andalso
+ is_atom(Announcement) andalso
+ is_atom(Slogan) ->
+ %% iprint("announce -> entry with: "
+ %% "~n To: ~p"
+ %% "~n Announcement: ~p"
+ %% "~n Slogan: ~p"
+ %% "~n Extra: ~p",
+ %% [To, Announcement, Slogan, Extra]),
+ To ! {Announcement, self(), Slogan, Extra},
+ ok.
+
+
+
+%% ============================================================================
+
+-spec await_start() -> Pid | {Pid, Extra} when
+ Pid :: pid(),
+ Extra :: term().
+
+await_start() ->
+ await_start(any).
+
+-spec await_start(Pid) -> Pid | {Pid, Extra} when
+ Pid :: pid(),
+ Extra :: term().
+
+await_start(P) when is_pid(P) orelse (P =:= any) ->
+ case await(P, ?START_NAME_NONE, ?ANNOUNCEMENT_START, ?START_SLOGAN, []) of
+ {ok, Any} when is_pid(P) ->
+ Any;
+ {ok, Pid} when is_pid(Pid) andalso (P =:= any) ->
+ Pid;
+ {ok, {Pid, _} = OK} when is_pid(Pid) andalso (P =:= any) ->
+ OK
+ end.
+
+
+%% ============================================================================
+
+-spec await_continue(From, Name, Slogan) -> ok | {ok, Extra} | {error, Reason} when
+ From :: pid(),
+ Name :: atom(),
+ Slogan :: atom(),
+ Extra :: term(),
+ Reason :: term().
+
+await_continue(From, Name, Slogan) ->
+ await_continue(From, Name, Slogan, []).
+
+-spec await_continue(From, Name, Slogan, OtherPids) ->
+ ok | {ok, Extra} | {error, Reason} when
+ From :: pid(),
+ Name :: atom(),
+ Slogan :: atom(),
+ OtherPids :: [{pid(), atom()}],
+ Extra :: term(),
+ Reason :: term().
+
+await_continue(From, Name, Slogan, OtherPids)
+ when is_pid(From) andalso
+ is_atom(Name) andalso
+ is_atom(Slogan) andalso
+ is_list(OtherPids) ->
+ await(From, Name, ?ANNOUNCEMENT_CONTINUE, Slogan, OtherPids).
+
+
+
+%% ============================================================================
+
+-spec await_ready(From, Name, Slogan) -> ok | {ok, Extra} | {error, Reason} when
+ From :: pid(),
+ Name :: atom(),
+ Slogan :: atom(),
+ Extra :: term(),
+ Reason :: term().
+
+await_ready(From, Name, Slogan) ->
+ await_ready(From, Name, Slogan, []).
+
+-spec await_ready(From, Name, Slogan, OtherPids) ->
+ ok | {ok, Extra} | {error, Reason} when
+ From :: pid(),
+ Name :: atom(),
+ Slogan :: atom(),
+ OtherPids :: [{pid(), atom()}],
+ Extra :: term(),
+ Reason :: term().
+
+await_ready(From, Name, Slogan, OtherPids)
+ when is_pid(From) andalso
+ is_atom(Name) andalso
+ is_atom(Slogan) andalso
+ is_list(OtherPids) ->
+ await(From, Name, ?ANNOUNCEMENT_READY, Slogan, OtherPids).
+
+
+
+%% ============================================================================
+
+-spec await_terminate(Pid, Name) -> ok | {error, Reason} when
+ Pid :: pid(),
+ Name :: atom(),
+ Reason :: term().
+
+await_terminate(Pid, Name) when is_pid(Pid) andalso is_atom(Name) ->
+ await_terminate(Pid, Name, []).
+
+-spec await_terminate(Pid, Name, OtherPids) -> ok | {error, Reason} when
+ Pid :: pid(),
+ Name :: atom(),
+ OtherPids :: [{pid(), atom()}],
+ Reason :: term().
+
+await_terminate(Pid, Name, OtherPids) ->
+ await(Pid, Name, ?ANNOUNCEMENT_TERMINATE, ?TERMINATE_SLOGAN, OtherPids).
+
+
+%% ============================================================================
+
+-spec await_termination(Pid) -> ok | {error, Reason} when
+ Pid :: pid(),
+ Reason :: term().
+
+await_termination(Pid) when is_pid(Pid) ->
+ await_termination(Pid, any).
+
+-spec await_termination(Pid, ExpReason) -> ok | {error, Reason} when
+ Pid :: pid(),
+ ExpReason :: term(),
+ Reason :: term().
+
+await_termination(Pid, ExpReason) ->
+ receive
+ {'DOWN', _, process, Pid, _} when (ExpReason =:= any) ->
+ ok;
+ {'DOWN', _, process, Pid, Reason} when (ExpReason =:= Reason) ->
+ ok;
+ {'DOWN', _, process, Pid, Reason} ->
+ {error, {unexpected_exit, ExpReason, Reason}}
+ end.
+
+
+%% ============================================================================
+
+%% We expect a message (announcement) from Pid, but we also watch for DOWN from
+%% both Pid and OtherPids, in which case the test has failed!
+
+-spec await(ExpPid, Name, Announcement, Slogan, OtherPids) ->
+ ok | {ok, Extra} | {error, Reason} when
+ ExpPid :: any | pid(),
+ Name :: atom(),
+ Announcement :: atom(),
+ Slogan :: atom(),
+ OtherPids :: [{pid(), atom()}],
+ Extra :: term(),
+ Reason :: term().
+
+await(ExpPid, Name, Announcement, Slogan, OtherPids)
+ when (is_pid(ExpPid) orelse (ExpPid =:= any)) andalso
+ is_atom(Name) andalso
+ is_atom(Announcement) andalso
+ is_atom(Slogan) andalso
+ is_list(OtherPids) ->
+ receive
+ {Announcement, Pid, Slogan, ?EXTRA_NOTHING} when (ExpPid =:= any) ->
+ {ok, Pid};
+ {Announcement, Pid, Slogan, Extra} when (ExpPid =:= any) ->
+ {ok, {Pid, Extra}};
+ {Announcement, Pid, Slogan, ?EXTRA_NOTHING} when (Pid =:= ExpPid) ->
+ ok;
+ {Announcement, Pid, Slogan, Extra} when (Pid =:= ExpPid) ->
+ {ok, Extra};
+ {'DOWN', _, process, Pid, {skip, SkipReason}} when (Pid =:= ExpPid) ->
+ iprint("Unexpected SKIP from ~w (~p): "
+ "~n ~p", [Name, Pid, SkipReason]),
+ ?LIB:skip({Name, SkipReason});
+ {'DOWN', _, process, Pid, Reason} when (Pid =:= ExpPid) ->
+ eprint("Unexpected DOWN from ~w (~p): "
+ "~n ~p", [Name, Pid, Reason]),
+ {error, {unexpected_exit, Name}};
+ {'DOWN', _, process, OtherPid, Reason} ->
+ case check_down(OtherPid, Reason, OtherPids) of
+ ok ->
+ iprint("DOWN from unknown process ~p: "
+ "~n ~p", [OtherPid, Reason]),
+ await(ExpPid, Name, Announcement, Slogan, OtherPids);
+ {error, _} = ERROR ->
+ ERROR
+ end
+ after infinity -> % For easy debugging, just change to some valid time (5000)
+ iprint("await -> timeout for msg from ~p (~w): "
+ "~n Announcement: ~p"
+ "~n Slogan: ~p"
+ "~nwhen"
+ "~n Messages: ~p",
+ [ExpPid, Name, Announcement, Slogan, pi(messages)]),
+ await(ExpPid, Name, Announcement, Slogan, OtherPids)
+ end.
+
+pi(Item) ->
+ pi(self(), Item).
+
+pi(Pid, Item) ->
+ {Item, Info} = process_info(Pid, Item),
+ Info.
+
+check_down(Pid, DownReason, Pids) ->
+ case lists:keymember(Pid, 1, Pids) of
+ {value, {_, Name}} ->
+ eprint("Unexpected DOWN from ~w (~p): "
+ "~n ~p", [Name, Pid, DownReason]),
+ {error, {unexpected_exit, Name}};
+ false ->
+ ok
+ end.
+
+
+%% ============================================================================
+
+f(F, A) ->
+ lists:flatten(io_lib:format(F, A)).
+
+
+iprint(F, A) ->
+ print("", F, A).
+
+eprint(F, A) ->
+ print("<ERROR> ", F, A).
+
+print(Prefix, F, A) ->
+ %% The two prints is to get the output both in the shell (for when
+ %% "personal" testing is going on) and in the logs.
+ IDStr =
+ case get(sname) of
+ undefined ->
+ %% This means its not an evaluator,
+ %% or a named process. Instead its
+ %% most likely the test case itself,
+ %% so skip the name and the pid.
+ "";
+ SName ->
+ f("[~s][~p]", [SName, self()])
+ end,
+ ?LOGGER:format("[~s]~s ~s" ++ F,
+ [?LIB:formated_timestamp(), IDStr, Prefix | A]).
diff --git a/erts/emulator/test/socket_test_evaluator.hrl b/erts/emulator/test/socket_test_evaluator.hrl
new file mode 100644
index 0000000000..5be49dc022
--- /dev/null
+++ b/erts/emulator/test/socket_test_evaluator.hrl
@@ -0,0 +1,68 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifndef(socket_test_evaluator).
+-define(socket_test_evaluator, true).
+
+-record(ev, {name :: string(),
+ pid :: pid(),
+ mref :: reference()}).
+
+-define(SEV, socket_test_evaluator).
+
+-define(SEV_START(N, S, IS), ?SEV:start(N, S, IS)).
+-define(SEV_AWAIT_FINISH(Evs), ?SEV:await_finish(Evs)).
+
+-define(SEV_ANNOUNCE_START(To), ?SEV:announce_start(To)).
+-define(SEV_ANNOUNCE_START(To, Ex), ?SEV:announce_start(To, Ex)).
+-define(SEV_ANNOUNCE_CONTINUE(To, S), ?SEV:announce_continue(To, S)).
+-define(SEV_ANNOUNCE_CONTINUE(To, S, Ex), ?SEV:announce_continue(To, S, Ex)).
+-define(SEV_ANNOUNCE_READY(To, S), ?SEV:announce_ready(To, S)).
+-define(SEV_ANNOUNCE_READY(To, S, Ex), ?SEV:announce_ready(To, S, Ex)).
+-define(SEV_ANNOUNCE_TERMINATE(To), ?SEV:announce_terminate(To)).
+
+-define(SEV_AWAIT_START(), ?SEV:await_start()).
+-define(SEV_AWAIT_START(P), ?SEV:await_start(P)).
+-define(SEV_AWAIT_CONTINUE(F, N, S), ?SEV:await_continue(F, N, S)).
+-define(SEV_AWAIT_CONTINUE(F, N, S, Ps), ?SEV:await_continue(F, N, S, Ps)).
+-define(SEV_AWAIT_READY(F, N, S), ?SEV:await_ready(F, N, S)).
+-define(SEV_AWAIT_READY(F, N, S, Ps), ?SEV:await_ready(F, N, S, Ps)).
+-define(SEV_AWAIT_TERMINATE(F, N), ?SEV:await_terminate(F, N)).
+-define(SEV_AWAIT_TERMINATE(F, N, Ps), ?SEV:await_terminate(F, N, Ps)).
+-define(SEV_AWAIT_TERMINATION(P), ?SEV:await_termination(P)).
+-define(SEV_AWAIT_TERMINATION(P, R), ?SEV:await_termination(P, R)).
+
+-define(SEV_IPRINT(F, A), ?SEV:iprint(F, A)).
+-define(SEV_IPRINT(F), ?SEV_IPRINT(F, [])).
+-define(SEV_EPRINT(F, A), ?SEV:eprint(F, A)).
+-define(SEV_EPRINT(F), ?SEV_EPRINT(F, [])).
+
+-define(SEV_SLEEP(T), #{desc => "sleep",
+ cmd => fun(_) ->
+ ?SLEEP(T),
+ ok
+ end}).
+-define(SEV_FINISH_NORMAL, #{desc => "finish",
+ cmd => fun(_) ->
+ {ok, normal}
+ end}).
+
+-endif. % -ifdef(socket_test_evaluator).
+
diff --git a/erts/emulator/test/socket_test_lib.erl b/erts/emulator/test/socket_test_lib.erl
new file mode 100644
index 0000000000..4e65c4f3c0
--- /dev/null
+++ b/erts/emulator/test/socket_test_lib.erl
@@ -0,0 +1,98 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_lib).
+
+-export([
+ pi/1, pi/2, pi/3,
+
+ %% Time stuff
+ timestamp/0,
+ tdiff/2,
+ formated_timestamp/0,
+ format_timestamp/1,
+
+ %% String and format
+ f/2,
+
+ %% Skipping
+ not_yet_implemented/0,
+ skip/1
+ ]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+pi(Item) when is_atom(Item) ->
+ pi(self(), Item).
+
+pi(Pid, Item) when is_pid(Pid) andalso is_atom(Item) ->
+ {Item, Info} = process_info(Pid, Item),
+ Info;
+pi(Node, Pid) when is_pid(Pid) ->
+ rpc:call(Node, erlang, process_info, [Pid]).
+
+pi(Node, Pid, Item) when is_pid(Pid) andalso is_atom(Item) ->
+ rpc:call(Node, erlang, process_info, [Pid, Item]).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+timestamp() ->
+ os:timestamp().
+
+
+tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) ->
+ T1 = A1*1000000000+B1*1000+(C1 div 1000),
+ T2 = A2*1000000000+B2*1000+(C2 div 1000),
+ T2 - T1.
+
+
+formated_timestamp() ->
+ format_timestamp(os:timestamp()).
+
+format_timestamp({_N1, _N2, _N3} = TS) ->
+ {_Date, Time} = calendar:now_to_local_time(TS),
+ %% {YYYY,MM,DD} = Date,
+ {Hour,Min,Sec} = Time,
+ %% FormatTS =
+ %% io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w.~w",
+ %% [YYYY, MM, DD, Hour, Min, Sec, N3]),
+ FormatTS = io_lib:format("~.2.0w:~.2.0w:~.2.0w", [Hour, Min, Sec]),
+ lists:flatten(FormatTS).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+f(F, A) ->
+ lists:flatten(io_lib:format(F, A)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+not_yet_implemented() ->
+ skip("not yet implemented").
+
+skip(Reason) ->
+ throw({skip, Reason}).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/erts/emulator/test/socket_test_logger.erl b/erts/emulator/test/socket_test_logger.erl
new file mode 100644
index 0000000000..26610e9ef3
--- /dev/null
+++ b/erts/emulator/test/socket_test_logger.erl
@@ -0,0 +1,118 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_logger).
+
+-export([
+ start/0, start/1,
+ stop/0,
+ format/2
+ ]).
+
+
+-define(QUIET, true).
+-define(LIB, socket_test_lib).
+-define(LOGGER, ?MODULE).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+start() ->
+ start(?QUIET).
+
+start(Quiet) ->
+ case global:whereis_name(?LOGGER) of
+ Pid when is_pid(Pid) ->
+ ok;
+ undefined ->
+ Self = self(),
+ Pid = spawn_link(fun() -> init(Self, Quiet) end),
+ yes = global:register_name(?LOGGER, Pid),
+ ok
+ end.
+
+
+stop() ->
+ case global:whereis_name(?LOGGER) of
+ undefined ->
+ ok;
+ Pid when is_pid(Pid) ->
+ global:unregister_name(?LOGGER),
+ Pid ! {?LOGGER, '$logger', stop},
+ ok
+ end.
+
+
+format(F, []) ->
+ do_format(F);
+format(F, A) ->
+ do_format(?LIB:f(F, A)).
+
+do_format(Msg) ->
+ case global:whereis_name(?LOGGER) of
+ undefined ->
+ ok;
+ Pid when is_pid(Pid) ->
+ Pid ! {?MODULE, '$logger', {msg, Msg}},
+ ok
+ end.
+
+init(Parent, Quiet) ->
+ put(sname, "logger"),
+ print("[~s][logger] starting~n", [?LIB:formated_timestamp()]),
+ loop(#{parent => Parent, quiet => Quiet}).
+
+loop(#{parent := Parent,
+ quiet := Quiet} = State) ->
+ receive
+ {'EXIT', Parent, _} ->
+ print("[~s][logger] parent exit~n", [?LIB:formated_timestamp()]),
+ exit(normal);
+
+ {?MODULE, '$logger', stop} ->
+ print("[~s][logger] stopping~n", [?LIB:formated_timestamp()]),
+ exit(normal);
+
+ {?MODULE, '$logger', {msg, Msg}} ->
+ print_str(Quiet, Msg),
+ loop(State)
+ end.
+
+
+print(F, A) ->
+ print_str(false, ?LIB:f(F, A)).
+
+print_str(Quiet, Str) ->
+ try
+ begin
+ if (Quiet =/= true) -> io:format(user, Str ++ "~n", []);
+ true -> ok
+ end,
+ io:format(Str, [])
+ end
+ catch
+ _:_:_ ->
+ io:format(user,
+ "~nFailed Format message:"
+ "~n~p~n", [Str]),
+ io:format("~nFailed Format message:"
+ "~n~p~n", [Str])
+ end.
+
diff --git a/lib/kernel/src/net.erl b/erts/emulator/test/socket_test_ttest.hrl
index 2d0ae2ed0c..1a004a9a7a 100644
--- a/lib/kernel/src/net.erl
+++ b/erts/emulator/test/socket_test_ttest.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -17,24 +17,16 @@
%%
%% %CopyrightEnd%
%%
--module(net).
-%% Various network functions, kept here for compatibility
+-ifndef(socket_test_ttest).
+-define(socket_test_ttest, true).
--export([call/4,
- cast/4,
- broadcast/3,
- ping/1,
- relay/1,
- sleep/1]).
+-define(TTEST_TAG, 42).
+-define(TTEST_TYPE_REQUEST, 101).
+-define(TTEST_TYPE_REPLY, 102).
--deprecated(module).
-
-call(N,M,F,A) -> rpc:call(N,M,F,A).
-cast(N,M,F,A) -> rpc:cast(N,M,F,A).
-broadcast(M,F,A) -> rpc:eval_everywhere(M,F,A).
-ping(Node) -> net_adm:ping(Node).
-sleep(T) -> receive after T -> ok end.
-relay(X) -> slave:relay(X).
+-define(SECS(I), timer:seconds(I)).
+-define(SLEEP(T), receive after T -> ok end).
+-endif. % -ifdef(socket_test_ttest).
diff --git a/erts/emulator/test/socket_test_ttest_client.hrl b/erts/emulator/test/socket_test_ttest_client.hrl
new file mode 100644
index 0000000000..84e736cc34
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_client.hrl
@@ -0,0 +1,141 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifndef(socket_test_ttest_client).
+-define(socket_test_ttest_client, true).
+
+-define(MSG_ID_DEFAULT, 2).
+-define(RUNTIME_DEFAULT, ?SECS(10)).
+-define(MAX_ID, 16#FFFFFFFF).
+
+-define(MSG_DATA1, <<"This is test data 0123456789 0123456789 0123456789">>).
+-define(MSG_DATA2, <<"This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789">>).
+-define(MSG_DATA3, <<"This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789"
+ "This is test data 0123456789 0123456789 0123456789">>).
+
+
+-endif. % -ifdef(socket_test_ttest_client).
diff --git a/erts/emulator/test/socket_test_ttest_lib.erl b/erts/emulator/test/socket_test_ttest_lib.erl
new file mode 100644
index 0000000000..7fc13df46a
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_lib.erl
@@ -0,0 +1,127 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_ttest_lib).
+
+-compile({no_auto_import, [error/2]}).
+
+-export([
+ t/0, tdiff/2,
+ formated_timestamp/0, format_timestamp/1,
+ format_time/1,
+
+ formated_process_stats/1, formated_process_stats/2,
+
+ format/2,
+ error/1, error/2,
+ info/1, info/2
+ ]).
+
+%% ==========================================================================
+
+t() ->
+ os:timestamp().
+
+tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) ->
+ T1 = A1*1000000000+B1*1000+(C1 div 1000),
+ T2 = A2*1000000000+B2*1000+(C2 div 1000),
+ T2 - T1.
+
+formated_timestamp() ->
+ format_timestamp(os:timestamp()).
+
+format_timestamp({_N1, _N2, N3} = TS) ->
+ {_Date, Time} = calendar:now_to_local_time(TS),
+ {Hour,Min,Sec} = Time,
+ FormatTS = io_lib:format("~.2.0w:~.2.0w:~.2.0w.4~w",
+ [Hour, Min, Sec, round(N3/1000)]),
+ lists:flatten(FormatTS).
+
+%% Time is always in number os ms (milli seconds)
+%% At some point, we should convert this to a more readable format...
+format_time(T) when (T < 1000) ->
+ format("~w ms", [T]);
+format_time(T) ->
+ format("~w sec (~w ms)", [T div 1000, T]).
+
+
+formated_process_stats(Pid) ->
+ formated_process_stats("", Pid).
+
+formated_process_stats(Prefix, Pid) when is_list(Prefix) andalso is_pid(Pid) ->
+ try
+ begin
+ TotHeapSz = pi(Pid, total_heap_size),
+ HeapSz = pi(Pid, heap_size),
+ StackSz = pi(Pid, stack_size),
+ Reds = pi(Pid, reductions),
+ GCInfo = pi(Pid, garbage_collection),
+ MinBinVHeapSz = proplists:get_value(min_bin_vheap_size, GCInfo),
+ MinHeapSz = proplists:get_value(min_heap_size, GCInfo),
+ MinGCS = proplists:get_value(minor_gcs, GCInfo),
+ format("~n ~sTotal Heap Size: ~p"
+ "~n ~sHeap Size: ~p"
+ "~n ~sStack Size: ~p"
+ "~n ~sReductions: ~p"
+ "~n ~s[GC] Min Bin VHeap Size: ~p"
+ "~n ~s[GC] Min Heap Size: ~p"
+ "~n ~s[GC] Minor GCS: ~p",
+ [Prefix, TotHeapSz,
+ Prefix, HeapSz,
+ Prefix, StackSz,
+ Prefix, Reds,
+ Prefix, MinBinVHeapSz,
+ Prefix, MinHeapSz,
+ Prefix, MinGCS])
+ end
+ catch
+ _:_:_ ->
+ ""
+ end.
+
+
+pi(Pid, Item) ->
+ {Item, Info} = process_info(Pid, Item),
+ Info.
+
+
+
+%% ==========================================================================
+
+format(F, A) ->
+ lists:flatten(io_lib:format(F, A)).
+
+error(F) ->
+ error(F, []).
+
+error(F, A) ->
+ print(get(sname), "<ERROR> " ++ F, A).
+
+info(F) ->
+ info(F, []).
+
+info(F, A) ->
+ print(get(sname), "<INFO> " ++ F, A).
+
+print(undefined, F, A) ->
+ print("- ", F, A);
+print(Prefix, F, A) ->
+ io:format("[~s, ~s] " ++ F ++ "~n", [formated_timestamp(), Prefix |A]).
+
diff --git a/erts/emulator/test/socket_test_ttest_tcp_client.erl b/erts/emulator/test/socket_test_ttest_tcp_client.erl
new file mode 100644
index 0000000000..5efa3fe491
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_tcp_client.erl
@@ -0,0 +1,678 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% ==========================================================================
+%%
+%% This is the "simple" client using gen_tcp. The client is supposed to be
+%% as simple as possible in order to incur as little overhead as possible.
+%%
+%% There are three ways to run the client: active, passive or active-once.
+%%
+%% The client is the entity that controls the test, timing and counting.
+%%
+%% ==========================================================================
+%%
+%% Before the actual test starts, the client performs a "warmup".
+%% The warmup has two functions. First, to ensure that everything is "loaded"
+%% and, second, to calculate an approximate roundtrip time, in order to
+%% "know" how many iterations we should make (to run for the expected time).
+%% This is not intended to be exact, but just to ensure that all tests take
+%% approx the same time to run.
+%%
+%% ==========================================================================
+
+-module(socket_test_ttest_tcp_client).
+
+-export([
+ %% These are for the test suite
+ start_monitor/6, start_monitor/7, start_monitor/9,
+
+ %% These are for starting in a shell when run "manually"
+ start/4, start/5, start/7, start/8,
+ stop/1
+ ]).
+
+%% Internal exports
+-export([
+ do_start/10
+ ]).
+
+-include_lib("kernel/include/inet.hrl").
+-include("socket_test_ttest.hrl").
+-include("socket_test_ttest_client.hrl").
+
+-define(RECV_TIMEOUT, 10000).
+-define(MAX_OUTSTANDING_DEFAULT_1, 100).
+-define(MAX_OUTSTANDING_DEFAULT_2, 10).
+-define(MAX_OUTSTANDING_DEFAULT_3, 3).
+
+-define(LIB, socket_test_ttest_lib).
+-define(I(F), ?LIB:info(F)).
+-define(I(F,A), ?LIB:info(F, A)).
+-define(E(F,A), ?LIB:error(F, A)).
+-define(F(F,A), ?LIB:format(F, A)).
+-define(FORMAT_TIME(T), ?LIB:format_time(T)).
+-define(T(), ?LIB:t()).
+-define(TDIFF(T1,T2), ?LIB:tdiff(T1, T2)).
+
+-type active() :: once | boolean().
+-type msg_id() :: 1..3.
+-type max_outstanding() :: pos_integer().
+-type runtime() :: pos_integer().
+
+
+%% ==========================================================================
+
+start_monitor(Node, Notify, Transport, Active, Addr, Port) ->
+ start_monitor(Node, Notify, Transport, Active, Addr, Port, ?MSG_ID_DEFAULT).
+
+start_monitor(Node, Notify, Transport, Active, Addr, Port, 1 = MsgID) ->
+ start_monitor(Node, Notify, Transport, Active, Addr, Port, MsgID,
+ ?MAX_OUTSTANDING_DEFAULT_1, ?RUNTIME_DEFAULT);
+start_monitor(Node, Notify, Transport, Active, Addr, Port, 2 = MsgID) ->
+ start_monitor(Node, Notify, Transport, Active, Addr, Port, MsgID,
+ ?MAX_OUTSTANDING_DEFAULT_2, ?RUNTIME_DEFAULT);
+start_monitor(Node, Notify, Transport, Active, Addr, Port, 3 = MsgID) ->
+ start_monitor(Node, Notify, Transport, Active, Addr, Port, MsgID,
+ ?MAX_OUTSTANDING_DEFAULT_3, ?RUNTIME_DEFAULT).
+
+start_monitor(Node, Notify, Transport, Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime)
+ when (Node =/= node()) ->
+ Args = [false,
+ self(), Notify,
+ Transport, Active, Addr, Port, MsgID, MaxOutstanding, RunTime],
+ case rpc:call(Node, ?MODULE, do_start, Args) of
+ {badrpc, _} = Reason ->
+ {error, Reason};
+ {ok, Pid} when is_pid(Pid) ->
+ MRef = erlang:monitor(process, Pid),
+ {ok, {Pid, MRef}};
+ {error, _} = ERROR ->
+ ERROR
+ end;
+start_monitor(_, Notify, Transport, Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime) ->
+ case do_start(false,
+ self(), Notify,
+ Transport, Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime) of
+ {ok, Pid} ->
+ MRef = erlang:monitor(process, Pid),
+ {ok, {Pid, MRef}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+start(Transport, Active, Addr, Port) ->
+ start(Transport, Active, Addr, Port, ?MSG_ID_DEFAULT).
+
+start(Transport, Active, Addr, Port, 1 = MsgID) ->
+ start(false,
+ Transport, Active, Addr, Port, MsgID,
+ ?MAX_OUTSTANDING_DEFAULT_1, ?RUNTIME_DEFAULT);
+start(Transport, Active, Addr, Port, 2 = MsgID) ->
+ start(false,
+ Transport, Active, Addr, Port, MsgID,
+ ?MAX_OUTSTANDING_DEFAULT_2, ?RUNTIME_DEFAULT);
+start(Transport, Active, Addr, Port, 3 = MsgID) ->
+ start(false,
+ Transport, Active, Addr, Port, MsgID,
+ ?MAX_OUTSTANDING_DEFAULT_3, ?RUNTIME_DEFAULT).
+
+start(Transport, Active, Addr, Port, MsgID, MaxOutstanding, RunTime) ->
+ start(false,
+ Transport, Active, Addr, Port, MsgID, MaxOutstanding, RunTime).
+
+start(Quiet, Transport, Active, Addr, Port, MsgID, MaxOutstanding, RunTime) ->
+ Notify = fun(R) -> present_results(R) end,
+ do_start(Quiet,
+ self(), Notify,
+ Transport, Active, Addr, Port, MsgID, MaxOutstanding, RunTime).
+
+
+-spec do_start(Quiet,
+ Parent,
+ Notify,
+ Transport,
+ Active,
+ Addr,
+ Port,
+ MsgID,
+ MaxOutstanding,
+ RunTime) -> {ok, Pid} | {error, Reason} when
+ Quiet :: pid(),
+ Parent :: pid(),
+ Notify :: function(),
+ Transport :: atom() | tuple(),
+ Active :: active(),
+ Addr :: inet:ip_address(),
+ Port :: inet:port_number(),
+ MsgID :: msg_id(),
+ MaxOutstanding :: max_outstanding(),
+ RunTime :: runtime(),
+ Pid :: pid(),
+ Reason :: term().
+
+do_start(Quiet,
+ Parent, Notify,
+ Transport, Active, Addr, Port, MsgID, MaxOutstanding, RunTime)
+ when is_boolean(Quiet) andalso
+ is_pid(Parent) andalso
+ is_function(Notify) andalso
+ (is_atom(Transport) orelse is_tuple(Transport)) andalso
+ (is_boolean(Active) orelse (Active =:= once)) andalso
+ is_tuple(Addr) andalso
+ (is_integer(Port) andalso (Port > 0)) andalso
+ (is_integer(MsgID) andalso (MsgID >= 1) andalso (MsgID =< 3)) andalso
+ (is_integer(MaxOutstanding) andalso (MaxOutstanding > 0)) andalso
+ (is_integer(RunTime) andalso (RunTime > 0)) ->
+ Starter = self(),
+ Init = fun() -> put(sname, "client"),
+ init(Quiet,
+ Starter,
+ Parent,
+ Notify,
+ Transport, Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime)
+ end,
+ {Pid, MRef} = spawn_monitor(Init),
+ receive
+ {'DOWN', MRef, process, Pid, Reason} ->
+ {error, Reason};
+ {?MODULE, Pid, ok} ->
+ erlang:demonitor(MRef),
+ {ok, Pid};
+ {?MODULE, Pid, {error, _} = ERROR} ->
+ erlang:demonitor(MRef, [flush]),
+ ERROR
+ end.
+
+
+%% We should not normally stop this (it terminates when its done).
+stop(Pid) when is_pid(Pid) ->
+ req(Pid, stop).
+
+
+%% ==========================================================================
+
+init(Quiet,
+ Starter,
+ Parent, Notify,
+ Transport, Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime) ->
+ if
+ not Quiet ->
+ ?I("init with"
+ "~n Transport: ~p"
+ "~n Active: ~p"
+ "~n Addr: ~s"
+ "~n Port: ~p"
+ "~n Msg ID: ~p (=> 16 + ~w bytes)"
+ "~n Max Outstanding: ~p"
+ "~n (Suggested) Run Time: ~p ms",
+ [Transport, Active, inet:ntoa(Addr), Port,
+ MsgID, size(which_msg_data(MsgID)), MaxOutstanding, RunTime]);
+ true ->
+ ok
+ end,
+ {Mod, Connect} = process_transport(Transport),
+ case Connect(Addr, Port) of
+ {ok, Sock} ->
+ if not Quiet -> ?I("connected");
+ true -> ok
+ end,
+ Starter ! {?MODULE, self(), ok},
+ initial_activation(Mod, Sock, Active),
+ Results = loop(#{quiet => Quiet,
+ slogan => run,
+ runtime => RunTime,
+ start => ?T(),
+ parent => Parent,
+ mod => Mod,
+ sock => Sock,
+ active => Active,
+ msg_data => which_msg_data(MsgID),
+ outstanding => 0,
+ max_outstanding => MaxOutstanding,
+ sid => 1,
+ rid => 1,
+ scnt => 0,
+ rcnt => 0,
+ bcnt => 0,
+ num => undefined,
+ acc => <<>>}),
+ Notify(Results),
+ (catch Mod:close(Sock)),
+ exit(normal);
+ {error, Reason} ->
+ ?E("connect failed: ~p", [Reason]),
+ exit({connect, Reason})
+ end.
+
+process_transport(Mod) when is_atom(Mod) ->
+ {Mod, fun(A, P) -> Mod:connect(A, P) end};
+process_transport({Mod, Opts}) ->
+ {Mod, fun(A, P) -> Mod:connect(A, P, Opts) end}.
+
+
+which_msg_data(1) -> ?MSG_DATA1;
+which_msg_data(2) -> ?MSG_DATA2;
+which_msg_data(3) -> ?MSG_DATA3.
+
+
+present_results(#{status := ok,
+ runtime := RunTime,
+ bcnt := ByteCnt,
+ cnt := NumIterations}) ->
+ ?I("Results: "
+ "~n Run Time: ~s"
+ "~n ByteCnt: ~s"
+ "~n NumIterations: ~s",
+ [?FORMAT_TIME(RunTime),
+ if ((ByteCnt =:= 0) orelse (RunTime =:= 0)) ->
+ ?F("~w, ~w", [ByteCnt, RunTime]);
+ true ->
+ ?F("~p => ~p byte / ms", [ByteCnt, ByteCnt div RunTime])
+ end,
+ if (RunTime =:= 0) ->
+ "-";
+ true ->
+ ?F("~p => ~p iterations / ms",
+ [NumIterations, NumIterations div RunTime])
+ end]),
+ ok;
+present_results(#{status := Failure,
+ runtime := RunTime,
+ sid := SID,
+ rid := RID,
+ scnt := SCnt,
+ rcnt := RCnt,
+ bcnt := BCnt,
+ num := Num}) ->
+ ?I("Time Test failed: "
+ "~n ~p"
+ "~n"
+ "~nwhen"
+ "~n"
+ "~n Run Time: ~s"
+ "~n Send ID: ~p"
+ "~n Recv ID: ~p"
+ "~n Send Count: ~p"
+ "~n Recv Count: ~p"
+ "~n Byte Count: ~p"
+ "~n Num Iterations: ~p",
+ [Failure,
+ ?FORMAT_TIME(RunTime),
+ SID, RID, SCnt, RCnt, BCnt, Num]).
+
+
+
+loop(#{runtime := RunTime} = State) ->
+ erlang:start_timer(RunTime, self(), stop),
+ try do_loop(State)
+ catch
+ throw:Results ->
+ Results
+ end.
+
+do_loop(State) ->
+ do_loop( handle_message( msg_exchange(State) ) ).
+
+msg_exchange(#{rcnt := Num, num := Num} = State) ->
+ finish(ok, State);
+msg_exchange(#{scnt := Num, num := Num} = State) ->
+ %% We are done sending more requests - now we will just await
+ %% the replies for the (still) outstanding replies.
+ msg_exchange( recv_reply(State) );
+msg_exchange(#{outstanding := Outstanding,
+ max_outstanding := MaxOutstanding} = State)
+ when (Outstanding < MaxOutstanding) ->
+ msg_exchange( send_request(State) );
+msg_exchange(State) ->
+ send_request( recv_reply(State) ).
+
+
+finish(ok,
+ #{start := Start, bcnt := BCnt, num := Num}) ->
+ Stop = ?T(),
+ throw(#{status => ok,
+ runtime => ?TDIFF(Start, Stop),
+ bcnt => BCnt,
+ cnt => Num});
+finish(Reason,
+ #{start := Start,
+ sid := SID, rid := RID,
+ scnt := SCnt, rcnt := RCnt, bcnt := BCnt,
+ num := Num}) ->
+ Stop = ?T(),
+ throw(#{status => Reason,
+ runtime => ?TDIFF(Start, Stop),
+ sid => SID,
+ rid => RID,
+ scnt => SCnt,
+ rcnt => RCnt,
+ bcnt => BCnt,
+ num => Num}).
+
+send_request(#{mod := Mod,
+ sock := Sock,
+ sid := ID,
+ scnt := Cnt,
+ outstanding := Outstanding,
+ max_outstanding := MaxOutstanding,
+ msg_data := Data} = State)
+ when (MaxOutstanding > Outstanding) ->
+ SZ = size(Data),
+ Req = <<?TTEST_TAG:32,
+ ?TTEST_TYPE_REQUEST:32,
+ ID:32,
+ SZ:32,
+ Data/binary>>,
+ case Mod:send(Sock, Req) of
+ ok ->
+ State#{sid => next_id(ID),
+ scnt => Cnt + 1,
+ outstanding => Outstanding + 1};
+ {error, Reason} ->
+ ?E("Failed sending request: ~p", [Reason]),
+ exit({send, Reason})
+ end;
+send_request(State) ->
+ State.
+
+
+
+recv_reply(#{mod := Mod,
+ sock := Sock,
+ rid := ID,
+ active := false,
+ bcnt := BCnt,
+ rcnt := Cnt,
+ outstanding := Outstanding} = State) ->
+ case recv_reply_message1(Mod, Sock, ID) of
+ {ok, MsgSz} ->
+ State#{rid => next_id(ID),
+ bcnt => BCnt + MsgSz,
+ rcnt => Cnt + 1,
+ outstanding => Outstanding - 1};
+
+ {error, timeout} ->
+ ?I("receive timeout"),
+ State;
+
+ {error, Reason} ->
+ finish(Reason, State)
+ end;
+recv_reply(#{mod := Mod,
+ sock := Sock,
+ rid := ID,
+ active := Active,
+ bcnt := BCnt,
+ scnt := SCnt,
+ rcnt := RCnt,
+ outstanding := Outstanding,
+ acc := Acc} = State) ->
+ case recv_reply_message2(Mod, Sock, ID, Acc) of
+ {ok, {MsgSz, NewAcc}} when is_integer(MsgSz) andalso is_binary(NewAcc) ->
+ maybe_activate(Mod, Sock, Active),
+ State#{rid => next_id(ID),
+ bcnt => BCnt + MsgSz,
+ rcnt => RCnt + 1,
+ outstanding => Outstanding - 1,
+ acc => NewAcc};
+
+ ok ->
+ State;
+
+ {error, stop} ->
+ ?I("receive [~w] -> stop", [Active]),
+ %% This will have the effect that no more requests are sent...
+ State#{num => SCnt, stop_started => ?T()};
+
+ {error, timeout} ->
+ ?I("receive[~w] -> timeout", [Active]),
+ State;
+
+ {error, Reason} ->
+ finish(Reason, State)
+ end.
+
+
+%% This function reads exactly one (reply) message. No more no less.
+recv_reply_message1(Mod, Sock, ID) ->
+ case Mod:recv(Sock, 4*4, ?RECV_TIMEOUT) of
+ {ok, <<?TTEST_TAG:32,
+ ?TTEST_TYPE_REPLY:32,
+ ID:32,
+ SZ:32>> = Hdr} ->
+ %% Receive the ping-pong reply boby
+ case Mod:recv(Sock, SZ, ?RECV_TIMEOUT) of
+ {ok, Data} when (size(Data) =:= SZ) ->
+ {ok, size(Hdr) + size(Data)};
+ {error, Reason2} ->
+ ?E("Failed reading body: "
+ "~n ~p: ~p", [Reason2]),
+ {error, {recv_body, Reason2}}
+ end;
+
+ {ok, <<BadTag:32,
+ BadType:32,
+ BadID:32,
+ BadSZ:32>>} ->
+ {error, {invalid_hdr,
+ {?TTEST_TAG, BadTag},
+ {?TTEST_TYPE_REPLY, BadType},
+ {ID, BadID},
+ BadSZ}};
+ {ok, _InvHdr} ->
+ {error, invalid_hdr};
+
+ {error, Reason1} ->
+ ?E("Feiled reading header: "
+ "~n ~p", [Reason1]),
+ {error, {recv_hdr, Reason1}}
+ end.
+
+
+%% This function first attempts to process the data we have already
+%% accumulated. If that is not enough for a (complete) reply, it
+%% will attempt to receive more.
+recv_reply_message2(Mod, Sock, ID, Acc) ->
+ case process_acc_data(ID, Acc) of
+ ok ->
+ %% No or insufficient data, so get more
+ recv_reply_message3(Mod, Sock, ID, Acc);
+
+ {ok, _} = OK -> % We already had a reply accumulated - no need to read more
+ OK;
+
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+%% This function receives a "chunk" of data, then it tries to extract
+%% one (reply) message from the accumulated and new data (combined).
+recv_reply_message3(_Mod, Sock, ID, Acc) ->
+ receive
+ {timeout, _TRef, stop} ->
+ {error, stop};
+
+ {TagClosed, Sock} when (TagClosed =:= tcp_closed) orelse
+ (TagClosed =:= socket_closed) ->
+ {error, closed};
+
+ {TagErr, Sock, Reason} when (TagErr =:= tcp_error) orelse
+ (TagErr =:= socket_error) ->
+ {error, Reason};
+
+ {Tag, Sock, Msg} when (Tag =:= tcp) orelse
+ (Tag =:= socket) ->
+ process_acc_data(ID, <<Acc/binary, Msg/binary>>)
+
+ after ?RECV_TIMEOUT ->
+ ?I("timeout when"
+ "~n ID: ~p"
+ "~n size(Acc): ~p",
+ [ID, size(Acc)]),
+ %% {error, timeout}
+ recv_reply_message3(_Mod, Sock, ID, Acc)
+ end.
+
+
+process_acc_data(ID, <<?TTEST_TAG:32,
+ ?TTEST_TYPE_REPLY:32,
+ ID:32,
+ SZ:32,
+ Data/binary>>) when (SZ =< size(Data)) ->
+ <<_Body:SZ/binary, Rest/binary>> = Data,
+ {ok, {4*4+SZ, Rest}};
+process_acc_data(ID, <<BadTag:32,
+ BadType:32,
+ BadID:32,
+ BadSZ:32,
+ _Data/binary>>)
+ when ((BadTag =/= ?TTEST_TAG) orelse
+ (BadType =/= ?TTEST_TYPE_REPLY) orelse
+ (BadID =/= ID)) ->
+ {error, {invalid_hdr,
+ {?TTEST_TAG, BadTag},
+ {?TTEST_TYPE_REPLY, BadType},
+ {ID, BadID},
+ BadSZ}};
+%% Not enough for an entire (reply) message
+process_acc_data(_ID, _Data) ->
+ ok.
+
+
+handle_message(#{quiet := Quiet,
+ parent := Parent, sock := Sock, scnt := SCnt} = State) ->
+ receive
+ {timeout, _TRef, stop} ->
+ if not Quiet -> ?I("STOP");
+ true -> ok
+ end,
+ %% This will have the effect that no more requests are sent...
+ State#{num => SCnt, stop_started => ?T()};
+
+ {?MODULE, Ref, Parent, stop} ->
+ %% This *aborts* the test
+ reply(Parent, Ref, ok),
+ exit(normal);
+
+ %% Only when active
+ {TagClosed, Sock, Reason} when (TagClosed =:= tcp_closed) orelse
+ (TagClosed =:= socket_closed) ->
+ %% We should never get this (unless the server crashed)
+ exit({closed, Reason});
+
+ %% Only when active
+ {TagErr, Sock, Reason} when (TagErr =:= tcp_error) orelse
+ (TagErr =:= socket_error) ->
+ exit({error, Reason})
+
+ after 0 ->
+ State
+ end.
+
+
+initial_activation(_Mod, _Sock, false = _Active) ->
+ ok;
+initial_activation(Mod, Sock, Active) ->
+ Mod:active(Sock, Active).
+
+
+maybe_activate(Mod, Sock, once = Active) ->
+ Mod:active(Sock, Active);
+maybe_activate(_, _, _) ->
+ ok.
+
+
+%% ==========================================================================
+
+req(Pid, Req) ->
+ Ref = make_ref(),
+ Pid ! {?MODULE, Ref, Pid, Req},
+ receive
+ {'EXIT', Pid, Reason} ->
+ {error, {exit, Reason}};
+ {?MODULE, Ref, Reply} ->
+ Reply
+ end.
+
+reply(Pid, Ref, Reply) ->
+ Pid ! {?MODULE, Ref, Reply}.
+
+
+%% ==========================================================================
+
+next_id(ID) when (ID < ?MAX_ID) ->
+ ID + 1;
+next_id(_) ->
+ 1.
+
+
+%% ==========================================================================
+
+%% t() ->
+%% os:timestamp().
+
+%% tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) ->
+%% T1 = A1*1000000000+B1*1000+(C1 div 1000),
+%% T2 = A2*1000000000+B2*1000+(C2 div 1000),
+%% T2 - T1.
+
+%% formated_timestamp() ->
+%% format_timestamp(os:timestamp()).
+
+%% format_timestamp({_N1, _N2, N3} = TS) ->
+%% {_Date, Time} = calendar:now_to_local_time(TS),
+%% {Hour,Min,Sec} = Time,
+%% FormatTS = io_lib:format("~.2.0w:~.2.0w:~.2.0w.4~w",
+%% [Hour, Min, Sec, round(N3/1000)]),
+%% lists:flatten(FormatTS).
+
+%% %% Time is always in number os ms (milli seconds)
+%% format_time(T) ->
+%% f("~p", [T]).
+
+
+%% ==========================================================================
+
+%% f(F, A) ->
+%% lists:flatten(io_lib:format(F, A)).
+
+%% %% e(F) ->
+%% %% i("<ERROR> " ++ F).
+
+%% e(F, A) ->
+%% p(get(sname), "<ERROR> " ++ F, A).
+
+%% i(F) ->
+%% i(F, []).
+
+%% i(F, A) ->
+%% p(get(sname), "<INFO> " ++ F, A).
+
+%% p(undefined, F, A) ->
+%% p("- ", F, A);
+%% p(Prefix, F, A) ->
+%% io:format("[~s, ~s] " ++ F ++ "~n", [formated_timestamp(), Prefix |A]).
diff --git a/erts/emulator/test/socket_test_ttest_tcp_client_gen.erl b/erts/emulator/test/socket_test_ttest_tcp_client_gen.erl
new file mode 100644
index 0000000000..0ec2e908d7
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_tcp_client_gen.erl
@@ -0,0 +1,49 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_ttest_tcp_client_gen).
+
+-export([
+ start/3, start/4, start/6, start/7,
+ stop/1
+ ]).
+
+-define(TRANSPORT_MOD, socket_test_ttest_tcp_gen).
+
+start(Active, Addr, Port) ->
+ socket_test_ttest_tcp_client:start(?TRANSPORT_MOD, Active, Addr, Port).
+
+start(Active, Addr, Port, MsgID) ->
+ socket_test_ttest_tcp_client:start(?TRANSPORT_MOD, Active, Addr, Port, MsgID).
+
+start(Active, Addr, Port, MsgID, MaxOutstanding, RunTime) ->
+ socket_test_ttest_tcp_client:start(false,
+ ?TRANSPORT_MOD,
+ Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime).
+
+start(Quiet, Active, Addr, Port, MsgID, MaxOutstanding, RunTime) ->
+ socket_test_ttest_tcp_client:start(Quiet,
+ ?TRANSPORT_MOD,
+ Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime).
+
+stop(Pid) ->
+ socket_test_ttest_tcp_client:stop(Pid).
diff --git a/erts/emulator/test/socket_test_ttest_tcp_client_socket.erl b/erts/emulator/test/socket_test_ttest_tcp_client_socket.erl
new file mode 100644
index 0000000000..acf2556793
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_tcp_client_socket.erl
@@ -0,0 +1,51 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_ttest_tcp_client_socket).
+
+-export([
+ start/4, start/5, start/7, start/8,
+ stop/1
+ ]).
+
+-define(TRANSPORT_MOD, socket_test_ttest_tcp_socket).
+-define(MOD(M), {?TRANSPORT_MOD, #{method => Method}}).
+
+start(Method, Active, Addr, Port) ->
+ socket_test_ttest_tcp_client:start_monitor(?MOD(Method), Active, Addr, Port).
+
+start(Method, Active, Addr, Port, MsgID) ->
+ socket_test_ttest_tcp_client:start(?MOD(Method),
+ Active, Addr, Port, MsgID).
+
+start(Method, Active, Addr, Port, MsgID, MaxOutstanding, RunTime) ->
+ socket_test_ttest_tcp_client:start(false,
+ ?MOD(Method),
+ Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime).
+
+start(Quiet, Method, Active, Addr, Port, MsgID, MaxOutstanding, RunTime) ->
+ socket_test_ttest_tcp_client:start(Quiet,
+ ?MOD(Method),
+ Active, Addr, Port,
+ MsgID, MaxOutstanding, RunTime).
+
+stop(Pid) ->
+ socket_test_ttest_client:stop(Pid).
diff --git a/erts/emulator/test/socket_test_ttest_tcp_gen.erl b/erts/emulator/test/socket_test_ttest_tcp_gen.erl
new file mode 100644
index 0000000000..604408c489
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_tcp_gen.erl
@@ -0,0 +1,138 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_ttest_tcp_gen).
+
+-export([
+ accept/1, accept/2,
+ active/2,
+ close/1,
+ connect/2,
+ controlling_process/2,
+ listen/0, listen/1,
+ peername/1,
+ port/1,
+ recv/2, recv/3,
+ send/2,
+ shutdown/2,
+ sockname/1
+ ]).
+
+
+%% ==========================================================================
+
+%% getopt(Sock, Opt) when is_atom(Opt) ->
+%% case inet:getopts(Sock, [Opt]) of
+%% {ok, [{Opt, Value}]} ->
+%% {ok, Value};
+%% {error, _} = ERROR ->
+%% ERROR
+%% end.
+
+%% setopt(Sock, Opt, Value) when is_atom(Opt) ->
+%% inet:setopts(Sock, [{Opt, Value}]).
+
+
+%% ==========================================================================
+
+accept(Sock) ->
+ case gen_tcp:accept(Sock) of
+ {ok, NewSock} ->
+ {ok, NewSock};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+accept(Sock, Timeout) ->
+ case gen_tcp:accept(Sock, Timeout) of
+ {ok, NewSock} ->
+ {ok, NewSock};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+active(Sock, NewActive)
+ when (is_boolean(NewActive) orelse (NewActive =:= once)) ->
+ inet:setopts(Sock, [{active, NewActive}]).
+
+
+close(Sock) ->
+ gen_tcp:close(Sock).
+
+
+connect(Addr, Port) ->
+ Opts = [binary, {packet, raw}, {active, false}, {buffer, 32*1024}],
+ case gen_tcp:connect(Addr, Port, Opts) of
+ {ok, Sock} ->
+ {ok, Sock};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+controlling_process(Sock, NewPid) ->
+ gen_tcp:controlling_process(Sock, NewPid).
+
+
+%% Create a listen socket
+listen() ->
+ listen(0).
+
+listen(Port) when is_integer(Port) andalso (Port >= 0) ->
+ Opts = [binary, {ip, {0,0,0,0}}, {packet, raw}, {active, false},
+ {buffer, 32*1024}],
+ case gen_tcp:listen(Port, Opts) of
+ {ok, Sock} ->
+ {ok, Sock};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+peername(Sock) ->
+ inet:peername(Sock).
+
+
+port(Sock) ->
+ inet:port(Sock).
+
+
+recv(Sock, Length) ->
+ gen_tcp:recv(Sock, Length).
+recv(Sock, Length, Timeout) ->
+ gen_tcp:recv(Sock, Length, Timeout).
+
+
+send(Sock, Data) ->
+ gen_tcp:send(Sock, Data).
+
+
+shutdown(Sock, How) ->
+ gen_tcp:shutdown(Sock, How).
+
+
+sockname(Sock) ->
+ inet:sockname(Sock).
+
+
+%% ==========================================================================
+
+
+
diff --git a/erts/emulator/test/socket_test_ttest_tcp_server.erl b/erts/emulator/test/socket_test_ttest_tcp_server.erl
new file mode 100644
index 0000000000..e8d626e3d8
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_tcp_server.erl
@@ -0,0 +1,642 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% ==========================================================================
+%%
+%% This is the "simple" server using gen_tcp. The server is supposed to be
+%% as simple as possible in order to incur as little overhead as possible.
+%%
+%% There are three ways to run the server: active, passive or active-once.
+%%
+%% The server does only two things; accept connnections and then reply
+%% to requests (actually the handler(s) does that). No timing or counting.
+%% That is all done by the clients.
+%%
+%% ==========================================================================
+
+-module(socket_test_ttest_tcp_server).
+
+-export([
+ %% This are for the test suite
+ start_monitor/3,
+
+ %% This are for starting in a shell when run "manually"
+ start/2,
+
+ stop/1
+ ]).
+
+%% Internal exports
+-export([
+ do_start/3
+ ]).
+
+-include_lib("kernel/include/inet.hrl").
+-include("socket_test_ttest.hrl").
+
+-define(ACC_TIMEOUT, 5000).
+-define(RECV_TIMEOUT, 5000).
+
+-define(LIB, socket_test_ttest_lib).
+-define(I(F), ?LIB:info(F)).
+-define(I(F,A), ?LIB:info(F, A)).
+-define(E(F,A), ?LIB:error(F, A)).
+-define(F(F,A), ?LIB:format(F, A)).
+-define(FORMAT_TIME(T), ?LIB:format_time(T)).
+-define(T(), ?LIB:t()).
+-define(TDIFF(T1,T2), ?LIB:tdiff(T1, T2)).
+
+
+%% ==========================================================================
+
+start_monitor(Node, Transport, Active) when (Node =/= node()) ->
+ case rpc:call(Node, ?MODULE, do_start, [self(), Transport, Active]) of
+ {badrpc, _} = Reason ->
+ {error, Reason};
+ {ok, {Pid, AddrPort}} ->
+ MRef = erlang:monitor(process, Pid),
+ {ok, {{Pid, MRef}, AddrPort}};
+ {error, _} = ERROR ->
+ ERROR
+ end;
+start_monitor(_, Transport, Active) ->
+ case do_start(self(), Transport, Active) of
+ {ok, {Pid, AddrPort}} ->
+ MRef = erlang:monitor(process, Pid),
+ {ok, {{Pid, MRef}, AddrPort}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+
+start(Transport, Active) ->
+ do_start(self(), Transport, Active).
+
+
+do_start(Parent, Transport, Active)
+ when is_pid(Parent) andalso
+ (is_atom(Transport) orelse is_tuple(Transport)) andalso
+ (is_boolean(Active) orelse (Active =:= once)) ->
+ Starter = self(),
+ ServerInit = fun() -> put(sname, "server"),
+ server_init(Starter, Parent, Transport, Active)
+ end,
+ {Pid, MRef} = spawn_monitor(ServerInit),
+ receive
+ {'DOWN', MRef, process, Pid, Reason} ->
+ {error, Reason};
+ {?MODULE, Pid, {ok, AddrPort}} ->
+ erlang:demonitor(MRef),
+ {ok, {Pid, AddrPort}};
+ {?MODULE, Pid, {error, _} = ERROR} ->
+ erlang:demonitor(MRef, [flush]),
+ ERROR
+ end.
+
+
+stop(Pid) when is_pid(Pid) ->
+ req(Pid, stop).
+
+
+%% ==========================================================================
+
+server_init(Starter, Parent, Transport, Active) ->
+ ?I("init with"
+ "~n Transport: ~p"
+ "~n Active: ~p", [Transport, Active]),
+ {Mod, Listen, StatsInterval} = process_transport(Transport, Active),
+ case Listen(0) of
+ {ok, LSock} ->
+ case Mod:port(LSock) of
+ {ok, Port} ->
+ Addr = which_addr(), % This is just for convenience
+ ?I("listening on:"
+ "~n Addr: ~p (~s)"
+ "~n Port: ~w"
+ "~n", [Addr, inet:ntoa(Addr), Port]),
+ Starter ! {?MODULE, self(), {ok, {Addr, Port}}},
+ server_loop(#{parent => Parent,
+ mod => Mod,
+ active => Active,
+ lsock => LSock,
+ handlers => [],
+ stats_interval => StatsInterval,
+ %% Accumulation
+ runtime => 0,
+ mcnt => 0,
+ bcnt => 0,
+ hcnt => 0
+ });
+ {error, PReason} ->
+ (catch Mod:close(LSock)),
+ exit({port, PReason})
+ end;
+ {error, LReason} ->
+ exit({listen, LReason})
+ end.
+
+process_transport(Mod, _) when is_atom(Mod) ->
+ {Mod, fun(Port) -> Mod:listen(Port) end, infinity};
+process_transport({Mod, #{stats_interval := T} = Opts}, Active)
+ when (Active =/= false) ->
+ {Mod, fun(Port) -> Mod:listen(Port, Opts#{stats_to => self()}) end, T};
+process_transport({Mod, #{stats_interval := T} = Opts}, _Active) ->
+ {Mod, fun(Port) -> Mod:listen(Port, Opts) end, T};
+process_transport({Mod, Opts}, _Active) ->
+ {Mod, fun(Port) -> Mod:listen(Port, Opts) end, infinity}.
+
+
+
+server_loop(State) ->
+ server_loop( server_handle_message( server_accept(State) ) ).
+
+server_accept(#{mod := Mod,
+ active := Active,
+ lsock := LSock,
+ handlers := Handlers} = State) ->
+ case Mod:accept(LSock, ?ACC_TIMEOUT) of
+ {ok, Sock} ->
+ ?I("accepted connection from ~s",
+ [case Mod:peername(Sock) of
+ {ok, Peer} ->
+ format_peername(Peer);
+ {error, _} ->
+ "-"
+ end]),
+ {Pid, _} = handler_start(),
+ ?I("handler ~p started -> try transfer socket control", [Pid]),
+ case Mod:controlling_process(Sock, Pid) of
+ ok ->
+ maybe_start_stats_timer(State, Pid),
+ ?I("server-accept: handler ~p started", [Pid]),
+ handler_continue(Pid, Mod, Sock, Active),
+ Handlers2 = [Pid | Handlers],
+ State#{handlers => Handlers2};
+ {error, CPReason} ->
+ (catch Mod:close(Sock)),
+ (catch Mod:close(LSock)),
+ exit({controlling_process, CPReason})
+ end;
+ {error, timeout} ->
+ State;
+ {error, AReason} ->
+ (catch Mod:close(LSock)),
+ exit({accept, AReason})
+ end.
+
+format_peername({Addr, Port}) ->
+ case inet:gethostbyaddr(Addr) of
+ {ok, #hostent{h_name = N}} ->
+ ?F("~s (~s:~w)", [N, inet:ntoa(Addr), Port]);
+ {error, _} ->
+ ?F("~p, ~p", [Addr, Port])
+ end.
+
+maybe_start_stats_timer(#{active := Active, stats_interval := Time}, Handler)
+ when (Active =/= false) andalso (is_integer(Time) andalso (Time > 0)) ->
+ start_stats_timer(Time, "handler", Handler);
+maybe_start_stats_timer(_, _) ->
+ ok.
+
+start_stats_timer(Time, ProcStr, Pid) ->
+ erlang:start_timer(Time, self(), {stats, Time, ProcStr, Pid}).
+
+server_handle_message(#{parent := Parent, handlers := H} = State) ->
+ receive
+ {timeout, _TRef, {stats, Interval, ProcStr, Pid}} ->
+ case server_handle_stats(ProcStr, Pid) of
+ ok ->
+ start_stats_timer(Interval, ProcStr, Pid);
+ skip ->
+ ok
+ end,
+ State;
+
+ {?MODULE, Ref, Parent, stop} ->
+ reply(Parent, Ref, ok),
+ lists:foreach(fun(P) -> handler_stop(P) end, H),
+ exit(normal);
+
+ {'DOWN', _MRef, process, Pid, Reason} ->
+ server_handle_down(Pid, Reason, State)
+
+ after 0 ->
+ State
+ end.
+
+server_handle_stats(ProcStr, Pid) ->
+ case ?LIB:formated_process_stats(Pid) of
+ "" ->
+ skip;
+ FormatedStats ->
+ ?I("Statistics for ~s ~p:~s", [ProcStr, Pid, FormatedStats]),
+ ok
+ end.
+
+
+server_handle_down(Pid, Reason, #{handlers := Handlers} = State) ->
+ case lists:delete(Pid, Handlers) of
+ Handlers ->
+ ?I("unknown process ~p died", [Pid]),
+ State;
+ Handlers2 ->
+ server_handle_handler_down(Pid, Reason, State#{handlers => Handlers2})
+ end.
+
+
+server_handle_handler_down(Pid,
+ {done, RunTime, MCnt, BCnt},
+ #{runtime := AccRunTime,
+ mcnt := AccMCnt,
+ bcnt := AccBCnt,
+ hcnt := AccHCnt} = State) ->
+ AccRunTime2 = AccRunTime + RunTime,
+ AccMCnt2 = AccMCnt + MCnt,
+ AccBCnt2 = AccBCnt + BCnt,
+ AccHCnt2 = AccHCnt + 1,
+ ?I("handler ~p (~w) done => accumulated results: "
+ "~n Run Time: ~s ms"
+ "~n Message Count: ~s"
+ "~n Byte Count: ~s",
+ [Pid, AccHCnt2,
+ ?FORMAT_TIME(AccRunTime2),
+ if (AccRunTime2 > 0) ->
+ ?F("~w => ~w (~w) msgs / ms",
+ [AccMCnt2,
+ AccMCnt2 div AccRunTime2,
+ (AccMCnt2 div AccHCnt2) div AccRunTime2]);
+ true ->
+ ?F("~w", [AccMCnt2])
+ end,
+ if (AccRunTime2 > 0) ->
+ ?F("~w => ~w (~w) bytes / ms",
+ [AccBCnt2,
+ AccBCnt2 div AccRunTime2,
+ (AccBCnt2 div AccHCnt2) div AccRunTime2]);
+ true ->
+ ?F("~w", [AccBCnt2])
+ end]),
+ State#{runtime => AccRunTime2,
+ mcnt => AccMCnt2,
+ bcnt => AccBCnt2,
+ hcnt => AccHCnt2};
+server_handle_handler_down(Pid, Reason, State) ->
+ ?I("handler ~p terminated: "
+ "~n ~p", [Pid, Reason]),
+ State.
+
+
+
+%% ==========================================================================
+
+handler_start() ->
+ Self = self(),
+ HandlerInit = fun() -> put(sname, "handler"), handler_init(Self) end,
+ spawn_monitor(HandlerInit).
+
+handler_continue(Pid, Mod, Sock, Active) ->
+ req(Pid, {continue, Mod, Sock, Active}).
+
+handler_stop(Pid) ->
+ req(Pid, stop).
+
+handler_init(Parent) ->
+ ?I("starting"),
+ receive
+ {?MODULE, Ref, Parent, {continue, Mod, Sock, Active}} ->
+ ?I("received continue"),
+ reply(Parent, Ref, ok),
+ handler_initial_activation(Mod, Sock, Active),
+ handler_loop(#{parent => Parent,
+ mod => Mod,
+ sock => Sock,
+ active => Active,
+ start => ?T(),
+ mcnt => 0,
+ bcnt => 0,
+ last_reply => none,
+ acc => <<>>})
+
+ after 5000 ->
+ ?I("timeout when message queue: "
+ "~n ~p"
+ "~nwhen"
+ "~n Parent: ~p", [process_info(self(), messages), Parent]),
+ handler_init(Parent)
+ end.
+
+handler_loop(State) ->
+ handler_loop( handler_handle_message( handler_recv_message(State) ) ).
+
+%% When passive, we read *one* request and then attempt to reply to it.
+handler_recv_message(#{mod := Mod,
+ sock := Sock,
+ active := false,
+ mcnt := MCnt,
+ bcnt := BCnt,
+ last_reply := LID} = State) ->
+ case handler_recv_message2(Mod, Sock) of
+ {ok, {MsgSz, ID, Body}} ->
+ handler_send_reply(Mod, Sock, ID, Body),
+ State#{mcnt => MCnt + 1,
+ bcnt => BCnt + MsgSz,
+ last_reply => ID};
+ {error, closed} ->
+ handler_done(State);
+ {error, timeout} ->
+ ?I("timeout when: "
+ "~n MCnt: ~p"
+ "~n BCnt: ~p"
+ "~n LID: ~p", [MCnt, BCnt, LID]),
+ State
+ end;
+
+
+%% When "active" (once or true), we receive one data "message", which may
+%% contain any number of requests or only part of a request. Then we
+%% process this data together with whatever we had "accumulated" from
+%% prevous messages. Each request will be extracted and replied to. If
+%% there is some data left, not enough for a complete request, we store
+%% this in 'acc' (accumulate it).
+handler_recv_message(#{mod := Mod,
+ sock := Sock,
+ active := Active,
+ mcnt := MCnt,
+ bcnt := BCnt,
+ last_reply := LID,
+ acc := Acc} = State) ->
+ case handler_recv_message3(Mod, Sock, Acc, LID) of
+ {ok, {MCnt2, BCnt2, LID2}, NewAcc} ->
+ handler_maybe_activate(Mod, Sock, Active),
+ State#{mcnt => MCnt + MCnt2,
+ bcnt => BCnt + BCnt2,
+ last_reply => LID2,
+ acc => NewAcc};
+
+ {error, closed} ->
+ if
+ (size(Acc) =:= 0) ->
+ handler_done(State);
+ true ->
+ ?E("client done with partial message: "
+ "~n Last Reply Sent: ~w"
+ "~n Message Count: ~w"
+ "~n Byte Count: ~w"
+ "~n Partial Message: ~w bytes",
+ [LID, MCnt, BCnt, size(Acc)]),
+ exit({closed_with_partial_message, LID})
+ end;
+
+ {error, timeout} ->
+ ?I("timeout when: "
+ "~n MCnt: ~p"
+ "~n BCnt: ~p"
+ "~n LID: ~p"
+ "~n size(Acc): ~p", [MCnt, BCnt, LID, size(Acc)]),
+ State
+ end.
+
+handler_process_data(Acc, Mod, Sock, LID) ->
+ handler_process_data(Acc, Mod, Sock, 0, 0, LID).
+
+%% Extract each complete request, one at a time.
+handler_process_data(<<?TTEST_TAG:32,
+ ?TTEST_TYPE_REQUEST:32,
+ ID:32,
+ SZ:32,
+ Rest/binary>>,
+ Mod, Sock,
+ MCnt, BCnt, _LID) when (size(Rest) >= SZ) ->
+ <<Body:SZ/binary, Rest2/binary>> = Rest,
+ case handler_send_reply(Mod, Sock, ID, Body) of
+ ok ->
+ handler_process_data(Rest2, Mod, Sock, MCnt+1, BCnt+16+SZ, ID);
+ {error, _} = ERROR ->
+ ERROR
+ end;
+handler_process_data(Data, _Mod, _Sock, MCnt, BCnt, LID) ->
+ {ok, {MCnt, BCnt, LID}, Data}.
+
+
+handler_recv_message2(Mod, Sock) ->
+ case Mod:recv(Sock, 4*4, ?RECV_TIMEOUT) of
+ {ok, <<?TTEST_TAG:32,
+ ?TTEST_TYPE_REQUEST:32,
+ ID:32,
+ SZ:32>> = Hdr} ->
+ case Mod:recv(Sock, SZ, ?RECV_TIMEOUT) of
+ {ok, Body} when (SZ =:= size(Body)) ->
+ {ok, {size(Hdr) + size(Body), ID, Body}};
+ {error, BReason} ->
+ ?E("failed reading body (~w) of message ~w:"
+ "~n ~p", [SZ, ID, BReason]),
+ exit({recv, body, ID, SZ, BReason})
+ end;
+ {error, timeout} = ERROR ->
+ ERROR;
+ {error, closed} = ERROR ->
+ ERROR;
+ {error, HReason} ->
+ ?E("Failed reading header of message:"
+ "~n ~p", [HReason]),
+ exit({recv, header, HReason})
+ end.
+
+
+handler_recv_message3(Mod, Sock, Acc, LID) ->
+ receive
+ {TagClosed, Sock} when (TagClosed =:= tcp_closed) orelse
+ (TagClosed =:= socket_closed) ->
+ {error, closed};
+
+ {TagErr, Sock, Reason} when (TagErr =:= tcp_error) orelse
+ (TagErr =:= socket_error) ->
+ {error, Reason};
+
+ {Tag, Sock, Msg} when (Tag =:= tcp) orelse
+ (Tag =:= socket) ->
+ handler_process_data(<<Acc/binary, Msg/binary>>, Mod, Sock, LID)
+
+ after ?RECV_TIMEOUT ->
+ {error, timeout}
+ end.
+
+
+
+handler_send_reply(Mod, Sock, ID, Data) ->
+ SZ = size(Data),
+ Msg = <<?TTEST_TAG:32,
+ ?TTEST_TYPE_REPLY:32,
+ ID:32,
+ SZ:32,
+ Data/binary>>,
+ case Mod:send(Sock, Msg) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ (catch Mod:close(Sock)),
+ exit({send, Reason})
+ end.
+
+
+handler_done(State) ->
+ handler_done(State, ?T()).
+
+handler_done(#{start := Start,
+ mod := Mod,
+ sock := Sock,
+ mcnt := MCnt,
+ bcnt := BCnt}, Stop) ->
+ (catch Mod:close(Sock)),
+ exit({done, ?TDIFF(Start, Stop), MCnt, BCnt}).
+
+
+handler_handle_message(#{parent := Parent} = State) ->
+ receive
+ {'EXIT', Parent, Reason} ->
+ exit({parent_exit, Reason})
+ after 0 ->
+ State
+ end.
+
+
+handler_initial_activation(_Mod, _Sock, false = _Active) ->
+ ok;
+handler_initial_activation(Mod, Sock, Active) ->
+ Mod:active(Sock, Active).
+
+
+handler_maybe_activate(Mod, Sock, once = Active) ->
+ Mod:active(Sock, Active);
+handler_maybe_activate(_, _, _) ->
+ ok.
+
+
+
+%% ==========================================================================
+
+which_addr() ->
+ case inet:getifaddrs() of
+ {ok, IfAddrs} ->
+ which_addrs(inet, IfAddrs);
+ {error, Reason} ->
+ exit({getifaddrs, Reason})
+ end.
+
+which_addrs(_Family, []) ->
+ exit({getifaddrs, not_found});
+which_addrs(Family, [{"lo", _} | IfAddrs]) ->
+ %% Skip
+ which_addrs(Family, IfAddrs);
+which_addrs(Family, [{"docker" ++ _, _} | IfAddrs]) ->
+ %% Skip docker
+ which_addrs(Family, IfAddrs);
+which_addrs(Family, [{"br-" ++ _, _} | IfAddrs]) ->
+ %% Skip docker
+ which_addrs(Family, IfAddrs);
+which_addrs(Family, [{"en" ++ _, IfOpts} | IfAddrs]) ->
+ %% Maybe take this one
+ case which_addr(Family, IfOpts) of
+ {ok, Addr} ->
+ Addr;
+ error ->
+ which_addrs(Family, IfAddrs)
+ end;
+which_addrs(Family, [{_IfName, IfOpts} | IfAddrs]) ->
+ case which_addr(Family, IfOpts) of
+ {ok, Addr} ->
+ Addr;
+ error ->
+ which_addrs(Family, IfAddrs)
+ end.
+
+which_addr(_, []) ->
+ error;
+which_addr(inet, [{addr, Addr}|_])
+ when is_tuple(Addr) andalso (size(Addr) =:= 4) ->
+ {ok, Addr};
+which_addr(inet6, [{addr, Addr}|_])
+ when is_tuple(Addr) andalso (size(Addr) =:= 8) ->
+ {ok, Addr};
+which_addr(Family, [_|IfOpts]) ->
+ which_addr(Family, IfOpts).
+
+
+%% ==========================================================================
+
+req(Pid, Req) ->
+ Ref = make_ref(),
+ Pid ! {?MODULE, Ref, self(), Req},
+ receive
+ {'EXIT', Pid, Reason} ->
+ {error, {exit, Reason}};
+ {?MODULE, Ref, Reply} ->
+ Reply
+ end.
+
+reply(Pid, Ref, Reply) ->
+ Pid ! {?MODULE, Ref, Reply}.
+
+
+%% ==========================================================================
+
+%% t() ->
+%% os:timestamp().
+
+%% tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) ->
+%% T1 = A1*1000000000+B1*1000+(C1 div 1000),
+%% T2 = A2*1000000000+B2*1000+(C2 div 1000),
+%% T2 - T1.
+
+%% formated_timestamp() ->
+%% format_timestamp(os:timestamp()).
+
+%% format_timestamp({_N1, _N2, N3} = TS) ->
+%% {_Date, Time} = calendar:now_to_local_time(TS),
+%% {Hour,Min,Sec} = Time,
+%% FormatTS = io_lib:format("~.2.0w:~.2.0w:~.2.0w.4~w",
+%% [Hour, Min, Sec, round(N3/1000)]),
+%% lists:flatten(FormatTS).
+
+%% %% Time is always in number os ms (milli seconds)
+%% format_time(T) ->
+%% f("~p", [T]).
+
+
+%% ==========================================================================
+
+%% f(F, A) ->
+%% lists:flatten(io_lib:format(F, A)).
+
+%% e(F, A) ->
+%% p(get(sname), "<ERROR> " ++ F, A).
+
+%% i(F) ->
+%% i(F, []).
+
+%% i(F, A) ->
+%% p(get(sname), "<INFO> " ++ F, A).
+
+%% p(undefined, F, A) ->
+%% p("- ", F, A);
+%% p(Prefix, F, A) ->
+%% io:format("[~s, ~s] " ++ F ++ "~n", [formated_timestamp(), Prefix |A]).
+
diff --git a/erts/emulator/test/socket_test_ttest_tcp_server_gen.erl b/erts/emulator/test/socket_test_ttest_tcp_server_gen.erl
new file mode 100644
index 0000000000..b1b31f5158
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_tcp_server_gen.erl
@@ -0,0 +1,41 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_ttest_tcp_server_gen).
+
+-export([
+ start/1,
+ stop/1
+ ]).
+
+-define(TRANSPORT_MOD, socket_test_ttest_tcp_gen).
+
+start(Active) ->
+ socket_test_ttest_tcp_server:start(?TRANSPORT_MOD, Active).
+ %% {ok, {Pid, AddrPort}} ->
+ %% MRef = erlang:monitor(process, Pid),
+ %% {ok, {Pid, MRef, AddrPort}};
+ %% {error, _} = ERROR ->
+ %% ERROR
+ %% end.
+
+
+stop(Pid) ->
+ socket_test_ttest_tcp_server:stop(Pid).
diff --git a/erts/emulator/test/socket_test_ttest_tcp_server_socket.erl b/erts/emulator/test/socket_test_ttest_tcp_server_socket.erl
new file mode 100644
index 0000000000..b7ea1e8e93
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_tcp_server_socket.erl
@@ -0,0 +1,43 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_ttest_tcp_server_socket).
+
+-export([
+ start/2,
+ stop/1
+ ]).
+
+-define(TRANSPORT_MOD, socket_test_ttest_tcp_socket).
+%% -define(MOD(M), {?TRANSPORT_MOD, #{method => M,
+%% stats_interval => 10000}}).
+-define(MOD(M), {?TRANSPORT_MOD, #{method => M}}).
+
+start(Method, Active) ->
+ socket_test_ttest_tcp_server:start(?MOD(Method), Active).
+ %% {ok, {Pid, AddrPort}} ->
+ %% MRef = erlang:monitor(process, Pid),
+ %% {ok, {Pid, MRef, AddrPort}};
+ %% {error, _} = ERROR ->
+ %% ERROR
+ %% end.
+
+stop(Pid) ->
+ socket_test_ttest_tcp_server:stop(Pid).
diff --git a/erts/emulator/test/socket_test_ttest_tcp_socket.erl b/erts/emulator/test/socket_test_ttest_tcp_socket.erl
new file mode 100644
index 0000000000..0ae2412e4c
--- /dev/null
+++ b/erts/emulator/test/socket_test_ttest_tcp_socket.erl
@@ -0,0 +1,414 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket_test_ttest_tcp_socket).
+
+-export([
+ accept/1, accept/2,
+ active/2,
+ close/1,
+ connect/2, connect/3,
+ controlling_process/2,
+ listen/0, listen/1, listen/2,
+ port/1,
+ peername/1,
+ recv/2, recv/3,
+ send/2,
+ shutdown/2,
+ sockname/1
+ ]).
+
+
+-define(READER_RECV_TIMEOUT, 1000).
+
+-define(DATA_MSG(Sock, Method, Data),
+ {socket,
+ #{sock => Sock, reader => self(), method => Method},
+ Data}).
+
+-define(CLOSED_MSG(Sock, Method),
+ {socket_closed,
+ #{sock => Sock, reader => self(), method => Method}}).
+
+-define(ERROR_MSG(Sock, Method, Reason),
+ {socket_error,
+ #{sock => Sock, reader => self(), method => Method},
+ Reason}).
+
+
+%% ==========================================================================
+
+%% This does not really work. Its just a placeholder for the time beeing...
+
+%% getopt(Sock, Opt) when is_atom(Opt) ->
+%% socket:getopt(Sock, socket, Opt).
+
+%% setopt(Sock, Opt, Value) when is_atom(Opt) ->
+%% socket:setopts(Sock, socket, Opt, Value).
+
+
+%% ==========================================================================
+
+accept(#{sock := LSock, opts := #{method := Method} = Opts}) ->
+ case socket:accept(LSock) of
+ {ok, Sock} ->
+ Self = self(),
+ Reader = spawn(fun() -> reader_init(Self, Sock, false, Method) end),
+ maybe_start_stats_timer(Opts, Reader),
+ {ok, #{sock => Sock, reader => Reader, method => Method}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+accept(#{sock := LSock, opts := #{method := Method} = Opts}, Timeout) ->
+ case socket:accept(LSock, Timeout) of
+ {ok, Sock} ->
+ Self = self(),
+ Reader = spawn(fun() -> reader_init(Self, Sock, false, Method) end),
+ maybe_start_stats_timer(Opts, Reader),
+ {ok, #{sock => Sock, reader => Reader, method => Method}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+active(#{reader := Pid}, NewActive)
+ when (is_boolean(NewActive) orelse (NewActive =:= once)) ->
+ Pid ! {?MODULE, active, NewActive},
+ ok.
+
+
+close(#{sock := Sock, reader := Pid}) ->
+ Pid ! {?MODULE, stop},
+ socket:close(Sock).
+
+%% Create a socket and connect it to a peer
+connect(Addr, Port) ->
+ connect(Addr, Port, #{method => plain}).
+
+connect(Addr, Port, #{method := Method} = Opts) ->
+ try
+ begin
+ Sock =
+ case socket:open(inet, stream, tcp) of
+ {ok, S} ->
+ S;
+ {error, OReason} ->
+ throw({error, {open, OReason}})
+ end,
+ case socket:bind(Sock, any) of
+ {ok, _} ->
+ ok;
+ {error, BReason} ->
+ (catch socket:close(Sock)),
+ throw({error, {bind, BReason}})
+ end,
+ SA = #{family => inet,
+ addr => Addr,
+ port => Port},
+ case socket:connect(Sock, SA) of
+ ok ->
+ ok;
+ {error, CReason} ->
+ (catch socket:close(Sock)),
+ throw({error, {connect, CReason}})
+ end,
+ Self = self(),
+ Reader = spawn(fun() -> reader_init(Self, Sock, false, Method) end),
+ maybe_start_stats_timer(Opts, Reader),
+ {ok, #{sock => Sock, reader => Reader, method => Method}}
+ end
+ catch
+ throw:ERROR:_ ->
+ ERROR
+ end.
+
+
+maybe_start_stats_timer(#{stats_to := Pid,
+ stats_interval := T},
+ Reader) when is_pid(Pid) ->
+ erlang:start_timer(T, Pid, {stats, T, "reader", Reader});
+maybe_start_stats_timer(_O, _) ->
+ ok.
+
+controlling_process(#{sock := Sock, reader := Pid}, NewPid) ->
+ case socket:setopt(Sock, otp, controlling_process, NewPid) of
+ ok ->
+ Pid ! {?MODULE, self(), controlling_process, NewPid},
+ receive
+ {?MODULE, Pid, controlling_process} ->
+ ok
+ end;
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+%% Create a listen socket
+listen() ->
+ listen(0, #{method => plain}).
+
+listen(Port) ->
+ listen(Port, #{method => plain}).
+listen(Port, #{method := Method} = Opts)
+ when (is_integer(Port) andalso (Port >= 0)) andalso
+ ((Method =:= plain) orelse (Method =:= msg)) ->
+ try
+ begin
+ Sock = case socket:open(inet, stream, tcp) of
+ {ok, S} ->
+ S;
+ {error, OReason} ->
+ throw({error, {open, OReason}})
+ end,
+ SA = #{family => inet,
+ port => Port},
+ case socket:bind(Sock, SA) of
+ {ok, _} ->
+ ok;
+ {error, BReason} ->
+ (catch socket:close(Sock)),
+ throw({error, {bind, BReason}})
+ end,
+ case socket:listen(Sock) of
+ ok ->
+ ok;
+ {error, LReason} ->
+ (catch socket:close(Sock)),
+ throw({error, {listen, LReason}})
+ end,
+ {ok, #{sock => Sock, opts => Opts}}
+ end
+ catch
+ throw:{error, Reason}:_ ->
+ {error, Reason}
+ end.
+
+
+port(#{sock := Sock}) ->
+ case socket:sockname(Sock) of
+ {ok, #{port := Port}} ->
+ {ok, Port};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+peername(#{sock := Sock}) ->
+ case socket:peername(Sock) of
+ {ok, #{addr := Addr, port := Port}} ->
+ {ok, {Addr, Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+recv(#{sock := Sock, method := plain}, Length) ->
+ socket:recv(Sock, Length);
+recv(#{sock := Sock, method := msg}, Length) ->
+ case socket:recvmsg(Sock, Length, 0, [], infinity) of
+ {ok, #{iov := [Bin]}} ->
+ {ok, Bin};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+recv(#{sock := Sock, method := plain}, Length, Timeout) ->
+ socket:recv(Sock, Length, Timeout);
+recv(#{sock := Sock, method := msg}, Length, Timeout) ->
+ case socket:recvmsg(Sock, Length, 0, [], Timeout) of
+ {ok, #{iov := [Bin]}} ->
+ {ok, Bin};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+send(#{sock := Sock, method := plain}, Bin) ->
+ socket:send(Sock, Bin);
+send(#{sock := Sock, method := msg}, Bin) ->
+ socket:sendmsg(Sock, #{iov => [Bin]}).
+
+
+shutdown(#{sock := Sock}, How) ->
+ socket:shutdown(Sock, How).
+
+
+sockname(#{sock := Sock}) ->
+ case socket:sockname(Sock) of
+ {ok, #{addr := Addr, port := Port}} ->
+ {ok, {Addr, Port}};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+%% ==========================================================================
+
+reader_init(ControllingProcess, Sock, Active, Method)
+ when is_pid(ControllingProcess) andalso
+ (is_boolean(Active) orelse (Active =:= once)) andalso
+ ((Method =:= plain) orelse (Method =:= msg)) ->
+ MRef = erlang:monitor(process, ControllingProcess),
+ reader_loop(#{ctrl_proc => ControllingProcess,
+ ctrl_proc_mref => MRef,
+ active => Active,
+ sock => Sock,
+ method => Method}).
+
+
+%% Never read
+reader_loop(#{active := false,
+ ctrl_proc := Pid} = State) ->
+ receive
+ {?MODULE, stop} ->
+ exit(normal);
+
+ {?MODULE, Pid, controlling_process, NewPid} ->
+ MRef = maps:get(ctrl_proc_mref, State),
+ erlang:demonitor(MRef, [flush]),
+ NewMRef = erlang:monitor(process, NewPid),
+ Pid ! {?MODULE, self(), controlling_process},
+ reader_loop(State#{ctrl_proc => NewPid,
+ ctrl_proc_mref => NewMRef});
+
+ {?MODULE, active, NewActive} ->
+ reader_loop(State#{active => NewActive});
+
+ {'DOWN', MRef, process, Pid, Reason} ->
+ case maps:get(ctrl_proc_mref, State) of
+ MRef when (Reason =:= normal) ->
+ exit(normal);
+ MRef ->
+ exit({controlling_process, Reason});
+ _ ->
+ reader_loop(State)
+ end
+ end;
+
+%% Read *once* and then change to false
+reader_loop(#{active := once,
+ sock := Sock,
+ method := Method,
+ ctrl_proc := Pid} = State) ->
+ case do_recv(Method, Sock) of
+ {ok, Data} ->
+ Pid ! ?DATA_MSG(Sock, Method, Data),
+ reader_loop(State#{active => false});
+ {error, timeout} ->
+ receive
+ {?MODULE, stop} ->
+ exit(normal);
+
+ {?MODULE, Pid, controlling_process, NewPid} ->
+ MRef = maps:get(ctrl_proc_mref, State),
+ erlang:demonitor(MRef, [flush]),
+ MRef = erlang:monitor(process, NewPid),
+ Pid ! {?MODULE, self(), controlling_process},
+ reader_loop(State#{ctrl_proc => NewPid,
+ ctrl_proc_mref => MRef});
+
+ {?MODULE, active, NewActive} ->
+ reader_loop(State#{active => NewActive});
+
+ {'DOWN', MRef, process, Pid, Reason} ->
+ case maps:get(ctrl_proc_mref, State) of
+ MRef when (Reason =:= normal) ->
+ exit(normal);
+ MRef ->
+ exit({controlling_process, Reason});
+ _ ->
+ reader_loop(State)
+ end
+ after 0 ->
+ reader_loop(State)
+ end;
+
+ {error, closed} ->
+ Pid ! ?CLOSED_MSG(Sock, Method),
+ exit(normal);
+
+ {error, Reason} ->
+ Pid ! ?ERROR_MSG(Sock, Method, Reason),
+ exit(Reason)
+ end;
+
+%% Read and forward data continuously
+reader_loop(#{active := true,
+ sock := Sock,
+ method := Method,
+ ctrl_proc := Pid} = State) ->
+ case do_recv(Method, Sock) of
+ {ok, Data} ->
+ Pid ! ?DATA_MSG(Sock, Method, Data),
+ reader_loop(State);
+ {error, timeout} ->
+ receive
+ {?MODULE, stop} ->
+ exit(normal);
+
+ {?MODULE, Pid, controlling_process, NewPid} ->
+ MRef = maps:get(ctrl_proc_mref, State),
+ erlang:demonitor(MRef, [flush]),
+ MRef = erlang:monitor(process, NewPid),
+ Pid ! {?MODULE, self(), controlling_process},
+ reader_loop(State#{ctrl_proc => NewPid,
+ ctrl_proc_mref => MRef});
+
+ {?MODULE, active, NewActive} ->
+ reader_loop(State#{active => NewActive});
+
+ {'DOWN', MRef, process, Pid, Reason} ->
+ case maps:get(ctrl_proc_mref, State) of
+ MRef when (Reason =:= normal) ->
+ exit(normal);
+ MRef ->
+ exit({controlling_process, Reason});
+ _ ->
+ reader_loop(State)
+ end
+ after 0 ->
+ reader_loop(State)
+ end;
+
+ {error, closed} ->
+ Pid ! ?CLOSED_MSG(Sock, Method),
+ exit(normal);
+
+ {error, Reason} ->
+ Pid ! ?ERROR_MSG(Sock, Method, Reason),
+ exit(Reason)
+ end.
+
+
+do_recv(plain, Sock) ->
+ socket:recv(Sock, 0, ?READER_RECV_TIMEOUT);
+do_recv(msg, Sock) ->
+ case socket:recvmsg(Sock, 0, 0, [], ?READER_RECV_TIMEOUT) of
+ {ok, #{iov := [Bin]}} ->
+ {ok, Bin};
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+
+%% ==========================================================================
+
diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl
index 253d5fed23..ad802352b9 100644
--- a/erts/emulator/test/trace_local_SUITE.erl
+++ b/erts/emulator/test/trace_local_SUITE.erl
@@ -1181,7 +1181,9 @@ undef(X) ->
?MODULE:undef(X, X). % undef
lists_reverse(A, B) ->
- lists:reverse(A, B).
+ Res = lists:reverse(A, B),
+ _ = (catch abs(A)),
+ Res.
diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops
index f73e2362bf..1625b2cc65 100755
--- a/erts/emulator/utils/beam_makeops
+++ b/erts/emulator/utils/beam_makeops
@@ -1488,7 +1488,7 @@ sub code_gen {
$var_decls .= "Eterm $tmp;\n";
$tmp_arg_num++;
push(@f, $tmp);
- $prefix .= "GetR($arg_offset, $tmp);\n";
+ $prefix .= "GetSource(" . arg_offset($arg_offset) . ", $tmp);\n";
$need_block = 1;
last SWITCH;
};
diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c
index bd218ff725..bb843a616b 100644
--- a/erts/etc/common/heart.c
+++ b/erts/etc/common/heart.c
@@ -500,7 +500,7 @@ message_loop(erlin_fd, erlout_fd)
#if defined(__WIN32__)
static void
-kill_old_erlang(void){
+kill_old_erlang(int reason){
HANDLE erlh;
DWORD exit_code;
char* envvar = NULL;
@@ -536,7 +536,8 @@ kill_old_erlang(void){
}
#else
static void
-kill_old_erlang(void){
+kill_old_erlang(int reason)
+{
pid_t pid;
int i, res;
int sig = SIGKILL;
@@ -546,14 +547,25 @@ kill_old_erlang(void){
if (envvar && strcmp(envvar, "TRUE") == 0)
return;
- envvar = get_env(HEART_KILL_SIGNAL);
- if (envvar && strcmp(envvar, "SIGABRT") == 0) {
- print_error("kill signal SIGABRT requested");
- sig = SIGABRT;
- }
-
if(heart_beat_kill_pid != 0){
- pid = (pid_t) heart_beat_kill_pid;
+ pid = (pid_t) heart_beat_kill_pid;
+ if (reason == R_CLOSED) {
+ print_error("Wait 5 seconds for Erlang to terminate nicely");
+ for (i=0; i < 5; ++i) {
+ res = kill(pid, 0); /* check if alive */
+ if (res < 0 && errno == ESRCH)
+ return;
+ sleep(1);
+ }
+ print_error("Erlang still alive, kill it");
+ }
+
+ envvar = get_env(HEART_KILL_SIGNAL);
+ if (envvar && strcmp(envvar, "SIGABRT") == 0) {
+ print_error("kill signal SIGABRT requested");
+ sig = SIGABRT;
+ }
+
res = kill(pid,sig);
for(i=0; i < 5 && res == 0; ++i){
sleep(1);
@@ -677,7 +689,7 @@ do_terminate(int erlin_fd, int reason) {
if(!command)
print_error("Would reboot. Terminating.");
else {
- kill_old_erlang();
+ kill_old_erlang(reason);
/* High prio combined with system() works badly indeed... */
SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS);
win_system(command);
@@ -685,7 +697,7 @@ do_terminate(int erlin_fd, int reason) {
}
free_env_val(command);
} else {
- kill_old_erlang();
+ kill_old_erlang(reason);
/* High prio combined with system() works badly indeed... */
SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS);
win_system(&cmd[0]);
@@ -697,13 +709,13 @@ do_terminate(int erlin_fd, int reason) {
if(!command)
print_error("Would reboot. Terminating.");
else {
- kill_old_erlang();
+ kill_old_erlang(reason);
ret = system(command);
print_error("Executed \"%s\" -> %d. Terminating.",command, ret);
}
free_env_val(command);
} else {
- kill_old_erlang();
+ kill_old_erlang(reason);
ret = system((char*)&cmd[0]);
print_error("Executed \"%s\" -> %d. Terminating.",cmd, ret);
}
diff --git a/erts/etc/unix/Makefile b/erts/etc/unix/Makefile
index 83c64d35fd..21a725cb88 100644
--- a/erts/etc/unix/Makefile
+++ b/erts/etc/unix/Makefile
@@ -30,7 +30,8 @@ opt debug lcnt: etc
etc: etp-commands
etp-commands: etp-commands.in
- $(gen_verbose)sed 's:@ERL_TOP@:${ERL_TOP}:g' etp-commands.in > etp-commands
+ $(gen_verbose)sed -e 's:@ERL_TOP@:${ERL_TOP}:g' \
+ etp-commands.in > etp-commands
.PHONY: docs
docs:
diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src
index 2e034513b0..bcd64d242e 100644
--- a/erts/etc/unix/cerl.src
+++ b/erts/etc/unix/cerl.src
@@ -224,7 +224,13 @@ while [ $# -gt 0 ]; do
shift
cargs="$cargs -rr"
run_rr=yes
- skip_erlexec=yes
+ case "$1" in
+ "replay"|"ps")
+ ;;
+ *)
+ skip_erlexec=yes
+ ;;
+ esac
;;
*)
break
@@ -307,7 +313,26 @@ if [ "x$GDB" = "x" ]; then
exec $taskset1 valgrind $valgrind_xml $valgrind_log $valgrind_misc_flags $BINDIR/$EMU_NAME $sched_arg $emu_xargs "$@"
elif [ $run_rr = yes ]; then
- exec rr record --ignore-nested $BINDIR/$EMU_NAME $emu_xargs "$@"
+ if [ $1 = replay ]; then
+ shift
+ cmdfile="/tmp/.cerlgdb.$$"
+ echo "set \$etp_beam_executable = \"$BINDIR/$EMU_NAME\"" > $cmdfile
+ if [ "$1" = "-p" ]; then
+ echo 'set $etp_rr_run_until_beam = 1' >> $cmdfile
+ fi
+ cat $ROOTDIR/erts/etc/unix/etp-commands.in >> $cmdfile
+ exec rr replay -x $cmdfile $*
+ elif [ $1 = ps ]; then
+ shift
+ rr ps $* | head -1
+ ChildSetup=`rr ps $* | grep 'erl_child_setup' | awk '{ print $2 }'`
+ for CS in $ChildSetup; do
+ rr ps $* | grep -E "^$CS"
+ done
+ exit 0
+ else
+ exec rr record --ignore-nested $BINDIR/$EMU_NAME $emu_xargs "$@"
+ fi
else
exec $EXEC $xargs ${1+"$@"}
fi
diff --git a/erts/etc/unix/etp-commands.in b/erts/etc/unix/etp-commands.in
index b12a205ba7..e8dc59156f 100644
--- a/erts/etc/unix/etp-commands.in
+++ b/erts/etc/unix/etp-commands.in
@@ -149,7 +149,7 @@ define etp-1
else
# (($arg0) & 0x3) == 0
if (($arg0) == etp_the_non_value)
- printf "<the non-value>"
+ printf "<the-non-value>"
else
etp-cp-1 ($arg0)
end
@@ -1241,7 +1241,7 @@ define etp-sig-int
if $etp_sig_tag != etp_the_non_value
etp-1 $etp_sig_tag 0
else
- print "!ENCODED-DIST-MSG"
+ printf "!ENCODED-DIST-MSG"
end
if ($arg0)->m[1] != $etp_nil
printf " @token= "
@@ -1251,7 +1251,7 @@ define etp-sig-int
etp-1 ($arg0)->m[2] 0
else
if ($etp_sig_tag & 0x3f) != 0x30
- print "!INVALID-SIGNAL"
+ printf "!INVALID-SIGNAL"
else
set $etp_sig_op = (($etp_sig_tag >> 6) & 0xff)
set $etp_sig_type = (($etp_sig_tag >> 14) & 0xff)
@@ -1789,7 +1789,7 @@ define etp-pix2proc
# Args: Eterm
#
set $proc = (Process *) *((UWord *) &erts_proc.r.o.tab[((int) $arg0)])
- printf "(Process *) %p\n", $proc
+ printf "(Process*)%p\n", $proc
end
define etp-pid2proc-1
@@ -1803,7 +1803,7 @@ define etp-pid2proc
# Args: Eterm
#
etp-pid2proc-1 $arg0
- printf "(Process *) %p\n", $proc
+ printf "(Process*)%p\n", $proc
end
define etp-proc-state-int
@@ -2083,7 +2083,7 @@ define etp-process-info-int
printf "\n Flags: "
etp-proc-flags $etp_proc
if $proxy_process != 0
- printf " Pointer: (Process *) %p\n", $etp_proc
+ printf " Pointer: (Process*)%p\n", $etp_proc
printf " *** PROXY process struct *** refer to: \n"
etp-pid2proc-1 $etp_proc->common.id
etp-process-info $proc
@@ -2096,7 +2096,7 @@ define etp-process-info-int
end
end
printf " Current function: "
- if ($etp_proc->current)
+ if ($etp_proc->current && !($etp_proc->state.counter & 0x800))
etp-1 $etp_proc->current->module
printf ":"
etp-1 $etp_proc->current->function
@@ -2133,7 +2133,7 @@ define etp-process-info-int
end
printf " Parent: "
etp-1 ((Eterm)($etp_proc->parent))
- printf "\n Pointer: (Process *) %p\n", $etp_proc
+ printf "\n Pointer: (Process*)%p\n", $etp_proc
end
if ($arg1)
etp-sigqs $etp_proc
@@ -2156,6 +2156,43 @@ document etp-process-info
%---------------------------------------------------------------------------
end
+define etp-processes-free-runq-int
+ set $runq_prio = 0
+ while $runq_prio < 3
+ set $runq_proc = ($arg0)->procs.prio[$runq_prio].first
+ while $runq_proc != 0
+ if $runq_proc->state.counter & 0x400
+ printf "---\n"
+ printf " Pix: FREE -> run_queue %p\n", ($arg0)
+ etp-process-info-int $runq_proc ($arg1)
+ end
+ set $runq_proc = $runq_proc->next
+ end
+ set $runq_prio++
+ end
+end
+
+define etp-processes-free-de-int
+ set $de_ix = 0
+ while $de_ix < ($arg1)
+ set $de = ($arg0)+$de_ix
+ set $susp = $de->suspended
+ set $susp_curr = $susp
+ set $first_loop = 1
+ while $susp_curr != 0 && (($susp_curr != $susp) || $first_loop)
+ if ($susp_curr->u.pid & 0x3) == 0
+ printf "---\n"
+ printf " Pix: FREE "
+ etp $de->sysname
+ etp-process-info-int $susp_curr->u.pid ($arg2)
+ end
+ set $first_loop = 0
+ set $susp_curr = $susp_curr->next
+ end
+ set $de_ix++
+ end
+end
+
define etp-processes-int
if (!erts_initialized)
printf "No processes, since system isn't initialized!\n"
@@ -2176,11 +2213,36 @@ define etp-processes-int
set $proc_cnt--
end
if $proc_ix == $proc_printile
- printf "--- %d%% (%d / %d) searched\n", $proc_printile / $proc_decentile * 10, $proc_ix, $proc_max_ix
+ printf "--- %d%% (%d / %d) searched, looking for %d more\n", $proc_printile / $proc_decentile * 10, $proc_ix, $proc_max_ix, $proc_cnt
set $proc_printile += $proc_decentile
end
set $proc_ix++
end
+
+ ## We should also check for any FREE processes that are running
+ ## They can be found in esdp->current_process, dep->suspendees and
+ ## runq. Running FREE processes are processes that either are yielding
+ ## when exiting or running on a dirty scheduler while having exited.
+ set $sched_ix = 0
+ while $sched_ix < erts_no_schedulers
+ set $sched_data = &erts_aligned_scheduler_data[$sched_ix].esd
+ if $sched_data->current_process != 0
+ if $sched_data->current_process.state.counter & 0x400
+ printf "---\n"
+ printf " Pix: FREE -> scheduler %d\n", $sched_ix+1
+ etp-process-info-int $sched_data->current_process ($arg0)
+ end
+ end
+ etp-processes-free-runq-int $sched_data->run_queue ($arg0)
+ set $sched_ix++
+ end
+ etp-processes-free-runq-int &erts_aligned_run_queues[erts_no_run_queues].runq ($arg0)
+ etp-processes-free-runq-int &erts_aligned_run_queues[erts_no_run_queues+1].runq ($arg0)
+ etp-processes-free-de-int erts_hidden_dist_entries erts_no_of_hidden_dist_entries ($arg0)
+ etp-processes-free-de-int erts_visible_dist_entries erts_no_of_visible_dist_entries ($arg0)
+ etp-processes-free-de-int erts_pending_dist_entries erts_no_of_pending_dist_entries ($arg0)
+ etp-processes-free-de-int erts_not_connected_dist_entries erts_no_of_not_connected_dist_entries ($arg0)
+ etp-processes-free-de-int erts_this_dist_entry 1 ($arg0)
printf "---\n",
end
end
@@ -2237,9 +2299,9 @@ define etp-process-memory-info
end
printf " "
etp-1 $etp_pmem_proc->common.id
- printf ": (Process *) %p ", $etp_pmem_proc
+ printf ": (Process*)%p ", $etp_pmem_proc
if $proxy_process != 0
- printf "(Process *) %p ", $etp_pmem_proc
+ printf "(Process*)%p ", $etp_pmem_proc
printf " *** PROXY process struct *** refer to next: \n"
etp-pid2proc-1 $etp_pmem_proc->common.id
printf " -"
@@ -2313,7 +2375,7 @@ define etp-pix2port
# Args: Eterm
#
set $port = (Port *) *((UWord *) &erts_port.r.o.tab[((int) $arg0)])
- printf "(Port *) %p\n", $port
+ printf "(Port*)%p\n", $port
end
define etp-id2port-1
@@ -2327,7 +2389,7 @@ define etp-id2port
# Args: Eterm
#
etp-id2port-1 $arg0
- printf "(Port *) %p\n", $port
+ printf "(Port*)%p\n", $port
end
define etp-port-sched-flags-int
@@ -2501,7 +2563,7 @@ define etp-port-info
printf " Connected: "
set $connected = *(((Eterm *) &(((Port *) $etp_pinfo_port)->connected)))
etp-1 $connected
- printf "\n Pointer: (Port *) %p\n", $etp_pinfo_port
+ printf "\n Pointer: (Port*)%p\n", $etp_pinfo_port
end
document etp-port-info
@@ -2851,7 +2913,7 @@ define etp-scheduler-info-internal
printf " Sleep Info Flags:"
set $ssi_flags = *((Uint32 *) &$sched_data->ssi->flags)
etp-ssi-flags $ssi_flags
- printf " Pointer: (ErtsSchedulerData *) %p\n", $sched_data
+ printf " Pointer: (ErtsSchedulerData*)%p\n", $sched_data
end
define etp-run-queue-info-internal
@@ -2884,7 +2946,7 @@ define etp-run-queue-info-internal
end
set $rq_flags = *((Uint32 *) &($runq->flags))
etp-rq-flags-int $rq_flags
- printf " Pointer: (ErtsRunQueue *) %p\n", $runq
+ printf " Pointer: (ErtsRunQueue*)%p\n", $runq
end
define etp-fds
@@ -2961,7 +3023,7 @@ define etp-timer-wheel
printf "\n"
while 1
printf "- Timeout pos: %ld\n", $tmr->timeout_pos
- printf " Pointer: (ErtsTWheelTimer *) %p\n", $tmr
+ printf " Pointer: (ErtsTWheelTimer*)%p\n", $tmr
set $tmr = $tmr->next
if ($tmr == $tiw->w[$ix])
loop_break
@@ -2991,7 +3053,7 @@ define etp-timer-wheel
printf "\n"
while 1
printf "- Timeout pos: %ld\n", $tmr->timeout_pos
- printf " Pointer: (ErtsTWheelTimer *) %p\n", $tmr
+ printf " Pointer: (ErtsTWheelTimer*)%p\n", $tmr
set $tmr = $tmr->next
if ($tmr == $tiw->w[$ix])
loop_break
@@ -4326,6 +4388,20 @@ document etp-show
%---------------------------------------------------------------------------
end
+define etp-rr-run-until-beam
+ source @ERL_TOP@/erts/etc/unix/etp-rr-run-until-beam.py
+end
+
+document etp-rr-run-until-beam
+%---------------------------------------------------------------------------
+% etp-rr-run-until-beam
+%
+% Use this gdb macro to make cerl -rr replay -p PID walk until
+% the correct execute has been made. You may have to change the
+% file that is used to debug with.
+%---------------------------------------------------------------------------
+end
+
############################################################################
# Init
#
@@ -4363,7 +4439,13 @@ define hook-run
set $_exitsignal = -1
end
+handle SIGPIPE nostop
+
etp-init
help etp-init
-etp-show
-etp-system-info
+if $etp_rr_run_until_beam
+ help etp-rr-run-until-beam
+else
+ etp-show
+ etp-system-info
+end
diff --git a/erts/etc/unix/etp-rr-run-until-beam.py b/erts/etc/unix/etp-rr-run-until-beam.py
new file mode 100644
index 0000000000..078998b910
--- /dev/null
+++ b/erts/etc/unix/etp-rr-run-until-beam.py
@@ -0,0 +1,45 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2013-2016. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+
+has_exited = False
+
+def stop_handler (event):
+ global has_exited
+ if isinstance(event, gdb.SignalEvent):
+ print("exit code: %s" % (event.stop_signal))
+ has_exited = True
+
+gdb.events.stop.connect (stop_handler)
+
+gdb.execute('continue')
+
+while not has_exited:
+ r = gdb.execute('when', to_string=True)
+ m = re.match("[^0-9]*([0-9]+)", r)
+ if m:
+ event = int(m.group(1));
+ gdb.execute('start ' + str(event + 1));
+ gdb.execute('continue')
+
+gdb.events.stop.disconnect (stop_handler)
+
+gdb.execute('file ' + str(gdb.parse_and_eval("$etp_beam_executable")))
+gdb.execute('break main')
+gdb.execute('reverse-continue')
diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c
index afff8f7e54..ed4fe12e8b 100644
--- a/erts/etc/unix/to_erl.c
+++ b/erts/etc/unix/to_erl.c
@@ -245,7 +245,6 @@ int main(int argc, char **argv)
tty_smode.c_iflag =
1*BRKINT |/*Signal interrupt on break.*/
1*IGNPAR |/*Ignore characters with parity errors.*/
- 1*ISTRIP |/*Strip character.*/
0;
#if 0
diff --git a/erts/etc/win32/msys_tools/vc/ld.sh b/erts/etc/win32/msys_tools/vc/ld.sh
index 8917251f51..22184faf76 100644
--- a/erts/etc/win32/msys_tools/vc/ld.sh
+++ b/erts/etc/win32/msys_tools/vc/ld.sh
@@ -178,7 +178,10 @@ if [ "$RES" = "0" -a -f "$CMANIFEST" ]; then
RES=$?
if [ "$RES" != "0" ]; then
REMOVE=`echo "$OUTPUTRES" | sed 's,\\\;[12]$,,g'`
- CREMOVE=`cygpath $REMOVE`
+ CREMOVE=`win2msys_path.sh $REMOVE`
+ ## If Defender or Search are enabled, they will lock just created files
+ ## and then mt will fail :/
+ echo "If you get this error, make sure Windows Defender AND Windows Search is disabled">>/tmp/link.exe.${p}.1
rm -f "$CREMOVE"
fi
rm -f "$CMANIFEST"
diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in
index 8e1f5b58c4..1da11c2d0a 100644
--- a/erts/lib_src/Makefile.in
+++ b/erts/lib_src/Makefile.in
@@ -29,7 +29,6 @@ CC=@CC@
LD=@LD@
AR=@AR@
RANLIB=@RANLIB@
-RM=@RM@
MKDIR=@MKDIR@
INSTALL=@INSTALL@
INSTALL_DIR=@INSTALL_DIR@
@@ -536,9 +535,9 @@ release_docs_spec:
#
.PHONY: clean
clean:
- $(RM) -rf ../lib/internal/$(TARGET)/*
- $(RM) -rf ../lib/$(TARGET)/*
- $(RM) -rf obj/$(TARGET)/*
+ $(RM) -r ../lib/internal/$(TARGET)/*
+ $(RM) -r ../lib/$(TARGET)/*
+ $(RM) -r obj/$(TARGET)/*
#
# Make dependencies
diff --git a/erts/lib_src/common/erl_printf.c b/erts/lib_src/common/erl_printf.c
index 259ba8c81d..86f5da1c40 100644
--- a/erts/lib_src/common/erl_printf.c
+++ b/erts/lib_src/common/erl_printf.c
@@ -27,6 +27,11 @@
#include "config.h"
#endif
+#if defined(__sun) || defined(__sun__)
+ /* For flockfile(3c), putc_unlocked(3c), etc */
+ #define __EXTENSIONS__
+#endif
+
#include <string.h>
#include "erl_errno.h"
#ifdef __WIN32__
diff --git a/erts/preloaded/ebin/erl_init.beam b/erts/preloaded/ebin/erl_init.beam
index bac2cbb15b..81be5b021a 100644
--- a/erts/preloaded/ebin/erl_init.beam
+++ b/erts/preloaded/ebin/erl_init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index bbee904837..661bcd8413 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index dbc080cf2d..1d89174b25 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
Binary files differ
diff --git a/erts/preloaded/ebin/net.beam b/erts/preloaded/ebin/net.beam
new file mode 100644
index 0000000000..ebb1296b95
--- /dev/null
+++ b/erts/preloaded/ebin/net.beam
Binary files differ
diff --git a/erts/preloaded/ebin/persistent_term.beam b/erts/preloaded/ebin/persistent_term.beam
index e94ef983be..c882e4fad4 100644
--- a/erts/preloaded/ebin/persistent_term.beam
+++ b/erts/preloaded/ebin/persistent_term.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index b9f4791ba9..0efd954e50 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam
index 1e6eb3a37f..ff9268ad38 100644
--- a/erts/preloaded/ebin/prim_inet.beam
+++ b/erts/preloaded/ebin/prim_inet.beam
Binary files differ
diff --git a/erts/preloaded/ebin/socket.beam b/erts/preloaded/ebin/socket.beam
new file mode 100644
index 0000000000..e44dff8475
--- /dev/null
+++ b/erts/preloaded/ebin/socket.beam
Binary files differ
diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile
index c655bff72e..efeb92dce9 100644
--- a/erts/preloaded/src/Makefile
+++ b/erts/preloaded/src/Makefile
@@ -39,6 +39,8 @@ PRE_LOADED_ERL_MODULES = \
prim_buffer \
prim_file \
prim_inet \
+ socket \
+ net \
zlib \
prim_zip \
erl_init \
@@ -79,6 +81,10 @@ STDLIB_INCLUDE=$(ERL_TOP)/lib/stdlib/include
ERL_COMPILE_FLAGS += +debug_info -I$(KERNEL_SRC) -I$(KERNEL_INCLUDE)
+DIA_PLT = erts-preloaded.plt
+DIA_ANALYSIS = $(basename $(DIA_PLT)).dialyzer_analysis
+
+
debug opt: $(TARGET_FILES)
clean:
@@ -90,7 +96,6 @@ copy:
$(APP_TARGET): $(APP_SRC) $(ERL_TOP)/erts/vsn.mk
$(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@
-
include $(ERL_TOP)/make/otp_release_targets.mk
release_spec: $(APP_TARGET)
@@ -105,6 +110,30 @@ release_docs_spec:
list_preloaded:
@echo $(PRE_LOADED_MODULES)
+dclean:
+ rm -f $(DIA_PLT)
+ rm -f $(DIA_ANALYSIS)
+
+dialyzer_plt: $(DIA_PLT)
+
+$(DIA_PLT): $(ERL_FILES)
+ @echo "Building ($(basename $(DIA_PLT))) plt file"
+ @dialyzer --build_plt \
+ --output_plt $@ \
+ -r ../ebin \
+ ../../../lib/kernel/ebin \
+ ../../../lib/stdlib/ebin \
+ ../../../lib/crypto/ebin \
+ ../../../lib/compiler/ebin \
+ --output $(DIA_ANALYSIS) \
+ --verbose
+
+dialyzer: $(DIA_PLT)
+ @echo "Running dialyzer on $(basename $(DIA_PLT))"
+ @dialyzer --plt $< \
+ ../ebin \
+ --verbose
+
#
# Combine a BEAM assembly script file a stub Erlang file into a BEAM file.
# See add_abstract_chunk script.
diff --git a/erts/preloaded/src/erl_init.erl b/erts/preloaded/src/erl_init.erl
index d681f05398..6edead362c 100644
--- a/erts/preloaded/src/erl_init.erl
+++ b/erts/preloaded/src/erl_init.erl
@@ -35,6 +35,8 @@ start(Mod, BootArgs) ->
erl_tracer:on_load(),
prim_buffer:on_load(),
prim_file:on_load(),
+ socket:on_load(),
+ net:on_load(),
%% Proceed to the specified boot module
run(Mod, boot, BootArgs).
diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index fefdd34292..1605c20f2c 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -297,12 +297,13 @@ check_file_result(Func, Target, {error,Reason}) ->
"Target: " ++ TargetStr ++ ". " ++
"Function: " ++ atom_to_list(Func) ++ ". " ++ Process
end,
- %% this is equal to calling error_logger:error_report/1 which
- %% we don't want to do from code_server during system boot
+ %% This is equal to calling logger:error/2 which
+ %% we don't want to do from code_server during system boot.
+ %% We don't want to call logger:timestamp() either.
logger ! {log,error,#{label=>{?MODULE,file_error},report=>Report},
#{pid=>self(),
gl=>group_leader(),
- time=>erlang:system_time(microsecond),
+ time=>os:system_time(microsecond),
error_logger=>#{tag=>error_report,
type=>std_error}}},
error
diff --git a/erts/preloaded/src/erts.app.src b/erts/preloaded/src/erts.app.src
index 9de81cae27..c2a8511b6d 100644
--- a/erts/preloaded/src/erts.app.src
+++ b/erts/preloaded/src/erts.app.src
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -35,7 +35,9 @@
prim_zip,
atomics,
counters,
- zlib
+ zlib,
+ net,
+ socket
]},
{registered, []},
{applications, []},
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index 54cbd96710..5ea67347ec 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -477,13 +477,16 @@ do_handle_msg(Msg,State) ->
{From, {ensure_loaded, _}} ->
From ! {init, not_allowed};
X ->
+ %% This is equal to calling logger:info/3 which we don't
+ %% want to do from the init process, at least not during
+ %% system boot. We don't want to call logger:timestamp()
+ %% either.
case whereis(user) of
undefined ->
- Time = erlang:system_time(microsecond),
catch logger ! {log, info, "init got unexpected: ~p", [X],
#{pid=>self(),
gl=>self(),
- time=>Time,
+ time=>os:system_time(microsecond),
error_logger=>#{tag=>info_msg}}};
User ->
User ! X,
diff --git a/erts/preloaded/src/net.erl b/erts/preloaded/src/net.erl
new file mode 100644
index 0000000000..a24b5c8ce3
--- /dev/null
+++ b/erts/preloaded/src/net.erl
@@ -0,0 +1,336 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(net).
+
+-compile(no_native).
+
+%% Administrative and "global" utility functions
+-export([
+ on_load/0, on_load/1,
+ info/0,
+ command/1
+ ]).
+
+-export([
+ gethostname/0,
+ getnameinfo/1, getnameinfo/2,
+ getaddrinfo/1, getaddrinfo/2,
+
+ if_name2index/1,
+ if_index2name/1,
+ if_names/0
+ ]).
+
+%% Deprecated functions from the "old" net module
+-export([call/4,
+ cast/4,
+ broadcast/3,
+ ping/1,
+ relay/1,
+ sleep/1]).
+
+-export_type([
+ address_info/0,
+ name_info/0,
+
+ name_info_flags/0,
+ name_info_flag/0,
+ name_info_flag_ext/0,
+
+ network_interface_name/0,
+ network_interface_index/0
+ ]).
+
+-deprecated({call, 4, eventually}).
+-deprecated({cast, 4, eventually}).
+-deprecated({broadcast, 3, eventually}).
+-deprecated({ping, 1, eventually}).
+-deprecated({relay, 1, eventually}).
+-deprecated({sleep, 1, eventually}).
+
+
+-type name_info_flags() :: [name_info_flag()|name_info_flag_ext()].
+-type name_info_flag() :: namereqd |
+ dgram |
+ nofqdn |
+ numerichost |
+ nomericserv.
+-type name_info_flag_ext() :: idn |
+ idna_allow_unassigned |
+ idna_use_std3_ascii_rules.
+-type name_info() :: #{host := string(),
+ service := string()}.
+-type address_info() :: #{family := socket:domain(),
+ socktype := socket:type(),
+ protocol := socket:protocol(),
+ address := socket:sockaddr()}.
+-type network_interface_name() :: string().
+-type network_interface_index() :: non_neg_integer().
+
+
+%% ===========================================================================
+%%
+%% D E P R E C A T E D F U N C T I O N S
+%%
+%% ===========================================================================
+
+call(N,M,F,A) -> rpc:call(N,M,F,A).
+cast(N,M,F,A) -> rpc:cast(N,M,F,A).
+broadcast(M,F,A) -> rpc:eval_everywhere(M,F,A).
+ping(Node) -> net_adm:ping(Node).
+sleep(T) -> receive after T -> ok end.
+relay(X) -> slave:relay(X).
+
+
+
+%% ===========================================================================
+%%
+%% Administrative and utility API
+%%
+%% ===========================================================================
+
+-spec on_load() -> ok.
+
+%% Should we require that the Extra arg is a map?
+on_load() ->
+ on_load(#{}).
+
+-spec on_load(Extra) -> ok when
+ Extra :: map().
+
+on_load(Extra) ->
+ ok = erlang:load_nif(atom_to_list(?MODULE), Extra).
+
+
+-spec info() -> list().
+
+info() ->
+ nif_info().
+
+
+-spec command(Cmd :: term()) -> term().
+
+command(Cmd) ->
+ nif_command(Cmd).
+
+
+
+%% ===========================================================================
+%%
+%% The proper net API
+%%
+%% ===========================================================================
+
+%% ===========================================================================
+%%
+%% gethostname - Get the name of the current host.
+%%
+%%
+
+-spec gethostname() -> {ok, HostName} | {error, Reason} when
+ HostName :: string(),
+ Reason :: term().
+
+gethostname() ->
+ nif_gethostname().
+
+
+%% ===========================================================================
+%%
+%% getnameinfo - Address-to-name translation in protocol-independent manner.
+%%
+%%
+
+-spec getnameinfo(SockAddr) -> {ok, Info} | {error, Reason} when
+ SockAddr :: socket:sockaddr(),
+ Info :: name_info(),
+ Reason :: term().
+
+getnameinfo(SockAddr) ->
+ getnameinfo(SockAddr, undefined).
+
+-spec getnameinfo(SockAddr, Flags) -> {ok, Info} | {error, Reason} when
+ SockAddr :: socket:sockaddr(),
+ Flags :: name_info_flags() | undefined,
+ Info :: name_info(),
+ Reason :: term().
+
+getnameinfo(SockAddr, [] = _Flags) ->
+ getnameinfo(SockAddr, undefined);
+getnameinfo(#{family := Fam, addr := _Addr} = SockAddr, Flags)
+ when ((Fam =:= inet) orelse (Fam =:= inet6)) andalso
+ (is_list(Flags) orelse (Flags =:= undefined)) ->
+ nif_getnameinfo(socket:ensure_sockaddr(SockAddr), Flags);
+getnameinfo(#{family := Fam, path := _Path} = SockAddr, Flags)
+ when (Fam =:= local) andalso (is_list(Flags) orelse (Flags =:= undefined)) ->
+ nif_getnameinfo(SockAddr, Flags).
+
+
+
+%% ===========================================================================
+%%
+%% getaddrinfo - Network address and service translation
+%%
+%% There is also a "hint" argument that we "at some point" should implement.
+
+-spec getaddrinfo(Host) -> {ok, Info} | {error, Reason} when
+ Host :: string(),
+ Info :: [address_info()],
+ Reason :: term().
+
+getaddrinfo(Host) when is_list(Host) ->
+ getaddrinfo(Host, undefined).
+
+
+-spec getaddrinfo(Host, undefined) -> {ok, Info} | {error, Reason} when
+ Host :: string(),
+ Info :: [address_info()],
+ Reason :: term()
+ ; (undefined, Service) -> {ok, Info} | {error, Reason} when
+ Service :: string(),
+ Info :: [address_info()],
+ Reason :: term()
+ ; (Host, Service) -> {ok, Info} | {error, Reason} when
+ Host :: string(),
+ Service :: string(),
+ Info :: [address_info()],
+ Reason :: term().
+
+getaddrinfo(Host, Service)
+ when (is_list(Host) orelse (Host =:= undefined)) andalso
+ (is_list(Service) orelse (Service =:= undefined)) andalso
+ (not ((Service =:= undefined) andalso (Host =:= undefined))) ->
+ nif_getaddrinfo(Host, Service, undefined).
+
+
+
+%% ===========================================================================
+%%
+%% if_name2index - Mappings between network interface names and indexes:
+%% name -> idx
+%%
+%%
+
+-spec if_name2index(Name) -> {ok, Idx} | {error, Reason} when
+ Name :: network_interface_name(),
+ Idx :: network_interface_index(),
+ Reason :: term().
+
+if_name2index(If) when is_list(If) ->
+ nif_if_name2index(If).
+
+
+
+%% ===========================================================================
+%%
+%% if_index2name - Mappings between network interface index and names:
+%% idx -> name
+%%
+%%
+
+-spec if_index2name(Idx) -> {ok, Name} | {error, Reason} when
+ Idx :: network_interface_index(),
+ Name :: network_interface_name(),
+ Reason :: term().
+
+if_index2name(Idx) when is_integer(Idx) ->
+ nif_if_index2name(Idx).
+
+
+
+%% ===========================================================================
+%%
+%% if_names - Get network interface names and indexes
+%%
+%%
+
+-spec if_names() -> Names | {error, Reason} when
+ Names :: [{Idx, If}],
+ Idx :: network_interface_index(),
+ If :: network_interface_name(),
+ Reason :: term().
+
+if_names() ->
+ nif_if_names().
+
+
+
+%% ===========================================================================
+%%
+%% Misc utility functions
+%%
+%% ===========================================================================
+
+%% formated_timestamp() ->
+%% format_timestamp(os:timestamp()).
+
+%% format_timestamp(Now) ->
+%% N2T = fun(N) -> calendar:now_to_local_time(N) end,
+%% format_timestamp(Now, N2T, true).
+
+%% format_timestamp({_N1, _N2, N3} = N, N2T, true) ->
+%% FormatExtra = ".~.2.0w",
+%% ArgsExtra = [N3 div 10000],
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra);
+%% format_timestamp({_N1, _N2, _N3} = N, N2T, false) ->
+%% FormatExtra = "",
+%% ArgsExtra = [],
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra).
+
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra) ->
+%% {Date, Time} = N2T(N),
+%% {YYYY,MM,DD} = Date,
+%% {Hour,Min,Sec} = Time,
+%% FormatDate =
+%% io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w" ++ FormatExtra,
+%% [YYYY, MM, DD, Hour, Min, Sec] ++ ArgsExtra),
+%% lists:flatten(FormatDate).
+
+
+%% ===========================================================================
+%%
+%% The actual NIF-functions.
+%%
+%% ===========================================================================
+
+nif_info() ->
+ erlang:nif_error(undef).
+
+nif_command(_Cmd) ->
+ erlang:nif_error(undef).
+
+nif_gethostname() ->
+ erlang:nif_error(undef).
+
+nif_getnameinfo(_Addr, _Flags) ->
+ erlang:nif_error(undef).
+
+nif_getaddrinfo(_Host, _Service, _Hints) ->
+ erlang:nif_error(undef).
+
+nif_if_name2index(_Name) ->
+ erlang:nif_error(undef).
+
+nif_if_index2name(_Id) ->
+ erlang:nif_error(undef).
+
+nif_if_names() ->
+ erlang:nif_error(undef).
diff --git a/erts/preloaded/src/persistent_term.erl b/erts/preloaded/src/persistent_term.erl
index 5d0c266127..ee7e49b6cb 100644
--- a/erts/preloaded/src/persistent_term.erl
+++ b/erts/preloaded/src/persistent_term.erl
@@ -19,7 +19,7 @@
%%
-module(persistent_term).
--export([erase/1,get/0,get/1,info/0,put/2]).
+-export([erase/1,get/0,get/1,get/2,info/0,put/2]).
-type key() :: term().
-type value() :: term().
@@ -41,6 +41,13 @@ get() ->
get(_Key) ->
erlang:nif_error(undef).
+-spec get(Key, Default) -> Value when
+ Key :: key(),
+ Default :: value(),
+ Value :: value().
+get(_Key, _Default) ->
+ erlang:nif_error(undef).
+
-spec info() -> Info when
Info :: #{'count':=Count,'memory':=Memory},
Count :: non_neg_integer(),
diff --git a/erts/preloaded/src/prim_eval.S b/erts/preloaded/src/prim_eval.S
index e4b1560517..900fda5d89 100644
--- a/erts/preloaded/src/prim_eval.S
+++ b/erts/preloaded/src/prim_eval.S
@@ -42,6 +42,10 @@
{label,3}.
{loop_rec,{f,5},{x,0}}.
{move,{y,1},{x,1}}.
+ %% Tell the validator that it's safe to pass the message as an argument,
+ %% as the match fun is "known" not to build a term with it, and the
+ %% loop_rec instruction has disabled the GC.
+ {'%', {remove_fragility, {x,0}}}.
{call_fun,1}.
{test,is_ne_exact,{f,4},[{x,0},{atom,nomatch}]}.
remove_message.
diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl
index 0994e2a9f4..1aa5d85c64 100644
--- a/erts/preloaded/src/prim_file.erl
+++ b/erts/preloaded/src/prim_file.erl
@@ -572,12 +572,13 @@ list_dir_convert([RawName | Rest], SkipInvalid, Result) ->
{error, ignore} ->
list_dir_convert(Rest, SkipInvalid, Result);
{error, warning} ->
- %% this is equal to calling error_logger:warning_msg/2 which
- %% we don't want to do from code_server during system boot
+ %% This is equal to calling logger:warning/3 which
+ %% we don't want to do from code_server during system boot.
+ %% We don't want to call logger:timestamp() either.
logger ! {log,warning,"Non-unicode filename ~p ignored\n", [RawName],
#{pid=>self(),
gl=>group_leader(),
- time=>erlang:system_time(microsecond),
+ time=>os:system_time(microsecond),
error_logger=>#{tag=>warning_msg}}},
list_dir_convert(Rest, SkipInvalid, Result);
{error, _} ->
diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl
index cc2711b540..d5abdd2483 100644
--- a/erts/preloaded/src/prim_inet.erl
+++ b/erts/preloaded/src/prim_inet.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -172,8 +172,18 @@ close(S) when is_port(S) ->
%% and is a contradiction in itself.
%% We have hereby done our best...
%%
- Tref = erlang:start_timer(T * 1000, self(), close_port),
- close_pend_loop(S, Tref, undefined);
+ case subscribe(S, [subs_empty_out_q]) of
+ {ok, [{subs_empty_out_q,0}]} ->
+ close_port(S);
+ {ok, [{subs_empty_out_q,N}]} when N > 0 ->
+ %% Wait for pending output to be sent
+ Tref = erlang:start_timer(T * 1000, self(), close_port),
+ close_pend_loop(S, Tref, N);
+ _ ->
+ %% Subscribe failed - wait full time
+ Tref = erlang:start_timer(T * 1000, self(), close_port),
+ close_pend_loop(S, Tref, undefined)
+ end;
_ -> % Regard this as {ok,{false,_}}
case subscribe(S, [subs_empty_out_q]) of
{ok, [{subs_empty_out_q,N}]} when N > 0 ->
@@ -2679,12 +2689,13 @@ get_ip6([X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16 | T]) ->
?u16(X9,X10),?u16(X11,X12),?u16(X13,X14),?u16(X15,X16)},
T }.
+-define(ERTS_INET_DRV_CONTROL_MAGIC_NUMBER, 16#03f1a300).
%% Control command
ctl_cmd(Port, Cmd, Args) ->
?DBG_FORMAT("prim_inet:ctl_cmd(~p, ~p, ~p)~n", [Port,Cmd,Args]),
Result =
- try erlang:port_control(Port, Cmd, Args) of
+ try erlang:port_control(Port, Cmd+?ERTS_INET_DRV_CONTROL_MAGIC_NUMBER, Args) of
[?INET_REP_OK|Reply] -> {ok,Reply};
[?INET_REP] -> inet_reply;
[?INET_REP_ERROR|Err] -> {error,list_to_atom(Err)}
diff --git a/erts/preloaded/src/socket.erl b/erts/preloaded/src/socket.erl
new file mode 100644
index 0000000000..5c1647290d
--- /dev/null
+++ b/erts/preloaded/src/socket.erl
@@ -0,0 +1,3680 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2018-2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(socket).
+
+-compile(no_native).
+-compile({no_auto_import,[error/1]}).
+
+%% Administrative and "global" utility functions
+-export([
+ on_load/0, on_load/1,
+ info/0,
+ supports/0, supports/1, supports/2, supports/3,
+ ensure_sockaddr/1
+ ]).
+
+-export([
+ open/2, open/3, open/4,
+ bind/2, bind/3,
+ connect/2, connect/3,
+ listen/1, listen/2,
+ accept/1, accept/2,
+
+ send/2, send/3, send/4,
+ sendto/3, sendto/4, sendto/5,
+ sendmsg/2, sendmsg/3, sendmsg/4,
+
+ recv/1, recv/2, recv/3, recv/4,
+ recvfrom/1, recvfrom/2, recvfrom/3, recvfrom/4,
+ recvmsg/1, recvmsg/2, recvmsg/3, recvmsg/5,
+
+ close/1,
+ shutdown/2,
+
+ setopt/4,
+ getopt/3,
+
+ sockname/1,
+ peername/1
+ ]).
+
+-export_type([
+ domain/0,
+ type/0,
+ protocol/0,
+ socket/0,
+
+ port_number/0,
+ ip_address/0,
+ ip4_address/0,
+ ip6_address/0,
+ sockaddr/0,
+ sockaddr_in4/0,
+ sockaddr_in6/0,
+ sockaddr_un/0,
+
+ accept_flags/0,
+ accept_flag/0,
+
+ send_flags/0,
+ send_flag/0,
+
+ recv_flags/0,
+ recv_flag/0,
+
+ shutdown_how/0,
+
+ sockopt_level/0,
+ otp_socket_option/0,
+ socket_option/0,
+ ip_socket_option/0,
+ ipv6_socket_option/0,
+ tcp_socket_option/0,
+ udp_socket_option/0,
+ sctp_socket_option/0,
+ raw_socket_option/0,
+
+ timeval/0,
+ ip_tos/0,
+ ip_mreq/0,
+ ip_mreq_source/0,
+ ip_pmtudisc/0,
+ ip_msfilter_mode/0,
+ ip_msfilter/0,
+ ip_pktinfo/0,
+ ipv6_mreq/0,
+ ipv6_pmtudisc/0,
+ ipv6_pktinfo/0,
+ in6_flow_info/0,
+ in6_scope_id/0,
+ sctp_assoc_id/0,
+ sctp_sndrcvinfo/0,
+ sctp_event_subscribe/0,
+ sctp_assocparams/0,
+ sctp_initmsg/0,
+ sctp_rtoinfo/0,
+
+
+ msghdr_flag/0,
+ msghdr_flags/0,
+ msghdr/0,
+ cmsghdr_level/0,
+ cmsghdr_type/0,
+ %% cmsghdr_data/0,
+ cmsghdr_recv/0, cmsghdr_send/0,
+
+ uint8/0,
+ uint16/0,
+ uint20/0,
+ uint32/0,
+ int32/0
+ ]).
+
+
+-type uint8() :: 0..16#FF.
+-type uint16() :: 0..16#FFFF.
+-type uint20() :: 0..16#FFFFF.
+-type uint32() :: 0..16#FFFFFFFF.
+-type int32() :: -2147483648..2147483647.
+
+
+%% We support only a subset of all domains.
+-type domain() :: local | inet | inet6.
+
+%% We support only a subset of all types.
+%% RDM - Reliably Delivered Messages
+-type type() :: stream | dgram | raw | rdm | seqpacket.
+
+%% We support only a subset of all protocols:
+%% Note that the '{raw, integer()}' construct is intended
+%% to be used with type = raw.
+%% Note also that only the "superuser" can create a raw socket.
+-type protocol() :: ip | tcp | udp | sctp | icmp | igmp | {raw, integer()}.
+
+-type port_number() :: 0..65535.
+
+-type ip_address() :: ip4_address() | ip6_address().
+
+-type ip4_address() :: {0..255, 0..255, 0..255, 0..255}.
+
+-type in6_flow_info() :: uint20().
+-type in6_scope_id() :: uint32().
+
+-type ip6_address() ::
+ {0..65535,
+ 0..65535,
+ 0..65535,
+ 0..65535,
+ 0..65535,
+ 0..65535,
+ 0..65535,
+ 0..65535}.
+
+-type timeval() :: #{sec := integer(),
+ usec := integer()}.
+
+-type ip_pktinfo() :: #{
+ ifindex := non_neg_integer(), % Interface Index
+ spec_dst := ip4_address(), % Local Address
+ addr := ip4_address() % Header Destination address
+ }.
+
+%% If the integer value is used, its up to the caller to ensure its valid!
+-type ip_tos() :: lowdeley |
+ throughput |
+ reliability |
+ mincost |
+ integer().
+
+%% This type is used when requesting to become member of a multicast
+%% group with a call to setopt. Example:
+%%
+%% socket:setopt(Socket, ip, add_membership, #{multiaddr => Addr,
+%% interface => any}).
+%%
+%% Its also used when removing from a multicast group. Example:
+%%
+%% socket:setopt(Socket, ip, drop_membership, #{multiaddr => Addr,
+%% interface => any}).
+%%
+
+-type ip_mreq() :: #{multiaddr := ip4_address(),
+ interface := any | ip4_address()}.
+%% -type ip_mreqn() :: #{multiaddr := ip4_address(),
+%% address := any | ip4_address(),
+%% ifindex := integer()}.
+
+-type ip_mreq_source() :: #{multiaddr := ip4_address(),
+ interface := ip4_address(),
+ sourceaddr := ip4_address()}.
+
+-type ip_pmtudisc() :: want | dont | do | probe.
+
+%% multiaddr: Multicast group address
+%% interface: Address of local interface
+%% mode: Filter mode
+%% slist: List of source addresses
+-type ip_msfilter_mode() :: include | exclude.
+
+-type ip_msfilter() :: #{multiaddr := ip4_address(),
+ interface := ip4_address(),
+ mode := ip_msfilter_mode(),
+ slist := [ip4_address()]}.
+
+-type ipv6_mreq() :: #{multiaddr := ip6_address(),
+ interface := non_neg_integer()}.
+
+-type ipv6_pmtudisc() :: ip_pmtudisc().
+
+-type ipv6_pktinfo() :: #{
+ addr := ip6_address(),
+ ifindex := integer()
+ }.
+
+
+-type sctp_assoc_id() :: int32().
+-type sctp_sndrcvinfo() :: #{
+ stream := uint16(),
+ ssn := uint16(),
+ flags := uint16(),
+ ppid := uint16(),
+ context := uint16(),
+ timetolive := uint16(),
+ tsn := uint16(),
+ cumtsn := uint16(),
+ assoc_id := sctp_assoc_id()
+ }.
+
+-type sctp_event_subscribe() :: #{data_in := boolean(),
+ association := boolean(),
+ address := boolean(),
+ send_failure := boolean(),
+ peer_error := boolean(),
+ shutdown := boolean(),
+ partial_delivery := boolean(),
+ adaptation_layer := boolean(),
+ authentication := boolean(),
+ sender_dry := boolean()}.
+
+-type sctp_assocparams() :: #{assoc_id := sctp_assoc_id(),
+ max_rxt := uint16(),
+ num_peer_dests := uint16(),
+ peer_rwnd := uint32(),
+ local_rwnd := uint32(),
+ cookie_life := uint32()}.
+
+-type sctp_initmsg() :: #{num_outstreams := uint16(),
+ max_instreams := uint16(),
+ max_attempts := uint16(),
+ max_init_timeo := uint16()
+ }.
+
+-type sctp_rtoinfo() :: #{assoc_id := sctp_assoc_id(),
+ initial := uint32(),
+ max := uint32(),
+ min := uint32()}.
+
+-type sockaddr_un() :: #{family := local,
+ path := binary() | string()}.
+-type sockaddr_in4() :: #{family := inet,
+ port := port_number(),
+ addr := any | loopback | ip4_address()}.
+-type sockaddr_in6() :: #{family := inet6,
+ port := port_number(),
+ addr := any | loopback | ip6_address(),
+ flowinfo := in6_flow_info(),
+ scope_id := in6_scope_id()}.
+-type sockaddr() :: sockaddr_in4() |
+ sockaddr_in6() |
+ sockaddr_un().
+
+-define(SOCKADDR_IN4_DEFAULTS(A), #{port => 0,
+ addr => A}).
+-define(SOCKADDR_IN4_DEFAULTS, ?SOCKADDR_IN4_DEFAULTS(any)).
+-define(SOCKADDR_IN4_DEFAULT(A), (?SOCKADDR_IN4_DEFAULTS(A))#{family => inet}).
+-define(SOCKADDR_IN6_DEFAULTS(A), #{port => 0,
+ addr => A,
+ flowinfo => 0,
+ scope_id => 0}).
+-define(SOCKADDR_IN6_DEFAULTS, ?SOCKADDR_IN6_DEFAULTS(any)).
+-define(SOCKADDR_IN6_DEFAULT(A), (?SOCKADDR_IN6_DEFAULTS(A))#{family => inet6}).
+
+%% otp - The option is internal to our (OTP) imeplementation.
+%% socket - The socket layer (SOL_SOCKET).
+%% ip - The IP layer (SOL_IP or is it IPPROTO_IP?).
+%% ipv6 - The IPv6 layer (SOL_IPV6).
+%% tcp - The TCP (Transport Control Protocol) layer (IPPROTO_TCP).
+%% udp - The UDP (User Datagram Protocol) layer (IPPROTO_UDP).
+%% sctp - The SCTP (Stream Control Transmission Protocol) layer (IPPROTO_SCTP).
+%% Int - Raw level, sent down and used "as is".
+-type sockopt_level() :: otp |
+ socket |
+ ip | ipv6 | tcp | udp | sctp |
+ non_neg_integer().
+
+%% There are some options that are 'read-only'.
+%% Should those be included here or in a special list?
+%% Should we just document it and leave it to the user?
+%% Or catch it in the encode functions?
+%% A setopt for a readonly option leads to einval?
+%% Do we really need a sndbuf?
+
+-type otp_socket_option() :: debug |
+ iow |
+ controlling_process |
+ rcvbuf | % sndbuf |
+ rcvctrlbuf |
+ sndctrlbuf |
+ fd.
+%% Shall we have special treatment of linger??
+%% read-only options:
+%% domain | protocol | type.
+%% FreeBSD (only?): acceptfilter
+-type socket_option() :: acceptconn |
+ acceptfilter |
+ bindtodevice |
+ broadcast |
+ busy_poll |
+ debug |
+ domain |
+ dontroute |
+ error |
+ keepalive |
+ linger |
+ mark |
+ oobinline |
+ passcred |
+ peek_off |
+ peekcred |
+ priority |
+ protocol |
+ rcvbuf |
+ rcvbufforce |
+ rcvlowat |
+ rcvtimeo |
+ reuseaddr |
+ reuseport |
+ rxq_ovfl |
+ setfib |
+ sndbuf |
+ sndbufforce |
+ sndlowat |
+ sndtimeo |
+ timestamp |
+ type.
+
+%% Read-only options:
+%% mtu
+%%
+%% Options only valid on FreeBSD?:
+%% dontfrag
+%% Options only valid for RAW sockets:
+%% nodefrag (linux only?)
+-type ip_socket_option() :: add_membership |
+ add_source_membership |
+ block_source |
+ dontfrag |
+ drop_membership |
+ drop_source_membership |
+ freebind |
+ hdrincl |
+ minttl |
+ msfilter |
+ mtu |
+ mtu_discover |
+ multicast_all |
+ multicast_if |
+ multicast_loop |
+ multicast_ttl |
+ nodefrag |
+ options |
+ pktinfo |
+ recverr |
+ recvif |
+ recvdstaddr |
+ recvopts |
+ recvorigdstaddr |
+ recvtos |
+ recvttl |
+ retopts |
+ router_alert |
+ sndsrcaddr |
+ tos |
+ transparent |
+ ttl |
+ unblock_source.
+-type ipv6_socket_option() ::
+ addrform |
+ add_membership |
+ authhdr |
+ auth_level |
+ checksum |
+ drop_membership |
+ dstopts |
+ esp_trans_level |
+ esp_network_level |
+ faith |
+ flowinfo |
+ hoplimit |
+ hopopts |
+ ipcomp_level |
+ join_group |
+ leave_group |
+ mtu |
+ mtu_discover |
+ multicast_hops |
+ multicast_if |
+ multicast_loop |
+ portrange |
+ pktoptions |
+ recverr |
+ recvpktinfo | pktinfo |
+ recvtclass |
+ router_alert |
+ rthdr |
+ tclass |
+ unicast_hops |
+ use_min_mtu |
+ v6only.
+
+-type tcp_socket_option() :: congestion |
+ cork |
+ info |
+ keepcnt |
+ keepidle |
+ keepintvl |
+ maxseg |
+ md5sig |
+ nodelay |
+ noopt |
+ nopush |
+ syncnt |
+ user_timeout.
+
+-type udp_socket_option() :: cork.
+
+-type sctp_socket_option() ::
+ adaption_layer |
+ associnfo |
+ auth_active_key |
+ auth_asconf |
+ auth_chunk |
+ auth_key |
+ auth_delete_key |
+ autoclose |
+ context |
+ default_send_params |
+ delayed_ack_time |
+ disable_fragments |
+ hmac_ident |
+ events |
+ explicit_eor |
+ fragment_interleave |
+ get_peer_addr_info |
+ initmsg |
+ i_want_mapped_v4_addr |
+ local_auth_chunks |
+ maxseg |
+ maxburst |
+ nodelay |
+ partial_delivery_point |
+ peer_addr_params |
+ peer_auth_chunks |
+ primary_addr |
+ reset_streams |
+ rtoinfo |
+ set_peer_primary_addr |
+ status |
+ use_ext_recvinfo.
+
+-type raw_socket_option() :: filter.
+
+%% -type plain_socket_option() :: integer().
+%% -type sockopt() :: otp_socket_option() |
+%% socket_option() |
+%% ip_socket_option() |
+%% ipv6_socket_option() |
+%% tcp_socket_option() |
+%% udp_socket_option() |
+%% sctp_socket_option() |
+%% raw_socket_option() |
+%% plain_socket_option().
+
+-record(socket, {ref :: reference()}).
+
+-opaque socket() :: #socket{}.
+
+-type accept_flags() :: [accept_flag()].
+-type accept_flag() :: nonblock | cloexec.
+
+-type send_flags() :: [send_flag()].
+-type send_flag() :: confirm |
+ dontroute |
+ eor |
+ more |
+ nosignal |
+ oob.
+
+%% Extend with OWN flags for other usage:
+%% - adapt-buffer-sz:
+%% This will have the effect that the nif recvfrom will use
+%% MSG_PEEK to ensure no part of the message is lost, but if
+%% necessary adapt (increase) the buffer size until all of
+%% it fits.
+%%
+%% Note that not all of these flags is useful for every recv function!
+%%
+-type recv_flags() :: [recv_flag()].
+-type recv_flag() :: cmsg_cloexec |
+ errqueue |
+ oob |
+ peek |
+ trunc.
+
+-type shutdown_how() :: read | write | read_write.
+
+%% These are just place-holder(s) - used by the sendmsg/recvmsg functions...
+-type msghdr_flag() :: ctrunc | eor | errqueue | oob | trunc.
+-type msghdr_flags() :: [msghdr_flag()].
+-type msghdr() :: #{
+ %% *Optional* target address
+ %% Used on an unconnected socket to specify the
+ %% target address for a datagram.
+ addr := sockaddr(),
+
+ iov := [binary()],
+
+ %% The maximum size of the control buffer is platform
+ %% specific. It is the users responsibility to ensure
+ %% that its not exceeded.
+ ctrl := [cmsghdr_recv()] | [cmsghdr_send()],
+
+ %% Only valid with recvmsg
+ flags := msghdr_flags()
+ }.
+%% We are able to (completely) decode *some* control message headers.
+%% Even if we are able to decode both level and type, we may not be
+%% able to decode the data, in which case it will be a binary.
+
+-type cmsghdr_level() :: socket | ip | ipv6 | integer().
+-type cmsghdr_type() :: timestamp |
+ pktinfo |
+ tos |
+ ttl |
+ rights |
+ credentials |
+ origdstaddr |
+ integer().
+-type cmsghdr_recv() ::
+ #{level := socket, type := timestamp, data := timeval()} |
+ #{level := socket, type := rights, data := binary()} |
+ #{level := socket, type := credentials, data := binary()} |
+ #{level := socket, type := integer(), data := binary()} |
+ #{level := ip, type := tos, data := ip_tos()} |
+ #{level := ip, type := ttl, data := integer()} |
+ #{level := ip, type := pktinfo, data := ip_pktinfo()} |
+ #{level := ip, type := origdstaddr, data := sockaddr_in4()} |
+ #{level := ip, type := integer(), data := binary()} |
+ #{level := ipv6, type := pktinfo, data := ipv6_pktinfo()} |
+ #{level := ipv6, type := integer(), data := binary()} |
+ #{level := integer(), type := integer(), data := binary()}.
+-type cmsghdr_send() ::
+ #{level := socket, type := integer(), data := binary()} |
+ #{level := ip, type := tos, data := ip_tos() | binary()} |
+ #{level := ip, type := ttl, data := integer() | binary()} |
+ #{level := ip, type := integer(), data := binary()} |
+ #{level := ipv6, type := integer(), data := binary()} |
+ #{level := udp, type := integer(), data := binary()} |
+ #{level := integer(), type := integer(), data := binary()}.
+
+
+-define(SOCKET_DOMAIN_LOCAL, 1).
+-define(SOCKET_DOMAIN_UNIX, ?SOCKET_DOMAIN_LOCAL).
+-define(SOCKET_DOMAIN_INET, 2).
+-define(SOCKET_DOMAIN_INET6, 3).
+
+-define(SOCKET_TYPE_STREAM, 1).
+-define(SOCKET_TYPE_DGRAM, 2).
+-define(SOCKET_TYPE_RAW, 3).
+%% -define(SOCKET_TYPE_RDM, 4).
+-define(SOCKET_TYPE_SEQPACKET, 5).
+
+-define(SOCKET_PROTOCOL_IP, 1).
+-define(SOCKET_PROTOCOL_TCP, 2).
+-define(SOCKET_PROTOCOL_UDP, 3).
+-define(SOCKET_PROTOCOL_SCTP, 4).
+-define(SOCKET_PROTOCOL_ICMP, 5).
+-define(SOCKET_PROTOCOL_IGMP, 6).
+
+-define(SOCKET_LISTEN_BACKLOG_DEFAULT, 5).
+
+-define(SOCKET_ACCEPT_TIMEOUT_DEFAULT, infinity).
+
+-define(SOCKET_SEND_FLAG_CONFIRM, 0).
+-define(SOCKET_SEND_FLAG_DONTROUTE, 1).
+-define(SOCKET_SEND_FLAG_EOR, 2).
+-define(SOCKET_SEND_FLAG_MORE, 3).
+-define(SOCKET_SEND_FLAG_NOSIGNAL, 4).
+-define(SOCKET_SEND_FLAG_OOB, 5).
+
+-define(SOCKET_SEND_FLAGS_DEFAULT, []).
+-define(SOCKET_SEND_TIMEOUT_DEFAULT, infinity).
+-define(SOCKET_SENDTO_FLAGS_DEFAULT, []).
+-define(SOCKET_SENDTO_TIMEOUT_DEFAULT, ?SOCKET_SEND_TIMEOUT_DEFAULT).
+-define(SOCKET_SENDMSG_FLAGS_DEFAULT, []).
+-define(SOCKET_SENDMSG_TIMEOUT_DEFAULT, ?SOCKET_SEND_TIMEOUT_DEFAULT).
+
+-define(SOCKET_RECV_FLAG_CMSG_CLOEXEC, 0).
+-define(SOCKET_RECV_FLAG_ERRQUEUE, 1).
+-define(SOCKET_RECV_FLAG_OOB, 2).
+-define(SOCKET_RECV_FLAG_PEEK, 3).
+-define(SOCKET_RECV_FLAG_TRUNC, 4).
+
+-define(SOCKET_RECV_FLAGS_DEFAULT, []).
+-define(SOCKET_RECV_TIMEOUT_DEFAULT, infinity).
+
+-define(SOCKET_OPT_LEVEL_OTP, 0).
+-define(SOCKET_OPT_LEVEL_SOCKET, 1).
+-define(SOCKET_OPT_LEVEL_IP, 2).
+-define(SOCKET_OPT_LEVEL_IPV6, 3).
+-define(SOCKET_OPT_LEVEL_TCP, 4).
+-define(SOCKET_OPT_LEVEL_UDP, 5).
+-define(SOCKET_OPT_LEVEL_SCTP, 6).
+
+%% *** OTP (socket) options
+-define(SOCKET_OPT_OTP_DEBUG, 1).
+-define(SOCKET_OPT_OTP_IOW, 2).
+-define(SOCKET_OPT_OTP_CTRL_PROC, 3).
+-define(SOCKET_OPT_OTP_RCVBUF, 4).
+%%-define(SOCKET_OPT_OTP_SNDBUF, 5).
+-define(SOCKET_OPT_OTP_RCVCTRLBUF, 6).
+-define(SOCKET_OPT_OTP_SNDCTRLBUF, 7).
+-define(SOCKET_OPT_OTP_FD, 8).
+-define(SOCKET_OPT_OTP_DOMAIN, 16#FF01). % INTERNAL
+-define(SOCKET_OPT_OTP_TYPE, 16#FF02). % INTERNAL
+-define(SOCKET_OPT_OTP_PROTOCOL, 16#FF03). % INTERNAL
+
+%% *** SOCKET (socket) options
+-define(SOCKET_OPT_SOCK_ACCEPTCONN, 1).
+%% -define(SOCKET_OPT_SOCK_ACCEPTFILTER, 2). % FreeBSD
+-define(SOCKET_OPT_SOCK_BINDTODEVICE, 3).
+-define(SOCKET_OPT_SOCK_BROADCAST, 4).
+%% -define(SOCKET_OPT_SOCK_BUSY_POLL, 5).
+-define(SOCKET_OPT_SOCK_DEBUG, 6).
+-define(SOCKET_OPT_SOCK_DOMAIN, 7).
+-define(SOCKET_OPT_SOCK_DONTROUTE, 8).
+%% -define(SOCKET_OPT_SOCK_ERROR, 9).
+-define(SOCKET_OPT_SOCK_KEEPALIVE, 10).
+-define(SOCKET_OPT_SOCK_LINGER, 11).
+%% -define(SOCKET_OPT_SOCK_MARK, 12).
+-define(SOCKET_OPT_SOCK_OOBINLINE, 13).
+%% -define(SOCKET_OPT_SOCK_PASSCRED, 14).
+-define(SOCKET_OPT_SOCK_PEEK_OFF, 15).
+%% -define(SOCKET_OPT_SOCK_PEEKCRED, 16).
+-define(SOCKET_OPT_SOCK_PRIORITY, 17).
+-define(SOCKET_OPT_SOCK_PROTOCOL, 18).
+-define(SOCKET_OPT_SOCK_RCVBUF, 19).
+%% -define(SOCKET_OPT_SOCK_RCVBUFFORCE, 20).
+-define(SOCKET_OPT_SOCK_RCVLOWAT, 21).
+-define(SOCKET_OPT_SOCK_RCVTIMEO, 22).
+-define(SOCKET_OPT_SOCK_REUSEADDR, 23).
+-define(SOCKET_OPT_SOCK_REUSEPORT, 24).
+%% -define(SOCKET_OPT_SOCK_RXQ_OVFL, 25).
+%% -define(SOCKET_OPT_SOCK_SETFIB, 26). % FreeBSD
+-define(SOCKET_OPT_SOCK_SNDBUF, 27).
+%% -define(SOCKET_OPT_SOCK_SNDBUFFORCE, 28).
+-define(SOCKET_OPT_SOCK_SNDLOWAT, 29).
+-define(SOCKET_OPT_SOCK_SNDTIMEO, 30).
+-define(SOCKET_OPT_SOCK_TIMESTAMP, 31).
+-define(SOCKET_OPT_SOCK_TYPE, 32).
+
+%% *** IP (socket) options
+-define(SOCKET_OPT_IP_ADD_MEMBERSHIP, 1).
+-define(SOCKET_OPT_IP_ADD_SOURCE_MEMBERSHIP, 2).
+-define(SOCKET_OPT_IP_BLOCK_SOURCE, 3).
+%% -define(SOCKET_OPT_IP_DONTFRAG, 4). % FreeBSD
+-define(SOCKET_OPT_IP_DROP_MEMBERSHIP, 5).
+-define(SOCKET_OPT_IP_DROP_SOURCE_MEMBERSHIP, 6).
+-define(SOCKET_OPT_IP_FREEBIND, 7).
+-define(SOCKET_OPT_IP_HDRINCL, 8).
+-define(SOCKET_OPT_IP_MINTTL, 9).
+-define(SOCKET_OPT_IP_MSFILTER, 10).
+-define(SOCKET_OPT_IP_MTU, 11).
+-define(SOCKET_OPT_IP_MTU_DISCOVER, 12).
+-define(SOCKET_OPT_IP_MULTICAST_ALL, 13).
+-define(SOCKET_OPT_IP_MULTICAST_IF, 14).
+-define(SOCKET_OPT_IP_MULTICAST_LOOP, 15).
+-define(SOCKET_OPT_IP_MULTICAST_TTL, 16).
+-define(SOCKET_OPT_IP_NODEFRAG, 17).
+%% -define(SOCKET_OPT_IP_OPTIONS, 18). % FreeBSD
+-define(SOCKET_OPT_IP_PKTINFO, 19).
+-define(SOCKET_OPT_IP_RECVDSTADDR, 20). % FreeBSD
+-define(SOCKET_OPT_IP_RECVERR, 21).
+-define(SOCKET_OPT_IP_RECVIF, 22).
+-define(SOCKET_OPT_IP_RECVOPTS, 23).
+-define(SOCKET_OPT_IP_RECVORIGDSTADDR, 24).
+-define(SOCKET_OPT_IP_RECVTOS, 25).
+-define(SOCKET_OPT_IP_RECVTTL, 26).
+-define(SOCKET_OPT_IP_RETOPTS, 27).
+-define(SOCKET_OPT_IP_ROUTER_ALERT, 28).
+-define(SOCKET_OPT_IP_SENDSRCADDR, 29). % FreeBSD
+-define(SOCKET_OPT_IP_TOS, 30).
+-define(SOCKET_OPT_IP_TRANSPARENT, 31).
+-define(SOCKET_OPT_IP_TTL, 32).
+-define(SOCKET_OPT_IP_UNBLOCK_SOURCE, 33).
+
+%% *** IPv6 (socket) options
+-define(SOCKET_OPT_IPV6_ADDRFORM, 1).
+-define(SOCKET_OPT_IPV6_ADD_MEMBERSHIP, 2).
+-define(SOCKET_OPT_IPV6_AUTHHDR, 3). % Obsolete?
+%% -define(SOCKET_OPT_IPV6_AUTH_LEVEL, 4). % FreeBSD
+%% -define(SOCKET_OPT_IPV6_CHECKSUM, 5). % FreeBSD
+-define(SOCKET_OPT_IPV6_DROP_MEMBERSHIP, 6).
+-define(SOCKET_OPT_IPV6_DSTOPTS, 7).
+%% -define(SOCKET_OPT_IPV6_ESP_NETWORK_LEVEL, 8). % FreeBSD
+%% -define(SOCKET_OPT_IPV6_ESP_TRANS_LEVEL, 9). % FreeBSD
+%% -define(SOCKET_OPT_IPV6_FAITH, 10). % FreeBSD
+-define(SOCKET_OPT_IPV6_FLOWINFO, 11).
+-define(SOCKET_OPT_IPV6_HOPLIMIT, 12).
+-define(SOCKET_OPT_IPV6_HOPOPTS, 13).
+%% -define(SOCKET_OPT_IPV6_IPCOMP_LEVEL, 14). % FreeBSD
+%% -define(SOCKET_OPT_IPV6_JOIN_GROUP, 15). % FreeBSD
+%% -define(SOCKET_OPT_IPV6_LEAVE_GROUP, 16). % FreeBSD
+-define(SOCKET_OPT_IPV6_MTU, 17).
+-define(SOCKET_OPT_IPV6_MTU_DISCOVER, 18).
+-define(SOCKET_OPT_IPV6_MULTICAST_HOPS, 19).
+-define(SOCKET_OPT_IPV6_MULTICAST_IF, 20).
+-define(SOCKET_OPT_IPV6_MULTICAST_LOOP, 21).
+%% -define(SOCKET_OPT_IPV6_PORTRANGE, 22). % FreeBSD
+%% -define(SOCKET_OPT_IPV6_PKTOPTIONS, 23). % FreeBSD
+-define(SOCKET_OPT_IPV6_RECVERR, 24).
+-define(SOCKET_OPT_IPV6_RECVPKTINFO, 25). % On FreeBSD: PKTINFO
+%% -define(SOCKET_OPT_IPV6_RECVTCLASS, 26).
+-define(SOCKET_OPT_IPV6_ROUTER_ALERT, 27).
+-define(SOCKET_OPT_IPV6_RTHDR, 28).
+%% -define(SOCKET_OPT_IPV6_TCLASS, 29). % FreeBSD
+-define(SOCKET_OPT_IPV6_UNICAST_HOPS, 30).
+%% -define(SOCKET_OPT_IPV6_USE_MIN_MTU, 31). % FreeBSD
+-define(SOCKET_OPT_IPV6_V6ONLY, 32).
+
+%% *** TCP (socket) options
+-define(SOCKET_OPT_TCP_CONGESTION, 1).
+-define(SOCKET_OPT_TCP_CORK, 2).
+%% -define(SOCKET_OPT_TCP_INFO, 3).
+%% -define(SOCKET_OPT_TCP_KEEPCNT, 4).
+%% -define(SOCKET_OPT_TCP_KEEPIDLE, 5).
+%% -define(SOCKET_OPT_TCP_KEEPINTVL, 6).
+-define(SOCKET_OPT_TCP_MAXSEG, 7).
+%% -define(SOCKET_OPT_TCP_MD5SIG, 8).
+-define(SOCKET_OPT_TCP_NODELAY, 9).
+%% -define(SOCKET_OPT_TCP_NOOPT, 10).
+%% -define(SOCKET_OPT_TCP_NOPUSH, 11).
+%% -define(SOCKET_OPT_TCP_SYNCNT, 12).
+%% -define(SOCKET_OPT_TCP_USER_TIMEOUT, 13).
+
+%% *** UDP (socket) options
+-define(SOCKET_OPT_UDP_CORK, 1).
+
+%% *** SCTP (socket) options
+%% -define(SOCKET_OPT_SCTP_ADAPTION_LAYER, 1).
+-define(SOCKET_OPT_SCTP_ASSOCINFO, 2).
+%% -define(SOCKET_OPT_SCTP_AUTH_ACTIVE_KEY, 3).
+%% -define(SOCKET_OPT_SCTP_AUTH_ASCONF, 4).
+%% -define(SOCKET_OPT_SCTP_AUTH_CHUNK, 5).
+%% -define(SOCKET_OPT_SCTP_AUTH_KEY, 6).
+%% -define(SOCKET_OPT_SCTP_AUTH_DELETE_KEY, 7).
+-define(SOCKET_OPT_SCTP_AUTOCLOSE, 8).
+%% -define(SOCKET_OPT_SCTP_CONTEXT, 9).
+%% -define(SOCKET_OPT_SCTP_DEFAULT_SEND_PARAMS, 10).
+%% -define(SOCKET_OPT_SCTP_DELAYED_ACK_TIME, 11).
+-define(SOCKET_OPT_SCTP_DISABLE_FRAGMENTS, 12).
+%% -define(SOCKET_OPT_SCTP_HMAC_IDENT, 13).
+-define(SOCKET_OPT_SCTP_EVENTS, 14).
+%% -define(SOCKET_OPT_SCTP_EXPLICIT_EOR, 15).
+%% -define(SOCKET_OPT_SCTP_FRAGMENT_INTERLEAVE, 16).
+%% -define(SOCKET_OPT_SCTP_GET_PEER_ADDR_INFO, 17).
+-define(SOCKET_OPT_SCTP_INITMSG, 18).
+%% -define(SOCKET_OPT_SCTP_I_WANT_MAPPED_V4_ADDR, 19).
+%% -define(SOCKET_OPT_SCTP_LOCAL_AUTH_CHUNKS, 20).
+-define(SOCKET_OPT_SCTP_MAXSEG, 21).
+%% -define(SOCKET_OPT_SCTP_MAXBURST, 22).
+-define(SOCKET_OPT_SCTP_NODELAY, 23).
+%% -define(SOCKET_OPT_SCTP_PARTIAL_DELIVERY_POINT, 24).
+%% -define(SOCKET_OPT_SCTP_PEER_ADDR_PARAMS, 25).
+%% -define(SOCKET_OPT_SCTP_PEER_AUTH_CHUNKS, 26).
+%% -define(SOCKET_OPT_SCTP_PRIMARY_ADDR, 27).
+%% -define(SOCKET_OPT_SCTP_RESET_STREAMS, 28).
+-define(SOCKET_OPT_SCTP_RTOINFO, 29).
+%% -define(SOCKET_OPT_SCTP_SET_PEER_PRIMARY_ADDR, 30).
+%% -define(SOCKET_OPT_SCTP_STATUS, 31).
+%% -define(SOCKET_OPT_SCTP_USE_EXT_RECVINFO, 32).
+
+-define(SOCKET_SHUTDOWN_HOW_READ, 0).
+-define(SOCKET_SHUTDOWN_HOW_WRITE, 1).
+-define(SOCKET_SHUTDOWN_HOW_READ_WRITE, 2).
+
+
+-define(SOCKET_SUPPORTS_OPTIONS, 16#0001).
+-define(SOCKET_SUPPORTS_SCTP, 16#0002).
+-define(SOCKET_SUPPORTS_IPV6, 16#0003).
+
+
+%% ===========================================================================
+%%
+%% Administrative and utility API
+%%
+%% ===========================================================================
+
+-spec on_load() -> ok.
+
+%% Should we require that the Extra arg is a map?
+on_load() ->
+ on_load(#{}).
+
+-spec on_load(Extra) -> ok when
+ Extra :: map().
+
+on_load(Extra) ->
+ ok = erlang:load_nif(atom_to_list(?MODULE), Extra).
+
+
+
+-spec info() -> list().
+
+info() ->
+ nif_info().
+
+
+
+%% ===========================================================================
+%%
+%% supports - get information about what the platform "supports".
+%%
+%% Generates a list of various info about what the plaform can support.
+%% The most obvious case is 'options'.
+%%
+%% Each item in a 'supports'-list will appear only *one* time.
+%%
+%% ===========================================================================
+
+-type supports_options_socket() :: [{socket_option(), boolean()}].
+-type supports_options_ip() :: [{ip_socket_option(), boolean()}].
+-type supports_options_ipv6() :: [{ipv6_socket_option(), boolean()}].
+-type supports_options_tcp() :: [{tcp_socket_option(), boolean()}].
+-type supports_options_udp() :: [{udp_socket_option(), boolean()}].
+-type supports_options_sctp() :: [{sctp_socket_option(), boolean()}].
+-type supports_options() :: [{socket, supports_options_socket()} |
+ {ip, supports_options_ip()} |
+ {ipv6, supports_options_ipv6()} |
+ {tcp, supports_options_tcp()} |
+ {udp, supports_options_udp()} |
+ {sctp, supports_options_sctp()}].
+
+-spec supports() -> [{options, supports_options()} |
+ {sctp, boolean()} |
+ {ipv6, boolean()}].
+
+supports() ->
+ [{options, supports(options)},
+ {sctp, supports(sctp)},
+ {ipv6, supports(ipv6)}].
+
+
+-dialyzer({nowarn_function, supports/1}).
+-spec supports(options) -> supports_options();
+ (sctp) -> boolean();
+ (ipv6) -> boolean();
+ (Key1) -> false when
+ Key1 :: term().
+
+supports(options) ->
+ nif_supports(?SOCKET_SUPPORTS_OPTIONS);
+supports(sctp) ->
+ nif_supports(?SOCKET_SUPPORTS_SCTP);
+supports(ipv6) ->
+ nif_supports(?SOCKET_SUPPORTS_IPV6);
+supports(_Key1) ->
+ false.
+
+-dialyzer({nowarn_function, supports/2}).
+-spec supports(options, socket) -> supports_options_socket();
+ (options, ip) -> supports_options_ip();
+ (options, ipv6) -> supports_options_ipv6();
+ (options, tcp) -> supports_options_tcp();
+ (options, udp) -> supports_options_udp();
+ (options, sctp) -> supports_options_sctp();
+ (Key1, Key2) -> false when
+ Key1 :: term(),
+ Key2 :: term().
+
+supports(options, Level) ->
+ proplists:get_value(Level, supports(options), false);
+supports(_Key1, _Level) ->
+ false.
+
+
+-dialyzer({nowarn_function, supports/3}).
+-spec supports(options, socket, Opt) -> boolean() when
+ Opt :: socket_option();
+ (options, ip, Opt) -> boolean() when
+ Opt :: ip_socket_option();
+ (options, ipv6, Opt) -> boolean() when
+ Opt :: ipv6_socket_option();
+ (options, tcp, Opt) -> boolean() when
+ Opt :: tcp_socket_option();
+ (options, udp, Opt) -> boolean() when
+ Opt :: udp_socket_option();
+ (options, sctp, Opt) -> boolean() when
+ Opt :: sctp_socket_option();
+ (Key1, Key2, Key3) -> false when
+ Key1 :: term(),
+ Key2 :: term(),
+ Key3 :: term().
+
+supports(options, Level, Opt) ->
+ case supports(options, Level) of
+ S when is_list(S) ->
+ proplists:get_value(Opt, S, false);
+ _ ->
+ false
+ end;
+supports(_Key1, _Key2, _Key3) ->
+ false.
+
+
+
+%% ===========================================================================
+%%
+%% The proper socket API
+%%
+%% ===========================================================================
+
+%% ===========================================================================
+%%
+%% open - create an endpoint for communication
+%%
+%% Extra: netns
+%%
+%% <KOLLA>
+%%
+%% How do we handle the case when an fd has been created (somehow)
+%% and we shall create a socket "from it".
+%% Can we figure out Domain, Type and Protocol from fd?
+%% Yes we can: SO_DOMAIN, SO_PROTOCOL, SO_TYPE
+%% But does that work on all platforms? Or shall we require that the
+%% caller provide this explicitly?
+%%
+%% </KOLLA>
+%%
+%%
+%% <KOLLA>
+%%
+%% Start a controller process here, *before* the nif_open call.
+%% If that call is successful, update with owner process (controlling
+%% process) and SockRef. If the open fails, kill the process.
+%% "Register" the process on success:
+%%
+%% nif_register(SockRef, self()).
+%%
+%% <ALSO>
+%%
+%% Maybe register the process under a name?
+%% Something like:
+%%
+%% list_to_atom(lists:flatten(io_lib:format("socket-~p", [SockRef]))).
+%%
+%% </ALSO>
+%%
+%% The nif sets up a monitor to this process, and if it dies the socket
+%% is closed. It is also used if someone wants to monitor the socket.
+%%
+%% We therefor need monitor function(s):
+%%
+%% socket:monitor(Socket)
+%% socket:demonitor(Socket)
+%%
+%% These are basically used to monitor the controller process.
+%% Should the socket record therefor contain the pid of the controller process?
+%%
+%% </KOLLA>
+%%
+
+%% -spec open(FD) -> {ok, Socket} | {error, Reason} when
+%% Socket :: socket(),
+%% Reason :: term().
+
+%% open(FD) ->
+%% try
+%% begin
+%% case nif_open(FD) of
+%% {ok, {SockRef, Domain, Type, Protocol}} ->
+%% SocketInfo = #{domain => Domain,
+%% type => Type,
+%% protocol => Protocol},
+%% Socket = #socket{info = SocketInfo,
+%% ref = SockRef},
+%% {ok, Socket};
+%% {error, _} = ERROR ->
+%% ERROR
+%% end
+%% end
+%% catch
+%% _:_ -> % This must be improved!!
+%% {error, einval}
+%% end.
+
+-spec open(Domain, Type) -> {ok, Socket} | {error, Reason} when
+ Domain :: domain(),
+ Type :: type(),
+ Socket :: socket(),
+ Reason :: term().
+
+open(Domain, Type) ->
+ open(Domain, Type, null).
+
+-spec open(Domain, Type, Protocol) -> {ok, Socket} | {error, Reason} when
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: null | protocol(),
+ Socket :: socket(),
+ Reason :: term().
+
+open(Domain, Type, Protocol) ->
+ open(Domain, Type, Protocol, #{}).
+
+-spec open(Domain, Type, Protocol, Extra) -> {ok, Socket} | {error, Reason} when
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: null | protocol(),
+ Extra :: map(),
+ Socket :: socket(),
+ Reason :: term().
+
+open(Domain, Type, Protocol0, Extra) when is_map(Extra) ->
+ try
+ begin
+ Protocol = default_protocol(Protocol0, Type),
+ EDomain = enc_domain(Domain),
+ EType = enc_type(Domain, Type),
+ EProtocol = enc_protocol(Type, Protocol),
+ case nif_open(EDomain, EType, EProtocol, Extra) of
+ {ok, SockRef} ->
+ Socket = #socket{ref = SockRef},
+ {ok, Socket};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end
+ catch
+ throw:T ->
+ T;
+ %% <WIN32-TEMPORARY>
+ error:notsup:S ->
+ erlang:raise(error, notsup, S);
+ %% </WIN32-TEMPORARY>
+ error:Reason ->
+ {error, Reason}
+ end.
+
+%% Note that this is just a convenience function for when the protocol was
+%% not specified. If its actually specified, then that will be selected.
+%% Also, this only works for the some of the type's (stream, dgram and
+%% seqpacket).
+default_protocol(null, stream) -> tcp;
+default_protocol(null, dgram) -> udp;
+default_protocol(null, seqpacket) -> sctp;
+default_protocol(null, Type) -> throw({error, {no_default_protocol, Type}});
+default_protocol(Protocol, _) -> Protocol.
+
+
+%% ===========================================================================
+%%
+%% bind - bind a name to a socket
+%%
+
+-spec bind(Socket, Addr) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Addr :: any | loopback | sockaddr(),
+ Reason :: term().
+
+bind(#socket{ref = SockRef}, Addr)
+ when ((Addr =:= any) orelse (Addr =:= loopback)) ->
+ try which_domain(SockRef) of
+ inet ->
+ nif_bind(SockRef, ?SOCKADDR_IN4_DEFAULT(Addr));
+ inet6 ->
+ nif_bind(SockRef, ?SOCKADDR_IN6_DEFAULT(Addr))
+ catch
+ %% <WIN32-TEMPORARY>
+ error:notsup:S ->
+ erlang:raise(error, notsup, S);
+ %% </WIN32-TEMPORARY>
+ throw:ERROR ->
+ ERROR
+ end;
+bind(#socket{ref = SockRef} = _Socket, Addr) when is_map(Addr) ->
+ try
+ begin
+ nif_bind(SockRef, ensure_sockaddr(Addr))
+ end
+ catch
+ %% <WIN32-TEMPORARY>
+ error:notsup:S ->
+ erlang:raise(error, notsup, S);
+ %% </WIN32-TEMPORARY>
+ throw:ERROR ->
+ ERROR
+ end.
+
+
+
+%% ===========================================================================
+%%
+%% bind - Add or remove a bind addresses on a socket
+%%
+%% Calling this function is only valid if the socket is:
+%% type = seqpacket
+%% protocol = sctp
+%%
+%% If the domain is inet, then all addresses *must* be IPv4.
+%% If the domain is inet6, the addresses can be aither IPv4 or IPv6.
+%%
+
+-spec bind(Socket, Addrs, Action) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Addrs :: [sockaddr()],
+ Action :: add | remove,
+ Reason :: term().
+
+bind(#socket{ref = SockRef}, Addrs, Action)
+ when is_list(Addrs) andalso ((Action =:= add) orelse (Action =:= remove)) ->
+ try
+ begin
+ ensure_type(SockRef, seqpacket),
+ ensure_proto(SockRef, sctp),
+ validate_addrs(which_domain(SockRef), Addrs),
+ nif_bind(SockRef, Addrs, Action)
+ end
+ catch
+ %% <WIN32-TEMPORARY>
+ error:notsup:S ->
+ erlang:raise(error, notsup, S);
+ %% </WIN32-TEMPORARY>
+ throw:ERROR ->
+ ERROR
+ end.
+
+ensure_type(SockRef, Type) ->
+ case which_type(SockRef) of
+ Type ->
+ ok;
+ _InvalidType ->
+ einval()
+ end.
+
+ensure_proto(SockRef, Proto) ->
+ case which_protocol(SockRef) of
+ Proto ->
+ ok;
+ _InvalidProto ->
+ einval()
+ end.
+
+validate_addrs(inet = _Domain, Addrs) ->
+ validate_inet_addrs(Addrs);
+validate_addrs(inet6 = _Domain, Addrs) ->
+ validate_inet6_addrs(Addrs).
+
+validate_inet_addrs(Addrs) ->
+ Validator = fun(#{family := inet,
+ addrs := Addr}) when is_tuple(Addr) andalso
+ (size(Addr) =:= 4) ->
+ ok;
+ (X) ->
+ throw({error, {invalid_address, X}})
+ end,
+ lists:foreach(Validator, Addrs).
+
+validate_inet6_addrs(Addrs) ->
+ Validator = fun(#{family := inet,
+ addrs := Addr}) when is_tuple(Addr) andalso
+ (size(Addr) =:= 4) ->
+ ok;
+ (#{family := inet6,
+ addrs := Addr}) when is_tuple(Addr) andalso
+ (size(Addr) =:= 8) ->
+ ok;
+ (X) ->
+ throw({error, {invalid_address, X}})
+ end,
+ lists:foreach(Validator, Addrs).
+
+
+%% ===========================================================================
+%%
+%% connect - initiate a connection on a socket
+%%
+
+-spec connect(Socket, SockAddr) -> ok | {error, Reason} when
+ Socket :: socket(),
+ SockAddr :: sockaddr(),
+ Reason :: term().
+
+connect(Socket, SockAddr) ->
+ connect(Socket, SockAddr, infinity).
+
+-spec connect(Socket, SockAddr, Timeout) -> ok | {error, Reason} when
+ Socket :: socket(),
+ SockAddr :: sockaddr(),
+ Timeout :: timeout(),
+ Reason :: term().
+
+%% <KOLLA>
+%% Is it possible to connect with family = local for the (dest) sockaddr?
+%% </KOLLA>
+connect(_Socket, _SockAddr, Timeout)
+ when (is_integer(Timeout) andalso (Timeout =< 0)) ->
+ {error, timeout};
+connect(#socket{ref = SockRef}, #{family := Fam} = SockAddr, Timeout)
+ when ((Fam =:= inet) orelse (Fam =:= inet6) orelse (Fam =:= local)) andalso
+ ((Timeout =:= infinity) orelse is_integer(Timeout)) ->
+ TS = timestamp(Timeout),
+ case nif_connect(SockRef, SockAddr) of
+ ok ->
+ %% Connected!
+ ok;
+ {ok, Ref} ->
+ %% Connecting...
+ NewTimeout = next_timeout(TS, Timeout),
+ receive
+ {select, SockRef, Ref, ready_output} ->
+ %% <KOLLA>
+ %%
+ %% See open above!!
+ %%
+ %% * Here we should start and *register* the reader process
+ %% (This will cause the nif code to create a monitor to
+ %% the process)
+ %% * The reader is basically used to implement the active-X
+ %% feature!
+ %% * If the reader dies for whatever reason, then the socket
+ %% (resource) closes and the owner (controlling) process
+ %% is informed (closed message).
+ %%
+ %% </KOLLA>
+ nif_finalize_connection(SockRef)
+ after NewTimeout ->
+ cancel(SockRef, connect, Ref),
+ {error, timeout}
+ end;
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+%% ===========================================================================
+%%
+%% listen - listen for connections on a socket
+%%
+
+-spec listen(Socket) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Reason :: term().
+
+listen(Socket) ->
+ listen(Socket, ?SOCKET_LISTEN_BACKLOG_DEFAULT).
+
+-spec listen(Socket, Backlog) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Backlog :: pos_integer(),
+ Reason :: term().
+
+listen(#socket{ref = SockRef}, Backlog)
+ when (is_integer(Backlog) andalso (Backlog >= 0)) ->
+ nif_listen(SockRef, Backlog).
+
+
+
+
+%% ===========================================================================
+%%
+%% accept, accept4 - accept a connection on a socket
+%%
+
+-spec accept(LSocket) -> {ok, Socket} | {error, Reason} when
+ LSocket :: socket(),
+ Socket :: socket(),
+ Reason :: term().
+
+accept(Socket) ->
+ accept(Socket, ?SOCKET_ACCEPT_TIMEOUT_DEFAULT).
+
+-spec accept(LSocket, Timeout) -> {ok, Socket} | {error, Reason} when
+ LSocket :: socket(),
+ Timeout :: timeout(),
+ Socket :: socket(),
+ Reason :: term().
+
+%% Do we really need this optimization?
+accept(_, Timeout) when is_integer(Timeout) andalso (Timeout =< 0) ->
+ {error, timeout};
+accept(#socket{ref = LSockRef}, Timeout)
+ when is_integer(Timeout) orelse (Timeout =:= infinity) ->
+ do_accept(LSockRef, Timeout).
+
+do_accept(LSockRef, Timeout) ->
+ TS = timestamp(Timeout),
+ AccRef = make_ref(),
+ case nif_accept(LSockRef, AccRef) of
+ {ok, SockRef} ->
+ %% <KOLLA>
+ %%
+ %% * Here we should start and *register* the reader process
+ %% (This will cause the nif code to create a monitor to the process)
+ %% * The reader is basically used to implement the active-X feature!
+ %% * If the reader dies for whatever reason, then the socket (resource)
+ %% closes and the owner (controlling) process is informed (closed
+ %% message).
+ %%
+ %% </KOLLA>
+ Socket = #socket{ref = SockRef},
+ {ok, Socket};
+
+ {error, eagain} ->
+ %% Each call is non-blocking, but even then it takes
+ %% *some* time, so just to be sure, recalculate before
+ %% the receive.
+ NewTimeout = next_timeout(TS, Timeout),
+ receive
+ {select, LSockRef, AccRef, ready_input} ->
+ do_accept(LSockRef, next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {AccRef, Reason}} ->
+ {error, Reason}
+
+ after NewTimeout ->
+ cancel(LSockRef, accept, AccRef),
+ {error, timeout}
+ end;
+
+ {error, _} = ERROR ->
+ cancel(LSockRef, accept, AccRef), % Just to be on the safe side...
+ ERROR
+ end.
+
+
+
+%% ===========================================================================
+%%
+%% send, sendto, sendmsg - send a message on a socket
+%%
+
+-spec send(Socket, Data) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Data :: iodata(),
+ Reason :: term().
+
+send(Socket, Data) ->
+ send(Socket, Data, ?SOCKET_SEND_FLAGS_DEFAULT, ?SOCKET_SEND_TIMEOUT_DEFAULT).
+
+-spec send(Socket, Data, Flags) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Data :: iodata(),
+ Flags :: send_flags(),
+ Reason :: term()
+ ; (Socket, Data, Timeout) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Data :: iodata(),
+ Timeout :: timeout(),
+ Reason :: term().
+
+send(Socket, Data, Flags) when is_list(Flags) ->
+ send(Socket, Data, Flags, ?SOCKET_SEND_TIMEOUT_DEFAULT);
+send(Socket, Data, Timeout) ->
+ send(Socket, Data, ?SOCKET_SEND_FLAGS_DEFAULT, Timeout).
+
+-spec send(Socket, Data, Flags, Timeout) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Data :: iodata(),
+ Flags :: send_flags(),
+ Timeout :: timeout(),
+ Reason :: term().
+
+send(Socket, Data, Flags, Timeout) when is_list(Data) ->
+ Bin = erlang:list_to_binary(Data),
+ send(Socket, Bin, Flags, Timeout);
+send(#socket{ref = SockRef}, Data, Flags, Timeout)
+ when is_binary(Data) andalso is_list(Flags) ->
+ EFlags = enc_send_flags(Flags),
+ do_send(SockRef, Data, EFlags, Timeout).
+
+do_send(SockRef, Data, EFlags, Timeout) ->
+ TS = timestamp(Timeout),
+ SendRef = make_ref(),
+ case nif_send(SockRef, SendRef, Data, EFlags) of
+ ok ->
+ ok;
+ {ok, Written} ->
+ NewTimeout = next_timeout(TS, Timeout),
+ %% We are partially done, wait for continuation
+ receive
+ {select, SockRef, SendRef, ready_output} when (Written > 0) ->
+ <<_:Written/binary, Rest/binary>> = Data,
+ do_send(SockRef, Rest, EFlags,
+ next_timeout(TS, Timeout));
+ {select, SockRef, SendRef, ready_output} ->
+ do_send(SockRef, Data, EFlags,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {SendRef, Reason}} ->
+ {error, Reason}
+
+ after NewTimeout ->
+ cancel(SockRef, send, SendRef),
+ {error, {timeout, size(Data)}}
+ end;
+ {error, eagain} ->
+ receive
+ {select, SockRef, SendRef, ready_output} ->
+ do_send(SockRef, Data, EFlags,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {SendRef, Reason}} ->
+ {error, Reason}
+
+ after Timeout ->
+ cancel(SockRef, send, SendRef),
+ {error, {timeout, size(Data)}}
+ end;
+
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+
+
+%% ---------------------------------------------------------------------------
+%%
+
+-spec sendto(Socket, Data, Dest) ->
+ ok | {error, Reason} when
+ Socket :: socket(),
+ Data :: binary(),
+ Dest :: null | sockaddr(),
+ Reason :: term().
+
+sendto(Socket, Data, Dest) ->
+ sendto(Socket, Data, Dest, ?SOCKET_SENDTO_FLAGS_DEFAULT).
+
+-spec sendto(Socket, Data, Dest, Flags) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Data :: binary(),
+ Dest :: null | sockaddr(),
+ Flags :: send_flags(),
+ Reason :: term()
+ ; (Socket, Data, Dest, Timeout) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Data :: iodata(),
+ Dest :: null | sockaddr(),
+ Timeout :: timeout(),
+ Reason :: term().
+
+sendto(Socket, Data, Dest, Flags) when is_list(Flags) ->
+ sendto(Socket, Data, Dest, Flags, ?SOCKET_SENDTO_TIMEOUT_DEFAULT);
+sendto(Socket, Data, Dest, Timeout) ->
+ sendto(Socket, Data, Dest, ?SOCKET_SENDTO_FLAGS_DEFAULT, Timeout).
+
+
+-spec sendto(Socket, Data, Dest, Flags, Timeout) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Data :: binary(),
+ Dest :: null | sockaddr(),
+ Flags :: send_flags(),
+ Timeout :: timeout(),
+ Reason :: term().
+
+sendto(Socket, Data, Dest, Flags, Timeout) when is_list(Data) ->
+ Bin = erlang:list_to_binary(Data),
+ sendto(Socket, Bin, Dest, Flags, Timeout);
+sendto(#socket{ref = SockRef}, Data, Dest, Flags, Timeout)
+ when is_binary(Data) andalso
+ (Dest =:= null) andalso
+ is_list(Flags) andalso
+ (is_integer(Timeout) orelse (Timeout =:= infinity)) ->
+ EFlags = enc_send_flags(Flags),
+ do_sendto(SockRef, Data, Dest, EFlags, Timeout);
+sendto(#socket{ref = SockRef}, Data, #{family := Fam} = Dest, Flags, Timeout)
+ when is_binary(Data) andalso
+ ((Fam =:= inet) orelse (Fam =:= inet6) orelse (Fam =:= local)) andalso
+ is_list(Flags) andalso
+ (is_integer(Timeout) orelse (Timeout =:= infinity)) ->
+ EFlags = enc_send_flags(Flags),
+ do_sendto(SockRef, Data, Dest, EFlags, Timeout).
+
+do_sendto(SockRef, Data, Dest, EFlags, Timeout) ->
+ TS = timestamp(Timeout),
+ SendRef = make_ref(),
+ case nif_sendto(SockRef, SendRef, Data, Dest, EFlags) of
+ ok ->
+ %% We are done
+ ok;
+
+ {ok, Written} ->
+ %% We are partially done, wait for continuation
+ receive
+ {select, SockRef, SendRef, ready_output} when (Written > 0) ->
+ <<_:Written/binary, Rest/binary>> = Data,
+ do_sendto(SockRef, Rest, Dest, EFlags,
+ next_timeout(TS, Timeout));
+ {select, SockRef, SendRef, ready_output} ->
+ do_sendto(SockRef, Data, Dest, EFlags,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {SendRef, Reason}} ->
+ {error, Reason}
+
+ after Timeout ->
+ cancel(SockRef, sendto, SendRef),
+ {error, timeout}
+ end;
+
+ {error, eagain} ->
+ receive
+ {select, SockRef, SendRef, ready_output} ->
+ do_sendto(SockRef, Data, Dest, EFlags,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {SendRef, Reason}} ->
+ {error, Reason}
+
+ after Timeout ->
+ cancel(SockRef, sendto, SendRef),
+ {error, timeout}
+ end;
+
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+
+%% ---------------------------------------------------------------------------
+%%
+%% The only part of the msghdr() that *must* exist (a connected
+%% socket need not specify the addr field) is the iov.
+%% The ctrl field is optional, and the addr and flags are not
+%% used when sending.
+%%
+
+-spec sendmsg(Socket, MsgHdr) -> ok | {error, Reason} when
+ Socket :: socket(),
+ MsgHdr :: msghdr(),
+ Reason :: term().
+
+sendmsg(Socket, MsgHdr) ->
+ sendmsg(Socket, MsgHdr,
+ ?SOCKET_SENDMSG_FLAGS_DEFAULT, ?SOCKET_SENDMSG_TIMEOUT_DEFAULT).
+
+
+-spec sendmsg(Socket, MsgHdr, Flags) -> ok | {error, Reason} when
+ Socket :: socket(),
+ MsgHdr :: msghdr(),
+ Flags :: send_flags(),
+ Reason :: term()
+ ; (Socket, MsgHdr, Timeout) -> ok | {error, Reason} when
+ Socket :: socket(),
+ MsgHdr :: msghdr(),
+ Timeout :: timeout(),
+ Reason :: term().
+
+sendmsg(Socket, MsgHdr, Flags) when is_list(Flags) ->
+ sendmsg(Socket, MsgHdr, Flags, ?SOCKET_SENDMSG_TIMEOUT_DEFAULT);
+sendmsg(Socket, MsgHdr, Timeout)
+ when is_integer(Timeout) orelse (Timeout =:= infinity) ->
+ sendmsg(Socket, MsgHdr, ?SOCKET_SENDMSG_FLAGS_DEFAULT, Timeout).
+
+
+-spec sendmsg(Socket, MsgHdr, Flags, Timeout) -> ok | {ok, Remaining} | {error, Reason} when
+ Socket :: socket(),
+ MsgHdr :: msghdr(),
+ Flags :: send_flags(),
+ Timeout :: timeout(),
+ Remaining :: erlang:iovec(),
+ Reason :: term().
+
+sendmsg(#socket{ref = SockRef}, #{iov := IOV} = MsgHdr, Flags, Timeout)
+ when is_list(IOV) andalso
+ is_list(Flags) andalso
+ (is_integer(Timeout) orelse (Timeout =:= infinity)) ->
+ try ensure_msghdr(MsgHdr) of
+ M ->
+ EFlags = enc_send_flags(Flags),
+ do_sendmsg(SockRef, M, EFlags, Timeout)
+ catch
+ throw:T ->
+ T;
+ error:Reason ->
+ {error, Reason}
+ end.
+
+do_sendmsg(SockRef, MsgHdr, EFlags, Timeout) ->
+ TS = timestamp(Timeout),
+ SendRef = make_ref(),
+ case nif_sendmsg(SockRef, SendRef, MsgHdr, EFlags) of
+ ok ->
+ %% We are done
+ ok;
+
+ {ok, Written} when is_integer(Written) andalso (Written > 0) ->
+
+ %% We should not retry here since the protocol may not
+ %% be able to handle a message being split. Leave it to
+ %% the caller to figure out (call again with the rest).
+ %%
+ %% We should really not need to cancel, since this is
+ %% accepted for sendmsg!
+ %%
+ cancel(SockRef, sendmsg, SendRef),
+ {ok, do_sendmsg_rest(maps:get(iov, MsgHdr), Written)};
+
+ {error, eagain} ->
+ receive
+ {select, SockRef, SendRef, ready_output} ->
+ do_sendmsg(SockRef, MsgHdr, EFlags,
+ next_timeout(TS, Timeout))
+ after Timeout ->
+ cancel(SockRef, sendmsg, SendRef),
+ {error, timeout}
+ end;
+
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+do_sendmsg_rest([B|IOVec], Written) when (Written >= size(B)) ->
+ do_sendmsg_rest(IOVec, Written - size(B));
+do_sendmsg_rest([B|IOVec], Written) ->
+ <<_:Written/binary, Rest/binary>> = B,
+ [Rest|IOVec].
+
+ensure_msghdr(#{ctrl := []} = M) ->
+ ensure_msghdr(maps:remove(ctrl, M));
+ensure_msghdr(#{iov := IOV} = M) when is_list(IOV) andalso (IOV =/= []) ->
+ M#{iov := erlang:iolist_to_iovec(IOV)};
+ensure_msghdr(_) ->
+ einval().
+
+
+
+
+%% ===========================================================================
+%%
+%% writev - write data into multiple buffers
+%%
+
+
+
+%% ===========================================================================
+%%
+%% recv, recvfrom, recvmsg - receive a message from a socket
+%%
+%% Description:
+%% There is a special case for the argument Length. If its set to zero (0),
+%% it means "give me everything you have".
+%%
+%% Returns: {ok, Binary} | {error, Reason}
+%% Binary - The received data as a binary
+%% Reason - The error reason:
+%% timeout | {timeout, AccData} |
+%% posix() | {posix(), AccData} |
+%% atom() | {atom(), AccData}
+%% AccData - The data (as a binary) that we did manage to receive
+%% before the timeout.
+%%
+%% Arguments:
+%% Socket - The socket to read from.
+%% Length - The number of bytes to read.
+%% Flags - A list of "options" for the read.
+%% Timeout - Time-out in milliseconds.
+
+-spec recv(Socket) -> {ok, Data} | {error, Reason} when
+ Socket :: socket(),
+ Data :: binary(),
+ Reason :: term().
+
+recv(Socket) ->
+ recv(Socket, 0).
+
+-spec recv(Socket, Length) -> {ok, Data} | {error, Reason} when
+ Socket :: socket(),
+ Length :: non_neg_integer(),
+ Data :: binary(),
+ Reason :: term().
+
+recv(Socket, Length) ->
+ recv(Socket, Length,
+ ?SOCKET_RECV_FLAGS_DEFAULT,
+ ?SOCKET_RECV_TIMEOUT_DEFAULT).
+
+-spec recv(Socket, Length, Flags) -> {ok, Data} | {error, Reason} when
+ Socket :: socket(),
+ Length :: non_neg_integer(),
+ Flags :: recv_flags(),
+ Data :: binary(),
+ Reason :: term()
+ ; (Socket, Length, Timeout) -> {ok, Data} | {error, Reason} when
+ Socket :: socket(),
+ Length :: non_neg_integer(),
+ Timeout :: timeout(),
+ Data :: binary(),
+ Reason :: term().
+
+recv(Socket, Length, Flags) when is_list(Flags) ->
+ recv(Socket, Length, Flags, ?SOCKET_RECV_TIMEOUT_DEFAULT);
+recv(Socket, Length, Timeout) ->
+ recv(Socket, Length, ?SOCKET_RECV_FLAGS_DEFAULT, Timeout).
+
+-spec recv(Socket, Length, Flags, Timeout) -> {ok, Data} | {error, Reason} when
+ Socket :: socket(),
+ Length :: non_neg_integer(),
+ Flags :: recv_flags(),
+ Timeout :: timeout(),
+ Data :: binary(),
+ Reason :: term().
+
+recv(#socket{ref = SockRef}, Length, Flags, Timeout)
+ when (is_integer(Length) andalso (Length >= 0)) andalso
+ is_list(Flags) andalso
+ (is_integer(Timeout) orelse (Timeout =:= infinity)) ->
+ EFlags = enc_recv_flags(Flags),
+ do_recv(SockRef, undefined, Length, EFlags, <<>>, Timeout).
+
+%% We need to pass the "old recv ref" around because of the special case
+%% with Length = 0. This case makes it neccessary to have a timeout function
+%% clause since we may never wait for anything (no receive select), and so the
+%% the only timeout check will be the function clause.
+do_recv(SockRef, _OldRef, Length, EFlags, Acc, Timeout)
+ when (Timeout =:= infinity) orelse
+ (is_integer(Timeout) andalso (Timeout > 0)) ->
+ TS = timestamp(Timeout),
+ RecvRef = make_ref(),
+ %% p("do_recv -> try read with"
+ %% "~n Length: ~p", [Length]),
+ case nif_recv(SockRef, RecvRef, Length, EFlags) of
+ {ok, true = _Complete, Bin} when (size(Acc) =:= 0) ->
+ %% p("do_recv -> complete success: ~w", [size(Bin)]),
+ {ok, Bin};
+ {ok, true = _Complete, Bin} ->
+ %% p("do_recv -> completed success: ~w (~w)", [size(Bin), size(Acc)]),
+ {ok, <<Acc/binary, Bin/binary>>};
+
+ %% It depends on the amount of bytes we tried to read:
+ %% 0 - Read everything available
+ %% We got something, but there may be more - keep reading.
+ %% > 0 - We got a part of the message and we will be notified
+ %% when there is more to read (a select message)
+ {ok, false = _Complete, Bin} when (Length =:= 0) ->
+ %% p("do_recv -> partial success: ~w", [size(Bin)]),
+ do_recv(SockRef, RecvRef,
+ Length, EFlags,
+ <<Acc/binary, Bin/binary>>,
+ next_timeout(TS, Timeout));
+
+ {ok, false = _Completed, Bin} when (size(Acc) =:= 0) ->
+ %% We got the first chunk of it.
+ %% We will be notified (select message) when there
+ %% is more to read.
+ %% p("do_recv -> partial success(~w): ~w"
+ %% "~n ~p", [Length, size(Bin), Bin]),
+ NewTimeout = next_timeout(TS, Timeout),
+ receive
+ {select, SockRef, RecvRef, ready_input} ->
+ do_recv(SockRef, RecvRef,
+ Length-size(Bin), EFlags,
+ Bin,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {RecvRef, Reason}} ->
+ {error, Reason}
+
+ after NewTimeout ->
+ cancel(SockRef, recv, RecvRef),
+ {error, {timeout, Acc}}
+ end;
+
+ {ok, false = _Completed, Bin} ->
+ %% We got a chunk of it!
+ %% p("do_recv -> partial success(~w): ~w (~w)",
+ %% [Length, size(Bin), size(Acc)]),
+ NewTimeout = next_timeout(TS, Timeout),
+ receive
+ {select, SockRef, RecvRef, ready_input} ->
+ do_recv(SockRef, RecvRef,
+ Length-size(Bin), EFlags,
+ <<Acc/binary, Bin/binary>>,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {RecvRef, Reason}} ->
+ {error, Reason}
+
+ after NewTimeout ->
+ cancel(SockRef, recv, RecvRef),
+ {error, {timeout, Acc}}
+ end;
+
+ %% We return with the accumulated binary (if its non-empty)
+ {error, eagain} when (Length =:= 0) andalso (size(Acc) > 0) ->
+ %% CAN WE REALLY DO THIS? THE NIF HAS SELECTED!! OR?
+ {ok, Acc};
+
+ {error, eagain} ->
+ %% There is nothing just now, but we will be notified when there
+ %% is something to read (a select message).
+ %% p("do_recv -> eagain(~w): ~w", [Length, size(Acc)]),
+ NewTimeout = next_timeout(TS, Timeout),
+ receive
+ {select, SockRef, RecvRef, ready_input} ->
+ do_recv(SockRef, RecvRef,
+ Length, EFlags,
+ Acc,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {RecvRef, Reason}} ->
+ {error, Reason}
+
+ after NewTimeout ->
+ cancel(SockRef, recv, RecvRef),
+ {error, timeout}
+ end;
+
+ {error, closed = Reason} ->
+ do_close(SockRef),
+ if
+ (size(Acc) =:= 0) ->
+ {error, Reason};
+ true ->
+ {error, {Reason, Acc}}
+ end;
+
+ {error, _} = ERROR when (size(Acc) =:= 0) ->
+ ERROR;
+
+ {error, Reason} ->
+ {error, {Reason, Acc}}
+
+ end;
+
+do_recv(SockRef, RecvRef, 0 = _Length, _Eflags, Acc, _Timeout) ->
+ %% The current recv operation is to be cancelled, so no need for a ref...
+ %% The cancel will end our 'read everything you have' and "activate"
+ %% any waiting reader.
+ cancel(SockRef, recv, RecvRef),
+ {ok, Acc};
+do_recv(_SockRef, _RecvRef, _Length, _EFlags, Acc, _Timeout)
+ when (size(Acc) > 0) ->
+ {error, {timeout, Acc}};
+do_recv(_SockRef, _RecvRef, _Length, _EFlags, _Acc, _Timeout) ->
+ {error, timeout}.
+
+
+
+%% ---------------------------------------------------------------------------
+%%
+%% With recvfrom we get messages, which means that regardless of how
+%% much we want to read, we return when we get a message.
+%% The MaxSize argument basically defines the size of our receive
+%% buffer. By setting the size to zero (0), we use the configured
+%% size (see setopt).
+%% It may be impossible to know what (buffer) size is appropriate
+%% "in advance", and in those cases it may be convenient to use the
+%% (recv) 'peek' flag. When this flag is provided the message is *not*
+%% "consumed" from the underlying buffers, so another recvfrom call
+%% is needed, possibly with a then adjusted buffer size.
+%%
+
+-spec recvfrom(Socket) -> {ok, {Source, Data}} | {error, Reason} when
+ Socket :: socket(),
+ Source :: sockaddr() | undefined,
+ Data :: binary(),
+ Reason :: term().
+
+recvfrom(Socket) ->
+ recvfrom(Socket, 0).
+
+-spec recvfrom(Socket, BufSz) -> {ok, {Source, Data}} | {error, Reason} when
+ Socket :: socket(),
+ BufSz :: non_neg_integer(),
+ Source :: sockaddr() | undefined,
+ Data :: binary(),
+ Reason :: term().
+
+recvfrom(Socket, BufSz) ->
+ recvfrom(Socket, BufSz,
+ ?SOCKET_RECV_FLAGS_DEFAULT,
+ ?SOCKET_RECV_TIMEOUT_DEFAULT).
+
+-spec recvfrom(Socket, Flags, Timeout) ->
+ {ok, {Source, Data}} | {error, Reason} when
+ Socket :: socket(),
+ Flags :: recv_flags(),
+ Timeout :: timeout(),
+ Source :: sockaddr() | undefined,
+ Data :: binary(),
+ Reason :: term()
+ ; (Socket, BufSz, Flags) ->
+ {ok, {Source, Data}} | {error, Reason} when
+ Socket :: socket(),
+ BufSz :: non_neg_integer(),
+ Flags :: recv_flags(),
+ Source :: sockaddr() | undefined,
+ Data :: binary(),
+ Reason :: term()
+ ; (Socket, BufSz, Timeout) ->
+ {ok, {Source, Data}} | {error, Reason} when
+ Socket :: socket(),
+ BufSz :: non_neg_integer(),
+ Timeout :: timeout(),
+ Source :: sockaddr() | undefined,
+ Data :: binary(),
+ Reason :: term().
+
+recvfrom(Socket, Flags, Timeout) when is_list(Flags) ->
+ recvfrom(Socket, 0, Flags, Timeout);
+recvfrom(Socket, BufSz, Flags) when is_list(Flags) ->
+ recvfrom(Socket, BufSz, Flags, ?SOCKET_RECV_TIMEOUT_DEFAULT);
+recvfrom(Socket, BufSz, Timeout) ->
+ recvfrom(Socket, BufSz, ?SOCKET_RECV_FLAGS_DEFAULT, Timeout).
+
+-spec recvfrom(Socket, BufSz, Flags, Timeout) ->
+ {ok, {Source, Data}} | {error, Reason} when
+ Socket :: socket(),
+ BufSz :: non_neg_integer(),
+ Flags :: recv_flags(),
+ Timeout :: timeout(),
+ Source :: sockaddr() | undefined,
+ Data :: binary(),
+ Reason :: term().
+
+recvfrom(#socket{ref = SockRef}, BufSz, Flags, Timeout)
+ when (is_integer(BufSz) andalso (BufSz >= 0)) andalso
+ is_list(Flags) andalso
+ (is_integer(Timeout) orelse (Timeout =:= infinity)) ->
+ EFlags = enc_recv_flags(Flags),
+ do_recvfrom(SockRef, BufSz, EFlags, Timeout).
+
+do_recvfrom(SockRef, BufSz, EFlags, Timeout) ->
+ TS = timestamp(Timeout),
+ RecvRef = make_ref(),
+ case nif_recvfrom(SockRef, RecvRef, BufSz, EFlags) of
+ {ok, {_Source, _NewData}} = OK ->
+ OK;
+
+ {error, eagain} ->
+ %% There is nothing just now, but we will be notified when there
+ %% is something to read (a select message).
+ NewTimeout = next_timeout(TS, Timeout),
+ receive
+ {select, SockRef, RecvRef, ready_input} ->
+ do_recvfrom(SockRef, BufSz, EFlags,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {RecvRef, Reason}} ->
+ {error, Reason}
+
+ after NewTimeout ->
+ cancel(SockRef, recvfrom, RecvRef),
+ {error, timeout}
+ end;
+
+ {error, _Reason} = ERROR ->
+ ERROR
+
+ end.
+
+%% pi(Item) ->
+%% pi(self(), Item).
+
+%% pi(Pid, Item) ->
+%% {Item, Info} = process_info(Pid, Item),
+%% Info.
+
+
+%% ---------------------------------------------------------------------------
+%%
+
+-spec recvmsg(Socket) -> {ok, MsgHdr} | {error, Reason} when
+ Socket :: socket(),
+ MsgHdr :: msghdr(),
+ Reason :: term().
+
+recvmsg(Socket) ->
+ recvmsg(Socket, 0, 0,
+ ?SOCKET_RECV_FLAGS_DEFAULT, ?SOCKET_RECV_TIMEOUT_DEFAULT).
+
+-spec recvmsg(Socket, Flags) -> {ok, MsgHdr} | {error, Reason} when
+ Socket :: socket(),
+ Flags :: recv_flags(),
+ MsgHdr :: msghdr(),
+ Reason :: term()
+ ; (Socket, Timeout) -> {ok, MsgHdr} | {error, Reason} when
+ Socket :: socket(),
+ Timeout :: timeout(),
+ MsgHdr :: msghdr(),
+ Reason :: term().
+
+recvmsg(Socket, Flags) when is_list(Flags) ->
+ recvmsg(Socket, 0, 0, Flags, ?SOCKET_RECV_TIMEOUT_DEFAULT);
+recvmsg(Socket, Timeout) ->
+ recvmsg(Socket, 0, 0, ?SOCKET_RECV_FLAGS_DEFAULT, Timeout).
+
+-spec recvmsg(Socket, Flags, Timeout) -> {ok, MsgHdr} | {error, Reason} when
+ Socket :: socket(),
+ Flags :: recv_flags(),
+ Timeout :: timeout(),
+ MsgHdr :: msghdr(),
+ Reason :: term()
+ ; (Socket, BufSz, CtrlSz) -> {ok, MsgHdr} | {error, Reason} when
+ Socket :: socket(),
+ BufSz :: non_neg_integer(),
+ CtrlSz :: non_neg_integer(),
+ MsgHdr :: msghdr(),
+ Reason :: term().
+
+recvmsg(Socket, Flags, Timeout) when is_list(Flags) ->
+ recvmsg(Socket, 0, 0, Flags, Timeout);
+recvmsg(Socket, BufSz, CtrlSz) when is_integer(BufSz) andalso is_integer(CtrlSz) ->
+ recvmsg(Socket, BufSz, CtrlSz,
+ ?SOCKET_RECV_FLAGS_DEFAULT, ?SOCKET_RECV_TIMEOUT_DEFAULT).
+
+
+-spec recvmsg(Socket,
+ BufSz, CtrlSz,
+ Flags, Timeout) -> {ok, MsgHdr} | {error, Reason} when
+ Socket :: socket(),
+ BufSz :: non_neg_integer(),
+ CtrlSz :: non_neg_integer(),
+ Flags :: recv_flags(),
+ Timeout :: timeout(),
+ MsgHdr :: msghdr(),
+ Reason :: term().
+
+recvmsg(#socket{ref = SockRef}, BufSz, CtrlSz, Flags, Timeout)
+ when (is_integer(BufSz) andalso (BufSz >= 0)) andalso
+ (is_integer(CtrlSz) andalso (CtrlSz >= 0)) andalso
+ is_list(Flags) andalso
+ (is_integer(Timeout) orelse (Timeout =:= infinity)) ->
+ EFlags = enc_recv_flags(Flags),
+ do_recvmsg(SockRef, BufSz, CtrlSz, EFlags, Timeout).
+
+do_recvmsg(SockRef, BufSz, CtrlSz, EFlags, Timeout) ->
+ TS = timestamp(Timeout),
+ RecvRef = make_ref(),
+ case nif_recvmsg(SockRef, RecvRef, BufSz, CtrlSz, EFlags) of
+ {ok, _MsgHdr} = OK ->
+ OK;
+
+ {error, eagain} ->
+ %% There is nothing just now, but we will be notified when there
+ %% is something to read (a select message).
+ NewTimeout = next_timeout(TS, Timeout),
+ receive
+ {select, SockRef, RecvRef, ready_input} ->
+ do_recvmsg(SockRef, BufSz, CtrlSz, EFlags,
+ next_timeout(TS, Timeout));
+
+ {'$socket', _, abort, {RecvRef, Reason}} ->
+ {error, Reason}
+
+ after NewTimeout ->
+ cancel(SockRef, recvmsg, RecvRef),
+ {error, timeout}
+ end;
+
+ {error, closed} = ERROR ->
+ do_close(SockRef),
+ ERROR;
+
+ {error, _Reason} = ERROR ->
+ ERROR
+
+ end.
+
+
+
+%% ===========================================================================
+%%
+%% readv - read data into multiple buffers
+%%
+
+
+
+%% ===========================================================================
+%%
+%% close - close a file descriptor
+%%
+%% Closing a socket is a two stage rocket (because of linger).
+%% We need to perform the actual socket close while in BLOCKING mode.
+%% But that would hang the entire VM, so what we do is divide the
+%% close in two steps:
+%% 1) nif_close + the socket_stop (nif) callback function
+%% This is for everything that can be done safely NON-BLOCKING.
+%% 2) nif_finalize_close which is executed by a *dirty* scheduler
+%% Before we call the socket close function, we se the socket
+%% BLOCKING. Thereby linger is handled properly.
+
+
+-spec close(Socket) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Reason :: term().
+
+close(#socket{ref = SockRef}) ->
+ do_close(SockRef).
+
+do_close(SockRef) ->
+ case nif_close(SockRef) of
+ ok ->
+ nif_finalize_close(SockRef);
+ {ok, CloseRef} ->
+ %% We must wait for the socket_stop callback function to
+ %% complete its work
+ receive
+ {'$socket', SockRef, close, CloseRef} ->
+ nif_finalize_close(SockRef)
+ end;
+ {error, _} = ERROR ->
+ ERROR
+ end.
+
+
+
+
+%% ===========================================================================
+%%
+%% shutdown - shut down part of a full-duplex connection
+%%
+
+-spec shutdown(Socket, How) -> ok | {error, Reason} when
+ Socket :: socket(),
+ How :: shutdown_how(),
+ Reason :: term().
+
+shutdown(#socket{ref = SockRef}, How) ->
+ try
+ begin
+ EHow = enc_shutdown_how(How),
+ nif_shutdown(SockRef, EHow)
+ end
+ catch
+ throw:T ->
+ T;
+ %% <WIN32-TEMPORARY>
+ error:notsup:S ->
+ erlang:raise(error, notsup, S);
+ %% </WIN32-TEMPORARY>
+ error:Reason ->
+ {error, Reason}
+ end.
+
+
+
+
+%% ===========================================================================
+%%
+%% setopt - manipulate individual properties of a socket
+%%
+%% What properties are valid depend on what kind of socket it is
+%% (domain, type and protocol)
+%% If its an "invalid" option (or value), we should not crash but return some
+%% useful error...
+%%
+%% <KOLLA>
+%%
+%% WE NEED TO MAKE SURE THAT THE USER DOES NOT MAKE US BLOCKING
+%% AS MUCH OF THE CODE EXPECTS TO BE NON-BLOCKING!!
+%%
+%% </KOLLA>
+
+-spec setopt(Socket, otp, otp_socket_option(), Value) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, socket, socket_option(), Value) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, ip, ip_socket_option(), Value) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, ipv6, ipv6_socket_option(), Value) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, tcp, tcp_socket_option(), Value) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, udp, udp_socket_option(), Value) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, sctp, sctp_socket_option(), Value) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, Level, Key, Value) -> ok | {error, Reason} when
+ Socket :: socket(),
+ Level :: non_neg_integer(),
+ Key :: non_neg_integer(),
+ Value :: binary(),
+ Reason :: term().
+
+setopt(#socket{ref = SockRef}, Level, Key, Value) ->
+ try
+ begin
+ Domain = which_domain(SockRef),
+ Type = which_type(SockRef),
+ Protocol = which_protocol(SockRef),
+ {EIsEncoded, ELevel} = enc_setopt_level(Level),
+ EKey = enc_setopt_key(Level, Key, Domain, Type, Protocol),
+ EVal = enc_setopt_value(Level, Key, Value, Domain, Type, Protocol),
+ nif_setopt(SockRef, EIsEncoded, ELevel, EKey, EVal)
+ end
+ catch
+ throw:T ->
+ T;
+ %% <WIN32-TEMPORARY>
+ error:notsup:S ->
+ erlang:raise(error, notsup, S);
+ %% </WIN32-TEMPORARY>
+ error:Reason ->
+ {error, Reason} % Process more?
+ end.
+
+
+
+
+%% ===========================================================================
+%%
+%% getopt - retrieve individual properties of a socket
+%%
+%% What properties are valid depend on what kind of socket it is
+%% (domain, type and protocol).
+%% If its an "invalid" option, we should not crash but return some
+%% useful error...
+%%
+%% When specifying level as an integer, and therefor using "native mode",
+%% we should make it possible to specify common types instead of the
+%% value size. Example: int | bool | {string, pos_integer()} | non_neg_integer()
+%%
+
+-spec getopt(Socket, otp, otp_socket_option()) -> {ok, Value} | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, socket, socket_option()) -> {ok, Value} | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, ip, ip_socket_option()) -> {ok, Value} | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, ipv6, ipv6_socket_option()) -> {ok, Value} | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, tcp, tcp_socket_option()) -> {ok, Value} | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, udp, udp_socket_option()) -> {ok, Value} | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, sctp, sctp_socket_option()) -> {ok, Value} | {error, Reason} when
+ Socket :: socket(),
+ Value :: term(),
+ Reason :: term()
+ ; (Socket, Level, Key) -> ok | {ok, Value} | {error, Reason} when
+ Socket :: socket(),
+ Level :: integer(),
+ Key :: {NativeOpt, ValueSize},
+ NativeOpt :: integer(),
+ ValueSize :: int | bool | non_neg_integer(),
+ Value :: term(),
+ Reason :: term().
+
+getopt(#socket{ref = SockRef}, Level, Key) ->
+ try
+ begin
+ Domain = which_domain(SockRef),
+ Type = which_type(SockRef),
+ Protocol = which_protocol(SockRef),
+ {EIsEncoded, ELevel} = enc_getopt_level(Level),
+ EKey = enc_getopt_key(Level, Key, Domain, Type, Protocol),
+ %% We may need to decode the value (for the same reason
+ %% we (may have) needed to encode the value for setopt).
+ case nif_getopt(SockRef, EIsEncoded, ELevel, EKey) of
+ ok ->
+ ok;
+ {ok, EVal} ->
+ Val = dec_getopt_value(Level, Key, EVal,
+ Domain, Type, Protocol),
+ {ok, Val};
+ {error, _} = ERROR ->
+ ERROR
+ end
+ end
+ catch
+ throw:E:_S ->
+ E;
+ %% <WIN32-TEMPORARY>
+ error:notsup:S ->
+ erlang:raise(error, notsup, S);
+ %% </WIN32-TEMPORARY>
+ error:Reason:_Stack ->
+ {error, Reason} % Process more?
+ end.
+
+
+%% These are internal "shortcut" functions for the options
+%% domain, type and protocol.
+
+-spec which_domain(SockRef) -> Domain when
+ SockRef :: reference(),
+ Domain :: domain().
+
+which_domain(SockRef) ->
+ case nif_getopt(SockRef, true,
+ ?SOCKET_OPT_LEVEL_OTP, ?SOCKET_OPT_OTP_DOMAIN) of
+ {ok, Domain} ->
+ Domain;
+ {error, _} = ERROR ->
+ throw(ERROR)
+ end.
+
+
+-spec which_type(SockRef) -> Type when
+ SockRef :: reference(),
+ Type :: type().
+
+which_type(SockRef) ->
+ case nif_getopt(SockRef, true,
+ ?SOCKET_OPT_LEVEL_OTP, ?SOCKET_OPT_OTP_TYPE) of
+ {ok, Type} ->
+ Type;
+ {error, _} = ERROR ->
+ throw(ERROR)
+ end.
+
+-spec which_protocol(SockRef) -> Protocol when
+ SockRef :: reference(),
+ Protocol :: protocol().
+
+which_protocol(SockRef) ->
+ case nif_getopt(SockRef, true,
+ ?SOCKET_OPT_LEVEL_OTP, ?SOCKET_OPT_OTP_PROTOCOL) of
+ {ok, Proto} ->
+ Proto;
+ {error, _} = ERROR ->
+ throw(ERROR)
+ end.
+
+
+%% ===========================================================================
+%%
+%% sockname - return the current address of the socket.
+%%
+%%
+
+-spec sockname(Socket) -> {ok, SockAddr} | {error, Reason} when
+ Socket :: socket(),
+ SockAddr :: sockaddr(),
+ Reason :: term().
+
+sockname(#socket{ref = SockRef}) ->
+ nif_sockname(SockRef).
+
+
+
+%% ===========================================================================
+%%
+%% peername - return the address of the peer *connected* to the socket.
+%%
+%%
+
+-spec peername(Socket) -> {ok, SockAddr} | {error, Reason} when
+ Socket :: socket(),
+ SockAddr :: sockaddr(),
+ Reason :: term().
+
+peername(#socket{ref = SockRef}) ->
+ nif_peername(SockRef).
+
+
+
+%% ===========================================================================
+%%
+%% Encode / decode
+%%
+%% ===========================================================================
+
+-spec enc_domain(Domain) -> non_neg_integer() when
+ Domain :: domain().
+
+enc_domain(local) -> ?SOCKET_DOMAIN_LOCAL;
+enc_domain(inet) -> ?SOCKET_DOMAIN_INET;
+enc_domain(inet6) -> ?SOCKET_DOMAIN_INET6;
+enc_domain(Domain) -> throw({error, {invalid_domain, Domain}}).
+
+-spec enc_type(Domain, Type) -> non_neg_integer() when
+ Domain :: domain(),
+ Type :: type().
+
+%% What combos are valid?
+enc_type(_, stream) -> ?SOCKET_TYPE_STREAM;
+enc_type(_, dgram) -> ?SOCKET_TYPE_DGRAM;
+enc_type(_, raw) -> ?SOCKET_TYPE_RAW;
+enc_type(_, seqpacket) -> ?SOCKET_TYPE_SEQPACKET;
+enc_type(_, Type) -> throw({error, {invalid_type, Type}}).
+
+-spec enc_protocol(Type, Protocol) -> non_neg_integer() |
+ {raw, non_neg_integer()} when
+ Type :: type(),
+ Protocol :: protocol().
+
+enc_protocol(dgram, ip) -> ?SOCKET_PROTOCOL_IP;
+enc_protocol(stream, tcp) -> ?SOCKET_PROTOCOL_TCP;
+enc_protocol(dgram, udp) -> ?SOCKET_PROTOCOL_UDP;
+enc_protocol(seqpacket, sctp) -> ?SOCKET_PROTOCOL_SCTP;
+enc_protocol(raw, icmp) -> ?SOCKET_PROTOCOL_ICMP;
+enc_protocol(raw, igmp) -> ?SOCKET_PROTOCOL_IGMP;
+enc_protocol(raw, {raw, P} = RAW) when is_integer(P) -> RAW;
+enc_protocol(Type, Proto) ->
+ throw({error, {invalid_protocol, {Type, Proto}}}).
+
+
+-spec enc_send_flags(Flags) -> non_neg_integer() when
+ Flags :: send_flags().
+
+enc_send_flags(Flags) ->
+ EFlags = [{confirm, ?SOCKET_SEND_FLAG_CONFIRM},
+ {dontroute, ?SOCKET_SEND_FLAG_DONTROUTE},
+ {eor, ?SOCKET_SEND_FLAG_EOR},
+ {more, ?SOCKET_SEND_FLAG_MORE},
+ {nosignal, ?SOCKET_SEND_FLAG_NOSIGNAL},
+ {oob, ?SOCKET_SEND_FLAG_OOB}],
+ enc_flags(Flags, EFlags).
+
+-spec enc_recv_flags(Flags) -> non_neg_integer() when
+ Flags :: recv_flags().
+
+enc_recv_flags(Flags) ->
+ EFlags = [{cmsg_cloexec, ?SOCKET_RECV_FLAG_CMSG_CLOEXEC},
+ {errqueue, ?SOCKET_RECV_FLAG_ERRQUEUE},
+ {oob, ?SOCKET_RECV_FLAG_OOB},
+ {peek, ?SOCKET_RECV_FLAG_PEEK},
+ {trunc, ?SOCKET_RECV_FLAG_TRUNC}],
+ enc_flags(Flags, EFlags).
+
+
+enc_flags([], _) ->
+ 0;
+enc_flags(Flags, EFlags) ->
+ F = fun(Flag, Acc) ->
+ case lists:keysearch(Flag, 1, EFlags) of
+ {value, {Flag, EFlag}} ->
+ Acc bor (1 bsl EFlag);
+ false ->
+ throw({error, {unknown_flag, Flag}})
+ end
+ end,
+ lists:foldl(F, 0, Flags).
+
+
+%% +++ Encode setopt level +++
+
+-spec enc_setopt_level(Level) -> {IsEncoded, EncodedLevel} when
+ Level :: sockopt_level(),
+ IsEncoded :: boolean(),
+ EncodedLevel :: integer().
+
+enc_setopt_level(otp) ->
+ {true, ?SOCKET_OPT_LEVEL_OTP};
+enc_setopt_level(socket) ->
+ {true, ?SOCKET_OPT_LEVEL_SOCKET};
+enc_setopt_level(ip) ->
+ {true, ?SOCKET_OPT_LEVEL_IP};
+enc_setopt_level(ipv6) ->
+ {true, ?SOCKET_OPT_LEVEL_IPV6};
+enc_setopt_level(tcp) ->
+ {true, ?SOCKET_OPT_LEVEL_TCP};
+enc_setopt_level(udp) ->
+ {true, ?SOCKET_OPT_LEVEL_UDP};
+enc_setopt_level(sctp) ->
+ {true, ?SOCKET_OPT_LEVEL_SCTP};
+%% Any option that is of an plain level must be provided as a binary
+%% already fully encoded!
+enc_setopt_level(L) when is_integer(L) ->
+ {false, L}.
+
+
+%% +++ Encode setopt key +++
+
+%% We should ...really... do something with the domain, type and protocol args...
+%% Also, any option (key) which has an integer level (plain) must also be provided
+%% in a plain mode, that is, as an integer.
+%% Also, not all options are available on all platforms. That is something we
+%% don't check here, but in the nif-code.
+
+enc_setopt_key(Level, Opt, Domain, Type, Protocol) ->
+ enc_sockopt_key(Level, Opt, set, Domain, Type, Protocol).
+
+
+%% +++ Encode setopt value +++
+%%
+%% For the most part this function does *not* do an actual encode,
+%% it simply validates the value type. But in some cases it will
+%% encode the value into an more "manageable" type.
+%% It also handles "aliases" (see linger).
+
+-dialyzer({nowarn_function, enc_setopt_value/6}).
+-spec enc_setopt_value(otp, otp_socket_option(),
+ Value, Domain, Type, Protocol) -> term() when
+ Value :: term(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (socket, socket_option(),
+ Value, Domain, Type, Protocol) -> term() when
+ Value :: term(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (ip, ip_socket_option(),
+ Value, Domain, Type, Protocol) -> term() when
+ Value :: term(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (ipv6, ipv6_socket_option(),
+ Value, Domain, Type, Protocol) -> term() when
+ Value :: term(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (tcp, tcp_socket_option(),
+ Value, Domain, Type, Protocol) -> term() when
+ Value :: term(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (udp, udp_socket_option(),
+ Value, Domain, Type, Protocol) -> term() when
+ Value :: term(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (sctp, sctp_socket_option(),
+ Value, Domain, Type, Protocol) -> term() when
+ Value :: term(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Opt,
+ Value, Domain, Type, Protocol) -> term() when
+ Level :: integer(),
+ Opt :: integer(),
+ Value :: binary(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol().
+
+enc_setopt_value(otp, debug, V, _, _, _) when is_boolean(V) ->
+ V;
+enc_setopt_value(otp, iow, V, _, _, _) when is_boolean(V) ->
+ V;
+enc_setopt_value(otp, controlling_process, V, _, _, _) when is_pid(V) ->
+ V;
+enc_setopt_value(otp, rcvbuf, V, _, _, _) when (V =:= default) ->
+ 0; % This will cause the nif-code to choose the default value
+enc_setopt_value(otp, rcvbuf, V, _, _, _) when is_integer(V) andalso (V > 0) ->
+ V;
+%% N: Number of reads (when specifying length = 0)
+%% V: Size of the "read" buffer
+enc_setopt_value(otp, rcvbuf, {N, BufSz} = V, _, stream = _T, tcp = _P)
+ when (is_integer(N) andalso (N > 0)) andalso
+ (is_integer(BufSz) andalso (BufSz > 0)) ->
+ V;
+enc_setopt_value(otp, rcvctrlbuf, V, _, _, _) when (V =:= default) ->
+ 0;
+enc_setopt_value(otp, rcvctrlbuf, V, _, _, _) when is_integer(V) andalso (V > 0) ->
+ V;
+enc_setopt_value(otp, sndctrlbuf, V, _, _, _) when (V =:= default) ->
+ 0;
+enc_setopt_value(otp, sndctrlbuf, V, _, _, _) when is_integer(V) andalso (V > 0) ->
+ V;
+enc_setopt_value(otp = L, Opt, V, _D, _T, _P) ->
+ not_supported({L, Opt, V});
+
+enc_setopt_value(socket, bindtodevice, V, _D, _T, _P) when is_list(V) ->
+ V;
+enc_setopt_value(socket, broadcast, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(socket, debug, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(socket, dontroute, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(socket, keepalive, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(socket, linger, abort, D, T, P) ->
+ enc_setopt_value(socket, linger, {true, 0}, D, T, P);
+enc_setopt_value(socket, linger, {OnOff, Secs} = V, _D, _T, _P)
+ when is_boolean(OnOff) andalso is_integer(Secs) andalso (Secs >= 0) ->
+ V;
+enc_setopt_value(socket, oobinline, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(socket, peek_off, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(socket, priority, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(socket, rcvbuf, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(socket, rcvlowat, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(socket, rcvtimeo, #{sec := Sec, usec := USec} = V, _D, _T, _P)
+ when is_integer(Sec) andalso is_integer(USec) ->
+ V;
+enc_setopt_value(socket, reuseaddr, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(socket, reuseport, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(socket, sndbuf, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(socket, sndlowat, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(socket, sndtimeo, #{sec := Sec, usec := USec} = V, _D, _T, _P)
+ when is_integer(Sec) andalso is_integer(USec) ->
+ V;
+enc_setopt_value(socket, timestamp, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(socket = L, Opt, V, _D, _T, _P) ->
+ not_supported({L, Opt, V});
+
+enc_setopt_value(ip, add_membership, #{multiaddr := MA,
+ interface := IF} = V, _D, _T, _P)
+ when (is_tuple(MA) andalso (size(MA) =:= 4)) andalso
+ ((IF =:= any) orelse (is_tuple(IF) andalso (size(IF) =:= 4))) ->
+ V;
+enc_setopt_value(ip, add_source_membership, #{multiaddr := MA,
+ interface := IF,
+ sourceaddr := SA} = V, _D, _T, _P)
+ when (is_tuple(MA) andalso (size(MA) =:= 4)) andalso
+ (is_tuple(IF) andalso (size(IF) =:= 4)) andalso
+ (is_tuple(SA) andalso (size(SA) =:= 4)) ->
+ V;
+enc_setopt_value(ip, block_source, #{multiaddr := MA,
+ interface := IF,
+ sourceaddr := SA} = V, _D, _T, _P)
+ when (is_tuple(MA) andalso (size(MA) =:= 4)) andalso
+ (is_tuple(IF) andalso (size(IF) =:= 4)) andalso
+ (is_tuple(SA) andalso (size(SA) =:= 4)) ->
+ V;
+enc_setopt_value(ip, drop_membership, #{multiaddr := MA,
+ interface := IF} = V, _D, _T, _P)
+ when (is_tuple(MA) andalso (size(MA) =:= 4)) andalso
+ ((IF =:= any) orelse (is_tuple(IF) andalso (size(IF) =:= 4))) ->
+ V;
+enc_setopt_value(ip, drop_source_membership, #{multiaddr := MA,
+ interface := IF,
+ sourceaddr := SA} = V, _D, _T, _P)
+ when (is_tuple(MA) andalso (size(MA) =:= 4)) andalso
+ (is_tuple(IF) andalso (size(IF) =:= 4)) andalso
+ (is_tuple(SA) andalso (size(SA) =:= 4)) ->
+ V;
+enc_setopt_value(ip, freebind, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, hdrincl, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, minttl, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(ip, msfilter, null = V, _D, _T, _P) ->
+ V;
+enc_setopt_value(ip, msfilter, #{multiaddr := MA,
+ interface := IF,
+ fmode := FMode,
+ slist := SL} = V, _D, _T, _P)
+ when (is_tuple(MA) andalso (size(MA) =:= 4)) andalso
+ (is_tuple(IF) andalso (size(IF) =:= 4)) andalso
+ ((FMode =:= include) orelse (FMode =:= exclude)) andalso
+ is_list(SL) ->
+ ensure_ip_msfilter_slist(SL),
+ V;
+enc_setopt_value(ip, mtu_discover, V, _D, _T, _P)
+ when (V =:= want) orelse
+ (V =:= dont) orelse
+ (V =:= do) orelse
+ (V =:= probe) orelse
+ is_integer(V) ->
+ V;
+enc_setopt_value(ip, multicast_all, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, multicast_if, V, _D, _T, _P)
+ when (V =:= any) orelse (is_tuple(V) andalso (size(V) =:= 4)) ->
+ V;
+enc_setopt_value(ip, multicast_loop, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, multicast_ttl, V, _D, _T, _P)
+ when is_integer(V) andalso (0 =< V) andalso (V =< 255) ->
+ V;
+enc_setopt_value(ip, nodefrag, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, pktinfo, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, recvdstaddr, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, recverr, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, recvif, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, recvopts, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, recvorigdstaddr, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, recvtos, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, recvttl, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, retopts, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, router_alert, V, _D, _T, _P)
+ when is_integer(V) ->
+ V;
+enc_setopt_value(ip, sendsrcaddr, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, tos, V, _D, _T, _P)
+ when (V =:= lowdelay) orelse
+ (V =:= throughput) orelse
+ (V =:= reliability) orelse
+ (V =:= mincost) orelse
+ is_integer(V) ->
+ V;
+enc_setopt_value(ip, transparent, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ip, ttl, V, _D, _T, _P)
+ when is_integer(V) ->
+ V;
+enc_setopt_value(ip, unblock_source, #{multiaddr := MA,
+ interface := IF,
+ sourceaddr := SA} = V, _D, _T, _P)
+ when (is_tuple(MA) andalso (size(MA) =:= 4)) andalso
+ (is_tuple(IF) andalso (size(IF) =:= 4)) andalso
+ (is_tuple(SA) andalso (size(SA) =:= 4)) ->
+ V;
+enc_setopt_value(ip = L, Opt, V, _D, _T, _P) ->
+ not_supported({L, Opt, V});
+
+enc_setopt_value(ipv6, addrform, inet = V, _D, _T, _P) ->
+ enc_domain(V);
+enc_setopt_value(ipv6, add_membership, #{multiaddr := MA,
+ interface := IF} = V, _D, _T, _P)
+ when ((is_tuple(MA) andalso (size(MA) =:= 8)) andalso
+ (is_integer(IF) andalso (IF >= 0))) ->
+ V;
+%% Is this obsolete? When get, the result is enoprotoopt and in the
+%% header file it says 'obsolete'...
+%% But there might be (old?) versions of linux where it still works...
+enc_setopt_value(ipv6, authhdr, V, _D, T, _P)
+ when is_boolean(V) andalso ((T =:= dgram) orelse (T =:= raw)) ->
+ V;
+enc_setopt_value(ipv6, dstopts, V, _D, T, _P)
+ when is_boolean(V) andalso ((T =:= dgram) orelse (T =:= raw)) ->
+ V;
+enc_setopt_value(ipv6, drop_membership, #{multiaddr := MA,
+ interface := IF} = V, _D, _T, _P)
+ when ((is_tuple(MA) andalso (size(MA) =:= 8)) andalso
+ (is_integer(IF) andalso (IF >= 0))) ->
+ V;
+enc_setopt_value(ipv6, flowinfo, V, _D, T, _P)
+ when is_boolean(V) andalso ((T =:= dgram) orelse (T =:= raw)) ->
+ V;
+enc_setopt_value(ipv6, hoplimit, V, _D, T, _P)
+ when is_boolean(V) andalso ((T =:= dgram) orelse (T =:= raw)) ->
+ V;
+enc_setopt_value(ipv6, hopopts, V, _D, T, _P)
+ when is_boolean(V) andalso ((T =:= dgram) orelse (T =:= raw)) ->
+ V;
+enc_setopt_value(ipv6, mtu, V, _D, _T, _P) when is_integer(V) ->
+ V;
+enc_setopt_value(ipv6, mtu_discover, V, _D, _T, _P)
+ when (V =:= want) orelse
+ (V =:= dont) orelse
+ (V =:= do) orelse
+ (V =:= probe) orelse
+ is_integer(V) ->
+ V;
+enc_setopt_value(ipv6, multicast_hops, V, _D, _T, _P)
+ when (V =:= default) ->
+ -1;
+enc_setopt_value(ipv6, multicast_hops, V, _D, _T, _P)
+ when is_integer(V) andalso (V >= 0) andalso (V =< 255) ->
+ V;
+enc_setopt_value(ipv6, multicast_if, V, _D, _T, _P)
+ when is_integer(V) ->
+ V;
+enc_setopt_value(ipv6, multicast_loop, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ipv6, recverr, V, _D, _T, _P)
+ when is_boolean(V) ->
+ V;
+enc_setopt_value(ipv6, Opt, V, _D, _T, _P)
+ when ((Opt =:= recvpktinfo) orelse (Opt =:= pktinfo)) andalso
+ is_boolean(V) ->
+ V;
+enc_setopt_value(ipv6, router_alert, V, _D, T, _P)
+ when is_integer(V) andalso (T =:= raw) ->
+ V;
+enc_setopt_value(ipv6, rthdr, V, _D, T, _P)
+ when is_boolean(V) andalso ((T =:= dgram) orelse (T =:= raw)) ->
+ V;
+enc_setopt_value(ipv6, unicast_hops, V, _D, _T, _P)
+ when (V =:= default) ->
+ -1;
+enc_setopt_value(ipv6, unicast_hops, V, _D, _T, _P)
+ when is_integer(V) andalso (V >= 0) andalso (V =< 255) ->
+ V;
+enc_setopt_value(ipv6, v6only, V, _D, _T, _P) when is_boolean(V) ->
+ V;
+enc_setopt_value(ipv6 = L, Opt, V, _D, _T, _P) ->
+ not_supported({L, Opt, V});
+
+enc_setopt_value(tcp, congestion, V, _D, T, P)
+ when is_list(V) andalso
+ (T =:= stream) andalso
+ (P =:= tcp) ->
+ V;
+enc_setopt_value(tcp, maxseg, V, _D, T, P)
+ when is_integer(V) andalso
+ (T =:= stream) andalso
+ (P =:= tcp) ->
+ V;
+enc_setopt_value(tcp, nodelay, V, _D, T, P)
+ when is_boolean(V) andalso
+ (T =:= stream) andalso
+ (P =:= tcp) ->
+ V;
+enc_setopt_value(tcp = L, Opt, V, _D, _T, _P) ->
+ not_supported({L, Opt, V});
+
+enc_setopt_value(udp, cork, V, _D, T, P)
+ when is_boolean(V) andalso (T =:= dgram) andalso (P =:= udp) ->
+ V;
+enc_setopt_value(udp = L, Opt, _V, _D, _T, _P) ->
+ not_supported({L, Opt});
+
+enc_setopt_value(sctp, associnfo, #{assoc_id := AssocId,
+ asocmaxrxt := MaxRxt,
+ num_peer_dests := NumPeerDests,
+ peer_rwnd := PeerRWND,
+ local_rwnd := LocalRWND,
+ cookie_life := CLife} = V,
+ _D, _T, P)
+ when is_integer(AssocId) andalso
+ is_integer(MaxRxt) andalso (MaxRxt >= 0) andalso
+ is_integer(NumPeerDests) andalso (NumPeerDests >= 0) andalso
+ is_integer(PeerRWND) andalso (PeerRWND >= 0) andalso
+ is_integer(LocalRWND) andalso (LocalRWND >= 0) andalso
+ is_integer(CLife) andalso (CLife >= 0) andalso
+ (P =:= sctp) ->
+ V;
+enc_setopt_value(sctp, autoclose, V, _D, _T, P)
+ when is_integer(V) andalso (V >= 0) andalso (P =:= sctp) ->
+ V;
+enc_setopt_value(sctp, disable_fragments, V, _D, _T, P)
+ when is_boolean(V) andalso (P =:= sctp) ->
+ V;
+enc_setopt_value(sctp, events, #{data_in := DataIn,
+ association := Assoc,
+ address := Addr,
+ send_failure := SndFailure,
+ peer_error := PeerError,
+ shutdown := Shutdown,
+ partial_delivery := PartialDelivery,
+ adaptation_layer := AdaptLayer,
+ authentication := Auth,
+ sender_dry := SndDry} = V, _D, _T, P)
+ when is_boolean(DataIn) andalso
+ is_boolean(Assoc) andalso
+ is_boolean(Addr) andalso
+ is_boolean(SndFailure) andalso
+ is_boolean(PeerError) andalso
+ is_boolean(Shutdown) andalso
+ is_boolean(PartialDelivery) andalso
+ is_boolean(AdaptLayer) andalso
+ is_boolean(Auth) andalso
+ is_boolean(SndDry) andalso
+ (P =:= sctp) ->
+ V;
+enc_setopt_value(sctp, initmsg, #{num_outstreams := NumOut,
+ max_instreams := MaxIn,
+ max_attempts := MaxAttempts,
+ max_init_timeo := MaxInitTO} = V,
+ _D, _T, P)
+ when is_integer(NumOut) andalso (NumOut >= 0) andalso
+ is_integer(MaxIn) andalso (MaxIn >= 0) andalso
+ is_integer(MaxAttempts) andalso (MaxAttempts >= 0) andalso
+ is_integer(MaxInitTO) andalso (MaxInitTO >= 0) andalso
+ (P =:= sctp) ->
+ V;
+enc_setopt_value(sctp, maxseg, V, _D, _T, P)
+ when is_integer(V) andalso (V >= 0) andalso (P =:= sctp) ->
+ V;
+enc_setopt_value(sctp, nodelay, V, _D, _T, P)
+ when is_boolean(V) andalso (P =:= sctp) ->
+ V;
+enc_setopt_value(sctp, rtoinfo, #{assoc_id := AssocId,
+ initial := Init,
+ max := Max,
+ min := Min} = V,
+ _D, _T, P)
+ when is_integer(AssocId) andalso
+ is_integer(Init) andalso (Init >= 0) andalso
+ is_integer(Max) andalso (Max >= 0) andalso
+ is_integer(Min) andalso (Min >= 0) andalso
+ (P =:= sctp) ->
+ V;
+enc_setopt_value(sctp = L, Opt, V, _D, _T, _P) ->
+ not_supported({L, Opt, V});
+
+%% enc_setopt_value(raw = L, Opt, _V, _D, _T, _P) ->
+%% not_supported({L, Opt});
+
+%% Is this correct? What about getopt?
+enc_setopt_value(L, Opt, V, _, _, _)
+ when is_integer(L) andalso is_integer(Opt) andalso is_binary(V) ->
+ V.
+
+
+
+
+%% +++ Encode getopt value +++
+
+enc_getopt_level(Level) ->
+ enc_setopt_level(Level).
+
+
+%% +++ Encode getopt key +++
+
+enc_getopt_key(Level, Opt, Domain, Type, Protocol) ->
+ enc_sockopt_key(Level, Opt, get, Domain, Type, Protocol).
+
+
+%% +++ Decode getopt value +++
+%%
+%% For the most part, we simply let the value pass through, but for some
+%% values we may need to do an actual decode.
+%%
+
+%% Let the user deal with this for now...
+dec_getopt_value(_L, _Opt, V, _D, _T, _P) ->
+ V.
+
+
+
+%% +++ Encode socket option key +++
+
+%% Most options are usable both for set and get, but some are
+%% are only available for e.g. get.
+-spec enc_sockopt_key(Level, Opt,
+ Direction,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: otp,
+ Direction :: set | get,
+ Opt :: otp_socket_option(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Direction, Opt,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: socket,
+ Direction :: set | get,
+ Opt :: socket_option(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Direction, Opt,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: ip,
+ Direction :: set | get,
+ Opt :: ip_socket_option(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Direction, Opt,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: ipv6,
+ Direction :: set | get,
+ Opt :: ipv6_socket_option(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Direction, Opt,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: tcp,
+ Direction :: set | get,
+ Opt :: tcp_socket_option(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Direction, Opt,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: udp,
+ Direction :: set | get,
+ Opt :: udp_socket_option(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Direction, Opt,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: sctp,
+ Direction :: set | get,
+ Opt :: sctp_socket_option(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Direction, Opt,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: integer(),
+ Direction :: set,
+ Opt :: integer(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol()
+ ; (Level, Direction, Opt,
+ Domain, Type, Protocol) -> non_neg_integer() when
+ Level :: integer(),
+ Direction :: get,
+ Opt :: {NativeOpt, ValueSize},
+ NativeOpt :: integer(),
+ ValueSize :: non_neg_integer(),
+ Domain :: domain(),
+ Type :: type(),
+ Protocol :: protocol().
+
+
+%% +++ OTP socket options +++
+enc_sockopt_key(otp, debug, _, _, _, _) ->
+ ?SOCKET_OPT_OTP_DEBUG;
+enc_sockopt_key(otp, iow, _, _, _, _) ->
+ ?SOCKET_OPT_OTP_IOW;
+enc_sockopt_key(otp, controlling_process, _, _, _, _) ->
+ ?SOCKET_OPT_OTP_CTRL_PROC;
+enc_sockopt_key(otp, rcvbuf, _, _, _, _) ->
+ ?SOCKET_OPT_OTP_RCVBUF;
+enc_sockopt_key(otp, rcvctrlbuf, _, _, _, _) ->
+ ?SOCKET_OPT_OTP_RCVCTRLBUF;
+enc_sockopt_key(otp, sndctrlbuf, _, _, _, _) ->
+ ?SOCKET_OPT_OTP_SNDCTRLBUF;
+enc_sockopt_key(otp, fd, get = _Dir, _, _, _) ->
+ ?SOCKET_OPT_OTP_FD;
+enc_sockopt_key(otp = L, Opt, _, _, _, _) ->
+ not_supported({L, Opt});
+
+%% +++ SOCKET socket options +++
+enc_sockopt_key(socket = _L, acceptconn = _Opt, get = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_ACCEPTCONN;
+enc_sockopt_key(socket = L, acceptfilter = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+%% Before linux 3.8, this socket option could be set.
+%% Maximum size of buffer for name: IFNAMSZIZ
+%% So, we let the implementation decide.
+enc_sockopt_key(socket = _L, bindtodevice = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_BINDTODEVICE;
+enc_sockopt_key(socket, broadcast = _Opt, _Dir, _D, dgram = _T, _P) ->
+ ?SOCKET_OPT_SOCK_BROADCAST;
+enc_sockopt_key(socket = L, busy_poll = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(socket = _L, debug = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_DEBUG;
+enc_sockopt_key(socket, domain = _Opt, get = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_DOMAIN;
+enc_sockopt_key(socket, dontroute = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_DONTROUTE;
+enc_sockopt_key(socket = L, error = Opt, get = _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+%% This is only for connection-oriented sockets, but who are those?
+%% Type = stream or Protocol = tcp?
+%% For now, we just let is pass and it will fail later if not ok...
+enc_sockopt_key(socket, keepalive = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_KEEPALIVE;
+enc_sockopt_key(socket, linger = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_LINGER;
+enc_sockopt_key(socket = L, mark = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(socket = _L, oobinline = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_OOBINLINE;
+enc_sockopt_key(socket = L, passcred = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(socket = _L, peek_off = _Opt, _Dir, local = _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_PEEK_OFF;
+enc_sockopt_key(socket = L, peekcred = Opt, get = _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(socket, priority = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_PRIORITY;
+enc_sockopt_key(socket, protocol = _Opt, get = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_PROTOCOL;
+enc_sockopt_key(socket, rcvbuf = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_RCVBUF;
+enc_sockopt_key(socket = L, rcvbufforce = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+%% May not work on linux.
+enc_sockopt_key(socket = _L, rcvlowat = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_RCVLOWAT;
+enc_sockopt_key(socket = _L, rcvtimeo = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_RCVTIMEO;
+enc_sockopt_key(socket = _L, reuseaddr = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_REUSEADDR;
+enc_sockopt_key(socket = _L, reuseport = _Opt, _Dir, D, _T, _P)
+ when ((D =:= inet) orelse (D =:= inet6)) ->
+ ?SOCKET_OPT_SOCK_REUSEPORT;
+enc_sockopt_key(socket = L, rxq_ovfl = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(socket = L, setfib = Opt, set = _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(socket = _L, sndbuf = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_SNDBUF;
+enc_sockopt_key(socket = L, sndbufforce = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+%% Not changeable on linux.
+enc_sockopt_key(socket = _L, sndlowat = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_SNDLOWAT;
+enc_sockopt_key(socket = _L, sndtimeo = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_SNDTIMEO;
+enc_sockopt_key(socket = _L, timestamp = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_TIMESTAMP;
+enc_sockopt_key(socket = _L, type = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SOCK_TYPE;
+enc_sockopt_key(socket = L, UnknownOpt, _Dir, _D, _T, _P) ->
+ unknown({L, UnknownOpt});
+
+%% +++ IP socket options +++
+enc_sockopt_key(ip = _L, add_membership = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_ADD_MEMBERSHIP;
+enc_sockopt_key(ip = _L, add_source_membership = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_ADD_SOURCE_MEMBERSHIP;
+enc_sockopt_key(ip = _L, block_source = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_BLOCK_SOURCE;
+%% FreeBSD only?
+%% Only respected on udp and raw ip (unless the hdrincl option has been set).
+enc_sockopt_key(ip = L, dontfrag = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ip = _L, drop_membership = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_DROP_MEMBERSHIP;
+enc_sockopt_key(ip = _L, drop_source_membership = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_DROP_SOURCE_MEMBERSHIP;
+%% Linux only?
+enc_sockopt_key(ip = _L, freebind = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_FREEBIND;
+enc_sockopt_key(ip = _L, hdrincl = _Opt, _Dir, _D, raw = _T, _P) ->
+ ?SOCKET_OPT_IP_HDRINCL;
+enc_sockopt_key(ip = _L, minttl = _Opt, _Dir, _D, raw = _T, _P) ->
+ ?SOCKET_OPT_IP_MINTTL;
+enc_sockopt_key(ip = _L, msfilter = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_MSFILTER;
+enc_sockopt_key(ip = _L, mtu = _Opt, get = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_MTU;
+enc_sockopt_key(ip = _L, mtu_discover = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_MTU_DISCOVER;
+enc_sockopt_key(ip = _L, multicast_all = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_MULTICAST_ALL;
+enc_sockopt_key(ip = _L, multicast_if = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_MULTICAST_IF;
+enc_sockopt_key(ip = _L, multicast_loop = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_MULTICAST_LOOP;
+enc_sockopt_key(ip = _L, multicast_ttl = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_MULTICAST_TTL;
+enc_sockopt_key(ip = _L, nodefrag = _Opt, _Dir, _D, raw = _T, _P) ->
+ ?SOCKET_OPT_IP_NODEFRAG;
+enc_sockopt_key(ip = L, options = Opt, _Dir, _D, _T, _P) ->
+ not_supported({Opt, L});
+enc_sockopt_key(ip = _L, pktinfo = _Opt, _Dir, _D, dgram = _T, _P) ->
+ ?SOCKET_OPT_IP_PKTINFO;
+enc_sockopt_key(ip = _L, recvdstaddr = _Opt, _Dir, _D, T, _P) when (T =:= dgram) ->
+ ?SOCKET_OPT_IP_RECVDSTADDR;
+enc_sockopt_key(ip = _L, recverr = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_RECVERR;
+enc_sockopt_key(ip = _L, recvif = _Opt, _Dir, _D, T, _P)
+ when (T =:= dgram) orelse (T =:= raw) ->
+ ?SOCKET_OPT_IP_RECVIF;
+enc_sockopt_key(ip = _L, recvopts = _Opt, _Dir, _D, T, _P) when (T =/= stream) ->
+ ?SOCKET_OPT_IP_RECVOPTS;
+enc_sockopt_key(ip = _L, recvorigdstaddr = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_RECVORIGDSTADDR;
+enc_sockopt_key(ip, recvtos = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_RECVTOS;
+enc_sockopt_key(ip = _L, recvttl = _Opt, _Dir, _D, T, _P) when (T =/= stream) ->
+ ?SOCKET_OPT_IP_RECVTTL;
+enc_sockopt_key(ip = _L, retopts = _Opt, _Dir, _D, T, _P) when (T =/= stream) ->
+ ?SOCKET_OPT_IP_RETOPTS;
+enc_sockopt_key(ip, router_alert = _Opt, _Dir, _D, raw = _T, _P) ->
+ ?SOCKET_OPT_IP_ROUTER_ALERT;
+enc_sockopt_key(ip, sendsrcaddr = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_SENDSRCADDR;
+%% On FreeBSD it specifies that this option is only valid
+%% for stream, dgram and "some" raw sockets...
+%% No such condition on linux (in the man page)...
+enc_sockopt_key(ip, tos = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_TOS;
+enc_sockopt_key(ip = _L, transparent = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_TRANSPARENT;
+enc_sockopt_key(ip, ttl = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_TTL;
+enc_sockopt_key(ip = _L, unblock_source = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IP_UNBLOCK_SOURCE;
+enc_sockopt_key(ip = L, UnknownOpt, _Dir, _D, _T, _P) ->
+ unknown({L, UnknownOpt});
+
+%% IPv6 socket options
+enc_sockopt_key(ipv6 = _L, addrform = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_ADDRFORM;
+enc_sockopt_key(ipv6, add_membership = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_ADD_MEMBERSHIP;
+enc_sockopt_key(ipv6 = _L, authhdr = _Opt, _Dir, _D, T, _P)
+ when ((T =:= dgram) orelse (T =:= raw)) ->
+ ?SOCKET_OPT_IPV6_AUTHHDR;
+enc_sockopt_key(ipv6 = L, auth_level = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = L, checksum = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6, drop_membership = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_DROP_MEMBERSHIP;
+enc_sockopt_key(ipv6 = _L, dstopts = _Opt, _Dir, _D, T, _P)
+ when (T =:= dgram) orelse (T =:= raw) ->
+ ?SOCKET_OPT_IPV6_DSTOPTS;
+enc_sockopt_key(ipv6 = L, esp_trans_level = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = L, esp_network_level = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = _L, flowinfo = _Opt, _Dir, _D, T, _P)
+ when (T =:= dgram) orelse (T =:= raw) ->
+ ?SOCKET_OPT_IPV6_DSTOPTS;
+enc_sockopt_key(ipv6, hoplimit = _Opt, _Dir, _D, T, _P)
+ when (T =:= dgram) orelse (T =:= raw) ->
+ ?SOCKET_OPT_IPV6_HOPLIMIT;
+enc_sockopt_key(ipv6 = _L, hopopts = _Opt, _Dir, _D, T, _P)
+ when ((T =:= dgram) orelse (T =:= raw)) ->
+ ?SOCKET_OPT_IPV6_HOPOPTS;
+enc_sockopt_key(ipv6 = L, ipcomp_level = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = L, join_group = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = L, leave_group = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = _L, mtu = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_MTU;
+enc_sockopt_key(ipv6 = _L, mtu_discover = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_MTU_DISCOVER;
+enc_sockopt_key(ipv6 = _L, multicast_hops = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_MULTICAST_HOPS;
+enc_sockopt_key(ipv6 = _L, multicast_if = _Opt, _Dir, _D, T, _P)
+ when (T =:= dgram) orelse (T =:= raw) ->
+ ?SOCKET_OPT_IPV6_MULTICAST_IF;
+enc_sockopt_key(ipv6 = _L, multicast_loop = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_MULTICAST_LOOP;
+enc_sockopt_key(ipv6 = L, portrange = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = L, pktoptions = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = _L, recverr = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_RECVERR;
+enc_sockopt_key(ipv6 = _L, Opt, _Dir, _D, T, _P)
+ when ((Opt =:= recvpktinfo) orelse (Opt =:= pktinfo)) andalso
+ ((T =:= dgram) orelse (T =:= raw)) ->
+ ?SOCKET_OPT_IPV6_RECVPKTINFO;
+enc_sockopt_key(ipv6 = L, recvtclass = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = _L, router_alert = _Opt, _Dir, _D, T, _P) when (T =:= raw) ->
+ ?SOCKET_OPT_IPV6_ROUTER_ALERT;
+enc_sockopt_key(ipv6 = _L, rthdr = _Opt, _Dir, _D, T, _P)
+ when ((T =:= dgram) orelse (T =:= raw)) ->
+ ?SOCKET_OPT_IPV6_RTHDR;
+enc_sockopt_key(ipv6 = L, tclass = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = _L, unicast_hops = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_UNICAST_HOPS;
+enc_sockopt_key(ipv6 = L, use_min_mtu = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(ipv6 = _L, v6only = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_IPV6_V6ONLY;
+enc_sockopt_key(ipv6 = L, UnknownOpt, _Dir, _D, _T, _P) ->
+ unknown({L, UnknownOpt});
+
+%% TCP socket options
+%% There are other options that would be useful; info,
+%% but they are difficult to get portable...
+enc_sockopt_key(tcp, congestion = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_TCP_CONGESTION;
+enc_sockopt_key(tcp = L, cork = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(tcp = L, keepidle = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(tcp = L, keepintvl = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(tcp = L, keepcnt = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(tcp, maxseg = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_TCP_MAXSEG;
+enc_sockopt_key(tcp = L, md5sig = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(tcp, nodelay = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_TCP_NODELAY;
+enc_sockopt_key(tcp = L, noopt = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(tcp = L, nopush = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(tcp = L, syncnt = Opt, _Dir, _D, _T, _P) -> % Only set? 1..255
+ not_supported({L, Opt});
+enc_sockopt_key(tcp = L, user_timeout = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(tcp = L, UnknownOpt, _Dir, _D, _T, _P) ->
+ unknown({L, UnknownOpt});
+
+%% UDP socket options
+enc_sockopt_key(udp, cork = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_UDP_CORK;
+enc_sockopt_key(udp = L, UnknownOpt, _Dir, _D, _T, _P) ->
+ unknown({L, UnknownOpt});
+
+%% SCTP socket options
+enc_sockopt_key(sctp = L, adaption_layer = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = _L, associnfo = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SCTP_ASSOCINFO;
+enc_sockopt_key(sctp = L, auth_active_key = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, auth_asconf = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, auth_chunk = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, auth_key = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, auth_delete_key = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp, autoclose = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SCTP_AUTOCLOSE;
+enc_sockopt_key(sctp = L, context = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, default_send_params = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, delayed_ack_time = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = _L, disable_fragments = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SCTP_DISABLE_FRAGMENTS;
+enc_sockopt_key(sctp = L, hmac_ident = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = _L, events = _Opt, set = _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SCTP_EVENTS;
+enc_sockopt_key(sctp = L, explicit_eor = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, fragment_interleave = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, get_peer_addr_info = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = _L, initmsg = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SCTP_INITMSG;
+enc_sockopt_key(sctp = L, i_want_mapped_v4_addr = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, local_auth_chunks = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = _L, maxseg = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SCTP_MAXSEG;
+enc_sockopt_key(sctp = L, maxburst = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp, nodelay = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SCTP_NODELAY;
+enc_sockopt_key(sctp = L, partial_delivery_point = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, peer_addr_params = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, peer_auth_chunks = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, primary_addr = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, reset_streams = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = _L, rtoinfo = _Opt, _Dir, _D, _T, _P) ->
+ ?SOCKET_OPT_SCTP_RTOINFO;
+enc_sockopt_key(sctp = L, set_peer_primary_addr = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, status = Opt, get = _Dir, _D, _T, _P) ->
+ not_supported({L, Opt}); % ?SOCKET_OPT_SCTP_RTOINFO;
+enc_sockopt_key(sctp = L, use_exp_recvinfo = Opt, _Dir, _D, _T, _P) ->
+ not_supported({L, Opt});
+enc_sockopt_key(sctp = L, UnknownOpt, _Dir, _D, _T, _P) ->
+ unknown({L, UnknownOpt});
+
+%% +++ "Native" socket options +++
+enc_sockopt_key(Level, Opt, set = _Dir, _D, _T, _P)
+ when is_integer(Level) andalso is_integer(Opt) ->
+ Opt;
+enc_sockopt_key(Level, {NativeOpt, ValueSize} = Opt, get = _Dir, _D, _T, _P)
+ when is_integer(Level) andalso
+ is_integer(NativeOpt) andalso
+ ((is_integer(ValueSize) andalso (ValueSize >= 0)) orelse
+ ((ValueSize =:= int) orelse (ValueSize =:= bool))) ->
+ Opt;
+
+enc_sockopt_key(Level, Opt, _Dir, _Domain, _Type, _Protocol) ->
+ unknown({Level, Opt}).
+
+
+
+enc_shutdown_how(read) ->
+ ?SOCKET_SHUTDOWN_HOW_READ;
+enc_shutdown_how(write) ->
+ ?SOCKET_SHUTDOWN_HOW_WRITE;
+enc_shutdown_how(read_write) ->
+ ?SOCKET_SHUTDOWN_HOW_READ_WRITE.
+
+
+
+
+%% ===========================================================================
+%%
+%% Misc utility functions
+%%
+%% ===========================================================================
+
+-dialyzer({nowarn_function, ensure_ip_msfilter_slist/1}).
+ensure_ip_msfilter_slist(SL) ->
+ EnsureSA = fun(SA) when is_tuple(SA) andalso (size(SA) =:= 4) -> ok;
+ (_) -> einval()
+ end,
+ lists:foreach(EnsureSA, SL).
+
+
+ensure_sockaddr(#{family := inet} = SockAddr) ->
+ maps:merge(?SOCKADDR_IN4_DEFAULTS, SockAddr);
+ensure_sockaddr(#{family := inet6} = SockAddr) ->
+ maps:merge(?SOCKADDR_IN6_DEFAULTS, SockAddr);
+ensure_sockaddr(#{family := local, path := Path} = SockAddr)
+ when is_list(Path) andalso
+ (length(Path) > 0) andalso
+ (length(Path) =< 255) ->
+ BinPath = unicode:characters_to_binary(Path, file:native_name_encoding()),
+ ensure_sockaddr(SockAddr#{path => BinPath});
+ensure_sockaddr(#{family := local, path := Path} = SockAddr)
+ when is_binary(Path) andalso
+ (byte_size(Path) > 0) andalso
+ (byte_size(Path) =< 255) ->
+ SockAddr;
+ensure_sockaddr(_SockAddr) ->
+ einval().
+
+
+
+cancel(SockRef, Op, OpRef) ->
+ case nif_cancel(SockRef, Op, OpRef) of
+ %% The select has already completed
+ {error, select_sent} ->
+ flush_select_msgs(SockRef, OpRef);
+ Other ->
+ Other
+ end.
+
+flush_select_msgs(SockRef, Ref) ->
+ receive
+ {select, SockRef, Ref, _} ->
+ flush_select_msgs(SockRef, Ref)
+ after 0 ->
+ ok
+ end.
+
+
+%% formated_timestamp() ->
+%% format_timestamp(os:timestamp()).
+
+%% format_timestamp(Now) ->
+%% N2T = fun(N) -> calendar:now_to_local_time(N) end,
+%% format_timestamp(Now, N2T, true).
+
+%% format_timestamp({_N1, _N2, N3} = N, N2T, true) ->
+%% FormatExtra = ".~.2.0w",
+%% ArgsExtra = [N3 div 10000],
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra);
+%% format_timestamp({_N1, _N2, _N3} = N, N2T, false) ->
+%% FormatExtra = "",
+%% ArgsExtra = [],
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra).
+
+%% format_timestamp(N, N2T, FormatExtra, ArgsExtra) ->
+%% {Date, Time} = N2T(N),
+%% {YYYY,MM,DD} = Date,
+%% {Hour,Min,Sec} = Time,
+%% FormatDate =
+%% io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w" ++ FormatExtra,
+%% [YYYY, MM, DD, Hour, Min, Sec] ++ ArgsExtra),
+%% lists:flatten(FormatDate).
+
+
+%% A timestamp in ms
+
+timestamp(infinity) ->
+ undefined;
+timestamp(_) ->
+ timestamp().
+
+timestamp() ->
+ {A,B,C} = os:timestamp(),
+ A*1000000000+B*1000+(C div 1000).
+
+next_timeout(_, infinity = Timeout) ->
+ Timeout;
+next_timeout(TS, Timeout) ->
+ NewTimeout = Timeout - tdiff(TS, timestamp()),
+ if
+ (NewTimeout > 0) ->
+ NewTimeout;
+ true ->
+ 0
+ end.
+
+tdiff(T1, T2) ->
+ T2 - T1.
+
+
+
+%% p(F) ->
+%% p(F, []).
+
+%% p(F, A) ->
+%% p(get(sname), F, A).
+
+%% p(undefined, F, A) ->
+%% p("***", F, A);
+%% p(SName, F, A) ->
+%% io:format(user,"[~s,~p] " ++ F ++ "~n", [SName, self()|A]),
+%% io:format("[~s,~p] " ++ F ++ "~n", [SName, self()|A]).
+
+
+
+%% ===========================================================================
+%%
+%% Error functions
+%%
+%% ===========================================================================
+
+-spec not_supported(What) -> no_return() when
+ What :: term().
+
+not_supported(What) ->
+ error({not_supported, What}).
+
+-spec unknown(What) -> no_return() when
+ What :: term().
+
+unknown(What) ->
+ error({unknown, What}).
+
+-spec einval() -> no_return().
+
+einval() ->
+ error(einval).
+
+-spec error(Reason) -> no_return() when
+ Reason :: term().
+
+error(Reason) ->
+ throw({error, Reason}).
+
+
+%% ===========================================================================
+%%
+%% Below follows the actual NIF-functions.
+%%
+%% ===========================================================================
+
+nif_info() ->
+ erlang:nif_error(undef).
+
+nif_supports(_Key) ->
+ erlang:nif_error(undef).
+
+nif_open(_Domain, _Type, _Protocol, _Extra) ->
+ erlang:nif_error(undef).
+
+nif_bind(_SRef, _SockAddr) ->
+ erlang:nif_error(undef).
+
+nif_bind(_SRef, _SockAddrs, _Action) ->
+ erlang:nif_error(undef).
+
+nif_connect(_SRef, _SockAddr) ->
+ erlang:nif_error(undef).
+
+nif_finalize_connection(_SRef) ->
+ erlang:nif_error(undef).
+
+nif_listen(_SRef, _Backlog) ->
+ erlang:nif_error(undef).
+
+nif_accept(_SRef, _Ref) ->
+ erlang:nif_error(undef).
+
+nif_send(_SockRef, _SendRef, _Data, _Flags) ->
+ erlang:nif_error(undef).
+
+nif_sendto(_SRef, _SendRef, _Data, _Dest, _Flags) ->
+ erlang:nif_error(undef).
+
+nif_sendmsg(_SRef, _SendRef, _MsgHdr, _Flags) ->
+ erlang:nif_error(undef).
+
+nif_recv(_SRef, _RecvRef, _Length, _Flags) ->
+ erlang:nif_error(undef).
+
+nif_recvfrom(_SRef, _RecvRef, _Length, _Flags) ->
+ erlang:nif_error(undef).
+
+nif_recvmsg(_SRef, _RecvRef, _BufSz, _CtrlSz, _Flags) ->
+ erlang:nif_error(undef).
+
+nif_cancel(_SRef, _Op, _Ref) ->
+ erlang:nif_error(undef).
+
+nif_close(_SRef) ->
+ erlang:nif_error(undef).
+
+nif_shutdown(_SRef, _How) ->
+ erlang:nif_error(undef).
+
+nif_finalize_close(_SRef) ->
+ erlang:nif_error(undef).
+
+nif_setopt(_Ref, _IsEnc, _Lev, _Key, _Val) ->
+ erlang:nif_error(undef).
+
+nif_getopt(_Ref, _IsEnc, _Lev, _Key) ->
+ erlang:nif_error(undef).
+
+nif_sockname(_Ref) ->
+ erlang:nif_error(undef).
+
+nif_peername(_Ref) ->
+ erlang:nif_error(undef).
+
diff --git a/erts/vsn.mk b/erts/vsn.mk
index 9c912a422b..fac608ed4e 100644
--- a/erts/vsn.mk
+++ b/erts/vsn.mk
@@ -18,7 +18,7 @@
# %CopyrightEnd%
#
-VSN = 10.2.3
+VSN = 10.3
# Port number 4365 in 4.2
# Port number 4366 in 4.3
diff --git a/lib/Makefile b/lib/Makefile
index 6605c6145c..ea2827bef0 100644
--- a/lib/Makefile
+++ b/lib/Makefile
@@ -58,10 +58,10 @@ else
SUB_DIRECTORIES = hipe parsetools asn1/src
else
ifdef TERTIARY_BOOTSTRAP
- SUB_DIRECTORIES = snmp sasl jinterface syntax_tools wx
+ SUB_DIRECTORIES = snmp sasl erl_interface jinterface syntax_tools wx
else
ifdef DOC_BOOTSTRAP
- SUB_DIRECTORIES = xmerl edoc erl_docgen
+ SUB_DIRECTORIES = xmerl edoc erl_docgen public_key
else # Not bootstrap build
SUB_DIRECTORIES = $(ERTS_APPLICATIONS) \
$(ERLANG_APPLICATIONS) \
diff --git a/lib/common_test/doc/src/basics_chapter.xml b/lib/common_test/doc/src/basics_chapter.xml
index 95599ca1f1..899a52fa31 100644
--- a/lib/common_test/doc/src/basics_chapter.xml
+++ b/lib/common_test/doc/src/basics_chapter.xml
@@ -125,7 +125,7 @@
The test case is the smallest unit that the <c>Common Test</c> test server deals with.
</p>
<p>
- Subsets of test cases, called test case groups, can also be defined. A test case
+ Sets of test cases, called test case groups, can also be defined. A test case
group can have execution properties associated with it. Execution properties
specify if the test cases in the group are to be executed in
random order, in parallel, or in sequence, and if the execution of the group
diff --git a/lib/common_test/doc/src/ct_telnet.xml b/lib/common_test/doc/src/ct_telnet.xml
index 9a12ce79ed..76f5305c46 100644
--- a/lib/common_test/doc/src/ct_telnet.xml
+++ b/lib/common_test/doc/src/ct_telnet.xml
@@ -239,18 +239,21 @@
<v>Connection = connection()</v>
<v>Cmd = string()</v>
<v>Opts = [Opt]</v>
- <v>Opt = {timeout, timeout()} | {newline, boolean()}</v>
+ <v>Opt = {timeout, timeout()} | {newline, boolean() | string()}</v>
<v>Data = [string()]</v>
<v>Reason = term()</v>
</type>
<desc><marker id="cmd-3"/>
<p>Sends a command through Telnet and waits for prompt.</p>
- <p>By default, this function adds a new line to the end of the
+ <p>By default, this function adds "\n" to the end of the
specified command. If this is not desired, use option
<c>{newline,false}</c>. This is necessary, for example, when
sending Telnet command sequences prefixed with character
- Interprete As Command (IAC).</p>
+ Interpret As Command (IAC). Option <c>{newline,string()}</c>
+ can also be used if a different line end than "\n" is
+ required, for instance <c>{newline,"\r\n"}</c>, to add both
+ carriage return and newline characters.</p>
<p>Option <c>timeout</c> specifies how long the client must wait
for prompt. If the time expires, the function returns
@@ -280,7 +283,7 @@
<v>CmdFormat = string()</v>
<v>Args = list()</v>
<v>Opts = [Opt]</v>
- <v>Opt = {timeout, timeout()} | {newline, boolean()}</v>
+ <v>Opt = {timeout, timeout()} | {newline, boolean() | string()}</v>
<v>Data = [string()]</v>
<v>Reason = term()</v>
</type>
@@ -339,7 +342,7 @@
subexpression number <c>N</c>. Subexpressions are denoted with
<c>'(' ')'</c> in the regular expression.</p>
- <p>If a <c>Tag</c> is speciifed, the returned <c>Match</c> also
+ <p>If a <c>Tag</c> is specified, the returned <c>Match</c> also
includes the matched <c>Tag</c>. Otherwise, only <c>RxMatch</c>
is returned.</p>
@@ -382,7 +385,7 @@
can abort the operation of waiting for prompt.</p></item>
<tag><c>repeat | repeat, N</c></tag>
<item><p>The pattern(s) must be matched multiple times. If <c>N</c>
- is speciified, the pattern(s) are matched <c>N</c> times, and
+ is specified, the pattern(s) are matched <c>N</c> times, and
the function returns <c>HaltReason = done</c>. This option can be
interrupted by one or more <c>HaltPatterns</c>. <c>MatchList</c>
is always returned, that is, a list of <c>Match</c> instead of
@@ -547,17 +550,20 @@
<v>Connection = connection()</v>
<v>Cmd = string()</v>
<v>Opts = [Opt]</v>
- <v>Opt = {newline, boolean()}</v>
+ <v>Opt = {newline, boolean() | string()}</v>
<v>Reason = term()</v>
</type>
<desc><marker id="send-3"/>
<p>Sends a Telnet command and returns immediately.</p>
- <p>By default, this function adds a newline to the end of the
+ <p>By default, this function adds "\n" to the end of the
specified command. If this is not desired, option
<c>{newline,false}</c> can be used. This is necessary, for example,
when sending Telnet command sequences prefixed with character
- Interprete As Command (IAC).</p>
+ Interpret As Command (IAC). Option <c>{newline,string()}</c>
+ can also be used if a different line end than "\n" is
+ required, for instance <c>{newline,"\r\n"}</c>, to add both
+ carriage return and newline characters.</p>
<p>The resulting output from the command can be read with
<seealso marker="#get_data-1"><c>ct_telnet:get_data/2</c></seealso> or
@@ -584,12 +590,15 @@
<v>CmdFormat = string()</v>
<v>Args = list()</v>
<v>Opts = [Opt]</v>
- <v>Opt = {newline, boolean()}</v>
+ <v>Opt = {newline, boolean() | string()}</v>
<v>Reason = term()</v>
</type>
<desc><marker id="sendf-4"/>
<p>Sends a Telnet command and returns immediately (uses a format
string and a list of arguments to build the command).</p>
+
+ <p>For details, see
+ <seealso marker="#send-3"><c>ct_telnet:send/3</c></seealso>.</p>
</desc>
</func>
</funcs>
diff --git a/lib/common_test/doc/src/notes.xml b/lib/common_test/doc/src/notes.xml
index dc18def838..c8e0722a0f 100644
--- a/lib/common_test/doc/src/notes.xml
+++ b/lib/common_test/doc/src/notes.xml
@@ -33,6 +33,66 @@
<file>notes.xml</file>
</header>
+<section><title>Common_Test 1.17</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ A bug caused <c>ct:encrypt_config_file/3</c> and
+ <c>ct:decrypt_config_file/3</c> to fail with
+ <c>badmatch</c> if input parameter <c>KeyOrFile</c> was
+ <c>{key,string()}</c>. This is now corrected.</p>
+ <p>
+ Own Id: OTP-15540</p>
+ </item>
+ <item>
+ <p>
+ The status of a test case which failed with timetrap
+ timeout in <c>end_per_testcase</c> could not be modified
+ by returning <c>{fail,Reason}</c> from a
+ <c>post_end_per_testcase</c> hook function. This is now
+ corrected.</p>
+ <p>
+ Own Id: OTP-15584 Aux Id: ERIERL-282 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ A new variant of the <c>newline</c> option to
+ <c>ct_telnet:cmd/3</c> and <c>ct_telnet:send/3</c> is
+ added, which allows to specify a string to append as
+ newline indicator on a command. By default, the value is
+ "\n", but in some cases it is required to be "\r\n",
+ which this option allows.</p>
+ <p>
+ A faulty regular expression given as parameter to
+ <c>ct_telnet:expect/2,3</c> would earlier crash and look
+ like an internal error in common_test. A better error
+ indication is now given, but the test case will still
+ fail.</p>
+ <p>
+ Own Id: OTP-15229 Aux Id: ERIERL-203 </p>
+ </item>
+ <item>
+ <p>
+ Since the yang RFC allows more than one top element of
+ config data in an <c>edit-config</c> element,
+ <c>ct_netconfc:edit_config/3,4,5</c> can now take a list
+ of XML elements.</p>
+ <p>
+ Own Id: OTP-15298</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Common_Test 1.16.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -75,6 +135,44 @@
</section>
+<section><title>Common_Test 1.15.4.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The status of a test case which failed with timetrap
+ timeout in <c>end_per_testcase</c> could not be modified
+ by returning <c>{fail,Reason}</c> from a
+ <c>post_end_per_testcase</c> hook function. This is now
+ corrected.</p>
+ <p>
+ Own Id: OTP-15584 Aux Id: ERIERL-282 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Common_Test 1.15.4.0.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The status of a test case which failed with timetrap
+ timeout in <c>end_per_testcase</c> could not be modified
+ by returning <c>{fail,Reason}</c> from a
+ <c>post_end_per_testcase</c> hook function. This is now
+ corrected.</p>
+ <p>
+ Own Id: OTP-15584 Aux Id: ERIERL-282 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Common_Test 1.15.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -4026,8 +4124,3 @@
<section><title>common_test 1.3.0</title>
</section>
</chapter>
-
-
-
-
-
diff --git a/lib/common_test/src/ct_cover.erl b/lib/common_test/src/ct_cover.erl
index d286f20a4d..bcd98dcc58 100644
--- a/lib/common_test/src/ct_cover.erl
+++ b/lib/common_test/src/ct_cover.erl
@@ -262,6 +262,11 @@ get_app_info(App=#cover{app=Name}, [{src_files,Name,Src1}|Terms], Dir) ->
Src = App#cover.src,
get_app_info(App#cover{src=Src++Src1},Terms,Dir);
+get_app_info(App=#cover{app=none}, [{local_only,Bool}|Terms], Dir) ->
+ get_app_info(App, [{local_only,none,Bool}|Terms], Dir);
+get_app_info(App=#cover{app=Name}, [{local_only,Name,Bool}|Terms], Dir) ->
+ get_app_info(App#cover{local_only=Bool},Terms,Dir);
+
get_app_info(App, [_|Terms], Dir) ->
get_app_info(App, Terms, Dir);
diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl
index 29188a648e..6a758c4ea3 100644
--- a/lib/common_test/src/ct_netconfc.erl
+++ b/lib/common_test/src/ct_netconfc.erl
@@ -583,7 +583,7 @@ get_config(Client, Source, Filter, Timeout) ->
-spec edit_config(Client, Target, Config) -> Result when
Client :: client(),
Target :: netconf_db(),
- Config :: simple_xml(),
+ Config :: simple_xml() | [simple_xml()],
Result :: ok | {error,error_reason()}.
edit_config(Client, Target, Config) ->
edit_config(Client, Target, Config, ?DEFAULT_TIMEOUT).
@@ -591,7 +591,7 @@ edit_config(Client, Target, Config) ->
-spec edit_config(Client, Target, Config, OptParams) -> Result when
Client :: client(),
Target :: netconf_db(),
- Config :: simple_xml(),
+ Config :: simple_xml() | [simple_xml()],
OptParams :: [simple_xml()],
Result :: ok | {error,error_reason()};
(Client, Target, Config, Timeout) -> Result when
@@ -608,10 +608,12 @@ edit_config(Client, Target, Config, OptParams) when is_list(OptParams) ->
-spec edit_config(Client, Target, Config, OptParams, Timeout) -> Result when
Client :: client(),
Target :: netconf_db(),
- Config :: simple_xml(),
+ Config :: simple_xml() | [simple_xml()],
OptParams :: [simple_xml()],
Timeout :: timeout(),
Result :: ok | {error,error_reason()}.
+edit_config(Client, Target, Config, OptParams, Timeout) when not is_list(Config)->
+ edit_config(Client, Target, [Config], OptParams, Timeout);
edit_config(Client, Target, Config, OptParams, Timeout) ->
call(Client, {send_rpc_op, edit_config, [Target,Config,OptParams], Timeout}).
@@ -1113,7 +1115,7 @@ encode_rpc_operation(get,[Filter]) ->
encode_rpc_operation(get_config,[Source,Filter]) ->
{'get-config',[{source,[Source]}] ++ filter(Filter)};
encode_rpc_operation(edit_config,[Target,Config,OptParams]) ->
- {'edit-config',[{target,[Target]}] ++ OptParams ++ [{config,[Config]}]};
+ {'edit-config',[{target,[Target]}] ++ OptParams ++ [{config,Config}]};
encode_rpc_operation(delete_config,[Target]) ->
{'delete-config',[{target,[Target]}]};
encode_rpc_operation(copy_config,[Target,Source]) ->
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index c9d406f1fd..960252a6fe 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -2345,18 +2345,24 @@ start_cover(Opts=#opts{coverspec=CovData,cover_stop=CovStop},LogDir) ->
CovImport,
_CovExport,
#cover{app = CovApp,
+ local_only = LocalOnly,
level = CovLevel,
excl_mods = CovExcl,
incl_mods = CovIncl,
cross = CovCross,
src = _CovSrc}} = CovData,
+ case LocalOnly of
+ true -> cover:local_only();
+ false -> ok
+ end,
ct_logs:log("COVER INFO",
"Using cover specification file: ~ts~n"
"App: ~w~n"
+ "Local only: ~w~n"
"Cross cover: ~w~n"
"Including ~w modules~n"
"Excluding ~w modules",
- [CovFile,CovApp,CovCross,
+ [CovFile,CovApp,LocalOnly,CovCross,
length(CovIncl),length(CovExcl)]),
%% Tell test_server to print a link in its coverlog
diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl
index 58a29edace..219f58dcf5 100644
--- a/lib/common_test/src/ct_telnet.erl
+++ b/lib/common_test/src/ct_telnet.erl
@@ -194,6 +194,15 @@ send(Connection,Cmd,Opts) ->
check_send_opts([{newline,Bool}|Opts]) when is_boolean(Bool) ->
check_send_opts(Opts);
+check_send_opts([{newline,String}|Opts]) when is_list(String) ->
+ case lists:all(fun(I) when is_integer(I), I>=0, I=<127 -> true;
+ (_) -> false
+ end, String) of
+ true ->
+ check_send_opts(Opts);
+ false ->
+ {error,{invalid_option,{newline,String}}}
+ end;
check_send_opts([Invalid|_]) ->
{error,{invalid_option,Invalid}};
check_send_opts([]) ->
@@ -211,10 +220,16 @@ expect(Connection,Patterns) ->
expect(Connection,Patterns,Opts) ->
case get_handle(Connection) of
- {ok,Pid} ->
- call(Pid,{expect,Patterns,Opts});
- Error ->
- Error
+ {ok,Pid} ->
+ case call(Pid,{expect,Patterns,Opts}) of
+ {error,Reason} when element(1,Reason)==bad_pattern ->
+ %% Faulty user input - should fail the test case
+ exit({Reason,{?MODULE,?FUNCTION_NAME,3}});
+ Other ->
+ Other
+ end;
+ Error ->
+ Error
end.
%%%=================================================================
@@ -674,60 +689,68 @@ silent_teln_expect(Name,Pid,Data,Pattern,Prx,Opts) ->
%% 3b) Repeat (sequence): 2) is repeated either N times or until a
%% halt condition is fulfilled.
teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) ->
- HaltPatterns =
+ HaltPatterns0 =
case get_ignore_prompt(Opts) of
true ->
get_haltpatterns(Opts);
false ->
[prompt | get_haltpatterns(Opts)]
end,
-
- PromptCheck = get_prompt_check(Opts),
-
- {WaitForPrompt,Pattern1,Opts1} = wait_for_prompt(Pattern0,Opts),
-
- Seq = get_seq(Opts1),
- Pattern2 = convert_pattern(Pattern1,Seq),
- {IdleTimeout,TotalTimeout} = get_timeouts(Opts1),
-
- EO = #eo{teln_pid=Pid,
- prx=Prx,
- idle_timeout=IdleTimeout,
- total_timeout=TotalTimeout,
- seq=Seq,
- haltpatterns=HaltPatterns,
- prompt_check=PromptCheck},
+ case convert_pattern(HaltPatterns0,false) of
+ {ok,HaltPatterns} ->
+ {WaitForPrompt,Pattern1,Opts1} = wait_for_prompt(Pattern0,Opts),
+ Seq = get_seq(Opts1),
+ case convert_pattern(Pattern1,Seq) of
+ {ok,Pattern2} ->
+ {IdleTimeout,TotalTimeout} = get_timeouts(Opts1),
+ PromptCheck = get_prompt_check(Opts1),
+
+ EO = #eo{teln_pid=Pid,
+ prx=Prx,
+ idle_timeout=IdleTimeout,
+ total_timeout=TotalTimeout,
+ seq=Seq,
+ haltpatterns=HaltPatterns,
+ prompt_check=PromptCheck},
- case get_repeat(Opts1) of
- false ->
- case teln_expect1(Name,Pid,Data,Pattern2,[],EO) of
- {ok,Matched,Rest} when WaitForPrompt ->
- case lists:reverse(Matched) of
- [{prompt,_},Matched1] ->
- {ok,Matched1,Rest};
- [{prompt,_}|Matched1] ->
- {ok,lists:reverse(Matched1),Rest}
- end;
- {ok,Matched,Rest} ->
- {ok,Matched,Rest};
- {halt,Why,Rest} ->
- {error,Why,Rest};
- {error,Reason} ->
- {error,Reason}
- end;
- N ->
- EO1 = EO#eo{repeat=N},
- repeat_expect(Name,Pid,Data,Pattern2,[],EO1)
+ case get_repeat(Opts1) of
+ false ->
+ case teln_expect1(Name,Pid,Data,Pattern2,[],EO) of
+ {ok,Matched,Rest} when WaitForPrompt ->
+ case lists:reverse(Matched) of
+ [{prompt,_},Matched1] ->
+ {ok,Matched1,Rest};
+ [{prompt,_}|Matched1] ->
+ {ok,lists:reverse(Matched1),Rest}
+ end;
+ {ok,Matched,Rest} ->
+ {ok,Matched,Rest};
+ {halt,Why,Rest} ->
+ {error,Why,Rest};
+ {error,Reason} ->
+ {error,Reason}
+ end;
+ N ->
+ EO1 = EO#eo{repeat=N},
+ repeat_expect(Name,Pid,Data,Pattern2,[],EO1)
+ end;
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
end.
-convert_pattern(Pattern,Seq)
- when is_list(Pattern) and not is_integer(hd(Pattern)) ->
- case Seq of
- true -> Pattern;
- false -> rm_dupl(Pattern,[])
- end;
+convert_pattern(Pattern0,Seq)
+ when Pattern0==[] orelse (is_list(Pattern0) and not is_integer(hd(Pattern0))) ->
+ Pattern =
+ case Seq of
+ true -> Pattern0;
+ false -> rm_dupl(Pattern0,[])
+ end,
+ compile_pattern(Pattern,[]);
convert_pattern(Pattern,_Seq) ->
- [Pattern].
+ compile_pattern([Pattern],[]).
rm_dupl([P|Ps],Acc) ->
case lists:member(P,Acc) of
@@ -739,6 +762,25 @@ rm_dupl([P|Ps],Acc) ->
rm_dupl([],Acc) ->
lists:reverse(Acc).
+compile_pattern([prompt|Patterns],Acc) ->
+ compile_pattern(Patterns,[prompt|Acc]);
+compile_pattern([{prompt,_}=P|Patterns],Acc) ->
+ compile_pattern(Patterns,[P|Acc]);
+compile_pattern([{Tag,Pattern}|Patterns],Acc) ->
+ try re:compile(Pattern,[unicode]) of
+ {ok,MP} -> compile_pattern(Patterns,[{Tag,MP}|Acc]);
+ {error,Error} -> {error,{bad_pattern,{Tag,Pattern},Error}}
+ catch error:badarg -> {error,{bad_pattern,{Tag,Pattern}}}
+ end;
+compile_pattern([Pattern|Patterns],Acc) ->
+ try re:compile(Pattern,[unicode]) of
+ {ok,MP} -> compile_pattern(Patterns,[MP|Acc]);
+ {error,Error} -> {error,{bad_pattern,Pattern,Error}}
+ catch error:badarg -> {error,{bad_pattern,Pattern}}
+ end;
+compile_pattern([],Acc) ->
+ {ok,lists:reverse(Acc)}.
+
get_timeouts(Opts) ->
{case lists:keysearch(idle_timeout,1,Opts) of
{value,{_,T}} ->
@@ -772,7 +814,7 @@ get_seq(Opts) ->
get_haltpatterns(Opts) ->
case lists:keysearch(halt,1,Opts) of
{value,{halt,HaltPatterns}} ->
- convert_pattern(HaltPatterns,false);
+ HaltPatterns;
false ->
[]
end.
@@ -1068,7 +1110,7 @@ match_line(Name,Pid,Line,[{prompt,PromptType}|Patterns],FoundPrompt,Term,
when PromptType=/=FoundPrompt ->
match_line(Name,Pid,Line,Patterns,FoundPrompt,Term,EO,RetTag);
match_line(Name,Pid,Line,[{Tag,Pattern}|Patterns],FoundPrompt,Term,EO,RetTag) ->
- case re:run(Line,Pattern,[{capture,all,list},unicode]) of
+ case re:run(Line,Pattern,[{capture,all,list}]) of
nomatch ->
match_line(Name,Pid,Line,Patterns,FoundPrompt,Term,EO,RetTag);
{match,Match} ->
@@ -1076,7 +1118,7 @@ match_line(Name,Pid,Line,[{Tag,Pattern}|Patterns],FoundPrompt,Term,EO,RetTag) ->
{RetTag,{Tag,Match}}
end;
match_line(Name,Pid,Line,[Pattern|Patterns],FoundPrompt,Term,EO,RetTag) ->
- case re:run(Line,Pattern,[{capture,all,list},unicode]) of
+ case re:run(Line,Pattern,[{capture,all,list}]) of
nomatch ->
match_line(Name,Pid,Line,Patterns,FoundPrompt,Term,EO,RetTag);
{match,Match} ->
diff --git a/lib/common_test/src/ct_telnet_client.erl b/lib/common_test/src/ct_telnet_client.erl
index 76e4b9ea70..007477c855 100644
--- a/lib/common_test/src/ct_telnet_client.erl
+++ b/lib/common_test/src/ct_telnet_client.erl
@@ -101,9 +101,11 @@ close(Pid) ->
end.
send_data(Pid, Data) ->
- send_data(Pid, Data, true).
+ send_data(Pid, Data, "\n").
send_data(Pid, Data, true) ->
- send_data(Pid, Data++"\n", false);
+ send_data(Pid, Data, "\n");
+send_data(Pid, Data, Newline) when is_list(Newline) ->
+ send_data(Pid, Data++Newline, false);
send_data(Pid, Data, false) ->
Pid ! {send_data, Data},
ok.
diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl
index 039c8168ec..d5c93d05ba 100644
--- a/lib/common_test/src/ct_util.hrl
+++ b/lib/common_test/src/ct_util.hrl
@@ -62,6 +62,7 @@
merge_tests=true}).
-record(cover, {app=none,
+ local_only=false,
level=details,
excl_mods=[],
incl_mods=[],
diff --git a/lib/common_test/src/test_server.erl b/lib/common_test/src/test_server.erl
index a896a0551b..9eda3f2152 100644
--- a/lib/common_test/src/test_server.erl
+++ b/lib/common_test/src/test_server.erl
@@ -850,17 +850,23 @@ spawn_fw_call(Mod,EPTC={end_per_testcase,Func},EndConf,Pid,
"WARNING: end_per_testcase failed!</font>",
{died,W}
end,
- try do_end_tc_call(Mod,EPTC,{Pid,Report,[EndConf]}, Why) of
- _ -> ok
- catch
- _:FwEndTCErr ->
- exit({fw_notify_done,end_tc,FwEndTCErr})
- end,
- FailLoc = proplists:get_value(tc_fail_loc, EndConf),
+ FailLoc0 = proplists:get_value(tc_fail_loc, EndConf),
+ {RetVal1,FailLoc} =
+ try do_end_tc_call(Mod,EPTC,{Pid,Report,[EndConf]}, Why) of
+ Why ->
+ {RetVal,FailLoc0};
+ {failed,_} = R ->
+ {R,[{Mod,Func}]};
+ R ->
+ {R,FailLoc0}
+ catch
+ _:FwEndTCErr ->
+ exit({fw_notify_done,end_tc,FwEndTCErr})
+ end,
%% finished, report back (if end_per_testcase fails, a warning
%% should be printed as part of the comment)
SendTo ! {self(),fw_notify_done,
- {Time,RetVal,FailLoc,[],Warn}}
+ {Time,RetVal1,FailLoc,[],Warn}}
end,
spawn_link(FwCall);
@@ -902,14 +908,25 @@ spawn_fw_call(Mod,Func,CurrConf,Pid,Error,Loc,SendTo) ->
FwErrorNotifyErr})
end,
Conf = [{tc_status,{failed,Error}}|CurrConf],
- try do_end_tc_call(Mod,EndTCFunc,{Pid,Error,[Conf]},Error) of
- _ -> ok
- catch
- _:FwEndTCErr ->
- exit({fw_notify_done,end_tc,FwEndTCErr})
- end,
+ {Time,RetVal,Loc1} =
+ try do_end_tc_call(Mod,EndTCFunc,{Pid,Error,[Conf]},Error) of
+ Error ->
+ {died, Error, Loc};
+ {failed,Reason} = NewReturn ->
+ fw_error_notify(Mod,Func1,Conf,Reason),
+ {died, NewReturn, [{Mod,Func}]};
+ NewReturn ->
+ T = case Error of
+ {timetrap_timeout,TT} -> TT;
+ _ -> 0
+ end,
+ {T, NewReturn, Loc}
+ catch
+ _:FwEndTCErr ->
+ exit({fw_notify_done,end_tc,FwEndTCErr})
+ end,
%% finished, report back
- SendTo ! {self(),fw_notify_done,{died,Error,Loc,[],undefined}}
+ SendTo ! {self(),fw_notify_done,{Time,RetVal,Loc1,[],undefined}}
end,
spawn_link(FwCall).
diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl
index 0f5636a789..44b86b1dfe 100644
--- a/lib/common_test/test/ct_hooks_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE.erl
@@ -84,7 +84,7 @@ all(suite) ->
fail_post_suite_cth, skip_pre_suite_cth, skip_pre_end_cth,
skip_pre_init_tc_cth,
skip_post_suite_cth, recover_post_suite_cth, update_config_cth,
- state_update_cth, options_cth, same_id_cth,
+ state_update_cth, update_result_cth, options_cth, same_id_cth,
fail_n_skip_with_minimal_cth, prio_cth, no_config,
no_init_suite_config, no_init_config, no_end_config,
failed_sequence, repeat_force_stop, config_clash,
@@ -209,6 +209,10 @@ state_update_cth(Config) when is_list(Config) ->
do_test(state_update_cth, "ct_cth_fail_one_skip_one_SUITE.erl",
[state_update_cth,state_update_cth],Config).
+update_result_cth(Config) ->
+ do_test(update_result_cth, "ct_cth_update_result_post_end_tc_SUITE.erl",
+ [update_result_post_end_tc_cth],Config).
+
options_cth(Config) when is_list(Config) ->
do_test(options_cth, "ct_cth_empty_SUITE.erl",
[{empty_cth,[test]}],Config).
@@ -1099,6 +1103,106 @@ test_events(state_update_cth) ->
{?eh,stop_logging,[]}
];
+test_events(update_result_cth) ->
+ Suite = ct_cth_update_result_post_end_tc_SUITE,
+ [
+ {?eh,start_logging,'_'},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',init,['_',[]]}},
+ {?eh,tc_start,{Suite,init_per_suite}},
+ {?eh,tc_done,{Suite,init_per_suite,ok}},
+
+ {?eh,tc_start,{Suite,tc_ok_to_fail}},
+ {?eh,cth,{'_',post_end_per_testcase,[Suite,tc_ok_to_fail,'_',ok,[]]}},
+ {?eh,tc_done,{Suite,tc_ok_to_fail,{failed,{error,"Test failure"}}}},
+ {?eh,cth,{'_',on_tc_fail,'_'}},
+ {?eh,test_stats,{0,1,{0,0}}},
+
+ {?eh,tc_start,{Suite,tc_ok_to_skip}},
+ {?eh,cth,{'_',post_end_per_testcase,[Suite,tc_ok_to_skip,'_',ok,[]]}},
+ {?eh,tc_done,{Suite,tc_ok_to_skip,{skipped,"Test skipped"}}},
+ {?eh,cth,{'_',on_tc_skip,'_'}},
+ {?eh,test_stats,{0,1,{1,0}}},
+
+ {?eh,tc_start,{Suite,tc_fail_to_ok}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,tc_fail_to_ok,'_',
+ {error,{test_case_failed,"should be changed to ok"}},[]]}},
+ {?eh,tc_done,{Suite,tc_fail_to_ok,ok}},
+ {?eh,test_stats,{1,1,{1,0}}},
+
+ {?eh,tc_start,{Suite,tc_fail_to_skip}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,tc_fail_to_skip,'_',
+ {error,{test_case_failed,"should be changed to skip"}},[]]}},
+ {?eh,tc_done,{Suite,tc_fail_to_skip,{skipped,"Test skipped"}}},
+ {?eh,cth,{'_',on_tc_skip,'_'}},
+ {?eh,test_stats,{1,1,{2,0}}},
+
+ {?eh,tc_start,{Suite,tc_timetrap_to_ok}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,tc_timetrap_to_ok,'_',{timetrap_timeout,3000},[]]}},
+ {?eh,tc_done,{Suite,tc_timetrap_to_ok,ok}},
+ {?eh,test_stats,{2,1,{2,0}}},
+
+ {?eh,tc_start,{Suite,tc_timetrap_to_skip}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,tc_timetrap_to_skip,'_',{timetrap_timeout,3000},[]]}},
+ {?eh,tc_done,{Suite,tc_timetrap_to_skip,{skipped,"Test skipped"}}},
+ {?eh,cth,{'_',on_tc_skip,'_'}},
+ {?eh,test_stats,{2,1,{3,0}}},
+
+ {?eh,tc_start,{Suite,tc_skip_to_fail}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,tc_skip_to_fail,'_',
+ {skip,"should be changed to fail"},[]]}},
+ {?eh,tc_done,{Suite,tc_skip_to_fail,{failed,{error,"Test failure"}}}},
+ {?eh,cth,{'_',on_tc_fail,'_'}},
+ {?eh,test_stats,{2,2,{3,0}}},
+
+ {?eh,tc_start,{Suite,end_fail_to_fail}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,end_fail_to_fail,'_',
+ {failed,
+ {Suite,end_per_testcase,
+ {'EXIT',{test_case_failed,"change result when end fails"}}}},[]]}},
+ {?eh,tc_done,{Suite,end_fail_to_fail,{failed,{error,"Test failure"}}}},
+ {?eh,cth,{'_',on_tc_fail,'_'}},
+ {?eh,test_stats,{2,3,{3,0}}},
+
+ {?eh,tc_start,{Suite,end_fail_to_skip}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,end_fail_to_skip,'_',
+ {failed,
+ {Suite,end_per_testcase,
+ {'EXIT',{test_case_failed,"change result when end fails"}}}},[]]}},
+ {?eh,tc_done,{Suite,end_fail_to_skip,{skipped,"Test skipped"}}},
+ {?eh,cth,{'_',on_tc_skip,'_'}},
+ {?eh,test_stats,{2,3,{4,0}}},
+
+ {?eh,tc_start,{Suite,end_timetrap_to_fail}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,end_timetrap_to_fail,'_',
+ {failed,{Suite,end_per_testcase,{timetrap_timeout,3000}}},[]]}},
+ {?eh,tc_done,{Suite,end_timetrap_to_fail,{failed,{error,"Test failure"}}}},
+ {?eh,cth,{'_',on_tc_fail,'_'}},
+ {?eh,test_stats,{2,4,{4,0}}},
+
+ {?eh,tc_start,{Suite,end_timetrap_to_skip}},
+ {?eh,cth,{'_',post_end_per_testcase,
+ [Suite,end_timetrap_to_skip,'_',
+ {failed,{Suite,end_per_testcase,{timetrap_timeout,3000}}},[]]}},
+ {?eh,tc_done,{Suite,end_timetrap_to_skip,{skipped,"Test skipped"}}},
+ {?eh,cth,{'_',on_tc_skip,'_'}},
+ {?eh,test_stats,{2,4,{5,0}}},
+
+ {?eh,tc_start,{Suite,end_per_suite}},
+ {?eh,tc_done,{Suite,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,cth,{'_',terminate,[[]]}},
+ {?eh,stop_logging,[]}
+ ];
+
test_events(options_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_cth_update_result_post_end_tc_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_cth_update_result_post_end_tc_SUITE.erl
new file mode 100644
index 0000000000..a16138ce6f
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_cth_update_result_post_end_tc_SUITE.erl
@@ -0,0 +1,101 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ct_cth_update_result_post_end_tc_SUITE).
+
+-compile(export_all).
+
+-include("ct.hrl").
+
+suite() ->
+ [{timetrap,{seconds,3}}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(Config) ->
+ ok.
+
+init_per_group(_,Config) ->
+ Config.
+
+end_per_group(_,_) ->
+ ok.
+
+init_per_testcase(_,Config) ->
+ Config.
+
+end_per_testcase(EndTimetrap,_) when EndTimetrap==end_timetrap_to_fail;
+ EndTimetrap==end_timetrap_to_skip->
+ timer:sleep(10000);
+end_per_testcase(EndFail,_) when EndFail==end_fail_to_fail;
+ EndFail==end_fail_to_skip->
+ ct:fail("change result when end fails");
+end_per_testcase(_,_) ->
+ ok.
+
+all() ->
+ [tc_ok_to_fail,
+ tc_ok_to_skip,
+ tc_fail_to_ok,
+ tc_fail_to_skip,
+ tc_timetrap_to_ok,
+ tc_timetrap_to_skip,
+ tc_skip_to_fail,
+ end_fail_to_fail,
+ end_fail_to_skip,
+ end_timetrap_to_fail,
+ end_timetrap_to_skip].
+
+%% Test cases starts here.
+tc_ok_to_fail(_Config) ->
+ ok.
+
+tc_ok_to_skip(_Config) ->
+ ok.
+
+tc_fail_to_ok(_Config) ->
+ ct:fail("should be changed to ok").
+
+tc_fail_to_skip(_Config) ->
+ ct:fail("should be changed to skip").
+
+tc_timetrap_to_ok(_Config) ->
+ timer:sleep(10000), % will time out after 3 sek
+ ok.
+
+tc_timetrap_to_skip(_Config) ->
+ timer:sleep(10000), % will time out after 3 sek
+ ok.
+
+tc_skip_to_fail(_Config) ->
+ {skip,"should be changed to fail"}.
+
+end_fail_to_fail(_Config) ->
+ ok.
+
+end_fail_to_skip(_Config) ->
+ ok.
+
+end_timetrap_to_fail(_Config) ->
+ ok.
+
+end_timetrap_to_skip(_Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_result_post_end_tc_cth.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_result_post_end_tc_cth.erl
new file mode 100644
index 0000000000..7afb3d8781
--- /dev/null
+++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/update_result_post_end_tc_cth.erl
@@ -0,0 +1,98 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+
+-module(update_result_post_end_tc_cth).
+
+
+-include_lib("common_test/src/ct_util.hrl").
+-include_lib("common_test/include/ct_event.hrl").
+
+
+%% CT Hooks
+-compile(export_all).
+
+init(Id, Opts) ->
+ empty_cth:init(Id, Opts).
+
+pre_init_per_suite(Suite, Config, State) ->
+ empty_cth:pre_init_per_suite(Suite,Config,State).
+
+post_init_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_init_per_suite(Suite,Config,Return,State).
+
+pre_end_per_suite(Suite,Config,State) ->
+ empty_cth:pre_end_per_suite(Suite,Config,State).
+
+post_end_per_suite(Suite,Config,Return,State) ->
+ empty_cth:post_end_per_suite(Suite,Config,Return,State).
+
+pre_init_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_init_per_group(Suite,Group,Config,State).
+
+post_init_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_init_per_group(Suite,Group,Config,Return,State).
+
+pre_end_per_group(Suite,Group,Config,State) ->
+ empty_cth:pre_end_per_group(Suite,Group,Config,State).
+
+post_end_per_group(Suite,Group,Config,Return,State) ->
+ empty_cth:post_end_per_group(Suite,Group,Config,Return,State).
+
+pre_init_per_testcase(Suite,TC,Config,State) ->
+ empty_cth:pre_init_per_testcase(Suite,TC,Config,State).
+
+post_end_per_testcase(Suite,TC,Config,Return,State) ->
+ empty_cth:post_end_per_testcase(Suite,TC,Config,Return,State),
+ change_result(TC,Config,State).
+
+on_tc_fail(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_fail(Suite,TC,Reason,State).
+
+on_tc_skip(Suite,TC, Reason, State) ->
+ empty_cth:on_tc_skip(Suite,TC,Reason,State).
+
+terminate(State) ->
+ empty_cth:terminate(State).
+
+%%%-----------------------------------------------------------------
+%%%
+change_result(tc_ok_to_fail,_Config,State) ->
+ {{fail, "Test failure"}, State};
+change_result(tc_ok_to_skip,_Config,State) ->
+ {{skip, "Test skipped"}, State};
+change_result(tc_fail_to_ok,Config,State) ->
+ {lists:keydelete(tc_status,1,Config),State};
+change_result(tc_fail_to_skip,Config,State) ->
+ {{skip,"Test skipped"},State};
+change_result(tc_timetrap_to_ok,Config,State) ->
+ {lists:keydelete(tc_status,1,Config),State};
+change_result(tc_timetrap_to_skip,Config,State) ->
+ {{skip,"Test skipped"},State};
+change_result(tc_skip_to_fail,_Config,State) ->
+ {{fail, "Test failure"}, State};
+change_result(end_fail_to_fail,_Config,State) ->
+ {{fail, "Test failure"}, State};
+change_result(end_fail_to_skip,_Config,State) ->
+ {{skip, "Test skipped"}, State};
+change_result(end_timetrap_to_fail,_Config,State) ->
+ {{fail, "Test failure"}, State};
+change_result(end_timetrap_to_skip,_Config,State) ->
+ {{skip, "Test skipped"}, State}.
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
index 0a374d7404..7aaf33839f 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
@@ -440,6 +440,12 @@ edit_config(Config) ->
?ok = ct_netconfc:edit_config(Client,running,
{server,[{xmlns,"myns"}],
[{name,["myserver"]}]}),
+ ?NS:expect_reply('edit-config',ok),
+ ?ok = ct_netconfc:edit_config(Client,running,
+ [{server,[{xmlns,"myns"}],
+ [{name,["server1"]}]},
+ {server,[{xmlns,"myns"}],
+ [{name,["server2"]}]}]),
?NS:expect_do_reply('close-session',close,ok),
?ok = ct_netconfc:close_session(Client),
ok.
diff --git a/lib/common_test/test/ct_telnet_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE.erl
index a0089c9bc9..f71b7c370f 100644
--- a/lib/common_test/test/ct_telnet_SUITE.erl
+++ b/lib/common_test/test/ct_telnet_SUITE.erl
@@ -50,10 +50,10 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
groups() ->
- [{legacy, [], [unix_telnet,own_server,timetrap]},
- {raw, [], [unix_telnet,own_server,timetrap]},
- {html, [], [unix_telnet,own_server]},
- {silent, [], [unix_telnet,own_server]}].
+ [{legacy, [], [unix_telnet,own_server,faulty_regexp,timetrap]},
+ {raw, [], [unix_telnet,own_server,faulty_regexp,timetrap]},
+ {html, [], [unix_telnet,own_server,faulty_regexp]},
+ {silent, [], [unix_telnet,own_server,faulty_regexp]}].
all() ->
[
@@ -119,6 +119,12 @@ own_server(Config) ->
all_tests_in_suite(own_server,"ct_telnet_own_server_SUITE",
CfgFile,Config).
+faulty_regexp(Config) ->
+ CfgFile = "telnet.faulty_regexp." ++
+ atom_to_list(groupname(Config)) ++ ".cfg",
+ all_tests_in_suite(faulty_regexp,"ct_telnet_faulty_regexp_SUITE",
+ CfgFile,Config).
+
timetrap(Config) ->
CfgFile = "telnet.timetrap." ++
atom_to_list(groupname(Config)) ++ ".cfg",
@@ -225,6 +231,31 @@ events_to_check(unix_telnet,Config) ->
all_cases(ct_telnet_basic_SUITE,Config);
events_to_check(own_server,Config) ->
all_cases(ct_telnet_own_server_SUITE,Config);
+events_to_check(faulty_regexp,_Config) ->
+ [{?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,tc_done,
+ {ct_telnet_faulty_regexp_SUITE,expect_pattern,
+ {failed,
+ {error,{{bad_pattern,"invalid(pattern",{"missing )",15}},
+ {ct_telnet,expect,3}}}}}},
+ {?eh,tc_done,
+ {ct_telnet_faulty_regexp_SUITE,expect_pattern_no_string,
+ {failed,
+ {error,{{bad_pattern,invalid_pattern},
+ {ct_telnet,expect,3}}}}}},
+ {?eh,tc_done,
+ {ct_telnet_faulty_regexp_SUITE,expect_tag_pattern,
+ {failed,
+ {error,{{bad_pattern,{tag,"invalid(pattern"},{"missing )",15}},
+ {ct_telnet,expect,3}}}}}},
+ {?eh,tc_done,
+ {ct_telnet_faulty_regexp_SUITE,expect_tag_pattern_no_string,
+ {failed,
+ {error,{{bad_pattern,{tag,invalid_pattern}},
+ {ct_telnet,expect,3}}}}}},
+ {?eh,tc_done,{ct_telnet_faulty_regexp_SUITE,expect_pattern_unicode,ok}},
+ {?eh,tc_done,{ct_telnet_faulty_regexp_SUITE,expect_tag_pattern_unicode,ok}},
+ {?eh,stop_logging,[]}];
events_to_check(timetrap,_Config) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,tc_done,{ct_telnet_timetrap_SUITE,expect_timetrap,
diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_faulty_regexp_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_faulty_regexp_SUITE.erl
new file mode 100644
index 0000000000..a5c9451a9c
--- /dev/null
+++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_faulty_regexp_SUITE.erl
@@ -0,0 +1,79 @@
+-module(ct_telnet_faulty_regexp_SUITE).
+
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+
+-define(name, telnet_server_conn1).
+
+%%--------------------------------------------------------------------
+%% TEST SERVER CALLBACK FUNCTIONS
+%%--------------------------------------------------------------------
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+suite() -> [{require,?name,{unix,[telnet]}},
+ {require,ct_conn_log},
+ {ct_hooks, [{cth_conn_log,[]}]}].
+
+all() ->
+ [expect_pattern,
+ expect_pattern_no_string,
+ expect_tag_pattern,
+ expect_tag_pattern_no_string,
+ expect_pattern_unicode,
+ expect_tag_pattern_unicode].
+
+groups() ->
+ [].
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+init_per_testcase(_,Config) ->
+ ct:log("init_per_testcase: opening telnet connection...",[]),
+ {ok,_} = ct_telnet:open(?name),
+ ct:log("...done",[]),
+ Config.
+
+end_per_testcase(_,_Config) ->
+ ct:log("end_per_testcase: closing telnet connection...",[]),
+ _ = ct_telnet:close(?name),
+ ct:log("...done",[]),
+ ok.
+
+expect_pattern(_) ->
+ ok = ct_telnet:send(?name, "echo ayt"),
+ ok = ct_telnet:expect(?name, "invalid(pattern").
+
+expect_pattern_no_string(_) ->
+ ok = ct_telnet:send(?name, "echo ayt"),
+ ok = ct_telnet:expect(?name, invalid_pattern).
+
+expect_tag_pattern(_) ->
+ ok = ct_telnet:send(?name, "echo ayt"),
+ ok = ct_telnet:expect(?name, {tag,"invalid(pattern"}).
+
+expect_tag_pattern_no_string(_) ->
+ ok = ct_telnet:send(?name, "echo ayt"),
+ ok = ct_telnet:expect(?name, {tag,invalid_pattern}).
+
+%% Test that a unicode pattern can be given without the testcase
+%% failing. Do however notice that there is no real unicode support
+%% in ct_telnet yet, that is, the telnet binary mode is not supported.
+expect_pattern_unicode(_) ->
+ ok = ct_telnet:send(?name, "echo ayt"),
+ {error,{prompt,_}} = ct_telnet:expect(?name, "pattern_with_unicode_αβ"),
+ ok.
+
+expect_tag_pattern_unicode(_) ->
+ ok = ct_telnet:send(?name, "echo ayt"),
+ {error,{prompt,_}} = ct_telnet:expect(?name, "pattern_with_unicode_αβ"),
+ ok.
diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
index 985fa40ad2..34df57027e 100644
--- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
+++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
@@ -58,7 +58,8 @@ all() ->
server_speaks,
server_disconnects,
newline_ayt,
- newline_break
+ newline_break,
+ newline_string
].
groups() ->
@@ -393,3 +394,11 @@ newline_break(_) ->
"> " = lists:flatten(R),
ok = ct_telnet:close(Handle),
ok.
+
+%% Test option {newline,String} to specify an own newline, e.g. "\r\n"
+newline_string(_) ->
+ {ok, Handle} = ct_telnet:open(telnet_server_conn1),
+ ok = ct_telnet:send(Handle, "echo hello-", [{newline,"own_nl\n"}]),
+ {ok,["hello-own_nl"]} = ct_telnet:expect(Handle, ["hello-own_nl"]),
+ ok = ct_telnet:close(Handle),
+ ok.
diff --git a/lib/common_test/test_server/configure.in b/lib/common_test/test_server/configure.in
index 0511d126b4..e07bd4c2aa 100644
--- a/lib/common_test/test_server/configure.in
+++ b/lib/common_test/test_server/configure.in
@@ -459,11 +459,11 @@ dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a
dnl AC_LANG_JAVA instead...)
AC_DEFUN(ERL_TRY_LINK_JAVA,
[java_link='$JAVAC conftest.java 1>&AC_FD_CC'
-changequote(�, �)dnl
+changequote(, )dnl
cat > conftest.java <<EOF
-�$1�
+$1
class conftest { public static void main(String[] args) {
- �$2�
+ $2
; return; }}
EOF
changequote([, ])dnl
diff --git a/lib/common_test/test_server/ts_install.erl b/lib/common_test/test_server/ts_install.erl
index 09f3da860a..86f16fa072 100644
--- a/lib/common_test/test_server/ts_install.erl
+++ b/lib/common_test/test_server/ts_install.erl
@@ -268,7 +268,7 @@ add_vars(Vars0, Opts0) ->
{Opts, [{longnames, LongNames},
{platform_id, PlatformId},
{platform_filename, PlatformFilename},
- {rsh_name, os:getenv("ERL_RSH", "rsh")},
+ {rsh_name, os:getenv("ERL_RSH", "ssh")},
{platform_label, PlatformLabel},
{ts_net_dir, Mounted},
{erl_flags, []},
diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk
index fd5d4a57aa..23eb8d9656 100644
--- a/lib/common_test/vsn.mk
+++ b/lib/common_test/vsn.mk
@@ -1 +1 @@
-COMMON_TEST_VSN = 1.16.1
+COMMON_TEST_VSN = 1.17
diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml
index 02e6203137..d45dfef8f3 100644
--- a/lib/compiler/doc/src/notes.xml
+++ b/lib/compiler/doc/src/notes.xml
@@ -32,6 +32,38 @@
<p>This document describes the changes made to the Compiler
application.</p>
+<section><title>Compiler 7.3.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>An expression such as <c>(A / B) band 16#ff</c> would
+ crash the compiler.</p>
+ <p>
+ Own Id: OTP-15518 Aux Id: ERL-829 </p>
+ </item>
+ <item>
+ <p>There could be an incorrect warning when the
+ <c>tuple_calls</c> option was given. The generated code
+ would be correct. Here is an example of code that would
+ trigger the warning:</p>
+ <p><c>(list_to_atom("prefix_" ++
+ atom_to_list(suffix))):doit(X)</c>.</p>
+ <p>
+ Own Id: OTP-15552 Aux Id: ERL-838 </p>
+ </item>
+ <item>
+ <p>Optimize (again) Dialyzer's handling of
+ left-associative use of <c>andalso</c> and <c>orelse</c>
+ in guards.</p>
+ <p>
+ Own Id: OTP-15577 Aux Id: ERL-851, PR-2141, PR-1944 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Compiler 7.3.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/compiler/scripts/.gitignore b/lib/compiler/scripts/.gitignore
new file mode 100644
index 0000000000..4e4eba766d
--- /dev/null
+++ b/lib/compiler/scripts/.gitignore
@@ -0,0 +1 @@
+/smoke-build
diff --git a/lib/compiler/scripts/smoke b/lib/compiler/scripts/smoke
new file mode 100755
index 0000000000..ae31c923b8
--- /dev/null
+++ b/lib/compiler/scripts/smoke
@@ -0,0 +1,123 @@
+#!/usr/bin/env escript
+%% -*- erlang -*-
+-mode(compile).
+
+main(_Args) ->
+ setup(),
+ clone_elixir(),
+ build_elixir(),
+ test_elixir(),
+ setup_mix(),
+ smoke(main),
+ smoke(rabbitmq),
+ halt(0).
+
+setup() ->
+ ScriptsDir = scripts_dir(),
+ SmokeBuildDir = filename:join(ScriptsDir, "smoke-build"),
+ _ = file:make_dir(SmokeBuildDir),
+ ok = file:set_cwd(SmokeBuildDir),
+ ok.
+
+clone_elixir() ->
+ {ok,SmokeDir} = file:get_cwd(),
+ DotGitDir = filename:join([SmokeDir,"elixir",".git"]),
+ ElixirRepo = "[email protected]:elixir-lang/elixir.git",
+ case filelib:is_dir(DotGitDir) of
+ false ->
+ cmd("git clone " ++ ElixirRepo);
+ true ->
+ GetHeadSHA1 = "cd elixir && git rev-parse --verify HEAD",
+ Before = os:cmd(GetHeadSHA1),
+ cmd("cd elixir && git pull --ff-only origin master"),
+ case os:cmd(GetHeadSHA1) of
+ Before ->
+ ok;
+ _After ->
+ %% There were some changes. Clean to force a re-build.
+ cmd("cd elixir && make clean")
+ end
+ end.
+
+build_elixir() ->
+ cmd("cd elixir && make compile").
+
+test_elixir() ->
+ cmd("cd elixir && make test_stdlib").
+
+setup_mix() ->
+ MixExsFile = filename:join(scripts_dir(), "smoke-mix.exs"),
+ {ok,MixExs} = file:read_file(MixExsFile),
+ ok = file:write_file("mix.exs", MixExs),
+
+ {ok,SmokeDir} = file:get_cwd(),
+ ElixirBin = filename:join([SmokeDir,"elixir","bin"]),
+ PATH = ElixirBin ++ ":" ++ os:getenv("PATH"),
+ os:putenv("PATH", PATH),
+ mix("local.hex --force"),
+ mix("local.rebar --force"),
+ ok.
+
+smoke(Set) ->
+ os:putenv("SMOKE_DEPS_SET", atom_to_list(Set)),
+ _ = file:delete("mix.lock"),
+ cmd("touch mix.exs"),
+ mix("deps.clean --all"),
+ mix("deps.get"),
+ mix("deps.compile"),
+ ok.
+
+scripts_dir() ->
+ Root = code:lib_dir(compiler),
+ filename:join(Root, "scripts").
+
+mix(Cmd) ->
+ cmd("mix " ++ Cmd).
+
+cmd(Cmd) ->
+ run("sh", ["-c",Cmd]).
+
+run(Program0, Args) ->
+ Program = case os:find_executable(Program0) of
+ Path when is_list(Path) ->
+ Path;
+ false ->
+ abort("Unable to find program: ~s\n", [Program0])
+ end,
+ Cmd = case {Program0,Args} of
+ {"sh",["-c"|ShCmd]} ->
+ ShCmd;
+ {_,_} ->
+ lists:join(" ", [Program0|Args])
+ end,
+ io:format("\n# ~s\n", [Cmd]),
+ Options = [{args,Args},binary,exit_status,stderr_to_stdout],
+ try open_port({spawn_executable,Program}, Options) of
+ Port ->
+ case run_loop(Port, <<>>) of
+ 0 ->
+ ok;
+ ExitCode ->
+ abort("*** Failed with exit code: ~p\n",
+ [ExitCode])
+ end
+ catch
+ error:_ ->
+ abort("Failed to execute ~s\n", [Program0])
+ end.
+
+run_loop(Port, Output) ->
+ receive
+ {Port,{exit_status,Status}} ->
+ Status;
+ {Port,{data,Bin}} ->
+ io:put_chars(Bin),
+ run_loop(Port, <<Output/binary,Bin/binary>>);
+ Msg ->
+ io:format("L: ~p~n", [Msg]),
+ run_loop(Port, Output)
+ end.
+
+abort(Format, Args) ->
+ io:format(Format, Args),
+ halt(1).
diff --git a/lib/compiler/scripts/smoke-mix.exs b/lib/compiler/scripts/smoke-mix.exs
new file mode 100644
index 0000000000..82ae3370fe
--- /dev/null
+++ b/lib/compiler/scripts/smoke-mix.exs
@@ -0,0 +1,95 @@
+defmodule Smoke.MixProject do
+ use Mix.Project
+
+ def project do
+ [
+ app: :smoke,
+ version: "0.1.0",
+ elixir: "~> 1.8",
+ start_permanent: Mix.env() == :prod,
+ deps: deps()
+ ]
+ end
+
+ # Run "mix help compile.app" to learn about applications.
+ def application do
+ [
+ extra_applications: [:logger]
+ ]
+ end
+
+ # Run "mix help deps" to learn about dependencies.
+ defp deps do
+ case :os.getenv('SMOKE_DEPS_SET') do
+ 'main' ->
+ [
+ {:bear, "~> 0.8.7"},
+ {:cloudi_core, "~> 1.7"},
+ {:concuerror, "~> 0.20.0"},
+ {:cowboy, "~> 2.6.1"},
+ {:ecto, "~> 3.0.6"},
+ {:ex_doc, "~> 0.19.3"},
+ {:distillery, "~> 2.0.12"},
+ {:erlydtl, "~> 0.12.1"},
+ {:gen_smtp, "~> 0.13.0"},
+ {:getopt, "~> 1.0.1"},
+ {:gettext, "~> 0.16.1"},
+ {:gpb, "~> 4.6"},
+ {:gproc, "~> 0.8.0"},
+ {:graphql, "~> 0.15.0", hex: :graphql_erl},
+ {:hackney, "~> 1.15.0"},
+ {:ibrowse, "~> 4.4.1"},
+ {:jose, "~> 1.9.0"},
+ {:lager, "~> 3.6"},
+ {:locus, "~> 1.6"},
+ {:nimble_parsec, "~> 0.5.0"},
+ {:phoenix, "~> 1.4.0"},
+ {:riak_pb, "~> 2.3"},
+ {:scalaris, git: "https://github.com/scalaris-team/scalaris",
+ compile: build_scalaris()},
+ {:tdiff, "~> 0.1.2"},
+ {:webmachine, "~> 1.11"},
+ {:wings, git: "https://github.com/dgud/wings.git",
+ compile: build_wings()},
+ {:zotonic_stdlib, "~> 1.0"},
+ ]
+ 'rabbitmq' ->
+ [{:rabbit_common, "~> 3.7"}]
+ _ ->
+ []
+ end
+ end
+
+ defp build_scalaris do
+ # Only compile the Erlang code.
+
+ """
+ echo '-include("rt_simple.hrl").' >include/rt.hrl
+ (cd src && erlc -W0 -I ../include -I ../contrib/log4erl/include -I ../contrib/yaws/include *.erl)
+ (cd src/comm_layer && erlc -W0 -I ../../include -I *.erl)
+ (cd src/cp && erlc -W0 -I ../../include -I *.erl)
+ (cd src/crdt && erlc -W0 -I ../../include -I *.erl)
+ (cd src/json && erlc -W0 -I ../../include -I *.erl)
+ (cd src/paxos && erlc -W0 -I ../../include -I *.erl)
+ (cd src/rbr && erlc -W0 -I ../../include -I *.erl)
+ (cd src/rrepair && erlc -W0 -I ../../include -I *.erl)
+ (cd src/time && erlc -W0 -I ../../include -I *.erl)
+ (cd src/transactions && erlc -W0 -I ../../include -I *.erl)
+ (cd src/tx && erlc -W0 -I ../../include -I *.erl)
+ """
+ end
+
+ defp build_wings do
+ # If the Erlang system is not installed, the build will
+ # crash in plugins_src/accel when attempting to build
+ # the accel driver. Since there is very little Erlang code in
+ # the directory, skip the entire directory.
+
+ """
+ echo "all:\n\t" >plugins_src/accel/Makefile
+ git commit -a -m'Disable for smoke testing'
+ git tag -a -m'Smoke test' vsmoke_test
+ make
+ """
+ end
+end
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 97c73d0e07..c971e8844d 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -90,7 +90,6 @@ MODULES = \
rec_env \
sys_core_alias \
sys_core_bsm \
- sys_core_dsetel \
sys_core_fold \
sys_core_fold_lists \
sys_core_inline \
@@ -209,7 +208,6 @@ $(EBIN)/core_lint.beam: core_parse.hrl
$(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl
$(EBIN)/core_pp.beam: core_parse.hrl
$(EBIN)/sys_core_alias.beam: core_parse.hrl
-$(EBIN)/sys_core_dsetel.beam: core_parse.hrl
$(EBIN)/sys_core_fold.beam: core_parse.hrl
$(EBIN)/sys_core_fold_lists.beam: core_parse.hrl
$(EBIN)/sys_core_inline.beam: core_parse.hrl
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl
index 1ac892a8f1..0bccad1ecd 100644
--- a/lib/compiler/src/beam_a.erl
+++ b/lib/compiler/src/beam_a.erl
@@ -122,10 +122,6 @@ 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({test,bs_match_string=Op,F,[Ctx,Bits,{string,Str}]}) when is_list(Str) ->
- %% When compiling from an old .S file. Starting from OTP 22, Str is a binary.
- <<Bs:Bits/bits,_/bits>> = list_to_binary(Str),
- {test,Op,F,[Ctx,Bs]};
rename_instr({put_map_assoc,Fail,S,D,R,L}) ->
{put_map,Fail,assoc,S,D,R,L};
rename_instr({put_map_exact,Fail,S,D,R,L}) ->
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
index 49bfb5606f..28c89782c9 100644
--- a/lib/compiler/src/beam_except.erl
+++ b/lib/compiler/src/beam_except.erl
@@ -31,7 +31,7 @@
%%% erlang:error(function_clause, Args) => jump FuncInfoLabel
%%%
--import(lists, [reverse/1,seq/2,splitwith/2]).
+-import(lists, [reverse/1,reverse/2,seq/2,splitwith/2]).
-spec module(beam_utils:module_code(), [compile:option()]) ->
{'ok',beam_utils:module_code()}.
@@ -53,7 +53,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
-record(st,
{lbl :: beam_asm:label(), %func_info label
loc :: [_], %location for func_info
- arity :: arity() %arity for function
+ arity :: arity() %arity for function
}).
function_1(Is0) ->
@@ -79,13 +79,15 @@ translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) ->
no ->
translate(Is, St, [I|Acc0]);
{yes,function_clause,Acc2} ->
- case {Line,St} of
- {{line,Loc},#st{lbl=Fi,loc=Loc}} ->
+ case {Is,Line,St} of
+ {[return|_],{line,Loc},#st{lbl=Fi,loc=Loc}} ->
Instr = {jump,{f,Fi}},
translate(Is, St, [Instr|Acc2]);
- {_,_} ->
- %% This must be "error(function_clause, Args)" in
- %% the Erlang source code or a fun. Don't translate.
+ {_,_,_} ->
+ %% Not a call_only instruction, or not the same
+ %% location information as in in the line instruction
+ %% before the func_info instruction. Not safe
+ %% to translate to a jump.
translate(Is, St, [I|Acc0])
end;
{yes,Instr,Acc2} ->
@@ -148,10 +150,15 @@ dig_out_fc(Arity, Is0) ->
(_) -> true
end, Is0),
{Regs,Acc} = dig_out_fc_1(reverse(Is), Regs0, Acc0),
- case is_fc(Arity, Regs) of
- true ->
- {yes,function_clause,Acc};
- false ->
+ case Regs of
+ #{{x,0}:={atom,function_clause},{x,1}:=Args} ->
+ case moves_from_stack(Args, 0, []) of
+ {Moves,Arity} ->
+ {yes,function_clause,reverse(Moves, Acc)};
+ {_,_} ->
+ no
+ end;
+ #{} ->
no
end.
@@ -160,8 +167,10 @@ dig_out_fc_1([{block,Bl}|Is], Regs0, Acc) ->
dig_out_fc_1(Is, Regs, Acc);
dig_out_fc_1([{bs_set_position,_,_}=I|Is], Regs, Acc) ->
dig_out_fc_1(Is, Regs, [I|Acc]);
-dig_out_fc_1([{bs_get_tail,_,_,Live}=I|Is], Regs0, Acc) ->
- Regs = prune_xregs(Live, Regs0),
+dig_out_fc_1([{bs_get_tail,Src,Dst,Live0}|Is], Regs0, Acc) ->
+ Regs = prune_xregs(Live0, Regs0),
+ Live = dig_out_stack_live(Regs, Live0),
+ I = {bs_get_tail,Src,Dst,Live},
dig_out_fc_1(Is, Regs, [I|Acc]);
dig_out_fc_1([_|_], _Regs, _Acc) ->
{#{},[]};
@@ -182,25 +191,54 @@ dig_out_fc_block([{set,_,_,_}|_], _Regs) ->
#{};
dig_out_fc_block([], Regs) -> Regs.
-prune_xregs(Live, Regs) ->
- maps:filter(fun({x,X}, _) -> X < Live end, Regs).
-
-is_fc(Arity, Regs) ->
+dig_out_stack_live(Regs, Default) ->
+ Reg = {x,2},
case Regs of
- #{{x,0}:={atom,function_clause},{x,1}:=Args} ->
- is_fc_1(Args, 0) =:= Arity;
+ #{Reg:=List} ->
+ dig_out_stack_live_1(List, Default);
#{} ->
- false
+ Default
end.
-is_fc_1({cons,{arg,I},T}, I) ->
- is_fc_1(T, I+1);
-is_fc_1(nil, I) ->
- I;
-is_fc_1(_, _) -> -1.
+dig_out_stack_live_1({cons,{arg,N},T}, Live) ->
+ dig_out_stack_live_1(T, max(N + 1, Live));
+dig_out_stack_live_1({cons,_,T}, Live) ->
+ dig_out_stack_live_1(T, Live);
+dig_out_stack_live_1(nil, Live) ->
+ Live;
+dig_out_stack_live_1(_, Live) -> Live.
+
+prune_xregs(Live, Regs) ->
+ maps:filter(fun({x,X}, _) -> X < Live end, Regs).
+
+moves_from_stack({cons,{arg,N},_}, I, _Acc) when N =/= I ->
+ %% Wrong argument. Give up.
+ {[],-1};
+moves_from_stack({cons,H,T}, I, Acc) ->
+ case H of
+ {arg,I} ->
+ moves_from_stack(T, I+1, Acc);
+ _ ->
+ moves_from_stack(T, I+1, [{move,H,{x,I}}|Acc])
+ end;
+moves_from_stack(nil, I, Acc) ->
+ {reverse(Acc),I};
+moves_from_stack({literal,[H|T]}, I, Acc) ->
+ Cons = {cons,tag_literal(H),tag_literal(T)},
+ moves_from_stack(Cons, I, Acc);
+moves_from_stack(_, _, _) ->
+ %% Not understood. Give up.
+ {[],-1}.
+
get_reg(R, Regs) ->
case Regs of
#{R:=Val} -> Val;
#{} -> R
end.
+
+tag_literal([]) -> nil;
+tag_literal(T) when is_atom(T) -> {atom,T};
+tag_literal(T) when is_float(T) -> {float,T};
+tag_literal(T) when is_integer(T) -> {integer,T};
+tag_literal(T) -> {literal,T}.
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 8b0e3e32f8..74f80ca70e 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -179,21 +179,24 @@ function({function,Name,Arity,CLabel,Asm0}, Lc0) ->
eliminate_moves(Is) ->
eliminate_moves(Is, #{}, []).
-eliminate_moves([{select,select_val,Reg,_,List}=I|Is], D0, Acc) ->
- D = update_value_dict(List, Reg, D0),
+eliminate_moves([{select,select_val,Reg,{f,Fail},List}=I|Is], D0, Acc) ->
+ D1 = add_unsafe_label(Fail, D0),
+ D = update_value_dict(List, Reg, D1),
eliminate_moves(Is, D, [I|Acc]);
-eliminate_moves([{label,Lbl},{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk0|Is],
- D, Acc0) ->
+eliminate_moves([{test,is_eq_exact,_,[Reg,Val]}=I,
+ {block,BlkIs0}|Is], D0, Acc) ->
+ D = update_unsafe_labels(I, D0),
+ RegVal = {Reg,Val},
+ BlkIs = eliminate_moves_blk(BlkIs0, RegVal),
+ eliminate_moves([{block,BlkIs}|Is], D, [I|Acc]);
+eliminate_moves([{label,Lbl},{block,BlkIs0}=Blk|Is], D, Acc0) ->
Acc = [{label,Lbl}|Acc0],
- case already_has_value(Lit, Lbl, Dst, D) andalso
- no_fallthrough(Acc0) of
- true ->
- %% Remove redundant 'move' instruction.
- Blk = {block,BlkIs},
- eliminate_moves([Blk|Is], D, Acc);
- false ->
- %% Keep 'move' instruction.
- eliminate_moves([Blk0|Is], D, Acc)
+ case {no_fallthrough(Acc0),D} of
+ {true,#{Lbl:={_,_}=RegVal}} ->
+ BlkIs = eliminate_moves_blk(BlkIs0, RegVal),
+ eliminate_moves([{block,BlkIs}|Is], D, Acc);
+ {_,_} ->
+ eliminate_moves([Blk|Is], D, Acc)
end;
eliminate_moves([{block,[]}|Is], D, Acc) ->
%% Empty blocks can prevent further jump optimizations.
@@ -203,17 +206,20 @@ eliminate_moves([I|Is], D0, Acc) ->
eliminate_moves(Is, D, [I|Acc]);
eliminate_moves([], _, Acc) -> reverse(Acc).
+eliminate_moves_blk([{set,[Dst],[_],move}|_]=Is, {_,Dst}) ->
+ Is;
+eliminate_moves_blk([{set,[Dst],[Lit],move}|Is], {Dst,Lit}) ->
+ %% Remove redundant 'move' instruction.
+ Is;
+eliminate_moves_blk([{set,[Dst],[_],move}|_]=Is, {Dst,_}) ->
+ Is;
+eliminate_moves_blk([{set,[_],[_],move}=I|Is], {_,_}=RegVal) ->
+ [I|eliminate_moves_blk(Is, RegVal)];
+eliminate_moves_blk(Is, _) -> Is.
+
no_fallthrough([I|_]) ->
is_unreachable_after(I).
-already_has_value(Lit, Lbl, Reg, D) ->
- case D of
- #{Lbl:={Reg,Lit}} ->
- true;
- #{} ->
- false
- end.
-
update_value_dict([Lit,{f,Lbl}|T], Reg, D0) ->
D = case D0 of
#{Lbl:=unsafe} -> D0;
@@ -224,6 +230,9 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) ->
update_value_dict(T, Reg, D);
update_value_dict([], _, D) -> D.
+add_unsafe_label(L, D) ->
+ D#{L=>unsafe}.
+
update_unsafe_labels(I, D) ->
Ls = instr_labels(I),
update_unsafe_labels_1(Ls, D).
diff --git a/lib/compiler/src/beam_kernel_to_ssa.erl b/lib/compiler/src/beam_kernel_to_ssa.erl
index d6e675ae72..df95749fb3 100644
--- a/lib/compiler/src/beam_kernel_to_ssa.erl
+++ b/lib/compiler/src/beam_kernel_to_ssa.erl
@@ -327,7 +327,7 @@ select_bin_seg(#k_val_clause{val=#k_bin_seg{size=Size,unit=U,type=T,
{Mis,St1} = select_extract_bin(Next, Size, U, T, Fs, Fail,
Ctx, LineAnno, St0),
{Extracted,St2} = new_ssa_var(Seg#k_var.name, St1),
- {Bis,St} = bin_match_cg(Size, B, Fail, St2),
+ {Bis,St} = match_cg(B, Fail, St2),
BsGet = #b_set{op=bs_extract,dst=Extracted,args=[ssa_arg(Next, St)]},
Is = Mis ++ [BsGet] ++ Bis,
{Is,St};
@@ -362,14 +362,6 @@ select_bin_seg(#k_val_clause{val=#k_bin_int{size=Sz,unit=U,flags=Fs,
end,
{Is,St}.
-bin_match_cg(#k_atom{val=all}, B0, Fail, St) ->
- #k_select{types=Types} = B0,
- [#k_type_clause{type=k_bin_end,values=Values}] = Types,
- [#k_val_clause{val=#k_bin_end{},body=B}] = Values,
- match_cg(B, Fail, St);
-bin_match_cg(_, B, Fail, St) ->
- match_cg(B, Fail, St).
-
get_context(#k_var{}=Var, St) ->
ssa_arg(Var, St).
@@ -707,11 +699,6 @@ bif_cg(#k_bif{op=#k_remote{mod=#k_atom{val=erlang},name=#k_atom{val=Name}},
%% internal_cg(Bif, [Arg], [Ret], Le, State) ->
%% {[Ainstr],State}.
-internal_cg(dsetelement, [Index0,Tuple0,New0], _Rs, _Le, St) ->
- [New,Tuple,#b_literal{val=Index1}] = ssa_args([New0,Tuple0,Index0], St),
- Index = #b_literal{val=Index1-1},
- Set = #b_set{op=set_tuple_element,args=[New,Tuple,Index]},
- {[Set],St};
internal_cg(make_fun, [Name0,Arity0|As], Rs, _Le, St0) ->
#k_atom{val=Name} = Name0,
#k_int{val=Arity} = Arity0,
diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl
index b491e340b7..a9977b0b1d 100644
--- a/lib/compiler/src/beam_ssa.erl
+++ b/lib/compiler/src/beam_ssa.erl
@@ -23,7 +23,7 @@
-export([add_anno/3,get_anno/2,get_anno/3,
clobbers_xregs/1,def/2,def_used/2,
definitions/1,
- dominators/1,
+ dominators/1,common_dominators/3,
flatmapfold_instrs_rpo/4,
fold_po/3,fold_po/4,fold_rpo/3,fold_rpo/4,
fold_instrs_rpo/4,
@@ -85,7 +85,8 @@
-type anno() :: #{atom() := any()}.
-type block_map() :: #{label():=b_blk()}.
--type dominator_map() :: #{label():=ordsets:ordset(label())}.
+-type dominator_map() :: #{label():=[label()]}.
+-type numbering_map() :: #{label():=non_neg_integer()}.
-type usage_map() :: #{b_var():=[{label(),b_set() | terminator()}]}.
-type definition_map() :: #{b_var():=b_set()}.
-type rename_map() :: #{b_var():=value()}.
@@ -108,7 +109,7 @@
'make_fun' | 'new_try_tag' |
'peek_message' | 'phi' | 'put_list' | 'put_map' | 'put_tuple' |
'raw_raise' | 'recv_next' | 'remove_message' | 'resume' |
- 'set_tuple_element' | 'succeeded' |
+ 'succeeded' |
'timeout' |
'wait' | 'wait_timeout'.
@@ -117,7 +118,8 @@
%% Primops only used internally during code generation.
-type cg_prim_op() :: 'bs_get' | 'bs_match_string' | 'bs_restore' | 'bs_skip' |
- 'copy' | 'put_tuple_arity' | 'put_tuple_element'.
+ 'copy' | 'put_tuple_arity' | 'put_tuple_element' |
+ 'set_tuple_element'.
-import(lists, [foldl/3,keyfind/3,mapfoldl/3,member/2,reverse/1]).
@@ -142,7 +144,7 @@ add_anno(Key, Val, #b_switch{anno=Anno}=Bl) ->
-spec get_anno(atom(), construct()) -> any().
get_anno(Key, Construct) ->
- maps:get(Key, get_anno(Construct)).
+ map_get(Key, get_anno(Construct)).
-spec get_anno(atom(), construct(),any()) -> any().
@@ -303,7 +305,7 @@ normalize(#b_ret{}=Ret) ->
-spec successors(label(), block_map()) -> [label()].
successors(L, Blocks) ->
- successors(maps:get(L, Blocks)).
+ successors(map_get(L, Blocks)).
-spec def(Ls, Blocks) -> Def when
Ls :: [label()],
@@ -312,7 +314,7 @@ successors(L, Blocks) ->
def(Ls, Blocks) ->
Top = rpo(Ls, Blocks),
- Blks = [maps:get(L, Blocks) || L <- Top],
+ Blks = [map_get(L, Blocks) || L <- Top],
def_1(Blks, []).
-spec def_used(Ls, Blocks) -> {Def,Used} when
@@ -323,22 +325,45 @@ def(Ls, Blocks) ->
def_used(Ls, Blocks) ->
Top = rpo(Ls, Blocks),
- Blks = [maps:get(L, Blocks) || L <- Top],
- Preds = gb_sets:from_list(Top),
- def_used_1(Blks, Preds, [], gb_sets:empty()).
+ Blks = [map_get(L, Blocks) || L <- Top],
+ Preds = cerl_sets:from_list(Top),
+ def_used_1(Blks, Preds, [], []).
+
+%% dominators(BlockMap) -> {Dominators,Numbering}.
+%% Calculate the dominator tree, returning a map where each entry
+%% in the map is a list that gives the path from that block to
+%% the top of the dominator tree. (Note that the suffixes of the
+%% paths are shared with each other, which make the representation
+%% of the dominator tree highly memory-efficient.)
+%%
+%% The implementation is based on:
+%%
+%% http://www.hipersoft.rice.edu/grads/publications/dom14.pdf
+%% Cooper, Keith D.; Harvey, Timothy J; Kennedy, Ken (2001).
+%% A Simple, Fast Dominance Algorithm.
-spec dominators(Blocks) -> Result when
Blocks :: block_map(),
- Result :: dominator_map().
-
+ Result :: {dominator_map(), numbering_map()}.
dominators(Blocks) ->
Preds = predecessors(Blocks),
Top0 = rpo(Blocks),
- Top = [{L,maps:get(L, Preds)} || L <- Top0],
+ Df = maps:from_list(number(Top0, 0)),
+ [{0,[]}|Top] = [{L,map_get(L, Preds)} || L <- Top0],
%% The flow graph for an Erlang function is reducible, and
%% therefore one traversal in reverse postorder is sufficient.
- iter_dominators(Top, #{}).
+ Acc = #{0=>[0]},
+ {dominators_1(Top, Df, Acc),Df}.
+
+%% common_dominators([Label], Dominators, Numbering) -> [Label].
+%% Calculate the common dominators for the given list of blocks
+%% and Dominators and Numbering as returned from dominators/1.
+
+-spec common_dominators([label()], dominator_map(), numbering_map()) -> [label()].
+common_dominators(Ls, Dom, Numbering) ->
+ Doms = [map_get(L, Dom) || L <- Ls],
+ dom_intersection(Doms, Numbering).
-spec fold_instrs_rpo(Fun, From, Acc0, Blocks) -> any() when
Fun :: fun((b_blk()|terminator(), any()) -> any()),
@@ -365,9 +390,9 @@ mapfold_blocks_rpo(Fun, From, Acc, Blocks) ->
end, {Blocks, Acc}, Successors).
mapfold_blocks_rpo_1(Fun, Lbl, {Blocks0, Acc0}) ->
- Block0 = maps:get(Lbl, Blocks0),
+ Block0 = map_get(Lbl, Blocks0),
{Block, Acc} = Fun(Lbl, Block0, Acc0),
- Blocks = maps:put(Lbl, Block, Blocks0),
+ Blocks = Blocks0#{Lbl:=Block},
{Blocks, Acc}.
-spec mapfold_instrs_rpo(Fun, From, Acc0, Blocks0) -> {Blocks,Acc} when
@@ -581,7 +606,7 @@ used(_) -> [].
-spec definitions(Blocks :: block_map()) -> definition_map().
definitions(Blocks) ->
fold_instrs_rpo(fun(#b_set{ dst = Var }=I, Acc) ->
- maps:put(Var, I, Acc);
+ Acc#{Var => I};
(_Terminator, Acc) ->
Acc
end, [0], #{}, Blocks).
@@ -626,10 +651,10 @@ is_commutative(_) -> false.
def_used_1([#b_blk{is=Is,last=Last}|Bs], Preds, Def0, Used0) ->
{Def,Used1} = def_used_is(Is, Preds, Def0, Used0),
- Used = gb_sets:union(gb_sets:from_list(used(Last)), Used1),
+ Used = ordsets:union(used(Last), Used1),
def_used_1(Bs, Preds, Def, Used);
def_used_1([], _Preds, Def, Used) ->
- {ordsets:from_list(Def),gb_sets:to_list(Used)}.
+ {ordsets:from_list(Def),Used}.
def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is],
Preds, Def0, Used0) ->
@@ -637,12 +662,12 @@ def_used_is([#b_set{op=phi,dst=Dst,args=Args}|Is],
%% We must be careful to only include variables that will
%% be used when arriving from one of the predecessor blocks
%% in Preds.
- Used1 = [V || {#b_var{}=V,L} <- Args, gb_sets:is_member(L, Preds)],
- Used = gb_sets:union(gb_sets:from_list(Used1), Used0),
+ Used1 = [V || {#b_var{}=V,L} <- Args, cerl_sets:is_element(L, Preds)],
+ Used = ordsets:union(ordsets:from_list(Used1), Used0),
def_used_is(Is, Preds, Def, Used);
def_used_is([#b_set{dst=Dst}=I|Is], Preds, Def0, Used0) ->
Def = [Dst|Def0],
- Used = gb_sets:union(gb_sets:from_list(used(I)), Used0),
+ Used = ordsets:union(used(I), Used0),
def_used_is(Is, Preds, Def, Used);
def_used_is([], _Preds, Def, Used) ->
{Def,Used}.
@@ -657,44 +682,67 @@ def_is([#b_set{dst=Dst}|Is], Def) ->
def_is(Is, [Dst|Def]);
def_is([], Def) -> Def.
-iter_dominators([{0,[]}|Ls], _Doms) ->
- Dom = [0],
- iter_dominators(Ls, #{0=>Dom});
-iter_dominators([{L,Preds}|Ls], Doms) ->
- DomPreds = [maps:get(P, Doms) || P <- Preds, maps:is_key(P, Doms)],
- Dom = ordsets:add_element(L, ordsets:intersection(DomPreds)),
- iter_dominators(Ls, Doms#{L=>Dom});
-iter_dominators([], Doms) -> Doms.
+dominators_1([{L,Preds}|Ls], Df, Doms) ->
+ DomPreds = [map_get(P, Doms) || P <- Preds, is_map_key(P, Doms)],
+ Dom = [L|dom_intersection(DomPreds, Df)],
+ dominators_1(Ls, Df, Doms#{L=>Dom});
+dominators_1([], _Df, Doms) -> Doms.
+
+dom_intersection([S], _Df) ->
+ S;
+dom_intersection([S|Ss], Df) ->
+ dom_intersection(S, Ss, Df).
+
+dom_intersection(S1, [S2|Ss], Df) ->
+ dom_intersection(dom_intersection_1(S1, S2, Df), Ss, Df);
+dom_intersection(S, [], _Df) -> S.
+
+dom_intersection_1([E1|Es1]=Set1, [E2|Es2]=Set2, Df) ->
+ %% Blocks are numbered in the order they are found in
+ %% reverse postorder.
+ #{E1:=Df1,E2:=Df2} = Df,
+ if Df1 > Df2 ->
+ dom_intersection_1(Es1, Set2, Df);
+ Df2 > Df1 ->
+ dom_intersection_1(Es2, Set1, Df); %switch arguments!
+ true -> %Set1 == Set2
+ %% The common suffix of the sets is the intersection.
+ Set1
+ end.
+
+number([L|Ls], N) ->
+ [{L,N}|number(Ls, N+1)];
+number([], _) -> [].
fold_rpo_1([L|Ls], Fun, Blocks, Acc0) ->
- Block = maps:get(L, Blocks),
+ Block = map_get(L, Blocks),
Acc = Fun(L, Block, Acc0),
fold_rpo_1(Ls, Fun, Blocks, Acc);
fold_rpo_1([], _, _, Acc) -> Acc.
fold_instrs_rpo_1([L|Ls], Fun, Blocks, Acc0) ->
- #b_blk{is=Is,last=Last} = maps:get(L, Blocks),
+ #b_blk{is=Is,last=Last} = map_get(L, Blocks),
Acc1 = foldl(Fun, Acc0, Is),
Acc = Fun(Last, Acc1),
fold_instrs_rpo_1(Ls, Fun, Blocks, Acc);
fold_instrs_rpo_1([], _, _, Acc) -> Acc.
mapfold_instrs_rpo_1([L|Ls], Fun, Blocks0, Acc0) ->
- #b_blk{is=Is0,last=Last0} = Block0 = maps:get(L, Blocks0),
+ #b_blk{is=Is0,last=Last0} = Block0 = map_get(L, Blocks0),
{Is,Acc1} = mapfoldl(Fun, Acc0, Is0),
{Last,Acc} = Fun(Last0, Acc1),
Block = Block0#b_blk{is=Is,last=Last},
- Blocks = maps:put(L, Block, Blocks0),
+ Blocks = Blocks0#{L:=Block},
mapfold_instrs_rpo_1(Ls, Fun, Blocks, Acc);
mapfold_instrs_rpo_1([], _, Blocks, Acc) ->
{Blocks,Acc}.
flatmapfold_instrs_rpo_1([L|Ls], Fun, Blocks0, Acc0) ->
- #b_blk{is=Is0,last=Last0} = Block0 = maps:get(L, Blocks0),
+ #b_blk{is=Is0,last=Last0} = Block0 = map_get(L, Blocks0),
{Is,Acc1} = flatmapfoldl(Fun, Acc0, Is0),
{[Last],Acc} = Fun(Last0, Acc1),
Block = Block0#b_blk{is=Is,last=Last},
- Blocks = maps:put(L, Block, Blocks0),
+ Blocks = Blocks0#{L:=Block},
flatmapfold_instrs_rpo_1(Ls, Fun, Blocks, Acc);
flatmapfold_instrs_rpo_1([], _, Blocks, Acc) ->
{Blocks,Acc}.
@@ -705,7 +753,7 @@ linearize_1([L|Ls], Blocks, Seen0, Acc0) ->
linearize_1(Ls, Blocks, Seen0, Acc0);
false ->
Seen1 = cerl_sets:add_element(L, Seen0),
- Block = maps:get(L, Blocks),
+ Block = map_get(L, Blocks),
Successors = successors(Block),
{Acc,Seen} = linearize_1(Successors, Blocks, Seen1, Acc0),
linearize_1(Ls, Blocks, Seen, [{L,Block}|Acc])
@@ -745,7 +793,7 @@ rpo_1([L|Ls], Blocks, Seen0, Acc0) ->
true ->
rpo_1(Ls, Blocks, Seen0, Acc0);
false ->
- Block = maps:get(L, Blocks),
+ Block = map_get(L, Blocks),
Seen1 = cerl_sets:add_element(L, Seen0),
Successors = successors(Block),
{Acc,Seen} = rpo_1(Successors, Blocks, Seen1, Acc0),
@@ -775,11 +823,11 @@ rename_phi_vars([{Var,L}|As], Preds, Ren) ->
rename_phi_vars([], _, _) -> [].
map_instrs_1([L|Ls], Fun, Blocks0) ->
- #b_blk{is=Is0,last=Last0} = Blk0 = maps:get(L, Blocks0),
+ #b_blk{is=Is0,last=Last0} = Blk0 = map_get(L, Blocks0),
Is = [Fun(I) || I <- Is0],
Last = Fun(Last0),
Blk = Blk0#b_blk{is=Is,last=Last},
- Blocks = maps:put(L, Blk, Blocks0),
+ Blocks = Blocks0#{L:=Blk},
map_instrs_1(Ls, Fun, Blocks);
map_instrs_1([], _, Blocks) -> Blocks.
@@ -790,7 +838,7 @@ flatmapfoldl(F, Accu0, [Hd|Tail]) ->
flatmapfoldl(_, Accu, []) -> {[],Accu}.
split_blocks_1([L|Ls], P, Blocks0, Count0) ->
- #b_blk{is=Is0} = Blk = maps:get(L, Blocks0),
+ #b_blk{is=Is0} = Blk = map_get(L, Blocks0),
case split_blocks_is(Is0, P, []) of
{yes,Bef,Aft} ->
NewLbl = Count0,
diff --git a/lib/compiler/src/beam_ssa_bsm.erl b/lib/compiler/src/beam_ssa_bsm.erl
index 466337db0e..382e6f635e 100644
--- a/lib/compiler/src/beam_ssa_bsm.erl
+++ b/lib/compiler/src/beam_ssa_bsm.erl
@@ -300,7 +300,8 @@ get_fa(#b_function{ anno = Anno }) ->
promotions = #{} :: promotion_map() }).
alias_matched_binaries(Blocks0, Counter, AliasMap) when AliasMap =/= #{} ->
- State0 = #amb{ dominators = beam_ssa:dominators(Blocks0),
+ {Dominators, _} = beam_ssa:dominators(Blocks0),
+ State0 = #amb{ dominators = Dominators,
match_aliases = AliasMap,
cnt = Counter },
{Blocks, State} = beam_ssa:mapfold_blocks_rpo(fun amb_1/3, [0], State0,
@@ -347,7 +348,7 @@ amb_get_alias(#b_var{}=Arg, Lbl, State) ->
%% Our context may not have been created yet, so we skip assigning
%% an alias unless the given block is among our dominators.
Dominators = maps:get(Lbl, State#amb.dominators),
- case ordsets:is_element(AliasAfter, Dominators) of
+ case member(AliasAfter, Dominators) of
true -> amb_create_alias(Arg, Context, Lbl, State);
false -> {Arg, State}
end;
@@ -444,6 +445,7 @@ combine_matches({Fs0, ModInfo}) ->
combine_matches(#b_function{bs=Blocks0,cnt=Counter0}=F, ModInfo) ->
case funcinfo_get(F, has_bsm_ops, ModInfo) of
true ->
+ {Dominators, _} = beam_ssa:dominators(Blocks0),
{Blocks1, State} =
beam_ssa:mapfold_blocks_rpo(
fun(Lbl, #b_blk{is=Is0}=Block0, State0) ->
@@ -451,7 +453,7 @@ combine_matches(#b_function{bs=Blocks0,cnt=Counter0}=F, ModInfo) ->
{Block0#b_blk{is=Is}, State}
end, [0],
#cm{ definitions = beam_ssa:definitions(Blocks0),
- dominators = beam_ssa:dominators(Blocks0),
+ dominators = Dominators,
blocks = Blocks0 },
Blocks0),
@@ -491,7 +493,7 @@ cm_handle_priors(Src, DstCtx, Bool, Acc, MatchSeq, Lbl, State0) ->
%% dominate us.
Dominators = maps:get(Lbl, State0#cm.dominators, []),
[Ctx || {ValidAfter, Ctx} <- Priors,
- ordsets:is_element(ValidAfter, Dominators)];
+ member(ValidAfter, Dominators)];
error ->
[]
end,
diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl
index 067d9a6741..bb43a550ae 100644
--- a/lib/compiler/src/beam_ssa_dead.erl
+++ b/lib/compiler/src/beam_ssa_dead.erl
@@ -27,7 +27,8 @@
-export([opt/1]).
-include("beam_ssa.hrl").
--import(lists, [append/1,last/1,member/2,takewhile/2,reverse/1]).
+-import(lists, [append/1,keymember/3,last/1,member/2,
+ takewhile/2,reverse/1]).
-type used_vars() :: #{beam_ssa:label():=ordsets:ordset(beam_ssa:var_name())}.
@@ -58,7 +59,7 @@ opt(Linear) ->
Blocks0 = maps:from_list(Linear),
St0 = #st{bs=Blocks0,us=Used,skippable=Skippable},
St = shortcut_opt(St0),
- #st{bs=Blocks} = combine_eqs(St),
+ #st{bs=Blocks} = combine_eqs(St#st{us=#{}}),
beam_ssa:linearize(Blocks).
%%%
@@ -87,13 +88,22 @@ shortcut_opt(#st{bs=Blocks}=St) ->
%% opportunities for optimizations compared to post order. (Based on
%% running scripts/diffable with both PO and RPO and looking at
%% the diff.)
+ %%
+ %% Unfortunately, processing the blocks in reverse post order
+ %% potentially makes the time complexity quadratic or even cubic if
+ %% the ordset of unset variables grows large, instead of
+ %% linear for post order processing. We try to still get reasonable
+ %% compilation times by optimizations that will keep the constant
+ %% factor as low as possible, and we try to avoid the cubic time
+ %% complexity by trying to keep the set of unset variables as small
+ %% as possible.
+
Ls = beam_ssa:rpo(Blocks),
- shortcut_opt(Ls, #{from=>0}, St).
+ shortcut_opt(Ls, #{}, St).
-shortcut_opt([L|Ls], Bs0, #st{bs=Blocks0}=St) ->
+shortcut_opt([L|Ls], Bs, #st{bs=Blocks0}=St) ->
#b_blk{is=Is,last=Last0} = Blk0 = get_block(L, St),
- Bs = Bs0#{from:=L},
- case shortcut_terminator(Last0, Is, Bs, St) of
+ case shortcut_terminator(Last0, Is, L, Bs, St) of
Last0 ->
%% No change. No need to update the block.
shortcut_opt(Ls, Bs, St);
@@ -107,17 +117,17 @@ shortcut_opt([L|Ls], Bs0, #st{bs=Blocks0}=St) ->
shortcut_opt([], _, St) -> St.
shortcut_terminator(#b_br{bool=#b_literal{val=true},succ=Succ0},
- _Is, Bs, St0) ->
+ _Is, From, Bs, St0) ->
St = St0#st{rel_op=none},
- shortcut(Succ0, Bs, St);
+ shortcut(Succ0, From, Bs, St);
shortcut_terminator(#b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0}=Br,
- Is, Bs, St0) ->
+ Is, From, Bs, St0) ->
St = St0#st{target=one_way},
RelOp = get_rel_op(Bool, Is),
SuccBs = bind_var(Bool, #b_literal{val=true}, Bs),
- BrSucc = shortcut(Succ0, SuccBs, St#st{rel_op=RelOp}),
+ BrSucc = shortcut(Succ0, From, SuccBs, St#st{rel_op=RelOp}),
FailBs = bind_var(Bool, #b_literal{val=false}, Bs),
- BrFail = shortcut(Fail0, FailBs, St#st{rel_op=invert_op(RelOp)}),
+ BrFail = shortcut(Fail0, From, FailBs, St#st{rel_op=invert_op(RelOp)}),
case {BrSucc,BrFail} of
{#b_br{bool=#b_literal{val=true},succ=Succ},
#b_br{bool=#b_literal{val=true},succ=Fail}}
@@ -128,25 +138,25 @@ shortcut_terminator(#b_br{bool=#b_var{}=Bool,succ=Succ0,fail=Fail0}=Br,
%% No change.
Br
end;
-shortcut_terminator(#b_switch{arg=Bool,list=List0}=Sw, _Is, Bs, St) ->
- List = shortcut_switch(List0, Bool, Bs, St),
+shortcut_terminator(#b_switch{arg=Bool,list=List0}=Sw, _Is, From, Bs, St) ->
+ List = shortcut_switch(List0, Bool, From, Bs, St),
beam_ssa:normalize(Sw#b_switch{list=List});
-shortcut_terminator(Last, _Is, _Bs, _St) ->
+shortcut_terminator(Last, _Is, _Bs, _From, _St) ->
Last.
-shortcut_switch([{Lit,L0}|T], Bool, Bs, St0) ->
+shortcut_switch([{Lit,L0}|T], Bool, From, Bs, St0) ->
RelOp = {'=:=',Bool,Lit},
St = St0#st{rel_op=RelOp},
#b_br{bool=#b_literal{val=true},succ=L} =
- shortcut(L0, bind_var(Bool, Lit, Bs), St#st{target=one_way}),
- [{Lit,L}|shortcut_switch(T, Bool, Bs, St0)];
-shortcut_switch([], _, _, _) -> [].
+ shortcut(L0, From, bind_var(Bool, Lit, Bs), St#st{target=one_way}),
+ [{Lit,L}|shortcut_switch(T, Bool, From, Bs, St0)];
+shortcut_switch([], _, _, _, _) -> [].
-shortcut(L, Bs, St) ->
- shortcut_1(L, Bs, ordsets:new(), St).
+shortcut(L, From, Bs, St) ->
+ shortcut_1(L, From, Bs, ordsets:new(), St).
-shortcut_1(L, Bs0, UnsetVars0, St) ->
- case shortcut_2(L, Bs0, UnsetVars0, St) of
+shortcut_1(L, From, Bs0, UnsetVars0, St) ->
+ case shortcut_2(L, From, Bs0, UnsetVars0, St) of
none ->
%% No more shortcuts found. Package up the previous
%% label in an unconditional branch.
@@ -156,13 +166,13 @@ shortcut_1(L, Bs0, UnsetVars0, St) ->
Br;
{#b_br{bool=#b_literal{val=true},succ=Succ},Bs,UnsetVars} ->
%% This is a safe `br`, but try to find a better one.
- shortcut_1(Succ, Bs#{from:=L}, UnsetVars, St)
+ shortcut_1(Succ, L, Bs, UnsetVars, St)
end.
%% Try to shortcut this block, branching to a successor.
-shortcut_2(L, Bs0, UnsetVars0, St) ->
+shortcut_2(L, From, Bs0, UnsetVars0, St) ->
#b_blk{is=Is,last=Last} = get_block(L, St),
- case eval_is(Is, Bs0, St) of
+ case eval_is(Is, From, Bs0, St) of
none ->
%% It is not safe to avoid this block because it
%% has instructions with potential side effects.
@@ -181,127 +191,172 @@ shortcut_2(L, Bs0, UnsetVars0, St) ->
%% We have a potentially suitable br.
%% Now update the set of variables that will never
%% be set if this block will be skipped.
- UnsetVars1 = [V || #b_set{dst=V} <- Is],
- UnsetVars = ordsets:union(UnsetVars0,
- ordsets:from_list(UnsetVars1)),
-
- %% Continue checking whether this br is suitable.
- shortcut_3(Br, Bs#{from:=L}, UnsetVars, St)
+ case update_unset_vars(L, Is, Br, UnsetVars0, St) of
+ unsafe ->
+ %% It is unsafe to use this br,
+ %% because it refers to a variable defined
+ %% in this block.
+ shortcut_unsafe_br(Br, L, Bs, UnsetVars0, St);
+ UnsetVars ->
+ %% Continue checking whether this br is
+ %% suitable.
+ shortcut_test_br(Br, L, Bs, UnsetVars, St)
+ end
end
end.
-shortcut_3(Br, Bs, UnsetVars, #st{target=Target}=St) ->
+shortcut_test_br(Br, From, Bs, UnsetVars, St) ->
case is_br_safe(UnsetVars, Br, St) of
false ->
- %% Branching using this `br` is unsafe, either because it
- %% is an unconditional branch to a phi node, or because
- %% one or more of the variables that are not set will be
- %% used. Try to follow branches of this `br`, to find a
- %% safe `br`.
- case Br of
- #b_br{bool=#b_literal{val=true},succ=L} ->
- case Target of
- L ->
- %% We have reached the forced target, and it
- %% is unsafe. Give up.
- none;
- _ ->
- %% Try following this branch to see whether it
- %% leads to a safe `br`.
- shortcut_2(L, Bs, UnsetVars, St)
- end;
- #b_br{bool=#b_var{},succ=Succ,fail=Fail} ->
- case {Succ,Fail} of
- {L,Target} ->
- %% The failure label is the forced target.
- %% Try following the success label to see
- %% whether it also ultimately ends up at the
- %% forced target.
- shortcut_2(L, Bs, UnsetVars, St);
- {Target,L} ->
- %% The success label is the forced target.
- %% Try following the failure label to see
- %% whether it also ultimately ends up at the
- %% forced target.
- shortcut_2(L, Bs, UnsetVars, St);
- {_,_} ->
- case Target of
- any ->
- %% This two-way branch is unsafe. Try reducing
- %% it to a one-way branch.
- shortcut_two_way(Br, Bs, UnsetVars, St);
- one_way ->
- %% This two-way branch is unsafe. Try reducing
- %% it to a one-way branch.
- shortcut_two_way(Br, Bs, UnsetVars, St);
- _ when is_integer(Target) ->
- %% This two-way branch is unsafe, and
- %% there already is a forced target.
- %% Give up.
- none
- end
- end
- end;
+ shortcut_unsafe_br(Br, From, Bs, UnsetVars, St);
true ->
- %% This `br` instruction is safe. It does not
- %% branch to a phi node, and all variables that
- %% will be used are guaranteed to be defined.
- case Br of
- #b_br{bool=#b_literal{val=true},succ=L} ->
- %% This is a one-way branch.
+ shortcut_safe_br(Br, From, Bs, UnsetVars, St)
+ end.
+
+shortcut_unsafe_br(Br, From, Bs, UnsetVars, #st{target=Target}=St) ->
+ %% Branching using this `br` is unsafe, either because it
+ %% is an unconditional branch to a phi node, or because
+ %% one or more of the variables that are not set will be
+ %% used. Try to follow branches of this `br`, to find a
+ %% safe `br`.
+ case Br of
+ #b_br{bool=#b_literal{val=true},succ=L} ->
+ case Target of
+ L ->
+ %% We have reached the forced target, and it
+ %% is unsafe. Give up.
+ none;
+ _ ->
+ %% Try following this branch to see whether it
+ %% leads to a safe `br`.
+ shortcut_2(L, From, Bs, UnsetVars, St)
+ end;
+ #b_br{bool=#b_var{},succ=Succ,fail=Fail} ->
+ case {Succ,Fail} of
+ {L,Target} ->
+ %% The failure label is the forced target.
+ %% Try following the success label to see
+ %% whether it also ultimately ends up at the
+ %% forced target.
+ shortcut_2(L, From, Bs, UnsetVars, St);
+ {Target,L} ->
+ %% The success label is the forced target.
+ %% Try following the failure label to see
+ %% whether it also ultimately ends up at the
+ %% forced target.
+ shortcut_2(L, From, Bs, UnsetVars, St);
+ {_,_} ->
case Target of
any ->
- %% No forced target. Success!
- {Br,Bs,UnsetVars};
+ %% This two-way branch is unsafe. Try
+ %% reducing it to a one-way branch.
+ shortcut_two_way(Br, From, Bs, UnsetVars, St);
one_way ->
- %% The target must be a one-way branch, which this
- %% `br` is. Success!
- {Br,Bs,UnsetVars};
- L when is_integer(Target) ->
- %% The forced target is L. Success!
- {Br,Bs,UnsetVars};
+ %% This two-way branch is unsafe. Try
+ %% reducing it to a one-way branch.
+ shortcut_two_way(Br, From, Bs, UnsetVars, St);
_ when is_integer(Target) ->
- %% Wrong forced target. Try following this branch
- %% to see if it ultimately ends up at the forced
- %% target.
- shortcut_2(L, Bs, UnsetVars, St)
- end;
- #b_br{bool=#b_var{}} ->
- %% This is a two-way branch.
- if
- Target =:= any; Target =:= one_way ->
- %% No specific forced target. Try to reduce the
- %% two-way branch to an one-way branch.
- case shortcut_two_way(Br, Bs, UnsetVars, St) of
- none when Target =:= any ->
- %% This `br` can't be reduced to a one-way
- %% branch. Return the `br` as-is.
- {Br,Bs,UnsetVars};
- none when Target =:= one_way ->
- %% This `br` can't be reduced to a one-way
- %% branch. The caller wants a one-way branch.
- %% Give up.
- none;
- {_,_,_}=Res ->
- %% This `br` was successfully reduced to a
- %% one-way branch.
- Res
- end;
- is_integer(Target) ->
- %% There is a forced target, which can't
- %% be reached because this `br` is a two-way
- %% branch. Give up.
+ %% This two-way branch is unsafe, and
+ %% there already is a forced target.
+ %% Give up.
none
end
end
end.
-shortcut_two_way(#b_br{succ=Succ,fail=Fail}, Bs0, UnsetVars0, St) ->
- case shortcut_2(Succ, Bs0, UnsetVars0, St#st{target=Fail}) of
+shortcut_safe_br(Br, From, Bs, UnsetVars, #st{target=Target}=St) ->
+ %% This `br` instruction is safe. It does not branch to a phi
+ %% node, and all variables that will be used are guaranteed to be
+ %% defined.
+ case Br of
+ #b_br{bool=#b_literal{val=true},succ=L} ->
+ %% This is a one-way branch.
+ case Target of
+ any ->
+ %% No forced target. Success!
+ {Br,Bs,UnsetVars};
+ one_way ->
+ %% The target must be a one-way branch, which this
+ %% `br` is. Success!
+ {Br,Bs,UnsetVars};
+ L when is_integer(Target) ->
+ %% The forced target is L. Success!
+ {Br,Bs,UnsetVars};
+ _ when is_integer(Target) ->
+ %% Wrong forced target. Try following this branch
+ %% to see if it ultimately ends up at the forced
+ %% target.
+ shortcut_2(L, From, Bs, UnsetVars, St)
+ end;
+ #b_br{bool=#b_var{}} ->
+ %% This is a two-way branch.
+ if
+ Target =:= any; Target =:= one_way ->
+ %% No specific forced target. Try to reduce the
+ %% two-way branch to an one-way branch.
+ case shortcut_two_way(Br, From, Bs, UnsetVars, St) of
+ none when Target =:= any ->
+ %% This `br` can't be reduced to a one-way
+ %% branch. Return the `br` as-is.
+ {Br,Bs,UnsetVars};
+ none when Target =:= one_way ->
+ %% This `br` can't be reduced to a one-way
+ %% branch. The caller wants a one-way
+ %% branch. Give up.
+ none;
+ {_,_,_}=Res ->
+ %% This `br` was successfully reduced to a
+ %% one-way branch.
+ Res
+ end;
+ is_integer(Target) ->
+ %% There is a forced target, which can't
+ %% be reached because this `br` is a two-way
+ %% branch. Give up.
+ none
+ end
+ end.
+
+update_unset_vars(L, Is, Br, UnsetVars, #st{skippable=Skippable}) ->
+ case is_map_key(L, Skippable) of
+ true ->
+ %% None of the variables used in this block are used in
+ %% the successors. Thus, there is no need to add the
+ %% variables to the set of unset variables.
+ case Br of
+ #b_br{bool=#b_var{}=Bool} ->
+ case keymember(Bool, #b_set.dst, Is) of
+ true ->
+ %% Bool is a variable defined in this
+ %% block. Using the br instruction from
+ %% this block (and skipping the body of
+ %% the block) is unsafe.
+ unsafe;
+ false ->
+ %% Bool is either a variable not defined
+ %% in this block or a literal. Adding it
+ %% to the UnsetVars set would not change
+ %% the outcome of the tests in
+ %% is_br_safe/2.
+ UnsetVars
+ end;
+ #b_br{} ->
+ UnsetVars
+ end;
+ false ->
+ %% Some variables defined in this block are used by
+ %% successors. We must update the set of unset variables.
+ SetInThisBlock = [V || #b_set{dst=V} <- Is],
+ ordsets:union(UnsetVars, ordsets:from_list(SetInThisBlock))
+ end.
+
+shortcut_two_way(#b_br{succ=Succ,fail=Fail}, From, Bs0, UnsetVars0, St0) ->
+ case shortcut_2(Succ, From, Bs0, UnsetVars0, St0#st{target=Fail}) of
{#b_br{bool=#b_literal{},succ=Fail},_,_}=Res ->
Res;
none ->
- case shortcut_2(Fail, Bs0, UnsetVars0, St#st{target=Succ}) of
+ St = St0#st{target=Succ},
+ case shortcut_2(Fail, From, Bs0, UnsetVars0, St) of
{#b_br{bool=#b_literal{},succ=Succ},_,_}=Res ->
Res;
none ->
@@ -343,40 +398,42 @@ is_forbidden(L, St) ->
%% Return the updated bindings, or 'none' if there is
%% any instruction with potential side effects.
-eval_is([#b_set{op=phi,dst=Dst,args=Args}|Is], Bs0, St) ->
- From = maps:get(from, Bs0),
- [Val] = [Val || {Val,Pred} <- Args, Pred =:= From],
+eval_is([#b_set{op=phi,dst=Dst,args=Args}|Is], From, Bs0, St) ->
+ Val = get_phi_arg(Args, From),
Bs = bind_var(Dst, Val, Bs0),
- eval_is(Is, Bs, St);
-eval_is([#b_set{op={bif,_},dst=Dst}=I0|Is], Bs, St) ->
+ eval_is(Is, From, Bs, St);
+eval_is([#b_set{op={bif,_},dst=Dst}=I0|Is], From, Bs, St) ->
I = sub(I0, Bs),
case eval_bif(I, St) of
#b_literal{}=Val ->
- eval_is(Is, bind_var(Dst, Val, Bs), St);
+ eval_is(Is, From, bind_var(Dst, Val, Bs), St);
none ->
- eval_is(Is, Bs, St)
+ eval_is(Is, From, Bs, St)
end;
-eval_is([#b_set{op=Op,dst=Dst}=I|Is], Bs, St)
+eval_is([#b_set{op=Op,dst=Dst}=I|Is], From, Bs, St)
when Op =:= is_tagged_tuple; Op =:= is_nonempty_list ->
#b_set{args=Args} = sub(I, Bs),
case eval_rel_op(Op, Args, St) of
#b_literal{}=Val ->
- eval_is(Is, bind_var(Dst, Val, Bs), St);
+ eval_is(Is, From, bind_var(Dst, Val, Bs), St);
none ->
- eval_is(Is, Bs, St)
+ eval_is(Is, From, Bs, St)
end;
-eval_is([#b_set{}=I|Is], Bs, St) ->
+eval_is([#b_set{}=I|Is], From, Bs, St) ->
case beam_ssa:no_side_effect(I) of
true ->
%% This instruction has no side effects. It can
%% safely be omitted.
- eval_is(Is, Bs, St);
+ eval_is(Is, From, Bs, St);
false ->
%% This instruction may have some side effect.
%% It is not safe to avoid this instruction.
none
end;
-eval_is([], Bs, _St) -> Bs.
+eval_is([], _From, Bs, _St) -> Bs.
+
+get_phi_arg([{Val,From}|_], From) -> Val;
+get_phi_arg([_|As], From) -> get_phi_arg(As, From).
eval_terminator(#b_br{bool=#b_var{}=Bool}=Br, Bs, _St) ->
Val = get_value(Bool, Bs),
@@ -446,20 +503,31 @@ eval_bif(#b_set{op={bif,Bif},args=Args}, St) ->
false ->
none;
true ->
- case [Lit || #b_literal{val=Lit} <- Args] of
- LitArgs when length(LitArgs) =:= Arity ->
+ case get_lit_args(Args) of
+ none ->
+ %% Not literal arguments. Try to evaluate
+ %% it based on a previous relational operator.
+ eval_rel_op({bif,Bif}, Args, St);
+ LitArgs ->
try apply(erlang, Bif, LitArgs) of
Val -> #b_literal{val=Val}
catch
error:_ -> none
- end;
- _ ->
- %% Not literal arguments. Try to evaluate
- %% it based on a previous relational operator.
- eval_rel_op({bif,Bif}, Args, St)
+ end
end
end.
+get_lit_args([#b_literal{val=Lit1}]) ->
+ [Lit1];
+get_lit_args([#b_literal{val=Lit1},
+ #b_literal{val=Lit2}]) ->
+ [Lit1,Lit2];
+get_lit_args([#b_literal{val=Lit1},
+ #b_literal{val=Lit2},
+ #b_literal{val=Lit3}]) ->
+ [Lit1,Lit2,Lit3];
+get_lit_args(_) -> none.
+
%%%
%%% Handling of relational operators.
%%%
@@ -795,7 +863,7 @@ combine_eqs_1([L|Ls], #st{bs=Blocks0}=St0) ->
%% Everything OK! Combine the lists.
Sw0 = #b_switch{arg=Arg,fail=Fail,list=List},
Sw = beam_ssa:normalize(Sw0),
- Blk0 = maps:get(L, Blocks0),
+ Blk0 = map_get(L, Blocks0),
Blk = Blk0#b_blk{last=Sw},
Blocks = Blocks0#{L:=Blk},
St = St0#st{bs=Blocks},
@@ -819,8 +887,8 @@ combine_eqs_1([], St) -> St.
comb_get_sw(L, Blocks) ->
comb_get_sw(L, true, Blocks).
-comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}=St) ->
- #b_blk{is=Is,last=Last} = maps:get(L, Blocks),
+comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}) ->
+ #b_blk{is=Is,last=Last} = map_get(L, Blocks),
Safe1 = Safe0 andalso is_map_key(L, Skippable),
case Last of
#b_ret{} ->
@@ -834,8 +902,8 @@ comb_get_sw(L, Safe0, #st{bs=Blocks,skippable=Skippable}=St) ->
{#b_set{},_} ->
none
end;
- #b_br{bool=#b_literal{val=true},succ=Succ} ->
- comb_get_sw(Succ, Safe1, St);
+ #b_br{} ->
+ none;
#b_switch{arg=#b_var{}=Arg,fail=Fail,list=List} ->
{none,Safe} = comb_is(Is, none, Safe1),
{Safe,Arg,L,Fail,List}
@@ -915,15 +983,15 @@ used_vars([{L,#b_blk{is=Is}=Blk}|Bs], UsedVars0, Skip0) ->
%% shortcut_opt/1.
Successors = beam_ssa:successors(Blk),
- Used0 = used_vars_succ(Successors, L, UsedVars0),
+ Used0 = used_vars_succ(Successors, L, UsedVars0, []),
Used = used_vars_blk(Blk, Used0),
UsedVars = used_vars_phis(Is, L, Used, UsedVars0),
- %% combine_eqs/1 needs different variable usage
- %% information than shortcut_opt/1. The Skip
- %% map will have an entry for each block that
- %% can be skipped (does not bind any variable used
- %% in successor).
+ %% combine_eqs/1 needs different variable usage information than
+ %% shortcut_opt/1. The Skip map will have an entry for each block
+ %% that can be skipped (does not bind any variable used in
+ %% successor). This information is also useful for speeding up
+ %% shortcut_opt/1.
Defined0 = [Def || #b_set{dst=Def} <- Is],
Defined = ordsets:from_list(Defined0),
@@ -938,19 +1006,22 @@ used_vars([{L,#b_blk{is=Is}=Blk}|Bs], UsedVars0, Skip0) ->
used_vars([], UsedVars, Skip) ->
{UsedVars,Skip}.
-used_vars_succ([S|Ss], L, UsedVars) ->
- Live0 = used_vars_succ(Ss, L, UsedVars),
+used_vars_succ([S|Ss], L, LiveMap, Live0) ->
Key = {S,L},
- case UsedVars of
+ case LiveMap of
#{Key:=Live} ->
- ordsets:union(Live, Live0);
+ %% The successor has a phi node, and the value for
+ %% this block in the phi node is a variable.
+ used_vars_succ(Ss, L, LiveMap, ordsets:union(Live, Live0));
#{S:=Live} ->
- ordsets:union(Live, Live0);
+ %% No phi node in the successor, or the value for
+ %% this block in the phi node is a literal.
+ used_vars_succ(Ss, L, LiveMap, ordsets:union(Live, Live0));
#{} ->
- Live0
+ %% A peek_message block which has not been processed yet.
+ used_vars_succ(Ss, L, LiveMap, Live0)
end;
-used_vars_succ([], _, _) ->
- ordsets:new().
+used_vars_succ([], _, _, Acc) -> Acc.
used_vars_phis(Is, L, Live0, UsedVars0) ->
UsedVars = UsedVars0#{L=>Live0},
@@ -992,11 +1063,12 @@ used_vars_is([], Used) ->
sub(#b_set{args=Args}=I, Sub) ->
I#b_set{args=[sub_arg(A, Sub) || A <- Args]}.
-sub_arg(Old, Sub) ->
+sub_arg(#b_var{}=Old, Sub) ->
case Sub of
#{Old:=New} -> New;
#{} -> Old
- end.
+ end;
+sub_arg(Old, _Sub) -> Old.
rel2fam(S0) ->
S1 = sofs:relation(S0),
diff --git a/lib/compiler/src/beam_ssa_funs.erl b/lib/compiler/src/beam_ssa_funs.erl
index 38df50fd74..e77c00fa89 100644
--- a/lib/compiler/src/beam_ssa_funs.erl
+++ b/lib/compiler/src/beam_ssa_funs.erl
@@ -47,14 +47,14 @@ module(#b_module{body=Fs0}=Module, _Opts) ->
%% the same arguments in the same order, we can shave off a call by short-
%% circuiting it.
find_trampolines(#b_function{args=Args,bs=Blocks}=F, Trampolines) ->
- case maps:get(0, Blocks) of
+ case map_get(0, Blocks) of
#b_blk{is=[#b_set{op=call,
args=[#b_local{}=Actual | Args],
dst=Dst}],
last=#b_ret{arg=Dst}} ->
{_, Name, Arity} = beam_ssa:get_anno(func_info, F),
Trampoline = #b_local{name=#b_literal{val=Name},arity=Arity},
- maps:put(Trampoline, Actual, Trampolines);
+ Trampolines#{Trampoline => Actual};
_ ->
Trampolines
end.
@@ -80,7 +80,7 @@ lfo_analyze_is([#b_set{op=make_fun,
lfo_analyze_is([#b_set{op=call,
args=[Fun | CallArgs]} | Is],
LFuns) when is_map_key(Fun, LFuns) ->
- #b_set{args=[#b_local{arity=Arity} | FreeVars]} = maps:get(Fun, LFuns),
+ #b_set{args=[#b_local{arity=Arity} | FreeVars]} = map_get(Fun, LFuns),
case length(CallArgs) + length(FreeVars) of
Arity ->
lfo_analyze_is(Is, maps:without(CallArgs, LFuns));
@@ -133,7 +133,7 @@ lfo_optimize_1([], _LFuns, _Trampolines) ->
lfo_optimize_is([#b_set{op=call,
args=[Fun | CallArgs]}=Call0 | Is],
LFuns, Trampolines) when is_map_key(Fun, LFuns) ->
- #b_set{args=[Local | FreeVars]} = maps:get(Fun, LFuns),
+ #b_set{args=[Local | FreeVars]} = map_get(Fun, LFuns),
Args = [lfo_short_circuit(Local, Trampolines) | CallArgs ++ FreeVars],
Call = beam_ssa:add_anno(local_fun_opt, Fun, Call0#b_set{args=Args}),
[Call | lfo_optimize_is(Is, LFuns, Trampolines)];
diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl
index 2c898ba6f8..90c0d3cf16 100644
--- a/lib/compiler/src/beam_ssa_opt.erl
+++ b/lib/compiler/src/beam_ssa_opt.erl
@@ -79,14 +79,12 @@ module(Module, Opts) ->
{ok, finish(Module, StMap)}.
phase([FuncId | Ids], Ps, StMap, FuncDb0) ->
- try
- {St, FuncDb} =
- compile:run_sub_passes(Ps, {map_get(FuncId, StMap), FuncDb0}),
-
- phase(Ids, Ps, StMap#{ FuncId => St }, FuncDb)
+ try compile:run_sub_passes(Ps, {map_get(FuncId, StMap), FuncDb0}) of
+ {St, FuncDb} ->
+ phase(Ids, Ps, StMap#{ FuncId => St }, FuncDb)
catch
Class:Error:Stack ->
- #b_local{name=Name,arity=Arity} = FuncId,
+ #b_local{name=#b_literal{val=Name},arity=Arity} = FuncId,
io:fwrite("Function: ~w/~w\n", [Name,Arity]),
erlang:raise(Class, Error, Stack)
end;
@@ -166,15 +164,18 @@ repeated_passes(Opts) ->
epilogue_passes(Opts) ->
Ps = [?PASS(ssa_opt_type_finish),
?PASS(ssa_opt_float),
- ?PASS(ssa_opt_live), %One last time to clean up the
- %mess left by the float pass.
+ ?PASS(ssa_opt_sw),
+
+ %% Run live one more time to clean up after the float and sw
+ %% passes.
+ ?PASS(ssa_opt_live),
?PASS(ssa_opt_bsm),
?PASS(ssa_opt_bsm_units),
?PASS(ssa_opt_bsm_shortcut),
- ?PASS(ssa_opt_sw),
?PASS(ssa_opt_blockify),
?PASS(ssa_opt_sink),
?PASS(ssa_opt_merge_blocks),
+ ?PASS(ssa_opt_get_tuple_element),
?PASS(ssa_opt_trim_unreachable)],
passes_1(Ps, Opts).
@@ -251,22 +252,14 @@ fdb_update(Caller, Callee, FuncDb) ->
FuncDb#{ Caller => CallerVertex#func_info{out=Calls},
Callee => CalleeVertex#func_info{in=CalledBy} }.
-%% Returns the post-order of all local calls in this module. That is, it starts
-%% with the functions that don't call any others and then walks up the call
-%% chain.
+%% Returns the post-order of all local calls in this module. That is,
+%% called functions will be ordered before the functions calling them.
%%
%% Functions where module-level optimization is disabled are added last in
%% arbitrary order.
get_call_order_po(StMap, FuncDb) ->
- Leaves = maps:fold(fun(Id, #func_info{out=[]}, Acc) ->
- [Id | Acc];
- (_, _, Acc) ->
- Acc
- end, [], FuncDb),
-
- Order = gco_po_1(sort(Leaves), FuncDb, [], #{}),
-
+ Order = gco_po(FuncDb),
Order ++ maps:fold(fun(K, _V, Acc) ->
case is_map_key(K, FuncDb) of
false -> [K | Acc];
@@ -274,20 +267,23 @@ get_call_order_po(StMap, FuncDb) ->
end
end, [], StMap).
-gco_po_1([Id | Ids], FuncDb, Children, Seen) when not is_map_key(Id, Seen) ->
- [Id | gco_po_1(Ids, FuncDb, [Id | Children], Seen#{ Id => true })];
-gco_po_1([_Id | Ids], FuncDb, Children, Seen) ->
- gco_po_1(Ids, FuncDb, Children, Seen);
-gco_po_1([], FuncDb, [_|_]=Children, Seen) ->
- gco_po_1(gco_po_parents(Children, FuncDb), FuncDb, [], Seen);
-gco_po_1([], _FuncDb, [], _Seen) ->
- [].
+gco_po(FuncDb) ->
+ All = sort(maps:keys(FuncDb)),
+ {RPO,_} = gco_rpo(All, FuncDb, cerl_sets:new(), []),
+ reverse(RPO).
-gco_po_parents([Child | Children], FuncDb) ->
- #{ Child := #func_info{in=Parents}} = FuncDb,
- Parents ++ gco_po_parents(Children, FuncDb);
-gco_po_parents([], _FuncDb) ->
- [].
+gco_rpo([Id|Ids], FuncDb, Seen0, Acc0) ->
+ case cerl_sets:is_element(Id, Seen0) of
+ true ->
+ gco_rpo(Ids, FuncDb, Seen0, Acc0);
+ false ->
+ #func_info{out=Successors} = map_get(Id, FuncDb),
+ Seen1 = cerl_sets:add_element(Id, Seen0),
+ {Acc,Seen} = gco_rpo(Successors, FuncDb, Seen1, Acc0),
+ gco_rpo(Ids, FuncDb, Seen, [Id|Acc])
+ end;
+gco_rpo([], _, Seen, Acc) ->
+ {Acc,Seen}.
%%%
%%% Trivial sub passes.
@@ -364,7 +360,7 @@ ssa_opt_coalesce_phis({#st{ssa=Blocks0}=St, FuncDb}) ->
{St#st{ssa=Blocks}, FuncDb}.
c_phis_1([L|Ls], Blocks0) ->
- case maps:get(L, Blocks0) of
+ case map_get(L, Blocks0) of
#b_blk{is=[#b_set{op=phi}|_]}=Blk ->
Blocks = c_phis_2(L, Blk, Blocks0),
c_phis_1(Ls, Blocks);
@@ -403,7 +399,7 @@ c_phis_args_1([{Var,Pred}|As], Blocks) ->
c_phis_args_1([], _Blocks) -> none.
c_get_pred_vars(Var, Pred, Blocks) ->
- case maps:get(Pred, Blocks) of
+ case map_get(Pred, Blocks) of
#b_blk{is=[#b_set{op=phi,dst=Var,args=Args}]} ->
{Var,Pred,Args};
#b_blk{} ->
@@ -424,7 +420,7 @@ c_rewrite_phi([A|As], Info) ->
c_rewrite_phi([], _Info) -> [].
c_fix_branches([{_,Pred}|As], L, Blocks0) ->
- #b_blk{last=Last0} = Blk0 = maps:get(Pred, Blocks0),
+ #b_blk{last=Last0} = Blk0 = map_get(Pred, Blocks0),
#b_br{bool=#b_literal{val=true}} = Last0, %Assertion.
Last = Last0#b_br{bool=#b_literal{val=true},succ=L,fail=L},
Blk = Blk0#b_blk{last=Last},
@@ -687,6 +683,14 @@ record_opt_is([#b_set{op={bif,is_tuple},dst=Bool,args=[Tuple]}=Set],
no ->
[Set]
end;
+record_opt_is([I|Is]=Is0, #b_br{bool=Bool}=Last, Blocks) ->
+ case is_tagged_tuple_1(Is0, Last, Blocks) of
+ {yes,_Fail,Tuple,Arity,Tag} ->
+ Args = [Tuple,Arity,Tag],
+ [I#b_set{op=is_tagged_tuple,dst=Bool,args=Args}];
+ no ->
+ [I|record_opt_is(Is, Last, Blocks)]
+ end;
record_opt_is([I|Is], Last, Blocks) ->
[I|record_opt_is(Is, Last, Blocks)];
record_opt_is([], _Last, _Blocks) -> [].
@@ -694,29 +698,30 @@ record_opt_is([], _Last, _Blocks) -> [].
is_tagged_tuple(#b_var{}=Tuple, Bool,
#b_br{bool=Bool,succ=Succ,fail=Fail},
Blocks) ->
- SuccBlk = maps:get(Succ, Blocks),
- is_tagged_tuple_1(SuccBlk, Tuple, Fail, Blocks);
+ #b_blk{is=Is,last=Last} = map_get(Succ, Blocks),
+ case is_tagged_tuple_1(Is, Last, Blocks) of
+ {yes,Fail,Tuple,Arity,Tag} ->
+ {yes,Arity,Tag};
+ _ ->
+ no
+ end;
is_tagged_tuple(_, _, _, _) -> no.
-is_tagged_tuple_1(#b_blk{is=Is,last=Last}, Tuple, Fail, Blocks) ->
- case Is of
- [#b_set{op={bif,tuple_size},dst=ArityVar,
- args=[#b_var{}=Tuple]},
- #b_set{op={bif,'=:='},
- dst=Bool,
- args=[ArityVar, #b_literal{val=ArityVal}=Arity]}]
- when is_integer(ArityVal) ->
- case Last of
- #b_br{bool=Bool,succ=Succ,fail=Fail} ->
- SuccBlk = maps:get(Succ, Blocks),
- case is_tagged_tuple_2(SuccBlk, Tuple, Fail) of
- no ->
- no;
- {yes,Tag} ->
- {yes,Arity,Tag}
- end;
- _ ->
- no
+is_tagged_tuple_1(Is, Last, Blocks) ->
+ case {Is,Last} of
+ {[#b_set{op={bif,tuple_size},dst=ArityVar,
+ args=[#b_var{}=Tuple]},
+ #b_set{op={bif,'=:='},
+ dst=Bool,
+ args=[ArityVar, #b_literal{val=ArityVal}=Arity]}],
+ #b_br{bool=Bool,succ=Succ,fail=Fail}}
+ when is_integer(ArityVal) ->
+ SuccBlk = map_get(Succ, Blocks),
+ case is_tagged_tuple_2(SuccBlk, Tuple, Fail) of
+ no ->
+ no;
+ {yes,Tag} ->
+ {yes,Fail,Tuple,Arity,Tag}
end;
_ ->
no
@@ -759,7 +764,7 @@ ssa_opt_cse({#st{ssa=Linear}=St, FuncDb}) ->
{St#st{ssa=cse(Linear, #{}, M)}, FuncDb}.
cse([{L,#b_blk{is=Is0,last=Last0}=Blk}|Bs], Sub0, M0) ->
- Es0 = maps:get(L, M0),
+ Es0 = map_get(L, M0),
{Is1,Es,Sub} = cse_is(Is0, Es0, Sub0, []),
Last = sub(Last0, Sub),
M = cse_successors(Is1, Blk, Es, M0),
@@ -854,6 +859,7 @@ cse_expr(#b_set{op=Op,args=Args}=I) ->
cse_suitable(#b_set{op=get_hd}) -> true;
cse_suitable(#b_set{op=get_tl}) -> true;
cse_suitable(#b_set{op=put_list}) -> true;
+cse_suitable(#b_set{op=get_tuple_element}) -> true;
cse_suitable(#b_set{op=put_tuple}) -> true;
cse_suitable(#b_set{op={bif,tuple_size}}) ->
%% Doing CSE for tuple_size/1 can prevent the
@@ -905,6 +911,11 @@ ssa_opt_float({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) ->
{Linear,Count} = float_opt(Linear0, Count0, Fs),
{St#st{ssa=Linear,cnt=Count}, FuncDb}.
+float_blk_is_in_guard(#b_blk{last=#b_br{fail=F}}, #fs{non_guards=NonGuards}) ->
+ not gb_sets:is_member(F, NonGuards);
+float_blk_is_in_guard(#b_blk{}, #fs{}) ->
+ false.
+
float_non_guards([{L,#b_blk{is=Is}}|Bs]) ->
case Is of
[#b_set{op=landingpad}|_] ->
@@ -914,21 +925,18 @@ float_non_guards([{L,#b_blk{is=Is}}|Bs]) ->
end;
float_non_guards([]) -> [?BADARG_BLOCK].
-float_opt([{L,#b_blk{last=#b_br{fail=F}}=Blk}|Bs0],
- Count0, #fs{non_guards=NonGuards}=Fs) ->
- case gb_sets:is_member(F, NonGuards) of
+float_opt([{L,Blk}|Bs0], Count0, Fs) ->
+ case float_blk_is_in_guard(Blk, Fs) of
true ->
- %% This block is not inside a guard.
- %% We can do the optimization.
- float_opt_1(L, Blk, Bs0, Count0, Fs);
- false ->
%% This block is inside a guard. Don't do
%% any floating point optimizations.
{Bs,Count} = float_opt(Bs0, Count0, Fs),
- {[{L,Blk}|Bs],Count}
+ {[{L,Blk}|Bs],Count};
+ false ->
+ %% This block is not inside a guard.
+ %% We can do the optimization.
+ float_opt_1(L, Blk, Bs0, Count0, Fs)
end;
-float_opt([{L,Blk}|Bs], Count, Fs) ->
- float_opt_1(L, Blk, Bs, Count, Fs);
float_opt([], Count, _Fs) ->
{[],Count}.
@@ -1004,10 +1012,14 @@ float_conv([{L,#b_blk{is=Is0}=Blk0}|Bs0], Fail, Count0) ->
float_maybe_flush(Blk0, #fs{s=cleared,fail=Fail,bs=Blocks}=Fs0, Count0) ->
#b_blk{last=#b_br{bool=#b_var{},succ=Succ}=Br} = Blk0,
- #b_blk{is=Is} = maps:get(Succ, Blocks),
+
+ %% If the success block starts with a floating point operation, we can
+ %% defer flushing to that block as long as it isn't a guard.
+ #b_blk{is=Is} = SuccBlk = map_get(Succ, Blocks),
+ SuccIsGuard = float_blk_is_in_guard(SuccBlk, Fs0),
+
case Is of
- [#b_set{anno=#{float_op:=_}}|_] ->
- %% The next operation is also a floating point operation.
+ [#b_set{anno=#{float_op:=_}}|_] when not SuccIsGuard ->
%% No flush needed.
{[],Blk0,Fs0,Count0};
_ ->
@@ -1151,25 +1163,28 @@ ssa_opt_live({#st{ssa=Linear0}=St, FuncDb}) ->
live_opt([{L,Blk0}|Bs], LiveMap0, Blocks) ->
Blk1 = beam_ssa_share:block(Blk0, Blocks),
Successors = beam_ssa:successors(Blk1),
- Live0 = live_opt_succ(Successors, L, LiveMap0),
+ Live0 = live_opt_succ(Successors, L, LiveMap0, gb_sets:empty()),
{Blk,Live} = live_opt_blk(Blk1, Live0),
LiveMap = live_opt_phis(Blk#b_blk.is, L, Live, LiveMap0),
live_opt(Bs, LiveMap, Blocks#{L:=Blk});
live_opt([], _, Acc) -> Acc.
-live_opt_succ([S|Ss], L, LiveMap) ->
- Live0 = live_opt_succ(Ss, L, LiveMap),
+live_opt_succ([S|Ss], L, LiveMap, Live0) ->
Key = {S,L},
case LiveMap of
#{Key:=Live} ->
- gb_sets:union(Live, Live0);
+ %% The successor has a phi node, and the value for
+ %% this block in the phi node is a variable.
+ live_opt_succ(Ss, L, LiveMap, gb_sets:union(Live, Live0));
#{S:=Live} ->
- gb_sets:union(Live, Live0);
+ %% No phi node in the successor, or the value for
+ %% this block in the phi node is a literal.
+ live_opt_succ(Ss, L, LiveMap, gb_sets:union(Live, Live0));
#{} ->
- Live0
+ %% A peek_message block which has not been processed yet.
+ live_opt_succ(Ss, L, LiveMap, Live0)
end;
-live_opt_succ([], _, _) ->
- gb_sets:empty().
+live_opt_succ([], _, _, Acc) -> Acc.
live_opt_phis(Is, L, Live0, LiveMap0) ->
LiveMap = LiveMap0#{L=>Live0},
@@ -1220,7 +1235,7 @@ live_opt_is([#b_set{op=succeeded,dst=SuccDst=SuccDstVar,
case gb_sets:is_member(SuccDst, Live0) of
true ->
Live1 = gb_sets:add(Dst, Live0),
- Live = gb_sets:delete_any(SuccDst, Live1),
+ Live = gb_sets:delete(SuccDst, Live1),
live_opt_is([I|Is], Live, [SuccI|Acc]);
false ->
live_opt_is([I|Is], Live0, Acc)
@@ -1231,7 +1246,7 @@ live_opt_is([#b_set{dst=Dst}=I|Is], Live0, Acc) ->
case gb_sets:is_member(Dst, Live0) of
true ->
Live1 = gb_sets:union(Live0, gb_sets:from_ordset(beam_ssa:used(I))),
- Live = gb_sets:delete_any(Dst, Live1),
+ Live = gb_sets:delete(Dst, Live1),
live_opt_is(Is, Live, [I|Acc]);
false ->
case beam_ssa:no_side_effect(I) of
@@ -1375,7 +1390,7 @@ bsm_positions([{L,#b_blk{is=Is,last=Last}}|Bs], PosMap0) ->
case {Is,Last} of
{[#b_set{op=bs_test_tail,dst=Bool,args=[Ctx,#b_literal{val=Bits0}]}],
#b_br{bool=Bool,fail=Fail}} ->
- Bits = Bits0 + maps:get(Ctx, PosMap0),
+ Bits = Bits0 + map_get(Ctx, PosMap0),
bsm_positions(Bs, PosMap#{L=>{Bits,Fail}});
{_,_} ->
bsm_positions(Bs, PosMap)
@@ -1467,7 +1482,7 @@ bsm_units_skip_1([#b_set{op=bs_match,
Block0, Units) ->
[#b_set{op=succeeded,dst=Bool,args=[New]}] = Test, %Assertion.
#b_br{bool=Bool} = Last0 = Block0#b_blk.last, %Assertion.
- CtxUnit = maps:get(Ctx, Units),
+ CtxUnit = map_get(Ctx, Units),
if
CtxUnit rem OpUnit =:= 0 ->
Is = takewhile(fun(I) -> I =/= Skip end, Block0#b_blk.is),
@@ -1479,7 +1494,7 @@ bsm_units_skip_1([#b_set{op=bs_match,
end;
bsm_units_skip_1([#b_set{op=bs_match,dst=New,args=Args}|_], Block, Units) ->
[_,Ctx|_] = Args,
- CtxUnit = maps:get(Ctx, Units),
+ CtxUnit = map_get(Ctx, Units),
OpUnit = bsm_op_unit(Args),
{Block, Units#{ New => gcd(OpUnit, CtxUnit) }};
bsm_units_skip_1([_I | Is], Block, Units) ->
@@ -1507,23 +1522,23 @@ bsm_op_unit(_) ->
%% may differ between them, so we can only keep the information that is common
%% to all paths.
bsm_units_join(Lbl, MapA, UnitMaps0) when is_map_key(Lbl, UnitMaps0) ->
- MapB = maps:get(Lbl, UnitMaps0),
+ MapB = map_get(Lbl, UnitMaps0),
Merged = if
map_size(MapB) =< map_size(MapA) ->
bsm_units_join_1(maps:keys(MapB), MapA, MapB);
map_size(MapB) > map_size(MapA) ->
bsm_units_join_1(maps:keys(MapA), MapB, MapA)
end,
- maps:put(Lbl, Merged, UnitMaps0);
+ UnitMaps0#{Lbl := Merged};
bsm_units_join(Lbl, MapA, UnitMaps0) when MapA =/= #{} ->
- maps:put(Lbl, MapA, UnitMaps0);
+ UnitMaps0#{Lbl => MapA};
bsm_units_join(_Lbl, _MapA, UnitMaps0) ->
UnitMaps0.
bsm_units_join_1([Key | Keys], Left, Right) when is_map_key(Key, Left) ->
- UnitA = maps:get(Key, Left),
- UnitB = maps:get(Key, Right),
- bsm_units_join_1(Keys, Left, maps:put(Key, gcd(UnitA, UnitB), Right));
+ UnitA = map_get(Key, Left),
+ UnitB = map_get(Key, Right),
+ bsm_units_join_1(Keys, Left, Right#{Key := gcd(UnitA, UnitB)});
bsm_units_join_1([Key | Keys], Left, Right) ->
bsm_units_join_1(Keys, Left, maps:remove(Key, Right));
bsm_units_join_1([], _MapA, Right) ->
@@ -1834,12 +1849,16 @@ opt_tup_size_is([], _, _, _Acc) -> none.
%%%
ssa_opt_sw({#st{ssa=Linear0,cnt=Count0}=St, FuncDb}) ->
- {Linear,Count} = opt_sw(Linear0, #{}, Count0, []),
+ {Linear,Count} = opt_sw(Linear0, Count0, []),
{St#st{ssa=Linear,cnt=Count}, FuncDb}.
-opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) ->
- Phis = opt_sw_phis(Is, Phis0),
- case opt_sw_last(Last0, Phis) of
+opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Sw0}=Blk0}|Bs], Count0, Acc) ->
+ %% Ensure that no label in the switch list is the same
+ %% as the failure label.
+ #b_switch{fail=Fail,list=List0} = Sw0,
+ List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail],
+ Sw1 = beam_ssa:normalize(Sw0#b_switch{list=List}),
+ case Sw1 of
#b_switch{arg=Arg,fail=Fail,list=[{Lit,Lbl}]} ->
%% Rewrite a single value switch to a br.
Bool = #b_var{name={'@ssa_bool',Count0}},
@@ -1847,7 +1866,7 @@ opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) -
IsEq = #b_set{op={bif,'=:='},dst=Bool,args=[Arg,Lit]},
Br = #b_br{bool=Bool,succ=Lbl,fail=Fail},
Blk = Blk0#b_blk{is=Is++[IsEq],last=Br},
- opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]);
+ opt_sw(Bs, Count, [{L,Blk}|Acc]);
#b_switch{arg=Arg,fail=Fail,
list=[{#b_literal{val=B1},Lbl},{#b_literal{val=B2},Lbl}]}
when B1 =:= not B2 ->
@@ -1857,71 +1876,18 @@ opt_sw([{L,#b_blk{is=Is,last=#b_switch{}=Last0}=Blk0}|Bs], Phis0, Count0, Acc) -
IsBool = #b_set{op={bif,is_boolean},dst=Bool,args=[Arg]},
Br = #b_br{bool=Bool,succ=Lbl,fail=Fail},
Blk = Blk0#b_blk{is=Is++[IsBool],last=Br},
- opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]);
- Last0 ->
- opt_sw(Bs, Phis, Count0, [{L,Blk0}|Acc]);
- Last ->
- Blk = Blk0#b_blk{last=Last},
- opt_sw(Bs, Phis, Count0, [{L,Blk}|Acc])
+ opt_sw(Bs, Count, [{L,Blk}|Acc]);
+ Sw0 ->
+ opt_sw(Bs, Count0, [{L,Blk0}|Acc]);
+ Sw ->
+ Blk = Blk0#b_blk{last=Sw},
+ opt_sw(Bs, Count0, [{L,Blk}|Acc])
end;
-opt_sw([{L,#b_blk{is=Is}=Blk}|Bs], Phis0, Count, Acc) ->
- Phis = opt_sw_phis(Is, Phis0),
- opt_sw(Bs, Phis, Count, [{L,Blk}|Acc]);
-opt_sw([], _Phis, Count, Acc) ->
+opt_sw([{L,#b_blk{}=Blk}|Bs], Count, Acc) ->
+ opt_sw(Bs, Count, [{L,Blk}|Acc]);
+opt_sw([], Count, Acc) ->
{reverse(Acc),Count}.
-opt_sw_phis([#b_set{op=phi,dst=Dst,args=Args}|Is], Phis) ->
- case opt_sw_literals(Args, []) of
- error ->
- opt_sw_phis(Is, Phis);
- Literals ->
- opt_sw_phis(Is, Phis#{Dst=>Literals})
- end;
-opt_sw_phis(_, Phis) -> Phis.
-
-opt_sw_last(#b_switch{arg=Arg,fail=Fail,list=List0}=Sw0, Phis) ->
- case Phis of
- #{Arg:=Values0} ->
- Values = gb_sets:from_list(Values0),
-
- %% Prune the switch list to only contain the possible values.
- List1 = [P || {Lit,_}=P <- List0, gb_sets:is_member(Lit, Values)],
-
- %% Now test whether the failure label can ever be reached.
- Sw = case gb_sets:size(Values) =:= length(List1) of
- true ->
- %% The switch list has the same number of values as the phi node.
- %% The values must be the same, because the values that were not
- %% possible were pruned from the switch list. Therefore, the
- %% failure label can't possibly be reached, and we can choose a
- %% a new failure label by picking a value from the list.
- case List1 of
- [{#b_literal{},Lbl}|List] ->
- Sw0#b_switch{fail=Lbl,list=List};
- [] ->
- Sw0#b_switch{list=List1}
- end;
- false ->
- %% There are some values in the phi node that are not in the
- %% switch list; thus, the failure label can still be reached.
- Sw0
- end,
- beam_ssa:normalize(Sw);
- #{} ->
- %% Ensure that no label in the switch list is the same
- %% as the failure label.
- List = [{Val,Lbl} || {Val,Lbl} <- List0, Lbl =/= Fail],
- Sw = Sw0#b_switch{list=List},
- beam_ssa:normalize(Sw)
- end.
-
-opt_sw_literals([{#b_literal{}=Lit,_}|T], Acc) ->
- opt_sw_literals(T, [Lit|Acc]);
-opt_sw_literals([_|_], _Acc) ->
- error;
-opt_sw_literals([], Acc) -> Acc.
-
-
%%%
%%% Merge blocks.
%%%
@@ -1943,7 +1909,7 @@ merge_blocks_1([L|Ls], Preds0, Blocks0) ->
Is = Is0 ++ Is1,
Blk = Blk1#b_blk{is=Is},
Blocks1 = maps:remove(L, Blocks0),
- Blocks2 = maps:put(P, Blk, Blocks1),
+ Blocks2 = Blocks1#{P:=Blk},
Successors = beam_ssa:successors(Blk),
Blocks = beam_ssa:update_phi_labels(Successors, L, P, Blocks2),
Preds = merge_update_preds(Successors, L, P, Preds0),
@@ -1957,8 +1923,8 @@ merge_blocks_1([L|Ls], Preds0, Blocks0) ->
merge_blocks_1([], _Preds, Blocks) -> Blocks.
merge_update_preds([L|Ls], From, To, Preds0) ->
- Ps = [rename_label(P, From, To) || P <- maps:get(L, Preds0)],
- Preds = maps:put(L, Ps, Preds0),
+ Ps = [rename_label(P, From, To) || P <- map_get(L, Preds0)],
+ Preds = Preds0#{L:=Ps},
merge_update_preds(Ls, From, To, Preds);
merge_update_preds([], _, _, Preds) -> Preds.
@@ -1972,13 +1938,17 @@ verify_merge_is([#b_set{op=Op}|_]) ->
verify_merge_is(_) ->
ok.
-is_merge_allowed(_, _, #b_blk{is=[#b_set{op=peek_message}|_]}) ->
+is_merge_allowed(_, #b_blk{}, #b_blk{is=[#b_set{op=peek_message}|_]}) ->
false;
-is_merge_allowed(L, Blk0, #b_blk{}) ->
- case beam_ssa:successors(Blk0) of
+is_merge_allowed(L, #b_blk{last=#b_br{}}=Blk, #b_blk{}) ->
+ %% The predecessor block must have exactly one successor (L) for
+ %% the merge to be safe.
+ case beam_ssa:successors(Blk) of
[L] -> true;
[_|_] -> false
- end.
+ end;
+is_merge_allowed(_, #b_blk{last=#b_switch{}}, #b_blk{}) ->
+ false.
%%%
%%% When a tuple is matched, the pattern matching compiler generates a
@@ -2001,14 +1971,22 @@ ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) ->
%% Create a map with all variables that define get_tuple_element
%% instructions. The variable name map to the block it is defined in.
- Defs = maps:from_list(def_blocks(Linear)),
+ case def_blocks(Linear) of
+ [] ->
+ %% No get_tuple_element instructions, so there is nothing to do.
+ {St, FuncDb};
+ [_|_]=Defs0 ->
+ Defs = maps:from_list(Defs0),
+ {do_ssa_opt_sink(Linear, Defs, St), FuncDb}
+ end.
+do_ssa_opt_sink(Linear, Defs, #st{ssa=Blocks0}=St) ->
%% Now find all the blocks that use variables defined by get_tuple_element
%% instructions.
Used = used_blocks(Linear, Defs, []),
%% Calculate dominators.
- Dom0 = beam_ssa:dominators(Blocks0),
+ {Dom,Numbering} = beam_ssa:dominators(Blocks0),
%% It is not safe to move get_tuple_element instructions to blocks
%% that begin with certain instructions. It is also unsafe to move
@@ -2016,28 +1994,18 @@ ssa_opt_sink({#st{ssa=Blocks0}=St, FuncDb}) ->
%% unsafe moves, pretend that the unsuitable blocks are not
%% dominators.
Unsuitable = unsuitable(Linear, Blocks0),
- Dom = case gb_sets:is_empty(Unsuitable) of
- true ->
- Dom0;
- false ->
- F = fun(_, DomBy) ->
- [L || L <- DomBy,
- not gb_sets:is_element(L, Unsuitable)]
- end,
- maps:map(F, Dom0)
- end,
%% Calculate new positions for get_tuple_element instructions. The new
%% position is a block that dominates all uses of the variable.
- DefLoc = new_def_locations(Used, Defs, Dom),
+ DefLoc = new_def_locations(Used, Defs, Dom, Numbering, Unsuitable),
%% Now move all suitable get_tuple_element instructions to their
%% new blocks.
Blocks = foldl(fun({V,To}, A) ->
- From = maps:get(V, Defs),
+ From = map_get(V, Defs),
move_defs(V, From, To, A)
end, Blocks0, DefLoc),
- {St#st{ssa=Blocks}, FuncDb}.
+ St#st{ssa=Blocks}.
def_blocks([{L,#b_blk{is=Is}}|Bs]) ->
def_blocks_is(Is, L, def_blocks(Bs));
@@ -2104,11 +2072,11 @@ unsuitable_loop(L, Blocks, Predecessors) ->
unsuitable_loop(L, Blocks, Predecessors, []).
unsuitable_loop(L, Blocks, Predecessors, Acc) ->
- Ps = maps:get(L, Predecessors),
+ Ps = map_get(L, Predecessors),
unsuitable_loop_1(Ps, Blocks, Predecessors, Acc).
unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) ->
- case maps:get(P, Blocks) of
+ case map_get(P, Blocks) of
#b_blk{is=[#b_set{op=peek_message}|_]} ->
unsuitable_loop_1(Ps, Blocks, Predecessors, Acc0);
#b_blk{} ->
@@ -2123,50 +2091,42 @@ unsuitable_loop_1([P|Ps], Blocks, Predecessors, Acc0) ->
end;
unsuitable_loop_1([], _, _, Acc) -> Acc.
-%% new_def_locations([{Variable,[UsedInBlock]}|Vs], Defs, Dominators) ->
-%% [{Variable,NewDefinitionBlock}]
-%% Calculate new locations for get_tuple_element instructions. For each
-%% variable, the new location is a block that dominates all uses of
-%% variable and as near to the uses of as possible. If no such block
-%% distinct from the block where the instruction currently is, the
-%% variable will not be included in the result list.
-
-new_def_locations([{V,UsedIn}|Vs], Defs, Dom) ->
- DefIn = maps:get(V, Defs),
- case common_dom(UsedIn, DefIn, Dom) of
- [] ->
- new_def_locations(Vs, Defs, Dom);
- [_|_]=BetterDef ->
- L = most_dominated(BetterDef, Dom),
- [{V,L}|new_def_locations(Vs, Defs, Dom)]
- end;
-new_def_locations([], _, _) -> [].
-
-common_dom([L|Ls], DefIn, Dom) ->
- DomBy0 = maps:get(L, Dom),
- DomBy = ordsets:subtract(DomBy0, maps:get(DefIn, Dom)),
- common_dom_1(Ls, Dom, DomBy).
-
-common_dom_1(_, _, []) ->
- [];
-common_dom_1([L|Ls], Dom, [_|_]=DomBy0) ->
- DomBy1 = maps:get(L, Dom),
- DomBy = ordsets:intersection(DomBy0, DomBy1),
- common_dom_1(Ls, Dom, DomBy);
-common_dom_1([], _, DomBy) -> DomBy.
-
-most_dominated([L|Ls], Dom) ->
- most_dominated(Ls, L, maps:get(L, Dom), Dom).
-
-most_dominated([L|Ls], L0, DomBy, Dom) ->
- case member(L, DomBy) of
+%% new_def_locations([{Variable,[UsedInBlock]}|Vs], Defs,
+%% Dominators, Numbering, Unsuitable) ->
+%% [{Variable,NewDefinitionBlock}]
+%%
+%% Calculate new locations for get_tuple_element instructions. For
+%% each variable, the new location is a block that dominates all uses
+%% of the variable and as near to the uses of as possible.
+
+new_def_locations([{V,UsedIn}|Vs], Defs, Dom, Numbering, Unsuitable) ->
+ DefIn = map_get(V, Defs),
+ Common = common_dominator(UsedIn, Dom, Numbering, Unsuitable),
+ case member(Common, map_get(DefIn, Dom)) of
true ->
- most_dominated(Ls, L0, DomBy, Dom);
+ %% The common dominator is either DefIn or an
+ %% ancestor of DefIn.
+ new_def_locations(Vs, Defs, Dom, Numbering, Unsuitable);
false ->
- most_dominated(Ls, L, maps:get(L, Dom), Dom)
+ %% We have found a suitable descendant of DefIn,
+ %% to which the get_tuple_element instruction can
+ %% be sunk.
+ [{V,Common}|new_def_locations(Vs, Defs, Dom, Numbering, Unsuitable)]
end;
-most_dominated([], L, _, _) -> L.
+new_def_locations([], _, _, _, _) -> [].
+common_dominator(Ls0, Dom, Numbering, Unsuitable) ->
+ [Common|_] = beam_ssa:common_dominators(Ls0, Dom, Numbering),
+ case gb_sets:is_member(Common, Unsuitable) of
+ true ->
+ %% It is not allowed to place the instruction here. Try
+ %% to find another suitable dominating block by going up
+ %% one step in the dominator tree.
+ [Common,OneUp|_] = map_get(Common, Dom),
+ common_dominator([OneUp], Dom, Numbering, Unsuitable);
+ false ->
+ Common
+ end.
%% Move get_tuple_element instructions to their new locations.
@@ -2206,7 +2166,6 @@ insert_def_is([#b_set{op=Op}=I|Is]=Is0, V, Def) ->
Action0 = case Op of
call -> beyond;
'catch_end' -> beyond;
- set_tuple_element -> beyond;
timeout -> beyond;
_ -> here
end,
@@ -2231,6 +2190,46 @@ insert_def_is([#b_set{op=Op}=I|Is]=Is0, V, Def) ->
insert_def_is([], _V, Def) ->
[Def].
+%%%
+%%% Order consecutive get_tuple_element instructions in ascending
+%%% position order. This will give the loader more opportunities
+%%% for combining get_tuple_element instructions.
+%%%
+
+ssa_opt_get_tuple_element({#st{ssa=Blocks0}=St, FuncDb}) ->
+ Blocks = opt_get_tuple_element(maps:to_list(Blocks0), Blocks0),
+ {St#st{ssa=Blocks}, FuncDb}.
+
+opt_get_tuple_element([{L,#b_blk{is=Is0}=Blk0}|Bs], Blocks) ->
+ case opt_get_tuple_element_is(Is0, false, []) of
+ {yes,Is} ->
+ Blk = Blk0#b_blk{is=Is},
+ opt_get_tuple_element(Bs, Blocks#{L:=Blk});
+ no ->
+ opt_get_tuple_element(Bs, Blocks)
+ end;
+opt_get_tuple_element([], Blocks) -> Blocks.
+
+opt_get_tuple_element_is([#b_set{op=get_tuple_element,
+ args=[#b_var{}=Src,_]}=I0|Is0],
+ _AnyChange, Acc) ->
+ {GetIs0,Is} = collect_get_tuple_element(Is0, Src, [I0]),
+ GetIs1 = sort([{Pos,I} || #b_set{args=[_,Pos]}=I <- GetIs0]),
+ GetIs = [I || {_,I} <- GetIs1],
+ opt_get_tuple_element_is(Is, true, reverse(GetIs, Acc));
+opt_get_tuple_element_is([I|Is], AnyChange, Acc) ->
+ opt_get_tuple_element_is(Is, AnyChange, [I|Acc]);
+opt_get_tuple_element_is([], AnyChange, Acc) ->
+ case AnyChange of
+ true -> {yes,reverse(Acc)};
+ false -> no
+ end.
+
+collect_get_tuple_element([#b_set{op=get_tuple_element,
+ args=[Src,_]}=I|Is], Src, Acc) ->
+ collect_get_tuple_element(Is, Src, [I|Acc]);
+collect_get_tuple_element(Is, _Src, Acc) ->
+ {Acc,Is}.
%%%
%%% Common utilities.
diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl
index fde1118c29..bad43a9c4e 100644
--- a/lib/compiler/src/beam_ssa_pre_codegen.erl
+++ b/lib/compiler/src/beam_ssa_pre_codegen.erl
@@ -124,6 +124,7 @@ passes(Opts) ->
false -> ignore;
true -> ?PASS(fix_tuples)
end,
+ ?PASS(use_set_tuple_element),
?PASS(place_frames),
?PASS(fix_receives),
@@ -272,7 +273,7 @@ make_bs_getpos_map([], _, Count, Acc) ->
{maps:from_list(Acc),Count}.
get_savepoint({_,_}=Ps, SavePoints) ->
- Name = {'@ssa_bs_position', maps:get(Ps, SavePoints)},
+ Name = {'@ssa_bs_position', map_get(Ps, SavePoints)},
#b_var{name=Name}.
make_bs_pos_dict([{Ctx,Pts}|T], Count0, Acc0) ->
@@ -323,7 +324,7 @@ make_restore_map([], _, Count, Acc) ->
make_slot({Same,Same}, _Slots) ->
#b_literal{val=start};
make_slot({_,_}=Ps, Slots) ->
- #b_literal{val=maps:get(Ps, Slots)}.
+ #b_literal{val=map_get(Ps, Slots)}.
make_save_point_dict([{Ctx,Pts}|T], Acc0) ->
Acc = make_save_point_dict_1(Pts, Ctx, 0, Acc0),
@@ -684,7 +685,7 @@ sanitize(#st{ssa=Blocks0,cnt=Count0}=St) ->
St#st{ssa=Blocks,cnt=Count}.
sanitize([L|Ls], Count0, Blocks0, Values0) ->
- #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks0),
+ #b_blk{is=Is0} = Blk0 = map_get(L, Blocks0),
case sanitize_is(Is0, Count0, Values0, false, []) of
no_change ->
sanitize(Ls, Count0, Blocks0, Values0);
@@ -817,7 +818,7 @@ sanitize_badarg(I) ->
I#b_set{op=call,args=[Func,#b_literal{val=badarg}]}.
remove_unreachable([L|Ls], Blocks, Reachable, Acc) ->
- #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks),
+ #b_blk{is=Is0} = Blk0 = map_get(L, Blocks),
case split_phis(Is0) of
{[_|_]=Phis,Rest} ->
Is = [prune_phi(Phi, Reachable) || Phi <- Phis] ++ Rest,
@@ -857,6 +858,202 @@ fix_tuples(#st{ssa=Blocks0,cnt=Count0}=St) ->
St#st{ssa=Blocks,cnt=Count}.
%%%
+%%% Introduce the set_tuple_element instructions to make
+%%% multiple-field record updates faster.
+%%%
+%%% The expansion of record field updates, when more than one field is
+%%% updated, but not a majority of the fields, will create a sequence of
+%%% calls to `erlang:setelement(Index, Value, Tuple)` where Tuple in the
+%%% first call is the original record tuple, and in the subsequent calls
+%%% Tuple is the result of the previous call. Furthermore, all Index
+%%% values are constant positive integers, and the first call to
+%%% `setelement` will have the greatest index. Thus all the following
+%%% calls do not actually need to test at run-time whether Tuple has type
+%%% tuple, nor that the index is within the tuple bounds.
+%%%
+%%% Since this optimization introduces destructive updates, it used to
+%%% be done as the very last Core Erlang pass before going to
+%%% lower-level code. However, it turns out that this kind of destructive
+%%% updates are awkward also in SSA code and can prevent or complicate
+%%% type analysis and aggressive optimizations.
+%%%
+%%% NOTE: Because there no write barriers in the system, this kind of
+%%% optimization can only be done when we are sure that garbage
+%%% collection will not be triggered between the creation of the tuple
+%%% and the destructive updates - otherwise we might insert pointers
+%%% from an older generation to a newer.
+%%%
+
+use_set_tuple_element(#st{ssa=Blocks0}=St) ->
+ Uses = count_uses(Blocks0),
+ RPO = reverse(beam_ssa:rpo(Blocks0)),
+ Blocks = use_ste_1(RPO, Uses, Blocks0),
+ St#st{ssa=Blocks}.
+
+use_ste_1([L|Ls], Uses, Blocks0) ->
+ {Blk0,Blocks} = use_ste_across(L, Uses, Blocks0),
+ #b_blk{is=Is0} = Blk0,
+ case use_ste_is(Is0, Uses) of
+ Is0 ->
+ use_ste_1(Ls, Uses, Blocks);
+ Is ->
+ Blk = Blk0#b_blk{is=Is},
+ use_ste_1(Ls, Uses, Blocks#{L:=Blk})
+ end;
+use_ste_1([], _, Blocks) -> Blocks.
+
+%%% Optimize within a single block.
+
+use_ste_is([#b_set{}=I|Is0], Uses) ->
+ Is = use_ste_is(Is0, Uses),
+ case extract_ste(I) of
+ none ->
+ [I|Is];
+ Extracted ->
+ use_ste_call(Extracted, I, Is, Uses)
+ end;
+use_ste_is([], _Uses) -> [].
+
+use_ste_call({Dst0,Pos0,_Var0,_Val0}, Call1, Is0, Uses) ->
+ case get_ste_call(Is0, []) of
+ {Prefix,{Dst1,Pos1,Dst0,Val1},Call2,Is}
+ when Pos1 > 0, Pos0 > Pos1 ->
+ case is_single_use(Dst0, Uses) of
+ true ->
+ Call = Call1#b_set{dst=Dst1},
+ Args = [Val1,Dst1,#b_literal{val=Pos1-1}],
+ Dsetel = Call2#b_set{op=set_tuple_element,
+ dst=Dst0,
+ args=Args},
+ [Call|Prefix] ++ [Dsetel|Is];
+ false ->
+ [Call1|Is0]
+ end;
+ _ ->
+ [Call1|Is0]
+ end.
+
+get_ste_call([#b_set{op=get_tuple_element}=I|Is], Acc) ->
+ get_ste_call(Is, [I|Acc]);
+get_ste_call([#b_set{op=call}=I|Is], Acc) ->
+ case extract_ste(I) of
+ none ->
+ none;
+ Extracted ->
+ {reverse(Acc),Extracted,I,Is}
+ end;
+get_ste_call(_, _) -> none.
+
+extract_ste(#b_set{op=call,dst=Dst,
+ args=[#b_remote{mod=#b_literal{val=M},
+ name=#b_literal{val=F}}|Args]}) ->
+ case {M,F,Args} of
+ {erlang,setelement,[#b_literal{val=Pos},Tuple,Val]} ->
+ {Dst,Pos,Tuple,Val};
+ {_,_,_} ->
+ none
+ end;
+extract_ste(#b_set{}) -> none.
+
+%%% Optimize accross blocks within a try/catch block.
+
+use_ste_across(L, Uses, Blocks) ->
+ case map_get(L, Blocks) of
+ #b_blk{last=#b_br{bool=#b_var{}}}=Blk ->
+ try
+ use_ste_across_1(L, Blk, Uses, Blocks)
+ catch
+ throw:not_possible ->
+ {Blk,Blocks}
+ end;
+ #b_blk{}=Blk ->
+ {Blk,Blocks}
+ end.
+
+use_ste_across_1(L, Blk0, Uses, Blocks0) ->
+ #b_blk{is=IsThis,last=#b_br{bool=Bool,succ=Next}} = Blk0,
+ case reverse(IsThis) of
+ [#b_set{op=succeeded,dst=Bool,args=[Result]}=Succ0,
+ #b_set{op=call,args=[#b_remote{}|_],dst=Result}=Call1|Prefix] ->
+ case is_single_use(Bool, Uses) andalso
+ is_n_uses(2, Result, Uses) of
+ true -> ok;
+ false -> throw(not_possible)
+ end,
+ Call2 = use_ste_across_next(Next, Uses, Blocks0),
+ Is = [Call1,Call2],
+ case use_ste_is(Is, decrement_uses(Result, Uses)) of
+ [#b_set{}=Call,#b_set{op=set_tuple_element}=Ste] ->
+ Blocks1 = use_ste_fix_next(Ste, Next, Blocks0),
+ Succ = Succ0#b_set{args=[Call#b_set.dst]},
+ Blk = Blk0#b_blk{is=reverse(Prefix, [Call,Succ])},
+ Blocks = Blocks1#{L:=Blk},
+ {Blk,Blocks};
+ _ ->
+ throw(not_possible)
+ end;
+ _ ->
+ throw(not_possible)
+ end.
+
+use_ste_across_next(Next, Uses, Blocks) ->
+ case map_get(Next, Blocks) of
+ #b_blk{is=[#b_set{op=call,dst=Result,args=[#b_remote{}|_]}=Call,
+ #b_set{op=succeeded,dst=Bool,args=[Result]}],
+ last=#b_br{bool=Bool}} ->
+ case is_single_use(Bool, Uses) andalso
+ is_n_uses(2, Result, Uses) of
+ true -> ok;
+ false -> throw(not_possible)
+ end,
+ Call;
+ #b_blk{} ->
+ throw(not_possible)
+ end.
+
+use_ste_fix_next(Ste, Next, Blocks) ->
+ Blk0 = map_get(Next, Blocks),
+ #b_blk{is=[#b_set{op=call},#b_set{op=succeeded}],last=Br0} = Blk0,
+ Br = beam_ssa:normalize(Br0#b_br{bool=#b_literal{val=true}}),
+ Blk = Blk0#b_blk{is=[Ste],last=Br},
+ Blocks#{Next:=Blk}.
+
+%% Count how many times each variable is used.
+
+count_uses(Blocks) ->
+ count_uses_blk(maps:values(Blocks), #{}).
+
+count_uses_blk([#b_blk{is=Is,last=Last}|Bs], CountMap0) ->
+ F = fun(I, CountMap) ->
+ foldl(fun(Var, Acc) ->
+ case Acc of
+ #{Var:=3} -> Acc;
+ #{Var:=C} -> Acc#{Var:=C+1};
+ #{} -> Acc#{Var=>1}
+ end
+ end, CountMap, beam_ssa:used(I))
+ end,
+ CountMap = F(Last, foldl(F, CountMap0, Is)),
+ count_uses_blk(Bs, CountMap);
+count_uses_blk([], CountMap) -> CountMap.
+
+decrement_uses(V, Uses) ->
+ #{V:=C} = Uses,
+ Uses#{V:=C-1}.
+
+is_n_uses(N, V, Uses) ->
+ case Uses of
+ #{V:=N} -> true;
+ #{} -> false
+ end.
+
+is_single_use(V, Uses) ->
+ case Uses of
+ #{V:=1} -> true;
+ #{} -> false
+ end.
+
+%%%
%%% Find out where frames should be placed.
%%%
@@ -874,7 +1071,7 @@ fix_tuples(#st{ssa=Blocks0,cnt=Count0}=St) ->
%% a stack frame or set up a stack frame with a different size.
place_frames(#st{ssa=Blocks}=St) ->
- Doms = beam_ssa:dominators(Blocks),
+ {Doms,_} = beam_ssa:dominators(Blocks),
Ls = beam_ssa:rpo(Blocks),
Tried = gb_sets:empty(),
Frames0 = [],
@@ -882,7 +1079,7 @@ place_frames(#st{ssa=Blocks}=St) ->
St#st{frames=Frames}.
place_frames_1([L|Ls], Blocks, Doms, Tried0, Frames0) ->
- Blk = maps:get(L, Blocks),
+ Blk = map_get(L, Blocks),
case need_frame(Blk) of
true ->
%% This block needs a frame. Try to place it here.
@@ -993,15 +1190,15 @@ place_frame_here(L, Blocks, Doms, Frames) ->
%% Return all predecessors referenced in phi nodes.
phi_predecessors(L, Blocks) ->
- #b_blk{is=Is} = maps:get(L, Blocks),
+ #b_blk{is=Is} = map_get(L, Blocks),
[P || #b_set{op=phi,args=Args} <- Is, {_,P} <- Args].
%% is_dominated_by(Label, DominatedBy, Dominators) -> true|false.
%% Test whether block Label is dominated by block DominatedBy.
is_dominated_by(L, DomBy, Doms) ->
- DominatedBy = maps:get(L, Doms),
- ordsets:is_element(DomBy, DominatedBy).
+ DominatedBy = map_get(L, Doms),
+ member(DomBy, DominatedBy).
%% need_frame(#b_blk{}) -> true|false.
%% Test whether any of the instructions in the block requires a stack frame.
@@ -1137,7 +1334,7 @@ recv_fix_common([Msg0|T], Exit, Rm, Blocks0, Count0) ->
{MsgVars,Count} = new_vars(duplicate(N, '@recv'), Count1),
PhiArgs = fix_exit_phi_args(MsgVars, Rm, Exit, Blocks1),
Phi = #b_set{op=phi,dst=Msg,args=PhiArgs},
- ExitBlk0 = maps:get(Exit, Blocks1),
+ ExitBlk0 = map_get(Exit, Blocks1),
ExitBlk = ExitBlk0#b_blk{is=[Phi|ExitBlk0#b_blk.is]},
Blocks2 = Blocks1#{Exit:=ExitBlk},
Blocks = recv_fix_common_1(MsgVars, Rm, Msg0, Blocks2),
@@ -1148,7 +1345,7 @@ recv_fix_common([], _, _, Blocks, Count) ->
recv_fix_common_1([V|Vs], [Rm|Rms], Msg, Blocks0) ->
Ren = #{Msg=>V},
Blocks1 = beam_ssa:rename_vars(Ren, [Rm], Blocks0),
- #b_blk{is=Is0} = Blk0 = maps:get(Rm, Blocks1),
+ #b_blk{is=Is0} = Blk0 = map_get(Rm, Blocks1),
Copy = #b_set{op=copy,dst=V,args=[Msg]},
Is = insert_after_phis(Is0, [Copy]),
Blk = Blk0#b_blk{is=Is},
@@ -1183,11 +1380,11 @@ fix_receive([L|Ls], Defs, Blocks0, Count0) ->
{NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Used], Count0),
Ren = zip(Used, NewVars),
Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0),
- #b_blk{is=Is0} = Blk1 = maps:get(L, Blocks1),
+ #b_blk{is=Is0} = Blk1 = map_get(L, Blocks1),
CopyIs = [#b_set{op=copy,dst=New,args=[Old]} || {Old,New} <- Ren],
Is = insert_after_phis(Is0, CopyIs),
Blk = Blk1#b_blk{is=Is},
- Blocks = maps:put(L, Blk, Blocks1),
+ Blocks = Blocks1#{L:=Blk},
fix_receive(Ls, Defs, Blocks, Count);
fix_receive([], _Defs, Blocks, Count) ->
{Blocks,Count}.
@@ -1212,7 +1409,7 @@ find_loop_exit_1(_, _, Exit) -> Exit.
find_rm_blocks(L, Blocks) ->
Seen = gb_sets:singleton(L),
- Blk = maps:get(L, Blocks),
+ Blk = map_get(L, Blocks),
Succ = beam_ssa:successors(Blk),
find_rm_blocks_1(Succ, Seen, Blocks).
@@ -1222,7 +1419,7 @@ find_rm_blocks_1([L|Ls], Seen0, Blocks) ->
find_rm_blocks_1(Ls, Seen0, Blocks);
false ->
Seen = gb_sets:insert(L, Seen0),
- Blk = maps:get(L, Blocks),
+ Blk = map_get(L, Blocks),
case find_rm_act(Blk#b_blk.is) of
prune ->
%% Looping back. Don't look at any successors.
@@ -1284,16 +1481,16 @@ find_yregs_1([{F,Defs}|Fs], Blocks0) ->
Ls = beam_ssa:rpo([F], Blocks0),
Yregs0 = [],
Yregs = find_yregs_2(Ls, Blocks0, D0, Yregs0),
- Blk0 = maps:get(F, Blocks0),
+ Blk0 = map_get(F, Blocks0),
Blk = beam_ssa:add_anno(yregs, Yregs, Blk0),
Blocks = Blocks0#{F:=Blk},
find_yregs_1(Fs, Blocks);
find_yregs_1([], Blocks) -> Blocks.
find_yregs_2([L|Ls], Blocks0, D0, Yregs0) ->
- Blk0 = maps:get(L, Blocks0),
+ Blk0 = map_get(L, Blocks0),
#b_blk{is=Is,last=Last} = Blk0,
- Ys0 = maps:get(L, D0),
+ Ys0 = map_get(L, D0),
{Yregs1,Ys} = find_yregs_is(Is, Ys0, Yregs0),
Yregs = find_yregs_terminator(Last, Ys, Yregs1),
Successors = beam_ssa:successors(Blk0),
@@ -1320,7 +1517,7 @@ find_defs_1([L|Ls], Blocks, Frames, Seen0, Defs0, Acc0) ->
false ->
Seen1 = gb_sets:insert(L, Seen0),
{Acc,Seen} = find_defs_1(Ls, Blocks, Frames, Seen1, Defs0, Acc0),
- #b_blk{is=Is} = Blk = maps:get(L, Blocks),
+ #b_blk{is=Is} = Blk = map_get(L, Blocks),
Defs = find_defs_is(Is, Defs0),
Successors = beam_ssa:successors(Blk),
find_defs_1(Successors, Blocks, Frames, Seen, Defs, Acc)
@@ -1339,10 +1536,10 @@ find_update_succ([S|Ss], #dk{d=Defs0,k=Killed0}=DK0, D0) ->
Defs = ordsets:intersection(Defs0, Defs1),
Killed = ordsets:union(Killed0, Killed1),
DK = #dk{d=Defs,k=Killed},
- D = maps:put(S, DK, D0),
+ D = D0#{S:=DK},
find_update_succ(Ss, DK0, D);
#{} ->
- D = maps:put(S, DK0, D0),
+ D = D0#{S=>DK0},
find_update_succ(Ss, DK0, D)
end;
find_update_succ([], _, D) -> D.
@@ -1432,7 +1629,7 @@ copy_retval(#st{frames=Frames,ssa=Blocks0,cnt=Count0}=St) ->
St#st{ssa=Blocks,cnt=Count}.
copy_retval_1([F|Fs], Blocks0, Count0) ->
- #b_blk{anno=#{yregs:=Yregs0},is=Is} = maps:get(F, Blocks0),
+ #b_blk{anno=#{yregs:=Yregs0},is=Is} = map_get(F, Blocks0),
Yregs1 = gb_sets:from_list(Yregs0),
Yregs = collect_yregs(Is, Yregs1),
Ls = beam_ssa:rpo([F], Blocks0),
@@ -1451,7 +1648,7 @@ collect_yregs([#b_set{}|Is], Yregs) ->
collect_yregs([], Yregs) -> Yregs.
copy_retval_2([L|Ls], Yregs, Copy0, Blocks0, Count0) ->
- #b_blk{is=Is0,last=Last} = Blk = maps:get(L, Blocks0),
+ #b_blk{is=Is0,last=Last} = Blk = map_get(L, Blocks0),
RC = case {Last,Ls} of
{#b_br{succ=Succ,fail=?BADARG_BLOCK},[Succ|_]} ->
true;
@@ -1593,7 +1790,7 @@ opt_get_list(#st{ssa=Blocks,res=Res}=St) ->
St#st{ssa=opt_get_list_1(Ls, ResMap, Blocks)}.
opt_get_list_1([L|Ls], Res, Blocks0) ->
- #b_blk{is=Is0} = Blk = maps:get(L, Blocks0),
+ #b_blk{is=Is0} = Blk = map_get(L, Blocks0),
case opt_get_list_is(Is0, Res, [], false) of
no ->
opt_get_list_1(Ls, Res, Blocks0);
@@ -1647,12 +1844,12 @@ number_instructions(#st{ssa=Blocks0}=St) ->
St#st{ssa=number_is_1(Ls, 1, Blocks0)}.
number_is_1([L|Ls], N0, Blocks0) ->
- #b_blk{is=Is0,last=Last0} = Bl0 = maps:get(L, Blocks0),
+ #b_blk{is=Is0,last=Last0} = Bl0 = map_get(L, Blocks0),
{Is,N1} = number_is_2(Is0, N0, []),
Last = beam_ssa:add_anno(n, N1, Last0),
N = N1 + 2,
Bl = Bl0#b_blk{is=Is,last=Last},
- Blocks = maps:put(L, Bl, Blocks0),
+ Blocks = Blocks0#{L:=Bl},
number_is_1(Ls, N, Blocks);
number_is_1([], _, Blocks) -> Blocks.
@@ -1693,7 +1890,7 @@ live_interval_blk(L, Blocks, {Vars0,LiveMap0}) ->
Live1 = update_successors(Successors, L, Blocks, LiveMap0, Live0),
%% Add ranges for all variables that are live in the successors.
- #b_blk{is=Is,last=Last} = maps:get(L, Blocks),
+ #b_blk{is=Is,last=Last} = map_get(L, Blocks),
End = beam_ssa:get_anno(n, Last),
Use = [{V,{use,End+1}} || V <- Live1],
@@ -1762,7 +1959,7 @@ first_number([], Last) ->
update_successors([L|Ls], Pred, Blocks, LiveMap, Live0) ->
Live1 = ordsets:union(Live0, get_live(L, LiveMap)),
- #b_blk{is=Is} = maps:get(L, Blocks),
+ #b_blk{is=Is} = map_get(L, Blocks),
Live = update_live_phis(Is, Pred, Live1),
update_successors(Ls, Pred, Blocks, LiveMap, Live);
update_successors([], _, _, _, Live) -> Live.
@@ -1800,7 +1997,7 @@ reserve_yregs(#st{frames=Frames}=St0) ->
foldl(fun reserve_yregs_1/2, St0, Frames).
reserve_yregs_1(L, #st{ssa=Blocks0,cnt=Count0,res=Res0}=St) ->
- Blk = maps:get(L, Blocks0),
+ Blk = map_get(L, Blocks0),
Yregs = beam_ssa:get_anno(yregs, Blk),
{Def,Used} = beam_ssa:def_used([L], Blocks0),
UsedYregs = ordsets:intersection(Yregs, Used),
@@ -1826,7 +2023,7 @@ reserve_try_tags_1([L|Ls], Blocks, Seen0, ActMap0) ->
reserve_try_tags_1(Ls, Blocks, Seen0, ActMap0);
false ->
Seen1 = gb_sets:insert(L, Seen0),
- #b_blk{is=Is} = Blk = maps:get(L, Blocks),
+ #b_blk{is=Is} = Blk = map_get(L, Blocks),
Active0 = get_active(L, ActMap0),
Active = reserve_try_tags_is(Is, Active0),
Successors = beam_ssa:successors(Blk),
@@ -1869,11 +2066,11 @@ rename_vars(Vs, L, Blocks0, Count0) ->
{NewVars,Count} = new_vars([Base || #b_var{name=Base} <- Vs], Count0),
Ren = zip(Vs, NewVars),
Blocks1 = beam_ssa:rename_vars(Ren, [L], Blocks0),
- #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks1),
+ #b_blk{is=Is0} = Blk0 = map_get(L, Blocks1),
CopyIs = [#b_set{op=copy,dst=New,args=[Old]} || {Old,New} <- Ren],
Is = insert_after_phis(Is0, CopyIs),
Blk = Blk0#b_blk{is=Is},
- Blocks = maps:put(L, Blk, Blocks1),
+ Blocks = Blocks1#{L:=Blk},
{NewVars,Blocks,Count}.
insert_after_phis([#b_set{op=phi}=I|Is], InsertIs) ->
@@ -1895,7 +2092,7 @@ frame_size(#st{frames=Frames,regs=Regs,ssa=Blocks0}=St) ->
frame_size_1(L, Regs, Blocks0) ->
Def = beam_ssa:def([L], Blocks0),
- Yregs0 = [maps:get(V, Regs) || V <- Def, is_yreg(maps:get(V, Regs))],
+ Yregs0 = [map_get(V, Regs) || V <- Def, is_yreg(map_get(V, Regs))],
Yregs = ordsets:from_list(Yregs0),
FrameSize = length(ordsets:from_list(Yregs)),
if
@@ -1907,17 +2104,17 @@ frame_size_1(L, Regs, Blocks0) ->
true ->
ok
end,
- Blk0 = maps:get(L, Blocks0),
+ Blk0 = map_get(L, Blocks0),
Blk = beam_ssa:add_anno(frame_size, FrameSize, Blk0),
%% Insert an annotation for frame deallocation on
%% each #b_ret{}.
- Blocks = maps:put(L, Blk, Blocks0),
+ Blocks = Blocks0#{L:=Blk},
Reachable = beam_ssa:rpo([L], Blocks),
frame_deallocate(Reachable, FrameSize, Blocks).
frame_deallocate([L|Ls], Size, Blocks0) ->
- Blk0 = maps:get(L, Blocks0),
+ Blk0 = map_get(L, Blocks0),
Blk = case Blk0 of
#b_blk{last=#b_ret{}=Ret0} ->
Ret = beam_ssa:add_anno(deallocate, Size, Ret0),
@@ -1925,7 +2122,7 @@ frame_deallocate([L|Ls], Size, Blocks0) ->
#b_blk{} ->
Blk0
end,
- Blocks = maps:put(L, Blk, Blocks0),
+ Blocks = Blocks0#{L:=Blk},
frame_deallocate(Ls, Size, Blocks);
frame_deallocate([], _, Blocks) -> Blocks.
@@ -1938,7 +2135,7 @@ frame_deallocate([], _, Blocks) -> Blocks.
turn_yregs(#st{frames=Frames,regs=Regs0,ssa=Blocks}=St) ->
Regs1 = foldl(fun(L, A) ->
- Blk = maps:get(L, Blocks),
+ Blk = map_get(L, Blocks),
FrameSize = beam_ssa:get_anno(frame_size, Blk),
Def = beam_ssa:def([L], Blocks),
[turn_yregs_1(Def, FrameSize, Regs0)|A]
@@ -1947,7 +2144,7 @@ turn_yregs(#st{frames=Frames,regs=Regs0,ssa=Blocks}=St) ->
St#st{regs=Regs}.
turn_yregs_1(Def, FrameSize, Regs) ->
- Yregs0 = [{maps:get(V, Regs),V} || V <- Def, is_yreg(maps:get(V, Regs))],
+ Yregs0 = [{map_get(V, Regs),V} || V <- Def, is_yreg(map_get(V, Regs))],
Yregs1 = rel2fam(Yregs0),
FrameSize = length(Yregs1),
Yregs2 = [{{y,FrameSize-Y-1},Vs} || {{y,Y},Vs} <- Yregs1],
@@ -1993,11 +2190,12 @@ reserve_zregs(Blocks, Intervals, Res) ->
end,
beam_ssa:fold_rpo(F, [0], Res, Blocks).
-reserve_zreg([#b_set{op=call,dst=Dst}],
- #b_br{bool=Dst}, _ShortLived, A) ->
- %% If type optimization has determined that the result of a call can be
- %% used directly in a branch, we must avoid reserving a z register or code
- %% generation will fail.
+reserve_zreg([#b_set{op=Op,dst=Dst}],
+ #b_br{bool=Dst}, _ShortLived, A) when Op =:= call;
+ Op =:= get_tuple_element ->
+ %% If type optimization has determined that the result of these
+ %% instructions can be used directly in a branch, we must avoid reserving a
+ %% z register or code generation will fail.
A;
reserve_zreg([#b_set{op={bif,tuple_size},dst=Dst},
#b_set{op={bif,'=:='},args=[Dst,Val]}], Last, ShortLived, A0) ->
@@ -2356,7 +2554,7 @@ linear_scan(#st{intervals=Intervals0,res=Res}=St0) ->
St#st{regs=maps:from_list(Regs)}.
init_interval({V,[{Start,_}|_]=Rs}, Res) ->
- Info = maps:get(V, Res),
+ Info = map_get(V, Res),
Pool = case Info of
{prefer,{x,_}} -> x;
x -> x;
@@ -2557,16 +2755,16 @@ free_reg(#i{reg={_,_}=Reg}=I, L) ->
update_pool(I, FreeRegs, L).
get_pool(#i{pool=Pool}, #l{free=Free}) ->
- maps:get(Pool, Free).
+ map_get(Pool, Free).
update_pool(#i{pool=Pool}, New, #l{free=Free0}=L) ->
- Free = maps:put(Pool, New, Free0),
+ Free = Free0#{Pool:=New},
L#l{free=Free}.
get_next_free(#i{pool=Pool}, #l{free=Free0}=L0) ->
K = {next,Pool},
- N = maps:get(K, Free0),
- Free = maps:put(K, N+1, Free0),
+ N = map_get(K, Free0),
+ Free = Free0#{K:=N+1},
L = L0#l{free=Free},
if
is_integer(Pool) -> {{y,N},L};
@@ -2602,7 +2800,7 @@ are_overlapping_1({_,_}, []) -> false.
is_loop_header(L, Blocks) ->
%% We KNOW that a loop header must start with a peek_message
%% instruction.
- case maps:get(L, Blocks) of
+ case map_get(L, Blocks) of
#b_blk{is=[#b_set{op=peek_message}|_]} -> true;
_ -> false
end.
diff --git a/lib/compiler/src/beam_ssa_recv.erl b/lib/compiler/src/beam_ssa_recv.erl
index 6e49b128da..1e0e1ecac2 100644
--- a/lib/compiler/src/beam_ssa_recv.erl
+++ b/lib/compiler/src/beam_ssa_recv.erl
@@ -101,7 +101,7 @@ opt([{L,#b_blk{is=[#b_set{op=peek_message}|_]}=Blk0}|Bs], Blocks0, Preds) ->
case recv_opt(Preds, L, Blocks0) of
{yes,Blocks1} ->
Blk = beam_ssa:add_anno(recv_set, L, Blk0),
- Blocks = maps:put(L, Blk, Blocks1),
+ Blocks = Blocks1#{L:=Blk},
opt(Bs, Blocks, []);
no ->
opt(Bs, Blocks0, [])
@@ -111,11 +111,11 @@ opt([{L,_}|Bs], Blocks, Preds) ->
opt([], Blocks, _) -> Blocks.
recv_opt([L|Ls], RecvLbl, Blocks) ->
- #b_blk{is=Is0} = Blk0 = maps:get(L, Blocks),
+ #b_blk{is=Is0} = Blk0 = map_get(L, Blocks),
case recv_opt_is(Is0, RecvLbl, Blocks, []) of
{yes,Is} ->
Blk = Blk0#b_blk{is=Is},
- {yes,maps:put(L, Blk, Blocks)};
+ {yes,Blocks#{L:=Blk}};
no ->
recv_opt(Ls, RecvLbl, Blocks)
end;
@@ -174,7 +174,7 @@ opt_ref_used(RecvLbl, Ref, Blocks) ->
end.
opt_ref_used_1(L, Vs0, Blocks) ->
- #b_blk{is=Is} = Blk = maps:get(L, Blocks),
+ #b_blk{is=Is} = Blk = map_get(L, Blocks),
case opt_ref_used_is(Is, Vs0) of
#{}=Vs ->
opt_ref_used_last(Blk, Vs, Blocks);
diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl
index 38ea5e6914..c01ea4af91 100644
--- a/lib/compiler/src/beam_ssa_type.erl
+++ b/lib/compiler/src/beam_ssa_type.erl
@@ -23,7 +23,8 @@
-include("beam_ssa_opt.hrl").
-import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2,
- partition/2,reverse/1,sort/1]).
+ keyfind/3,partition/2,reverse/1,reverse/2,
+ seq/2,sort/1,split/2]).
-define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}).
@@ -44,12 +45,13 @@
-record(t_bs_match, {type :: type()}).
-record(t_tuple, {size=0 :: integer(),
exact=false :: boolean(),
- elements=[] :: [any()]
- }).
+ %% Known element types (1-based index), unknown elements are
+ %% are assumed to be 'any'.
+ elements=#{} :: #{ non_neg_integer() => type() }}).
-type type() :: 'any' | 'none' |
#t_atom{} | #t_integer{} | #t_bs_match{} | #t_tuple{} |
- {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' |'number'.
+ {'binary',pos_integer()} | 'cons' | 'float' | 'list' | 'map' | 'nil' | 'number'.
-type type_db() :: #{beam_ssa:var_name():=type()}.
-spec opt_start(Linear, Args, Anno, FuncDb) -> {Linear, FuncDb} when
@@ -123,7 +125,7 @@ opt_continue_1(Linear0, Args, Id, Ts, FuncDb0) ->
ls=#{0=>Ts,?BADARG_BLOCK=>#{}},
once=UsedOnce },
- {Linear, FuncDb, NewRet} = opt_1(Linear0, D, []),
+ {Linear, FuncDb, NewRet} = opt(Linear0, D, []),
case FuncDb of
#{ Id := Entry0 } ->
@@ -166,8 +168,12 @@ opt_finish_1([Arg | Args], [TypeMap | TypeMaps], ParamInfo0) ->
opt_finish_1([], [], ParamInfo) ->
ParamInfo.
-validator_anno(#t_tuple{size=Size,exact=Exact}) ->
- beam_validator:type_anno(tuple, Size, Exact);
+validator_anno(#t_tuple{size=Size,exact=Exact,elements=Elements0}) ->
+ Elements = maps:fold(fun(Index, Type, Acc) ->
+ Key = beam_validator:type_anno(integer, Index),
+ Acc#{ Key => validator_anno(Type) }
+ end, #{}, Elements0),
+ beam_validator:type_anno(tuple, Size, Exact, Elements);
validator_anno(#t_integer{elements={Same,Same}}) ->
beam_validator:type_anno(integer, Same);
validator_anno(#t_integer{}) ->
@@ -188,57 +194,42 @@ get_func_id(Anno) ->
#{func_info:={_Mod, Name, Arity}} = Anno,
#b_local{name=#b_literal{val=Name}, arity=Arity}.
-opt_1([{L,Blk}|Bs], #d{ls=Ls}=D, Acc) ->
+opt([{L,Blk}|Bs], #d{ls=Ls}=D, Acc) ->
case Ls of
#{L:=Ts} ->
- opt_2(L, Blk, Bs, Ts, D, Acc);
+ opt_1(L, Blk, Bs, Ts, D, Acc);
#{} ->
%% This block is never reached. Discard it.
- opt_1(Bs, D, Acc)
+ opt(Bs, D, Acc)
end;
-opt_1([], D, Acc) ->
+opt([], D, Acc) ->
#d{func_db=FuncDb,ret_type=NewRet} = D,
{reverse(Acc), FuncDb, NewRet}.
-opt_2(L, #b_blk{is=Is0}=Blk0, Bs, Ts, #d{sub=Sub}=D0, Acc) ->
- case Is0 of
- [#b_set{op=call,dst=Dst,
- args=[#b_remote{mod=#b_literal{val=Mod},
- name=#b_literal{val=Name}}=Rem|Args0]}=I0] ->
- case erl_bifs:is_exit_bif(Mod, Name, length(Args0)) of
- true ->
- %% This call will never reach the successor block.
- %% Rewrite the terminator to a 'ret', and remove
- %% all type information for this label. That will
- %% simplify the phi node in the former successor.
- Args = simplify_args(Args0, Sub, Ts),
- I = I0#b_set{args=[Rem|Args]},
- Ret = #b_ret{arg=Dst},
- Blk = Blk0#b_blk{is=[I],last=Ret},
- Ls = maps:remove(L, D0#d.ls),
-
- %% We potentially lack a return value.
- RetType = join([none | D0#d.ret_type]),
-
- D = D0#d{ls=Ls,ret_type=[RetType]},
- opt_1(Bs, D, [{L,Blk} | Acc]);
- false ->
- opt_3(L, Blk0, Bs, Ts, D0, Acc)
- end;
- _ ->
- opt_3(L, Blk0, Bs, Ts, D0, Acc)
+opt_1(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0,
+ #d{ds=Ds0,sub=Sub0,func_db=Fdb0}=D0, Acc) ->
+ case opt_is(Is0, Ts0, Ds0, Fdb0, D0, Sub0, []) of
+ {Is,Ts,Ds,Fdb,Sub} ->
+ D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb},
+ Last1 = simplify_terminator(Last0, Sub, Ts, Ds),
+ Last = opt_terminator(Last1, Ts, Ds),
+ D = update_successors(Last, Ts, D1),
+ Blk = Blk0#b_blk{is=Is,last=Last},
+ opt(Bs, D, [{L,Blk}|Acc]);
+ {no_return,Ret,Is,Ds,Fdb,Sub} ->
+ %% This call will never reach the successor block.
+ %% Rewrite the terminator to a 'ret', and remove
+ %% all type information for this label. That can
+ %% potentially narrow the type of the phi node
+ %% in the former successor.
+ Ls = maps:remove(L, D0#d.ls),
+ RetType = join([none|D0#d.ret_type]),
+ D = D0#d{ds=Ds,ls=Ls,sub=Sub,
+ func_db=Fdb,ret_type=[RetType]},
+ Blk = Blk0#b_blk{is=Is,last=Ret},
+ opt(Bs, D, [{L,Blk}|Acc])
end.
-opt_3(L, #b_blk{is=Is0,last=Last0}=Blk0, Bs, Ts0,
- #d{ds=Ds0,ls=Ls0,sub=Sub0,func_db=Fdb0}=D0, Acc) ->
- {Is,Ts,Ds,Fdb,Sub} = opt_is(Is0, Ts0, Ds0, Fdb0, Ls0, D0, Sub0, []),
- D1 = D0#d{ds=Ds,sub=Sub,func_db=Fdb},
- Last1 = simplify_terminator(Last0, Sub, Ts, Ds),
- Last = opt_terminator(Last1, Ts, Ds),
- D = update_successors(Last, Ts, D1),
- Blk = Blk0#b_blk{is=Is,last=Last},
- opt_1(Bs, D, [{L,Blk} | Acc]).
-
simplify_terminator(#b_br{bool=Bool}=Br, Sub, Ts, _Ds) ->
Br#b_br{bool=simplify_arg(Bool, Sub, Ts)};
simplify_terminator(#b_switch{arg=Arg}=Sw, Sub, Ts, _Ds) ->
@@ -252,7 +243,7 @@ simplify_terminator(#b_ret{arg=Arg}=Ret, Sub, Ts, Ds) ->
end.
opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is],
- Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) ->
+ Ts0, Ds0, Fdb, #d{ls=Ls}=D, Sub0, Acc) ->
%% Simplify the phi node by removing all predecessor blocks that no
%% longer exists or no longer branches to this block.
Args = [{simplify_arg(Arg, Sub0, Ts0),From} ||
@@ -263,37 +254,44 @@ opt_is([#b_set{op=phi,dst=Dst,args=Args0}=I0|Is],
%% value or if the values are identical.
[{Val,_}|_] = Args,
Sub = Sub0#{Dst=>Val},
- opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc);
+ opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc);
false ->
I = I0#b_set{args=Args},
Ts = update_types(I, Ts0, Ds0),
Ds = Ds0#{Dst=>I},
- opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc])
+ opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc])
end;
-opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0 | Is],
- Ts0, Ds0, Fdb0, Ls, D, Sub, Acc) ->
- Args = simplify_args(Args0, Sub, Ts0),
+opt_is([#b_set{op=call,args=Args0,dst=Dst}=I0|Is],
+ Ts0, Ds0, Fdb0, D, Sub0, Acc) ->
+ Args = simplify_args(Args0, Sub0, Ts0),
I1 = beam_ssa:normalize(I0#b_set{args=Args}),
-
- %% This is a bit of a kludge; we know that any instruction whose return
- %% type is 'none' will fail at runtime, but we don't yet have a way to cut
- %% a block short so we move on like nothing nothing happened.
- %%
- %% This complicates argument type optimization as unreachable calls can
- %% add types that will never occur, so we skip optimizing this call if
- %% the type of any of its arguments is 'none'.
- [_Callee | Rest] = Args,
- case all(fun(Arg) -> get_type(Arg, Ts0) =/= none end, Rest) of
- true ->
- {Ts, Ds, Fdb, I} = opt_call(I1, D, Ts0, Ds0, Fdb0),
- opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub, [I|Acc]);
- false ->
- Ts = Ts0#{ Dst => any },
- Ds = Ds0#{ Dst => I1 },
- opt_is(Is, Ts, Ds, Fdb0, Ls, D, Sub, [I1|Acc])
+ {Ts1,Ds,Fdb,I2} = opt_call(I1, D, Ts0, Ds0, Fdb0),
+ case {map_get(Dst, Ts1),Is} of
+ {_,[#b_set{op=succeeded}]} ->
+ %% This call instruction is inside a try/catch
+ %% block. Don't attempt to optimize it.
+ opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I2|Acc]);
+ {none,_} ->
+ %% This call never returns. The rest of the
+ %% instructions will not be executed.
+ Ret = #b_ret{arg=Dst},
+ {no_return,Ret,reverse(Acc, [I2]),Ds,Fdb,Sub0};
+ {_,_} ->
+ case simplify_call(I2) of
+ #b_set{}=I ->
+ opt_is(Is, Ts1, Ds, Fdb, D, Sub0, [I|Acc]);
+ #b_literal{}=Lit ->
+ Sub = Sub0#{Dst=>Lit},
+ Ts = maps:remove(Dst, Ts1),
+ opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc);
+ #b_var{}=Var ->
+ Ts = maps:remove(Dst, Ts1),
+ Sub = Sub0#{Dst=>Var},
+ opt_is(Is, Ts, Ds0, Fdb, D, Sub, Acc)
+ end
end;
opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I],
- Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) ->
+ Ts0, Ds0, Fdb, D, Sub0, Acc) ->
case Ds0 of
#{ Arg := #b_set{op=call} } ->
%% The success check of a call is part of exception handling and
@@ -302,22 +300,22 @@ opt_is([#b_set{op=succeeded,args=[Arg],dst=Dst}=I],
Ts = update_types(I, Ts0, Ds0),
Ds = Ds0#{Dst=>I},
- opt_is([], Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]);
+ opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc]);
#{} ->
Args = simplify_args([Arg], Sub0, Ts0),
Type = type(succeeded, Args, Ts0, Ds0),
case get_literal_from_type(Type) of
#b_literal{}=Lit ->
Sub = Sub0#{Dst=>Lit},
- opt_is([], Ts0, Ds0, Fdb, Ls, D, Sub, Acc);
+ opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc);
none ->
Ts = Ts0#{Dst=>Type},
Ds = Ds0#{Dst=>I},
- opt_is([], Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc])
+ opt_is([], Ts, Ds, Fdb, D, Sub0, [I|Acc])
end
end;
opt_is([#b_set{args=Args0,dst=Dst}=I0|Is],
- Ts0, Ds0, Fdb, Ls, D, Sub0, Acc) ->
+ Ts0, Ds0, Fdb, D, Sub0, Acc) ->
Args = simplify_args(Args0, Sub0, Ts0),
I1 = beam_ssa:normalize(I0#b_set{args=Args}),
case simplify(I1, Ts0) of
@@ -325,24 +323,77 @@ opt_is([#b_set{args=Args0,dst=Dst}=I0|Is],
I = beam_ssa:normalize(I2),
Ts = update_types(I, Ts0, Ds0),
Ds = Ds0#{Dst=>I},
- opt_is(Is, Ts, Ds, Fdb, Ls, D, Sub0, [I|Acc]);
+ opt_is(Is, Ts, Ds, Fdb, D, Sub0, [I|Acc]);
#b_literal{}=Lit ->
Sub = Sub0#{Dst=>Lit},
- opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc);
+ opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc);
#b_var{}=Var ->
case Is of
[#b_set{op=succeeded,dst=SuccDst,args=[Dst]}] ->
%% We must remove this 'succeeded' instruction.
Sub = Sub0#{Dst=>Var,SuccDst=>#b_literal{val=true}},
- opt_is([], Ts0, Ds0, Fdb, Ls, D, Sub, Acc);
+ opt_is([], Ts0, Ds0, Fdb, D, Sub, Acc);
_ ->
Sub = Sub0#{Dst=>Var},
- opt_is(Is, Ts0, Ds0, Fdb, Ls, D, Sub, Acc)
+ opt_is(Is, Ts0, Ds0, Fdb, D, Sub, Acc)
end
end;
-opt_is([], Ts, Ds, Fdb, _Ls, _D, Sub, Acc) ->
+opt_is([], Ts, Ds, Fdb, _D, Sub, Acc) ->
{reverse(Acc), Ts, Ds, Fdb, Sub}.
+simplify_call(#b_set{op=call,args=[#b_remote{}=Rem|Args]}=I) ->
+ case Rem of
+ #b_remote{mod=#b_literal{val=Mod},
+ name=#b_literal{val=Name}} ->
+ case erl_bifs:is_pure(Mod, Name, length(Args)) of
+ true ->
+ simplify_remote_call(Mod, Name, Args, I);
+ false ->
+ I
+ end;
+ #b_remote{} ->
+ I
+ end;
+simplify_call(I) -> I.
+
+%% Simplify a remote call to a pure BIF.
+simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) ->
+ Tl;
+simplify_remote_call(erlang, setelement,
+ [#b_literal{val=Pos},
+ #b_literal{val=Tuple},
+ #b_var{}=Value], I)
+ when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) ->
+ %% Position is a literal integer and the shape of the
+ %% tuple is known.
+ Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)],
+ {Bef,[_|Aft]} = split(Pos - 1, Els0),
+ Els = Bef ++ [Value|Aft],
+ I#b_set{op=put_tuple,args=Els};
+simplify_remote_call(Mod, Name, Args0, I) ->
+ case make_literal_list(Args0) of
+ none ->
+ I;
+ Args ->
+ %% The arguments are literals. Try to evaluate the BIF.
+ try apply(Mod, Name, Args) of
+ Val ->
+ case cerl:is_literal_term(Val) of
+ true ->
+ #b_literal{val=Val};
+ false ->
+ %% The value can't be expressed as a literal
+ %% (e.g. a pid).
+ I
+ end
+ catch
+ _:_ ->
+ %% Failed. Don't bother trying to optimize
+ %% the call.
+ I
+ end
+ end.
+
opt_call(#b_set{dst=Dst,args=[#b_local{}=Callee|Args]}=I0, D, Ts0, Ds0, Fdb0) ->
{Ts, Ds, I} = opt_local_call(I0, Ts0, Ds0, Fdb0),
case Fdb0 of
@@ -365,14 +416,13 @@ opt_call(#b_set{dst=Dst}=I, _D, Ts0, Ds0, Fdb) ->
{Ts, Ds, Fdb, I}.
opt_local_call(#b_set{dst=Dst,args=[Id|_]}=I0, Ts0, Ds0, Fdb) ->
- %% We skip propagating 'none' as we don't yet have a good way to cut a
- %% block short.
Type = case Fdb of
- #{ Id := #func_info{ret_type=[T]} } when T =/= none -> T;
+ #{ Id := #func_info{ret_type=[T]} } -> T;
#{} -> any
end,
I = case Type of
any -> I0;
+ none -> I0;
_ -> beam_ssa:add_anno(result_type, validator_anno(Type), I0)
end,
Ts = Ts0#{ Dst => Type },
@@ -386,11 +436,6 @@ update_arg_types([Arg | Args], [TypeMap0 | TypeMaps], CallId, Ts) ->
#t_bs_match{} -> {binary, 1};
Type -> Type
end,
- PrevType = maps:get(CallId, TypeMap0, NewType),
-
- %% The new type must be narrower than the old one.
- true = meet(NewType, PrevType) =/= none, %Assertion.
-
TypeMap = TypeMap0#{ CallId => NewType },
[TypeMap | update_arg_types(Args, TypeMaps, CallId, Ts)];
update_arg_types([], [], _CallId, _Ts) ->
@@ -418,12 +463,14 @@ simplify(#b_set{op={bif,'or'},args=Args}=I, Ts) ->
false ->
I
end;
-simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I, Ts) ->
+simplify(#b_set{op={bif,element},args=[#b_literal{val=Index},Tuple]}=I0, Ts) ->
case t_tuple_size(get_type(Tuple, Ts)) of
{_,Size} when is_integer(Index), 1 =< Index, Index =< Size ->
- I#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=Index-1}]};
+ I = I0#b_set{op=get_tuple_element,
+ args=[Tuple,#b_literal{val=Index-1}]},
+ simplify(I, Ts);
_ ->
- eval_bif(I, Ts)
+ eval_bif(I0, Ts)
end;
simplify(#b_set{op={bif,hd},args=[List]}=I, Ts) ->
case get_type(List, Ts) of
@@ -471,10 +518,19 @@ simplify(#b_set{op={bif,'=='},args=Args}=I, Ts) ->
end;
simplify(#b_set{op={bif,'=:='},args=[Same,Same]}, _Ts) ->
#b_literal{val=true};
-simplify(#b_set{op={bif,'=:='},args=Args}=I, Ts) ->
- case meet(get_types(Args, Ts)) of
- none -> #b_literal{val=false};
- _ -> eval_bif(I, Ts)
+simplify(#b_set{op={bif,'=:='},args=[A1,_A2]=Args}=I, Ts) ->
+ [T1,T2] = get_types(Args, Ts),
+ case meet(T1, T2) of
+ none ->
+ #b_literal{val=false};
+ _ ->
+ case {t_is_boolean(T1),T2} of
+ {true,#t_atom{elements=[true]}} ->
+ %% Bool =:= true ==> Bool
+ A1;
+ {_,_} ->
+ eval_bif(I, Ts)
+ end
end;
simplify(#b_set{op={bif,Op},args=Args}=I, Ts) ->
Types = get_types(Args, Ts),
@@ -485,11 +541,17 @@ simplify(#b_set{op={bif,Op},args=Args}=I, Ts) ->
AnnoArgs = [anno_float_arg(A) || A <- Types],
eval_bif(beam_ssa:add_anno(float_op, AnnoArgs, I), Ts)
end;
-simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=0}]}=I, Ts) ->
+simplify(#b_set{op=get_tuple_element,args=[Tuple,#b_literal{val=N}]}=I, Ts) ->
case get_type(Tuple, Ts) of
- #t_tuple{elements=[First]} ->
- #b_literal{val=First};
- #t_tuple{} ->
+ #t_tuple{size=Size,elements=Es} when Size > N ->
+ ElemType = get_element_type(N + 1, Es),
+ case get_literal_from_type(ElemType) of
+ #b_literal{}=Lit -> Lit;
+ none -> I
+ end;
+ none ->
+ %% Will never be executed because of type conflict.
+ %% #b_literal{val=ignored};
I
end;
simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) ->
@@ -500,24 +562,8 @@ simplify(#b_set{op=is_nonempty_list,args=[Src]}=I, Ts) ->
_ -> #b_literal{val=false}
end;
simplify(#b_set{op=is_tagged_tuple,
- args=[Src,#b_literal{val=Size},#b_literal{val=Tag}]}=I, Ts) ->
- case get_type(Src, Ts) of
- #t_tuple{exact=true,size=Size,elements=[Tag]} ->
- #b_literal{val=true};
- #t_tuple{exact=true,size=ActualSize,elements=[]} ->
- if
- Size =/= ActualSize ->
- #b_literal{val=false};
- true ->
- I
- end;
- #t_tuple{exact=false} ->
- I;
- any ->
- I;
- _ ->
- #b_literal{val=false}
- end;
+ args=[Src,#b_literal{val=Size},#b_literal{}=Tag]}=I, Ts) ->
+ simplify_is_record(I, get_type(Src, Ts), Size, Tag, Ts);
simplify(#b_set{op=put_list,args=[#b_literal{val=H},
#b_literal{val=T}]}, _Ts) ->
#b_literal{val=[H|T]};
@@ -627,41 +673,49 @@ anno_float_arg(_) -> convert.
opt_terminator(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) ->
beam_ssa:normalize(Br);
-opt_terminator(#b_br{bool=#b_var{}=V}=Br, Ts, Ds) ->
- #{V:=Set} = Ds,
- case Set of
- #b_set{op={bif,'=:='},args=[Bool,#b_literal{val=true}]} ->
- case t_is_boolean(get_type(Bool, Ts)) of
- true ->
- %% Bool =:= true ==> Bool
- simplify_not(Br#b_br{bool=Bool}, Ts, Ds);
- false ->
- Br
- end;
- #b_set{} ->
- simplify_not(Br, Ts, Ds)
- end;
+opt_terminator(#b_br{bool=#b_var{}}=Br, Ts, Ds) ->
+ simplify_not(Br, Ts, Ds);
opt_terminator(#b_switch{arg=#b_literal{}}=Sw, _Ts, _Ds) ->
beam_ssa:normalize(Sw);
-opt_terminator(#b_switch{arg=#b_var{}=V}=Sw0, Ts, Ds) ->
- Type = get_type(V, Ts),
+opt_terminator(#b_switch{arg=#b_var{}=V}=Sw, Ts, Ds) ->
+ case get_type(V, Ts) of
+ any ->
+ beam_ssa:normalize(Sw);
+ Type ->
+ beam_ssa:normalize(opt_switch(Sw, Type, Ts, Ds))
+ end;
+opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret.
+
+
+opt_switch(#b_switch{fail=Fail,list=List0}=Sw0, Type, Ts, Ds) ->
+ List = prune_switch_list(List0, Fail, Type, Ts),
+ Sw1 = Sw0#b_switch{list=List},
case Type of
#t_integer{elements={_,_}=Range} ->
- simplify_switch_int(Sw0, Range);
- _ ->
+ simplify_switch_int(Sw1, Range);
+ #t_atom{elements=[_|_]} ->
case t_is_boolean(Type) of
true ->
- case simplify_switch_bool(Sw0, Ts, Ds) of
- #b_br{}=Br ->
- opt_terminator(Br, Ts, Ds);
- Sw ->
- beam_ssa:normalize(Sw)
- end;
+ #b_br{} = Br = simplify_switch_bool(Sw1, Ts, Ds),
+ opt_terminator(Br, Ts, Ds);
false ->
- beam_ssa:normalize(Sw0)
- end
+ simplify_switch_atom(Type, Sw1)
+ end;
+ _ ->
+ Sw1
+ end.
+
+prune_switch_list([{_,Fail}|T], Fail, Type, Ts) ->
+ prune_switch_list(T, Fail, Type, Ts);
+prune_switch_list([{Arg,_}=Pair|T], Fail, Type, Ts) ->
+ case meet(get_type(Arg, Ts), Type) of
+ none ->
+ %% Different types. This value can never match.
+ prune_switch_list(T, Fail, Type, Ts);
+ _ ->
+ [Pair|prune_switch_list(T, Fail, Type, Ts)]
end;
-opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret.
+prune_switch_list([], _, _, _) -> [].
update_successors(#b_br{bool=#b_literal{val=true},succ=S}, Ts, D) ->
update_successor(S, Ts, D);
@@ -670,38 +724,39 @@ update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) ->
true ->
%% This variable is defined in this block and is only
%% referenced by this br terminator. Therefore, there is
- %% no need to include the type database passed on to the
- %% successors of this block.
+ %% no need to include it in the type database passed on to
+ %% the successors of this block.
Ts = maps:remove(Bool, Ts0),
- {SuccTs,FailTs} = infer_types(Bool, Ts, D0),
+ {SuccTs,FailTs} = infer_types_br(Bool, Ts, D0),
D = update_successor(Fail, FailTs, D0),
update_successor(Succ, SuccTs, D);
false ->
- {SuccTs,FailTs} = infer_types(Bool, Ts0, D0),
+ {SuccTs,FailTs} = infer_types_br(Bool, Ts0, D0),
D = update_successor_bool(Bool, false, Fail, FailTs, D0),
update_successor_bool(Bool, true, Succ, SuccTs, D)
end;
-update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) ->
+update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts, D0) ->
case cerl_sets:is_element(V, D0#d.once) of
true ->
%% This variable is defined in this block and is only
%% referenced by this switch terminator. Therefore, there is
- %% no need to include the type database passed on to the
- %% successors of this block.
- Ts = maps:remove(V, Ts0),
+ %% no need to include it in the type database passed on to
+ %% the successors of this block.
D = update_successor(Fail, Ts, D0),
- F = fun({_Val,S}, A) ->
- update_successor(S, Ts, A)
+ F = fun({Val,S}, A) ->
+ SuccTs0 = infer_types_switch(V, Val, Ts, D),
+ SuccTs = maps:remove(V, SuccTs0),
+ update_successor(S, SuccTs, A)
end,
foldl(F, D, List);
false ->
%% V can not be equal to any of the values in List at the fail
%% block.
- FailTs = subtract_sw_list(V, List, Ts0),
+ FailTs = subtract_sw_list(V, List, Ts),
D = update_successor(Fail, FailTs, D0),
F = fun({Val,S}, A) ->
- T = get_type(Val, Ts0),
- update_successor(S, Ts0#{V=>T}, A)
+ SuccTs = infer_types_switch(V, Val, Ts, D),
+ update_successor(S, SuccTs, A)
end,
foldl(F, D, List)
end;
@@ -785,19 +840,40 @@ type(bs_get_tail, _Args, _Ts, _Ds) ->
type(call, [#b_remote{mod=#b_literal{val=Mod},
name=#b_literal{val=Name}}|Args], Ts, _Ds) ->
case {Mod,Name,Args} of
- {erlang,setelement,[Pos,Tuple,_]} ->
+ {erlang,setelement,[Pos,Tuple,Arg]} ->
case {get_type(Pos, Ts),get_type(Tuple, Ts)} of
- {#t_integer{elements={MinIndex,_}},#t_tuple{}=T}
- when MinIndex > 1 ->
- %% First element is not updated. The result
- %% will have the same type.
- T;
+ {#t_integer{elements={Index,Index}},
+ #t_tuple{elements=Es0,size=Size}=T} ->
+ %% This is an exact index, update the type of said element
+ %% or return 'none' if it's known to be out of bounds.
+ Es = set_element_type(Index, get_type(Arg, Ts), Es0),
+ case T#t_tuple.exact of
+ false ->
+ T#t_tuple{size=max(Index, Size),elements=Es};
+ true when Index =< Size ->
+ T#t_tuple{elements=Es};
+ true ->
+ none
+ end;
+ {#t_integer{elements={Min,Max}},
+ #t_tuple{elements=Es0,size=Size}=T} ->
+ %% We know this will land between Min and Max, so kill the
+ %% types for those indexes.
+ Es = maps:without(seq(Min, Max), Es0),
+ case T#t_tuple.exact of
+ false ->
+ T#t_tuple{elements=Es,size=max(Min, Size)};
+ true when Min =< Size ->
+ T#t_tuple{elements=Es,size=Size};
+ true ->
+ none
+ end;
{_,#t_tuple{}=T} ->
- %% Position is 1 or unknown. May update the first
- %% element of the tuple.
- T#t_tuple{elements=[]};
- {#t_integer{elements={MinIndex,_}},_} ->
- #t_tuple{size=MinIndex};
+ %% Position unknown, so we have to discard all element
+ %% information.
+ T#t_tuple{elements=#{}};
+ {#t_integer{elements={Min,_Max}},_} ->
+ #t_tuple{size=Min};
{_,_} ->
#t_tuple{}
end;
@@ -809,6 +885,9 @@ type(call, [#b_remote{mod=#b_literal{val=Mod},
end;
{erlang,'--',[_,_]} ->
list;
+ {lists,F,Args} ->
+ Types = get_types(Args, Ts),
+ lists_function_type(F, Types);
{math,_,_} ->
case is_math_bif(Name, length(Args)) of
false -> any;
@@ -820,6 +899,11 @@ type(call, [#b_remote{mod=#b_literal{val=Mod},
false -> any
end
end;
+type(get_tuple_element, [Tuple, Offset], Ts, _Ds) ->
+ #t_tuple{size=Size,elements=Es} = get_type(Tuple, Ts),
+ #b_literal{val=N} = Offset,
+ true = Size > N, %Assertion.
+ get_element_type(N + 1, Es);
type(is_nonempty_list, [_], _Ts, _Ds) ->
t_boolean();
type(is_tagged_tuple, [_,#b_literal{},#b_literal{}], _Ts, _Ds) ->
@@ -828,13 +912,13 @@ type(put_map, _Args, _Ts, _Ds) ->
map;
type(put_list, _Args, _Ts, _Ds) ->
cons;
-type(put_tuple, Args, _Ts, _Ds) ->
- case Args of
- [#b_literal{val=First}|_] ->
- #t_tuple{exact=true,size=length(Args),elements=[First]};
- _ ->
- #t_tuple{exact=true,size=length(Args)}
- end;
+type(put_tuple, Args, Ts, _Ds) ->
+ {Es, _} = foldl(fun(Arg, {Es0, Index}) ->
+ Type = get_type(Arg, Ts),
+ Es = set_element_type(Index, Type, Es0),
+ {Es, Index + 1}
+ end, {#{}, 1}, Args),
+ #t_tuple{exact=true,size=length(Args),elements=Es};
type(succeeded, [#b_var{}=Src], Ts, Ds) ->
case maps:get(Src, Ds) of
#b_set{op={bif,Bif},args=BifArgs} ->
@@ -895,6 +979,70 @@ arith_op_type(Args, Ts) ->
(_, _) -> none
end, unknown, Types).
+lists_function_type(F, Types) ->
+ case {F,Types} of
+ %% Functions that return booleans.
+ {all,[_,_]} ->
+ t_boolean();
+ {any,[_,_]} ->
+ t_boolean();
+ {keymember,[_,_,_]} ->
+ t_boolean();
+ {member,[_,_]} ->
+ t_boolean();
+ {prefix,[_,_]} ->
+ t_boolean();
+ {suffix,[_,_]} ->
+ t_boolean();
+
+ %% Functions that return lists.
+ {dropwhile,[_,_]} ->
+ list;
+ {duplicate,[_,_]} ->
+ list;
+ {filter,[_,_]} ->
+ list;
+ {flatten,[_]} ->
+ list;
+ {map,[_Fun,List]} ->
+ same_length_type(List);
+ {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl;
+ MapFold =:= mapfoldr ->
+ #t_tuple{size=2,exact=true,
+ elements=#{1=>same_length_type(List)}};
+ {partition,[_,_]} ->
+ t_two_tuple(list, list);
+ {reverse,[List]} ->
+ same_length_type(List);
+ {sort,[List]} ->
+ same_length_type(List);
+ {splitwith,[_,_]} ->
+ t_two_tuple(list, list);
+ {takewhile,[_,_]} ->
+ list;
+ {unzip,[List]} ->
+ ListType = same_length_type(List),
+ t_two_tuple(ListType, ListType);
+ {usort,[List]} ->
+ same_length_type(List);
+ {zip,[_,_]} ->
+ list;
+ {zipwith,[_,_,_]} ->
+ list;
+ {_,_} ->
+ any
+ end.
+
+%% For a lists function that return a list of the same
+%% length as the input list, return the type of the list.
+same_length_type(cons) -> cons;
+same_length_type(nil) -> nil;
+same_length_type(_) -> list.
+
+t_two_tuple(Type1, Type2) ->
+ #t_tuple{size=2,exact=true,
+ elements=#{1=>Type1,2=>Type2}}.
+
%% will_succeed(TestOperation, Type) -> yes|no|maybe.
%% Test whether TestOperation applied to an argument of type Type
%% will succeed. Return yes, no, or maybe.
@@ -1031,6 +1179,17 @@ bs_match_type(utf16, _) ->
bs_match_type(utf32, _) ->
?UNICODE_INT.
+simplify_switch_atom(#t_atom{elements=Atoms}, #b_switch{list=List0}=Sw) ->
+ case sort([A || {#b_literal{val=A},_} <- List0]) of
+ Atoms ->
+ %% All possible atoms are included in the list. The
+ %% failure label will never be used.
+ [{_,Fail}|List] = List0,
+ Sw#b_switch{fail=Fail,list=List};
+ _ ->
+ Sw
+ end.
+
simplify_switch_int(#b_switch{list=List0}=Sw, {Min,Max}) ->
List1 = sort(List0),
Vs = [V || {#b_literal{val=V},_} <- List1],
@@ -1047,14 +1206,42 @@ eq_ranges([H], H, H) -> true;
eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max);
eq_ranges(_, _, _) -> false.
-simplify_switch_bool(#b_switch{arg=B,list=List0}=Sw, Ts, Ds) ->
- List = sort(List0),
- case List of
- [{#b_literal{val=false},Fail},{#b_literal{val=true},Succ}] ->
- simplify_not(#b_br{bool=B,succ=Succ,fail=Fail}, Ts, Ds);
- [_|_] ->
- Sw
- end.
+simplify_is_record(I, #t_tuple{exact=Exact,
+ size=Size,
+ elements=Es},
+ RecSize, RecTag, Ts) ->
+ TagType = maps:get(1, Es, any),
+ TagMatch = case get_literal_from_type(TagType) of
+ #b_literal{}=RecTag -> yes;
+ #b_literal{} -> no;
+ none ->
+ %% Is it at all possible for the tag to match?
+ case meet(get_type(RecTag, Ts), TagType) of
+ none -> no;
+ _ -> maybe
+ end
+ end,
+ if
+ Size =/= RecSize, Exact; Size > RecSize; TagMatch =:= no ->
+ #b_literal{val=false};
+ Size =:= RecSize, Exact, TagMatch =:= yes ->
+ #b_literal{val=true};
+ true ->
+ I
+ end;
+simplify_is_record(I, any, _Size, _Tag, _Ts) ->
+ I;
+simplify_is_record(_I, _Type, _Size, _Tag, _Ts) ->
+ #b_literal{val=false}.
+
+simplify_switch_bool(#b_switch{arg=B,fail=Fail,list=List0}, Ts, Ds) ->
+ FalseVal = #b_literal{val=false},
+ TrueVal = #b_literal{val=true},
+ List1 = List0 ++ [{FalseVal,Fail},{TrueVal,Fail}],
+ {_,FalseLbl} = keyfind(FalseVal, 1, List1),
+ {_,TrueLbl} = keyfind(TrueVal, 1, List1),
+ Br = beam_ssa:normalize(#b_br{bool=B,succ=TrueLbl,fail=FalseLbl}),
+ simplify_not(Br, Ts, Ds).
simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) ->
case Ds of
@@ -1068,13 +1255,15 @@ simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) ->
end;
#{} ->
Br0
- end.
+ end;
+simplify_not(#b_br{bool=#b_literal{}}=Br, _Ts, _Ds) -> Br.
%%%
%%% Calculate the set of variables that are only used once in the
-%%% block that they are defined in. That will allow us to discard type
-%%% information for variables that will never be referenced by the
-%%% successor blocks, potentially improving compilation times.
+%%% terminator of the block that defines them. That will allow us to
+%%% discard type information for variables that will never be
+%%% referenced by the successor blocks, potentially improving
+%%% compilation times.
%%%
used_once(Linear, Args) ->
@@ -1083,34 +1272,48 @@ used_once(Linear, Args) ->
cerl_sets:from_list(maps:keys(Map)).
used_once_1([{L,#b_blk{is=Is,last=Last}}|Bs], Uses0) ->
- Uses = used_once_2([Last|reverse(Is)], L, Uses0),
+ Uses1 = used_once_last_uses(beam_ssa:used(Last), L, Uses0),
+ Uses = used_once_2(reverse(Is), L, Uses1),
used_once_1(Bs, Uses);
used_once_1([], Uses) -> Uses.
-used_once_2([I|Is], L, Uses0) ->
+used_once_2([#b_set{dst=Dst}=I|Is], L, Uses0) ->
Uses = used_once_uses(beam_ssa:used(I), L, Uses0),
- case I of
- #b_set{dst=Dst} ->
- case Uses of
- #{Dst:=[L]} ->
- used_once_2(Is, L, Uses);
- #{} ->
- used_once_2(Is, L, maps:remove(Dst, Uses))
- end;
- _ ->
- used_once_2(Is, L, Uses)
+ case Uses of
+ #{Dst:=[L]} ->
+ used_once_2(Is, L, Uses);
+ #{} ->
+ %% Used more than once or used once in
+ %% in another block.
+ used_once_2(Is, L, maps:remove(Dst, Uses))
end;
used_once_2([], _, Uses) -> Uses.
used_once_uses([V|Vs], L, Uses) ->
case Uses of
- #{V:=Us} ->
- used_once_uses(Vs, L, Uses#{V:=[L|Us]});
+ #{V:=more_than_once} ->
+ used_once_uses(Vs, L, Uses);
#{} ->
- used_once_uses(Vs, L, Uses#{V=>[L]})
+ %% Already used or first use is not in
+ %% a terminator.
+ used_once_uses(Vs, L, Uses#{V=>more_than_once})
end;
used_once_uses([], _, Uses) -> Uses.
+used_once_last_uses([V|Vs], L, Uses) ->
+ case Uses of
+ #{V:=[_]} ->
+ %% Second time this variable is used.
+ used_once_last_uses(Vs, L, Uses#{V:=more_than_once});
+ #{V:=more_than_once} ->
+ %% Used at least twice before.
+ used_once_last_uses(Vs, L, Uses);
+ #{} ->
+ %% First time this variable is used.
+ used_once_last_uses(Vs, L, Uses#{V=>[L]})
+ end;
+used_once_last_uses([], _, Uses) -> Uses.
+
get_types(Values, Ts) ->
[get_type(Val, Ts) || Val <- Values].
@@ -1134,8 +1337,12 @@ get_type(#b_literal{val=Val}, _Ts) ->
Val =:= {} ->
#t_tuple{exact=true};
is_tuple(Val) ->
- #t_tuple{exact=true,size=tuple_size(Val),
- elements=[element(1, Val)]};
+ {Es, _} = foldl(fun(E, {Es0, Index}) ->
+ Type = get_type(#b_literal{val=E}, #{}),
+ Es = set_element_type(Index, Type, Es0),
+ {Es, Index + 1}
+ end, {#{}, 1}, tuple_to_list(Val)),
+ #t_tuple{exact=true,size=tuple_size(Val),elements=Es};
Val =:= [] ->
nil;
true ->
@@ -1177,7 +1384,7 @@ get_type(#b_literal{val=Val}, _Ts) ->
%% failed and that L is not 'cons'. 'cons' can be subtracted from the
%% previously known type for L and the result put in FailTypes.
-infer_types(#b_var{}=V, Ts, #d{ds=Ds,once=Once}) ->
+infer_types_br(#b_var{}=V, Ts, #d{ds=Ds}) ->
#{V:=#b_set{op=Op,args=Args}} = Ds,
Types0 = infer_type(Op, Args, Ds),
@@ -1195,18 +1402,17 @@ infer_types(#b_var{}=V, Ts, #d{ds=Ds,once=Once}) ->
is_singleton_type(T)
end, EqTypes0),
- %% Don't bother updating the types for variables that
- %% are never used again.
- Types2 = Types1 ++ Types0,
- Types = [P || {InfV,_}=P <- Types2, not cerl_sets:is_element(InfV, Once)],
-
+ Types = Types1 ++ Types0,
{meet_types(EqTypes++Types, Ts),subtract_types(Types, Ts)}.
+infer_types_switch(V, Lit, Ts, #d{ds=Ds}) ->
+ Types = infer_eq_type({bif,'=:='}, [V, Lit], Ts, Ds),
+ meet_types(Types, Ts).
+
infer_eq_type({bif,'=:='}, [#b_var{}=Src,#b_literal{}=Lit], Ts, Ds) ->
Def = maps:get(Src, Ds),
Type = get_type(Lit, Ts),
- [{Src,Type}|infer_tuple_size(Def, Lit) ++
- infer_first_element(Def, Lit)];
+ [{Src,Type} | infer_eq_lit(Def, Lit)];
infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) ->
%% As an example, assume that L1 is known to be 'list', and L2 is
%% known to be 'cons'. Then if 'L1 =:= L2' evaluates to 'true', it can
@@ -1221,6 +1427,17 @@ infer_eq_type({bif,'=:='}, [#b_var{}=Arg0,#b_var{}=Arg1], Ts, _Ds) ->
infer_eq_type(_Op, _Args, _Ts, _Ds) ->
[].
+infer_eq_lit(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]},
+ #b_literal{val=Size}) when is_integer(Size) ->
+ [{Tuple,#t_tuple{exact=true,size=Size}}];
+infer_eq_lit(#b_set{op=get_tuple_element,
+ args=[#b_var{}=Tuple,#b_literal{val=N}]},
+ #b_literal{}=Lit) ->
+ Index = N + 1,
+ Es = set_element_type(Index, get_type(Lit, #{}), #{}),
+ [{Tuple,#t_tuple{size=Index,elements=Es}}];
+infer_eq_lit(_, _) -> [].
+
infer_type({bif,element}, [#b_literal{val=Pos},#b_var{}=Tuple], _Ds) ->
if
is_integer(Pos), 1 =< Pos ->
@@ -1254,8 +1471,9 @@ infer_type(bs_start_match, [#b_var{}=Bin], _Ds) ->
infer_type(is_nonempty_list, [#b_var{}=Src], _Ds) ->
[{Src,cons}];
infer_type(is_tagged_tuple, [#b_var{}=Src,#b_literal{val=Size},
- #b_literal{val=Tag}], _Ds) ->
- [{Src,#t_tuple{exact=true,size=Size,elements=[Tag]}}];
+ #b_literal{}=Tag], _Ds) ->
+ Es = set_element_type(1, get_type(Tag, #{}), #{}),
+ [{Src,#t_tuple{exact=true,size=Size,elements=Es}}];
infer_type(succeeded, [#b_var{}=Src], Ds) ->
#b_set{op=Op,args=Args} = maps:get(Src, Ds),
infer_type(Op, Args, Ds);
@@ -1348,17 +1566,6 @@ inferred_bif_type('*', [_,_]) -> number;
inferred_bif_type('/', [_,_]) -> number;
inferred_bif_type(_, _) -> any.
-infer_tuple_size(#b_set{op={bif,tuple_size},args=[#b_var{}=Tuple]},
- #b_literal{val=Size}) when is_integer(Size) ->
- [{Tuple,#t_tuple{exact=true,size=Size}}];
-infer_tuple_size(_, _) -> [].
-
-infer_first_element(#b_set{op=get_tuple_element,
- args=[#b_var{}=Tuple,#b_literal{val=0}]},
- #b_literal{val=First}) ->
- [{Tuple,#t_tuple{size=1,elements=[First]}}];
-infer_first_element(_, _) -> [].
-
is_math_bif(cos, 1) -> true;
is_math_bif(cosh, 1) -> true;
is_math_bif(sin, 1) -> true;
@@ -1457,6 +1664,19 @@ t_tuple_size(_) ->
is_singleton_type(Type) ->
get_literal_from_type(Type) =/= none.
+get_element_type(Index, Es) ->
+ case Es of
+ #{ Index := T } -> T;
+ #{} -> any
+ end.
+
+set_element_type(_Key, none, Es) ->
+ Es;
+set_element_type(Key, any, Es) ->
+ maps:remove(Key, Es);
+set_element_type(Key, Type, Es) ->
+ Es#{ Key => Type }.
+
%% join(Type1, Type2) -> Type
%% Return the "join" of Type1 and Type2. The join is a more general
%% type than Type1 and Type2. For example:
@@ -1504,15 +1724,41 @@ join(#t_integer{}, number) -> number;
join(number, #t_integer{}) -> number;
join(float, number) -> number;
join(number, float) -> number;
-join(#t_tuple{size=Sz,exact=Exact1}, #t_tuple{size=Sz,exact=Exact2}) ->
- Exact = Exact1 and Exact2,
- #t_tuple{size=Sz,exact=Exact};
-join(#t_tuple{size=Sz1}, #t_tuple{size=Sz2}) ->
- #t_tuple{size=min(Sz1, Sz2)};
+join(#t_tuple{size=Sz,exact=ExactA,elements=EsA},
+ #t_tuple{size=Sz,exact=ExactB,elements=EsB}) ->
+ Exact = ExactA and ExactB,
+ Es = join_tuple_elements(Sz, EsA, EsB),
+ #t_tuple{size=Sz,exact=Exact,elements=Es};
+join(#t_tuple{size=SzA,elements=EsA}, #t_tuple{size=SzB,elements=EsB}) ->
+ Sz = min(SzA, SzB),
+ Es = join_tuple_elements(Sz, EsA, EsB),
+ #t_tuple{size=Sz,elements=Es};
join(_T1, _T2) ->
%%io:format("~p ~p\n", [_T1,_T2]),
any.
+join_tuple_elements(MinSize, EsA, EsB) ->
+ Es0 = join_elements(EsA, EsB),
+ maps:filter(fun(Index, _Type) -> Index =< MinSize end, Es0).
+
+join_elements(Es1, Es2) ->
+ Keys = if
+ map_size(Es1) =< map_size(Es2) -> maps:keys(Es1);
+ map_size(Es1) > map_size(Es2) -> maps:keys(Es2)
+ end,
+ join_elements_1(Keys, Es1, Es2, #{}).
+
+join_elements_1([Key | Keys], Es1, Es2, Acc0) ->
+ case {Es1, Es2} of
+ {#{ Key := Type1 }, #{ Key := Type2 }} ->
+ Acc = set_element_type(Key, join(Type1, Type2), Acc0),
+ join_elements_1(Keys, Es1, Es2, Acc);
+ {#{}, #{}} ->
+ join_elements_1(Keys, Es1, Es2, Acc0)
+ end;
+join_elements_1([], _Es1, _Es2, Acc) ->
+ Acc.
+
gcd(A, B) ->
case A rem B of
0 -> B;
@@ -1609,9 +1855,6 @@ meet(_, _) ->
%% Inconsistent types. There will be an exception at runtime.
none.
-meet_tuples(#t_tuple{elements=[E1]}, #t_tuple{elements=[E2]})
- when E1 =/= E2 ->
- none;
meet_tuples(#t_tuple{size=Sz1,exact=true},
#t_tuple{size=Sz2,exact=true}) when Sz1 =/= Sz2 ->
none;
@@ -1619,12 +1862,31 @@ meet_tuples(#t_tuple{size=Sz1,exact=Ex1,elements=Es1},
#t_tuple{size=Sz2,exact=Ex2,elements=Es2}) ->
Size = max(Sz1, Sz2),
Exact = Ex1 or Ex2,
- Es = case {Es1,Es2} of
- {[],[_|_]} -> Es2;
- {[_|_],[]} -> Es1;
- {_,_} -> Es1
- end,
- #t_tuple{size=Size,exact=Exact,elements=Es}.
+ case meet_elements(Es1, Es2) of
+ none ->
+ none;
+ Es ->
+ #t_tuple{size=Size,exact=Exact,elements=Es}
+ end.
+
+meet_elements(Es1, Es2) ->
+ Keys = maps:keys(Es1) ++ maps:keys(Es2),
+ meet_elements_1(Keys, Es1, Es2, #{}).
+
+meet_elements_1([Key | Keys], Es1, Es2, Acc) ->
+ case {Es1, Es2} of
+ {#{ Key := Type1 }, #{ Key := Type2 }} ->
+ case meet(Type1, Type2) of
+ none -> none;
+ Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type })
+ end;
+ {#{ Key := Type1 }, _} ->
+ meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 });
+ {_, #{ Key := Type2 }} ->
+ meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 })
+ end;
+meet_elements_1([], _Es1, _Es2, Acc) ->
+ Acc.
%% verified_type(Type) -> Type
%% Returns the passed in type if it is one of the defined types.
@@ -1663,5 +1925,13 @@ verified_type(map=T) -> T;
verified_type(nil=T) -> T;
verified_type(cons=T) -> T;
verified_type(number=T) -> T;
-verified_type(#t_tuple{}=T) -> T;
+verified_type(#t_tuple{size=Size,elements=Es}=T) ->
+ %% All known elements must have a valid index and type. 'any' is prohibited
+ %% since it's implicit and should never be present in the map.
+ maps:fold(fun(Index, Element, _) when is_integer(Index),
+ 1 =< Index, Index =< Size,
+ Element =/= any, Element =/= none ->
+ verified_type(Element)
+ end, [], Es),
+ T;
verified_type(float=T) -> T.
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 4081e366a5..ab8caa1a0d 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -26,9 +26,9 @@
%% Interface for compiler.
-export([module/2, format_error/1]).
--export([type_anno/1, type_anno/2, type_anno/3]).
+-export([type_anno/1, type_anno/2, type_anno/4]).
--import(lists, [any/2,dropwhile/2,foldl/3,map/2,foreach/2,reverse/1]).
+-import(lists, [dropwhile/2,foldl/3,member/2,reverse/1,sort/1,zip/2]).
%% To be called by the compiler.
@@ -50,7 +50,7 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts)
-spec type_anno(term()) -> term().
type_anno(atom) -> {atom,[]};
type_anno(bool) -> bool;
-type_anno({binary,_}) -> term;
+type_anno({binary,_}) -> binary;
type_anno(cons) -> cons;
type_anno(float) -> {float,[]};
type_anno(integer) -> {integer,[]};
@@ -61,15 +61,16 @@ type_anno(number) -> number;
type_anno(nil) -> nil.
-spec type_anno(term(), term()) -> term().
-type_anno(atom, Value) -> {atom, Value};
-type_anno(float, Value) -> {float, Value};
-type_anno(integer, Value) -> {integer, Value}.
+type_anno(atom, Value) when is_atom(Value) -> {atom, Value};
+type_anno(float, Value) when is_float(Value) -> {float, Value};
+type_anno(integer, Value) when is_integer(Value) -> {integer, Value}.
--spec type_anno(term(), term(), term()) -> term().
-type_anno(tuple, Size, Exact) when is_integer(Size) ->
+-spec type_anno(term(), term(), term(), term()) -> term().
+type_anno(tuple, Size, Exact, Elements) when is_integer(Size), Size >= 0,
+ is_map(Elements) ->
case Exact of
- true -> {tuple, Size};
- false -> {tuple, [Size]}
+ true -> {tuple, Size, Elements};
+ false -> {tuple, [Size], Elements}
end.
-spec format_error(term()) -> iolist().
@@ -135,43 +136,100 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) ->
erlang:raise(Class, Error, Stack)
end.
+-record(value_ref, {id :: index()}).
+-record(value, {op :: term(), args :: [argument()], type :: type()}).
+
+-type argument() :: #value_ref{} | literal().
+
-type index() :: non_neg_integer().
--type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}).
-
--record(st, %Emulation state
- {x=init_regs(0, term) :: reg_tab(),%x register info.
- y=init_regs(0, initialized) :: reg_tab(),%y register info.
- f=init_fregs(), %
- numy=none, %Number of y registers.
- h=0, %Available heap size.
- hf=0, %Available heap size for floats.
- fls=undefined, %Floating point state.
- ct=[], %List of hot catch/try labels
- setelem=false, %Previous instruction was setelement/3.
- puts_left=none, %put/1 instructions left.
- defs=#{}, %Defining expression for each register.
- aliases=#{}
- }).
+
+-type literal() :: {atom, [] | atom()} |
+ {float, [] | float()} |
+ {integer, [] | integer()} |
+ {literal, term()} |
+ nil.
+
+-type tuple_sz() :: [non_neg_integer()] | %% Inexact
+ non_neg_integer(). %% Exact.
+
+%% Match context type.
+-record(ms,
+ {id=make_ref() :: reference(), %Unique ID.
+ valid=0 :: non_neg_integer(), %Valid slots
+ slots=0 :: non_neg_integer() %Number of slots
+ }).
+
+-type type() :: binary |
+ cons |
+ list |
+ map |
+ nil |
+ #ms{} |
+ ms_position |
+ none |
+ number |
+ term |
+ tuple_in_progress |
+ {tuple, tuple_sz(), #{ literal() => type() }} |
+ literal().
+
+-type tag() :: initialized |
+ uninitialized |
+ {catchtag, [label()]} |
+ {trytag, [label()]}.
+
+-type x_regs() :: #{ {x, index()} => #value_ref{} }.
+-type y_regs() :: #{ {y, index()} => tag() | #value_ref{} }.
+
+%% Emulation state
+-record(st,
+ {%% All known values.
+ vs=#{} :: #{ #value_ref{} => #value{} },
+ %% Register states.
+ xs=#{} :: x_regs(),
+ ys=#{} :: y_regs(),
+ f=init_fregs(),
+ %% A set of all registers containing "fragile" terms. That is, terms
+ %% that don't exist on our process heap and would be destroyed by a
+ %% GC.
+ fragile=cerl_sets:new() :: cerl_sets:set(),
+ %% Number of Y registers.
+ %%
+ %% Note that this may be 0 if there's a frame without saved values,
+ %% such as on a body-recursive call.
+ numy=none :: none | undecided | index(),
+ %% Available heap size.
+ h=0,
+ %Available heap size for floats.
+ hf=0,
+ %% Floating point state.
+ fls=undefined,
+ %% List of hot catch/try labels
+ ct=[],
+ %% Previous instruction was setelement/3.
+ setelem=false,
+ %% put/1 instructions left.
+ puts_left=none
+ }).
-type label() :: integer().
-type label_set() :: gb_sets:set(label()).
-type branched_tab() :: gb_trees:tree(label(), #st{}).
-type ft_tab() :: gb_trees:tree().
--record(vst, %Validator state
- {current=none :: #st{} | 'none', %Current state
- branched=gb_trees:empty() :: branched_tab(), %States at jumps
- labels=gb_sets:empty() :: label_set(), %All defined labels
- ft=gb_trees:empty() :: ft_tab() %Some other functions
- % in the module (those that start with bs_start_match2).
- }).
-
-%% Match context type.
--record(ms,
- {id=make_ref() :: reference(), %Unique ID.
- valid=0 :: non_neg_integer(), %Valid slots
- slots=0 :: non_neg_integer() %Number of slots
- }).
+%% Validator state
+-record(vst,
+ {%% Current state
+ current=none :: #st{} | 'none',
+ %% States at labels
+ branched=gb_trees:empty() :: branched_tab(),
+ %% All defined labels
+ labels=gb_sets:empty() :: label_set(),
+ %% Argument information of other functions in the module
+ ft=gb_trees:empty() :: ft_tab(),
+ %% Counter for #value_ref{} creation
+ ref_ctr=0 :: index()
+ }).
index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) ->
Code = dropwhile(fun({label,L}) when L =:= Entry -> false;
@@ -187,7 +245,7 @@ index_parameter_types([{function,_,_,Entry,Code0}|Fs], Acc0) ->
index_parameter_types(Fs, Acc0)
end;
index_parameter_types([], Acc) ->
- gb_trees:from_orddict(lists:sort(Acc)).
+ gb_trees:from_orddict(sort(Acc)).
index_parameter_types_1([{'%', {type_info, Reg, Type0}} | Is], Entry, Acc) ->
Type = case Type0 of
@@ -210,14 +268,10 @@ validate_2({Ls1,Is}, Name, Arity, _Entry, _Ft) ->
validate_3({Ls2,Is}, Name, Arity, Entry, Mod, Ls1, Ft) ->
Offset = 1 + length(Ls1) + 1 + length(Ls2),
- EntryOK = lists:member(Entry, Ls2),
+ EntryOK = member(Entry, Ls2),
if
EntryOK ->
- St = init_state(Arity),
- Vst0 = #vst{current=St,
- branched=gb_trees_from_list([{L,St} || L <- Ls1]),
- labels=gb_sets:from_list(Ls1++Ls2),
- ft=Ft},
+ Vst0 = init_vst(Arity, Ls1, Ls2, Ft),
MFA = {Mod,Name,Arity},
Vst = valfun(Is, MFA, Offset, Vst0),
validate_fun_info_branches(Ls1, MFA, Vst);
@@ -240,7 +294,7 @@ validate_fun_info_branches_1(X, {Mod,Name,Arity}=MFA, Vst) ->
#vst{current=#st{numy=Size}} ->
error({unexpected_stack_frame,Size})
end,
- get_term_type({x,X}, Vst)
+ assert_term({x,X}, Vst)
catch Error ->
I = {func_info,{atom,Mod},{atom,Name},Arity},
Offset = 2,
@@ -261,19 +315,22 @@ labels_1([{line,_}|Is], R) ->
labels_1(Is, R) ->
{reverse(R),Is}.
-init_state(Arity) ->
- Xs = init_regs(Arity, term),
- Ys = init_regs(0, initialized),
- kill_heap_allocation(#st{x=Xs,y=Ys,numy=none,ct=[]}).
+init_vst(Arity, Ls1, Ls2, Ft) ->
+ Vst0 = init_function_args(Arity - 1, #vst{current=#st{}}),
+ Branches = gb_trees_from_list([{L,Vst0#vst.current} || L <- Ls1]),
+ Labels = gb_sets:from_list(Ls1++Ls2),
+ Vst0#vst{branched=Branches,
+ labels=Labels,
+ ft=Ft}.
+
+init_function_args(-1, Vst) ->
+ Vst;
+init_function_args(X, Vst) ->
+ init_function_args(X - 1, create_term(term, argument, [], {x,X}, Vst)).
kill_heap_allocation(St) ->
St#st{h=0,hf=0}.
-init_regs(0, _) ->
- gb_trees:empty();
-init_regs(N, Type) ->
- gb_trees_from_list([{R,Type} || R <- lists:seq(0, N-1)]).
-
valfun([], MFA, _Offset, #vst{branched=Targets0,labels=Labels0}=Vst) ->
Targets = gb_trees:keys(Targets0),
Labels = gb_sets:to_list(Labels0),
@@ -294,20 +351,25 @@ valfun([I|Is], MFA, Offset, Vst0) ->
%% Instructions that are allowed in dead code or when failing,
%% that is while the state is undecided in some way.
-valfun_1({label,Lbl}, #vst{current=St0,branched=B,labels=Lbls}=Vst) ->
- St = merge_states(Lbl, St0, B),
- Vst#vst{current=St,branched=gb_trees:enter(Lbl, St, B),
- labels=gb_sets:add(Lbl, Lbls)};
+valfun_1({label,Lbl}, #vst{current=St0,
+ ref_ctr=Counter0,
+ branched=B,
+ labels=Lbls}=Vst) ->
+ {St, Counter} = merge_states(Lbl, St0, B, Counter0),
+ Vst#vst{current=St,
+ ref_ctr=Counter,
+ branched=gb_trees:enter(Lbl, St, B),
+ labels=gb_sets:add(Lbl, Lbls)};
valfun_1(_I, #vst{current=none}=Vst) ->
%% Ignore instructions after erlang:error/1,2, which
%% the original R10B compiler thought would return.
Vst;
valfun_1({badmatch,Src}, Vst) ->
- assert_term(Src, Vst),
+ assert_durable_term(Src, Vst),
verify_y_init(Vst),
kill_state(Vst);
valfun_1({case_end,Src}, Vst) ->
- assert_term(Src, Vst),
+ assert_durable_term(Src, Vst),
verify_y_init(Vst),
kill_state(Vst);
valfun_1(if_end, Vst) ->
@@ -315,40 +377,21 @@ valfun_1(if_end, Vst) ->
kill_state(Vst);
valfun_1({try_case_end,Src}, Vst) ->
verify_y_init(Vst),
- assert_term(Src, Vst),
+ assert_durable_term(Src, Vst),
kill_state(Vst);
%% Instructions that cannot cause exceptions
valfun_1({bs_get_tail,Ctx,Dst,Live}, Vst0) ->
+ bsm_validate_context(Ctx, Vst0),
verify_live(Live, Vst0),
verify_y_init(Vst0),
Vst = prune_x_regs(Live, Vst0),
- #vst{current=#st{x=Xs,y=Ys}} = Vst,
- {Reg, Tree} = case Ctx of
- {x,X} -> {X, Xs};
- {y,Y} -> {Y, Ys};
- _ -> error({bad_source,Ctx})
- end,
- Type = case gb_trees:lookup(Reg, Tree) of
- {value,#ms{}} -> propagate_fragility(term, [Ctx], Vst);
- _ -> error({bad_context,Reg})
- end,
- set_type_reg(Type, Dst, Vst);
+ extract_term(binary, bs_get_tail, [Ctx], Dst, Vst, Vst0);
valfun_1(bs_init_writable=I, Vst) ->
call(I, 1, Vst);
valfun_1(build_stacktrace=I, Vst) ->
call(I, 1, Vst);
-valfun_1({move,{y,_}=Src,{y,_}=Dst}, Vst) ->
- %% The stack trimming optimization may generate a move from an initialized
- %% but unassigned Y register to another Y register.
- case get_term_type_1(Src, Vst) of
- {catchtag,_} -> error({catchtag,Src});
- {trytag,_} -> error({trytag,Src});
- Type -> set_type_reg(Type, Dst, Vst)
- end;
-valfun_1({move,Src,Dst}, Vst0) ->
- Type = get_move_term_type(Src, Vst0),
- Vst = set_type_reg(Type, Dst, Vst0),
- set_alias(Src, Dst, Vst);
+valfun_1({move,Src,Dst}, Vst) ->
+ assign(Src, Dst, Vst);
valfun_1({fmove,Src,{fr,_}=Dst}, Vst) ->
assert_type(float, Src, Vst),
set_freg(Dst, Vst);
@@ -356,15 +399,15 @@ valfun_1({fmove,{fr,_}=Src,Dst}, Vst0) ->
assert_freg_set(Src, Vst0),
assert_fls(checked, Vst0),
Vst = eat_heap_float(Vst0),
- set_type_reg({float,[]}, Dst, Vst);
-valfun_1({kill,{y,_}=Reg}, Vst) ->
- set_type_y(initialized, Reg, Vst);
-valfun_1({init,{y,_}=Reg}, Vst) ->
- set_type_y(initialized, Reg, Vst);
+ create_term({float,[]}, fmove, [], Dst, Vst);
+valfun_1({kill,Reg}, Vst) ->
+ create_tag(initialized, kill, [], Reg, Vst);
+valfun_1({init,Reg}, Vst) ->
+ create_tag(initialized, init, [], Reg, Vst);
valfun_1({test_heap,Heap,Live}, Vst) ->
test_heap(Heap, Live, Vst);
-valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) ->
- case is_bif_safe(Op, length(Src)) of
+valfun_1({bif,Op,{f,_},Ss,Dst}=I, Vst) ->
+ case is_bif_safe(Op, length(Ss)) of
false ->
%% Since the BIF can fail, make sure that any catch state
%% is updated.
@@ -372,27 +415,32 @@ valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) ->
true ->
%% It can't fail, so we finish handling it here (not updating
%% catch state).
- validate_src(Src, Vst),
- Type = bif_type(Op, Src, Vst),
- set_type_reg_expr(Type, I, Dst, Vst)
+ validate_src(Ss, Vst),
+ Type = bif_return_type(Op, Ss, Vst),
+ extract_term(Type, {bif,Op}, Ss, Dst, Vst)
end;
%% Put instructions.
valfun_1({put_list,A,B,Dst}, Vst0) ->
assert_term(A, Vst0),
assert_term(B, Vst0),
Vst = eat_heap(2, Vst0),
- set_type_reg(cons, Dst, Vst);
+ create_term(cons, put_list, [A, B], Dst, Vst);
valfun_1({put_tuple2,Dst,{list,Elements}}, Vst0) ->
_ = [assert_term(El, Vst0) || El <- Elements],
Size = length(Elements),
Vst = eat_heap(Size+1, Vst0),
- Type = {tuple,Size},
- set_type_reg(Type, Dst, Vst);
+ {Es,_} = foldl(fun(Val, {Es0, Index}) ->
+ Type = get_term_type(Val, Vst0),
+ Es = set_element_type({integer,Index}, Type, Es0),
+ {Es, Index + 1}
+ end, {#{}, 1}, Elements),
+ Type = {tuple,Size,Es},
+ create_term(Type, put_tuple2, [], Dst, Vst);
valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) ->
Vst1 = eat_heap(1, Vst0),
- Vst = set_type_reg(tuple_in_progress, Dst, Vst1),
+ Vst = create_term(tuple_in_progress, put_tuple, [], Dst, Vst1),
#vst{current=St0} = Vst,
- St = St0#st{puts_left={Sz,{Dst,{tuple,Sz}}}},
+ St = St0#st{puts_left={Sz,{Dst,Sz,#{}}}},
Vst#vst{current=St};
valfun_1({put,Src}, Vst0) ->
assert_term(Src, Vst0),
@@ -401,11 +449,14 @@ valfun_1({put,Src}, Vst0) ->
case St0 of
#st{puts_left=none} ->
error(not_building_a_tuple);
- #st{puts_left={1,{Dst,Type}}} ->
+ #st{puts_left={1,{Dst,Sz,Es0}}} ->
+ Es = Es0#{ {integer,Sz} => get_term_type(Src, Vst0) },
St = St0#st{puts_left=none},
- set_type_reg(Type, Dst, Vst#vst{current=St});
- #st{puts_left={PutsLeft,Info}} when is_integer(PutsLeft) ->
- St = St0#st{puts_left={PutsLeft-1,Info}},
+ create_term({tuple,Sz,Es}, put_tuple, [], Dst, Vst#vst{current=St});
+ #st{puts_left={PutsLeft,{Dst,Sz,Es0}}} when is_integer(PutsLeft) ->
+ Index = Sz - PutsLeft + 1,
+ Es = Es0#{ {integer,Index} => get_term_type(Src, Vst0) },
+ St = St0#st{puts_left={PutsLeft-1,{Dst,Sz,Es}}},
Vst#vst{current=St}
end;
%% Instructions for optimization of selective receives.
@@ -418,26 +469,28 @@ valfun_1(remove_message, Vst) ->
%% The message term is no longer fragile. It can be used
%% without restrictions.
remove_fragility(Vst);
-valfun_1({'%', {type_info, Reg, match_context}}, Vst0) ->
- set_aliased_type(#ms{}, Reg, Vst0);
-valfun_1({'%', {type_info, Reg, NewType0}}, Vst0) ->
+valfun_1({'%', {type_info, Reg, match_context}}, Vst) ->
+ update_type(fun meet/2, #ms{}, Reg, Vst);
+valfun_1({'%', {type_info, Reg, Type}}, Vst) ->
%% Explicit type information inserted by optimization passes to indicate
%% that Reg has a certain type, so that we can accept cross-function type
%% optimizations.
- OldType = get_durable_term_type(Reg, Vst0),
- NewType = case meet(NewType0, OldType) of
- none -> error({bad_type_info, Reg, NewType0, OldType});
- T -> T
- end,
- Type = propagate_fragility(NewType, [Reg], Vst0),
- set_aliased_type(Type, Reg, Vst0);
+ update_type(fun meet/2, Type, Reg, Vst);
+valfun_1({'%', {remove_fragility, Reg}}, Vst) ->
+ %% This is a hack to make prim_eval:'receive'/2 work.
+ %%
+ %% Normally it's illegal to pass fragile terms as a function argument as we
+ %% have no way of knowing what the callee will do with it, but we know that
+ %% prim_eval:'receive'/2 won't leak the term, nor cause a GC since it's
+ %% disabled while matching messages.
+ remove_fragility(Reg, Vst);
valfun_1({'%',_}, Vst) ->
Vst;
valfun_1({line,_}, Vst) ->
Vst;
%% Exception generating calls
valfun_1({call_ext,Live,Func}=I, Vst) ->
- case return_type(Func, Vst) of
+ case call_return_type(Func, Vst) of
exception ->
verify_live(Live, Vst),
%% The stack will be scanned, so Y registers
@@ -452,104 +505,122 @@ valfun_1(_I, #vst{current=#st{ct=undecided}}) ->
%%
%% Allocate and deallocate, et.al
valfun_1({allocate,Stk,Live}, Vst) ->
- allocate(false, Stk, 0, Live, Vst);
+ allocate(uninitialized, Stk, 0, Live, Vst);
valfun_1({allocate_heap,Stk,Heap,Live}, Vst) ->
- allocate(false, Stk, Heap, Live, Vst);
+ allocate(uninitialized, Stk, Heap, Live, Vst);
valfun_1({allocate_zero,Stk,Live}, Vst) ->
- allocate(true, Stk, 0, Live, Vst);
+ allocate(initialized, Stk, 0, Live, Vst);
valfun_1({allocate_heap_zero,Stk,Heap,Live}, Vst) ->
- allocate(true, Stk, Heap, Live, Vst);
+ allocate(initialized, Stk, Heap, Live, Vst);
valfun_1({deallocate,StkSize}, #vst{current=#st{numy=StkSize}}=Vst) ->
verify_no_ct(Vst),
deallocate(Vst);
valfun_1({deallocate,_}, #vst{current=#st{numy=NumY}}) ->
error({allocated,NumY});
-valfun_1({trim,N,Remaining}, #vst{current=#st{y=Yregs0,numy=NumY}=St}=Vst) ->
+valfun_1({trim,N,Remaining}, #vst{current=St0}=Vst) ->
+ #st{numy=NumY} = St0,
if
- N =< NumY, N+Remaining =:= NumY ->
- Yregs1 = [{Y-N,Type} || {Y,Type} <- gb_trees:to_list(Yregs0), Y >= N],
- Yregs = gb_trees_from_list(Yregs1),
- Vst#vst{current=St#st{y=Yregs,numy=NumY-N,aliases=#{}}};
- true ->
- error({trim,N,Remaining,allocated,NumY})
+ N =< NumY, N+Remaining =:= NumY ->
+ Vst#vst{current=trim_stack(N, 0, NumY, St0)};
+ N > NumY; N+Remaining =/= NumY ->
+ error({trim,N,Remaining,allocated,NumY})
end;
%% Catch & try.
valfun_1({'catch',Dst,{f,Fail}}, Vst) when Fail =/= none ->
init_try_catch_branch(catchtag, Dst, Fail, Vst);
valfun_1({'try',Dst,{f,Fail}}, Vst) when Fail =/= none ->
init_try_catch_branch(trytag, Dst, Fail, Vst);
-valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) ->
- case get_special_y_type(Reg, Vst0) of
- {catchtag,Fail} ->
- Vst = #vst{current=St} = set_catch_end(Reg, Vst0),
- Xregs = gb_trees:enter(0, term, St#st.x),
- Vst#vst{current=St#st{x=Xregs,ct=Fails,fls=undefined,aliases=#{}}};
- Type ->
- error({bad_type,Type})
+valfun_1({catch_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) ->
+ case get_tag_type(Reg, Vst0) of
+ {catchtag,Fail} ->
+ %% {x,0} contains the caught term, if any.
+ create_term(term, catch_end, [], {x,0}, kill_catch_tag(Reg, Vst0));
+ Type ->
+ error({wrong_tag_type,Type})
end;
-valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|Fails]}=St0}=Vst) ->
- case get_special_y_type(Reg, Vst) of
- {trytag,Fail} ->
- St = St0#st{ct=Fails,fls=undefined},
- set_catch_end(Reg, Vst#vst{current=St});
- Type ->
- error({bad_type,Type})
+valfun_1({try_end,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst) ->
+ case get_tag_type(Reg, Vst) of
+ {trytag,Fail} ->
+ %% Kill the catch tag, note that x registers are unaffected.
+ kill_catch_tag(Reg, Vst);
+ Type ->
+ error({wrong_tag_type,Type})
end;
-valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|Fails]}}=Vst0) ->
- case get_special_y_type(Reg, Vst0) of
- {trytag,Fail} ->
- Vst = #vst{current=St} = set_catch_end(Reg, Vst0),
- Xs = gb_trees_from_list([{0,{atom,[]}},{1,term},{2,term}]),
- Vst#vst{current=St#st{x=Xs,ct=Fails,fls=undefined,aliases=#{}}};
- Type ->
- error({bad_type,Type})
+valfun_1({try_case,Reg}, #vst{current=#st{ct=[Fail|_]}}=Vst0) ->
+ case get_tag_type(Reg, Vst0) of
+ {trytag,Fail} ->
+ %% Kill the catch tag and all x registers.
+ Vst1 = prune_x_regs(0, kill_catch_tag(Reg, Vst0)),
+
+ %% Class:Error:Stacktrace
+ Vst2 = create_term({atom,[]}, try_case, [], {x,0}, Vst1),
+ Vst = create_term(term, try_case, [], {x,1}, Vst2),
+ create_term(term, try_case, [], {x,2}, Vst);
+ Type ->
+ error({wrong_tag_type,Type})
end;
valfun_1({get_list,Src,D1,D2}, Vst0) ->
assert_not_literal(Src),
assert_type(cons, Src, Vst0),
- Vst = set_type_reg(term, Src, D1, Vst0),
- set_type_reg(term, Src, D2, Vst);
+ Vst = extract_term(term, get_hd, [Src], D1, Vst0),
+ extract_term(term, get_tl, [Src], D2, Vst);
valfun_1({get_hd,Src,Dst}, Vst) ->
assert_not_literal(Src),
assert_type(cons, Src, Vst),
- set_type_reg(term, Src, Dst, Vst);
+ extract_term(term, get_hd, [Src], Dst, Vst);
valfun_1({get_tl,Src,Dst}, Vst) ->
assert_not_literal(Src),
assert_type(cons, Src, Vst),
- set_type_reg(term, Src, Dst, Vst);
-valfun_1({get_tuple_element,Src,I,Dst}, Vst) ->
+ extract_term(term, get_tl, [Src], Dst, Vst);
+valfun_1({get_tuple_element,Src,N,Dst}, Vst) ->
assert_not_literal(Src),
- assert_type({tuple_element,I+1}, Src, Vst),
- set_type_reg(term, Src, Dst, Vst);
+ assert_type({tuple_element,N+1}, Src, Vst),
+ Index = {integer,N+1},
+ Type = get_element_type(Index, Src, Vst),
+ extract_term(Type, {bif,element}, [Index, Src], Dst, Vst);
valfun_1({jump,{f,Lbl}}, Vst) ->
- kill_state(branch_state(Lbl, Vst));
+ branch(Lbl, Vst,
+ fun(SuccVst) ->
+ %% The next instruction is never executed.
+ kill_state(SuccVst)
+ end);
valfun_1(I, Vst) ->
valfun_2(I, Vst).
init_try_catch_branch(Tag, Dst, Fail, Vst0) ->
- Vst1 = set_type_y({Tag,[Fail]}, Dst, Vst0),
+ Vst1 = create_tag({Tag,[Fail]}, 'try_catch', [], Dst, Vst0),
#vst{current=#st{ct=Fails}=St0} = Vst1,
- CurrentSt = St0#st{ct=[[Fail]|Fails]},
-
- %% Set the initial state at the try/catch label.
- %% Assume that Y registers contain terms or try/catch
- %% tags.
- Yregs0 = map(fun({Y,uninitialized}) -> {Y,term};
- ({Y,initialized}) -> {Y,term};
- (E) -> E
- end, gb_trees:to_list(CurrentSt#st.y)),
- Yregs = gb_trees:from_orddict(Yregs0),
- BranchSt = CurrentSt#st{y=Yregs},
-
- Vst = branch_state(Fail, Vst1#vst{current=BranchSt}),
- Vst#vst{current=CurrentSt}.
-
-%% Update branched state if necessary and try next set of instructions.
-valfun_2(I, #vst{current=#st{ct=[]}}=Vst) ->
- valfun_3(I, Vst);
+ St = St0#st{ct=[[Fail]|Fails]},
+ Vst = Vst0#vst{current=St},
+
+ branch(Fail, Vst,
+ fun(CatchVst) ->
+ #vst{current=#st{ys=Ys}} = CatchVst,
+ maps:fold(fun init_catch_handler_1/3, CatchVst, Ys)
+ end,
+ fun(SuccVst) ->
+ %% All potentially-throwing instructions after this
+ %% one will implicitly branch to the fail label;
+ %% see valfun_2/2
+ SuccVst
+ end).
+
+%% Set the initial state at the try/catch label. Assume that Y registers
+%% contain terms or try/catch tags.
+init_catch_handler_1(Reg, initialized, Vst) ->
+ create_term(term, 'catch_handler', [], Reg, Vst);
+init_catch_handler_1(Reg, uninitialized, Vst) ->
+ create_term(term, 'catch_handler', [], Reg, Vst);
+init_catch_handler_1(_, _, Vst) ->
+ Vst.
+
valfun_2(I, #vst{current=#st{ct=[[Fail]|_]}}=Vst) when is_integer(Fail) ->
- %% Update branched state.
+ %% We have an active try/catch tag and we can jump there from this
+ %% instruction, so we need to update the branched state of the try/catch
+ %% handler.
valfun_3(I, branch_state(Fail, Vst));
+valfun_2(I, #vst{current=#st{ct=[]}}=Vst) ->
+ valfun_3(I, Vst);
valfun_2(_, _) ->
error(ambiguous_catch_try_state).
@@ -557,17 +628,23 @@ valfun_2(_, _) ->
%% Floating point.
valfun_3({fconv,Src,{fr,_}=Dst}, Vst) ->
assert_term(Src, Vst),
- set_freg(Dst, Vst);
-valfun_3({bif,fadd,_,[_,_]=Src,Dst}, Vst) ->
- float_op(Src, Dst, Vst);
-valfun_3({bif,fdiv,_,[_,_]=Src,Dst}, Vst) ->
- float_op(Src, Dst, Vst);
-valfun_3({bif,fmul,_,[_,_]=Src,Dst}, Vst) ->
- float_op(Src, Dst, Vst);
-valfun_3({bif,fnegate,_,[_]=Src,Dst}, Vst) ->
- float_op(Src, Dst, Vst);
-valfun_3({bif,fsub,_,[_,_]=Src,Dst}, Vst) ->
- float_op(Src, Dst, Vst);
+
+ %% An exception is raised on error, hence branching to 0.
+ branch(0, Vst,
+ fun(SuccVst0) ->
+ SuccVst = update_type(fun meet/2, number, Src, SuccVst0),
+ set_freg(Dst, SuccVst)
+ end);
+valfun_3({bif,fadd,_,[_,_]=Ss,Dst}, Vst) ->
+ float_op(Ss, Dst, Vst);
+valfun_3({bif,fdiv,_,[_,_]=Ss,Dst}, Vst) ->
+ float_op(Ss, Dst, Vst);
+valfun_3({bif,fmul,_,[_,_]=Ss,Dst}, Vst) ->
+ float_op(Ss, Dst, Vst);
+valfun_3({bif,fnegate,_,[_]=Ss,Dst}, Vst) ->
+ float_op(Ss, Dst, Vst);
+valfun_3({bif,fsub,_,[_,_]=Ss,Dst}, Vst) ->
+ float_op(Ss, Dst, Vst);
valfun_3(fclearerror, Vst) ->
case get_fls(Vst) of
undefined -> ok;
@@ -618,84 +695,87 @@ valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) ->
valfun_4({make_fun2,_,_,_,Live}, Vst) ->
call(make_fun, Live, Vst);
%% Other BIFs
-valfun_4({bif,tuple_size,{f,Fail},[Tuple],Dst}=I, Vst0) ->
- TupleType0 = get_term_type(Tuple, Vst0),
- Vst1 = branch_state(Fail, Vst0),
- TupleType = upgrade_tuple_type({tuple,[0]}, TupleType0),
- Vst = set_aliased_type(TupleType, Tuple, Vst1),
- set_type_reg_expr({integer,[]}, I, Dst, Vst);
-valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) ->
- TupleType0 = get_term_type(Tuple, Vst0),
- PosType = get_term_type(Pos, Vst0),
- Vst1 = branch_state(Fail, Vst0),
- TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0),
- Vst = set_aliased_type(TupleType, Tuple, Vst1),
- set_type_reg(term, Tuple, Dst, Vst);
+valfun_4({bif,element,{f,Fail},[Pos,Src],Dst}, Vst) ->
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ PosType = get_term_type(Pos, SuccVst0),
+ TupleType = {tuple,[get_tuple_size(PosType)],#{}},
+
+ SuccVst1 = update_type(fun meet/2, TupleType,
+ Src, SuccVst0),
+ SuccVst = update_type(fun meet/2, {integer,[]},
+ Pos, SuccVst1),
+
+ ElementType = get_element_type(PosType, Src, SuccVst),
+ extract_term(ElementType, {bif,element}, [Pos,Src],
+ Dst, SuccVst)
+ end);
valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) ->
validate_src(Src, Vst),
kill_state(Vst);
valfun_4(raw_raise=I, Vst) ->
call(I, 3, Vst);
-valfun_4({bif,map_get,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) ->
- validate_src(Src, Vst0),
- Vst1 = branch_state(Fail, Vst0),
- Vst = set_aliased_type(map, Map, Vst1),
- Type = propagate_fragility(term, Src, Vst),
- set_type_reg(Type, Dst, Vst);
-valfun_4({bif,is_map_key,{f,Fail},[_Key,Map]=Src,Dst}, Vst0) ->
- validate_src(Src, Vst0),
- Vst1 = branch_state(Fail, Vst0),
- Vst = set_aliased_type(map, Map, Vst1),
- Type = propagate_fragility(bool, Src, Vst),
- set_type_reg(Type, Dst, Vst);
-valfun_4({bif,Op,{f,Fail},[Cons]=Src,Dst}, Vst0)
- when Op =:= hd; Op =:= tl ->
- validate_src(Src, Vst0),
- Vst1 = branch_state(Fail, Vst0),
- Vst = set_aliased_type(cons, Cons, Vst1),
- Type0 = bif_type(Op, Src, Vst),
- Type = propagate_fragility(Type0, Src, Vst),
- set_type_reg(Type, Dst, Vst);
-valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) ->
- validate_src(Src, Vst0),
- Vst = branch_state(Fail, Vst0),
- Type0 = bif_type(Op, Src, Vst),
- Type = propagate_fragility(Type0, Src, Vst),
- set_type_reg(Type, Dst, Vst);
-valfun_4({gc_bif,Op,{f,Fail},Live,Src,Dst}, #vst{current=St0}=Vst0) ->
+valfun_4({bif,Op,{f,Fail},[Src]=Ss,Dst}, Vst) when Op =:= hd; Op =:= tl ->
+ assert_term(Src, Vst),
+ branch(Fail, Vst,
+ fun(FailVst) ->
+ update_type(fun subtract/2, cons, Src, FailVst)
+ end,
+ fun(SuccVst0) ->
+ SuccVst = update_type(fun meet/2, cons, Src, SuccVst0),
+ extract_term(term, {bif,Op}, Ss, Dst, SuccVst)
+ end);
+valfun_4({bif,Op,{f,Fail},Ss,Dst}, Vst) ->
+ validate_src(Ss, Vst),
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ %% Infer argument types. Note that we can't subtract
+ %% types as the BIF could fail for reasons other than
+ %% bad argument types.
+ ArgTypes = bif_arg_types(Op, Ss),
+ SuccVst = foldl(fun({Arg, T}, V) ->
+ update_type(fun meet/2, T, Arg, V)
+ end, SuccVst0, zip(Ss, ArgTypes)),
+ Type = bif_return_type(Op, Ss, SuccVst),
+ extract_term(Type, {bif,Op}, Ss, Dst, SuccVst)
+ end);
+valfun_4({gc_bif,Op,{f,Fail},Live,Ss,Dst}, #vst{current=St0}=Vst0) ->
+ validate_src(Ss, Vst0),
verify_live(Live, Vst0),
verify_y_init(Vst0),
+
+ %% Heap allocations and X registers are killed regardless of whether we
+ %% fail or not, as we may fail after GC.
St = kill_heap_allocation(St0),
- Vst1 = Vst0#vst{current=St},
- Vst2 = branch_state(Fail, Vst1),
- Vst3 = prune_x_regs(Live, Vst2),
- SrcType = get_term_type(hd(Src), Vst3),
- Vst = case Op of
- length when SrcType =/= cons, SrcType =/= nil ->
- %% If we already know we have a cons cell or nil, it
- %% shouldn't be demoted to list.
- set_type(list, hd(Src), Vst3);
- map_size ->
- set_type(map, hd(Src), Vst3);
- _ ->
- Vst3
- end,
- validate_src(Src, Vst),
- Type0 = bif_type(Op, Src, Vst),
- Type = propagate_fragility(Type0, Src, Vst),
- set_type_reg(Type, Dst, Vst);
+ Vst = prune_x_regs(Live, Vst0#vst{current=St}),
+
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ ArgTypes = bif_arg_types(Op, Ss),
+ SuccVst = foldl(fun({Arg, T}, V) ->
+ update_type(fun meet/2, T, Arg, V)
+ end, SuccVst0, zip(Ss, ArgTypes)),
+
+ Type = bif_return_type(Op, Ss, SuccVst),
+
+ %% We're passing Vst0 as the original because the
+ %% registers were pruned before the branch.
+ extract_term(Type, {gc_bif,Op}, Ss, Dst, SuccVst, Vst0)
+ end);
valfun_4(return, #vst{current=#st{numy=none}}=Vst) ->
- assert_term({x,0}, Vst),
+ assert_durable_term({x,0}, Vst),
kill_state(Vst);
valfun_4(return, #vst{current=#st{numy=NumY}}) ->
error({stack_frame,NumY});
-valfun_4({loop_rec,{f,Fail},Dst}, Vst0) ->
- Vst = branch_state(Fail, Vst0),
- %% This term may not be part of the root set until
- %% remove_message/0 is executed. If control transfers
- %% to the loop_rec_end/1 instruction, no part of
- %% this term must be stored in a Y register.
- set_type_reg({fragile,term}, Dst, Vst);
+valfun_4({loop_rec,{f,Fail},Dst}, Vst) ->
+ %% This term may not be part of the root set until remove_message/0 is
+ %% executed. If control transfers to the loop_rec_end/1 instruction, no
+ %% part of this term must be stored in a Y register.
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ {Ref, SuccVst} = new_value(term, loop_rec, [], SuccVst0),
+ mark_fragile(Dst, set_reg_vref(Ref, Dst, SuccVst))
+ end);
valfun_4({wait,_}, Vst) ->
verify_y_init(Vst),
kill_state(Vst);
@@ -706,101 +786,67 @@ valfun_4({wait_timeout,_,Src}, Vst) ->
valfun_4({loop_rec_end,_}, Vst) ->
verify_y_init(Vst),
kill_state(Vst);
-valfun_4(timeout, #vst{current=St}=Vst) ->
- Vst#vst{current=St#st{x=init_regs(0, term)}};
+valfun_4(timeout, Vst) ->
+ prune_x_regs(0, Vst);
valfun_4(send, Vst) ->
call(send, 2, Vst);
-valfun_4({set_tuple_element,Src,Tuple,I}, Vst) ->
+valfun_4({set_tuple_element,Src,Tuple,N}, Vst) ->
+ I = N + 1,
assert_term(Src, Vst),
- assert_type({tuple_element,I+1}, Tuple, Vst),
- Vst;
+ assert_type({tuple_element,I}, Tuple, Vst),
+ %% Manually update the tuple type; we can't rely on the ordinary update
+ %% helpers as we must support overwriting (rather than just widening or
+ %% narrowing) known elements, and we can't use extract_term either since
+ %% the source tuple may be aliased.
+ {tuple, Sz, Es0} = get_term_type(Tuple, Vst),
+ Es = set_element_type({integer,I}, get_term_type(Src, Vst), Es0),
+ override_type({tuple, Sz, Es}, Tuple, Vst);
%% Match instructions.
-valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst0) ->
- assert_term(Src, Vst0),
+valfun_4({select_val,Src,{f,Fail},{list,Choices}}, Vst) ->
+ assert_term(Src, Vst),
assert_choices(Choices),
- Vst = branch_state(Fail, Vst0),
- kill_state(select_val_branches(Src, Choices, Vst));
+ validate_select_val(Fail, Choices, Src, Vst);
valfun_4({select_tuple_arity,Tuple,{f,Fail},{list,Choices}}, Vst) ->
assert_type(tuple, Tuple, Vst),
assert_arities(Choices),
- TupleType = case get_term_type(Tuple, Vst) of
- {fragile,TupleType0} -> TupleType0;
- TupleType0 -> TupleType0
- end,
- kill_state(branch_arities(Choices, Tuple, TupleType,
- branch_state(Fail, Vst)));
+ validate_select_tuple_arity(Fail, Choices, Tuple, Vst);
%% New bit syntax matching instructions.
-valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst0) ->
- %% Match states are always okay as input.
- SrcType = get_move_term_type(Src, Vst0),
- DstType = propagate_fragility(bsm_match_state(), [Src], Vst0),
- verify_live(Live, Vst0),
- verify_y_init(Vst0),
- Vst1 = prune_x_regs(Live, Vst0),
- BranchVst = case SrcType of
- #ms{} ->
- %% The failure branch will never be taken when Src is a
- %% match context. Therefore, the type for Src at the
- %% failure label must not be match_context (or we could
- %% reject legal code).
- set_type_reg(term, Src, Vst1);
- _ ->
- Vst1
- end,
- Vst = branch_state(Fail, BranchVst),
- set_type_reg(DstType, Dst, Vst);
-valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst0) ->
- %% Match states are always okay as input.
- SrcType = get_move_term_type(Src, Vst0),
- DstType = propagate_fragility(bsm_match_state(Slots), [Src], Vst0),
- verify_live(Live, Vst0),
- verify_y_init(Vst0),
- Vst1 = prune_x_regs(Live, Vst0),
- BranchVst = case SrcType of
- #ms{} ->
- %% The failure branch will never be taken when Src is a
- %% match context. Therefore, the type for Src at the
- %% failure label must not be match_context (or we could
- %% reject legal code).
- set_type_reg(term, Src, Vst1);
- _ ->
- Vst1
- end,
- Vst = branch_state(Fail, BranchVst),
- set_type_reg(DstType, Dst, Vst);
+valfun_4({test,bs_start_match3,{f,Fail},Live,[Src],Dst}, Vst) ->
+ validate_bs_start_match(Fail, Live, bsm_match_state(), Src, Dst, Vst);
+valfun_4({test,bs_start_match2,{f,Fail},Live,[Src,Slots],Dst}, Vst) ->
+ validate_bs_start_match(Fail, Live, bsm_match_state(Slots), Src, Dst, Vst);
valfun_4({test,bs_match_string,{f,Fail},[Ctx,_,_]}, Vst) ->
bsm_validate_context(Ctx, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst, fun(V) -> V end);
valfun_4({test,bs_skip_bits2,{f,Fail},[Ctx,Src,_,_]}, Vst) ->
bsm_validate_context(Ctx, Vst),
assert_term(Src, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst, fun(V) -> V end);
valfun_4({test,bs_test_tail2,{f,Fail},[Ctx,_]}, Vst) ->
bsm_validate_context(Ctx, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst, fun(V) -> V end);
valfun_4({test,bs_test_unit,{f,Fail},[Ctx,_]}, Vst) ->
bsm_validate_context(Ctx, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst, fun(V) -> V end);
valfun_4({test,bs_skip_utf8,{f,Fail},[Ctx,Live,_]}, Vst) ->
validate_bs_skip_utf(Fail, Ctx, Live, Vst);
valfun_4({test,bs_skip_utf16,{f,Fail},[Ctx,Live,_]}, Vst) ->
validate_bs_skip_utf(Fail, Ctx, Live, Vst);
valfun_4({test,bs_skip_utf32,{f,Fail},[Ctx,Live,_]}, Vst) ->
validate_bs_skip_utf(Fail, Ctx, Live, Vst);
-valfun_4({test,bs_get_integer2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
-valfun_4({test,bs_get_float2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, {float, []}, Dst, Vst);
-valfun_4({test,bs_get_binary2,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
- Type = propagate_fragility(term, [Ctx], Vst),
- validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst);
-valfun_4({test,bs_get_utf8,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
-valfun_4({test,bs_get_utf16,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
-valfun_4({test,bs_get_utf32,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
- validate_bs_get(Fail, Ctx, Live, {integer, []}, Dst, Vst);
+valfun_4({test,bs_get_integer2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
+ validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst);
+valfun_4({test,bs_get_float2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
+ validate_bs_get(Op, Fail, Ctx, Live, {float, []}, Dst, Vst);
+valfun_4({test,bs_get_binary2=Op,{f,Fail},Live,[Ctx,_,_,_],Dst}, Vst) ->
+ validate_bs_get(Op, Fail, Ctx, Live, binary, Dst, Vst);
+valfun_4({test,bs_get_utf8=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
+ validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst);
+valfun_4({test,bs_get_utf16=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
+ validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst);
+valfun_4({test,bs_get_utf32=Op,{f,Fail},Live,[Ctx,_],Dst}, Vst) ->
+ validate_bs_get(Op, Fail, Ctx, Live, {integer, []}, Dst, Vst);
valfun_4({bs_save2,Ctx,SavePoint}, Vst) ->
bsm_save(Ctx, SavePoint, Vst);
valfun_4({bs_restore2,Ctx,SavePoint}, Vst) ->
@@ -810,99 +856,99 @@ valfun_4({bs_get_position, Ctx, Dst, Live}, Vst0) ->
verify_live(Live, Vst0),
verify_y_init(Vst0),
Vst = prune_x_regs(Live, Vst0),
- set_type_reg(bs_position, Dst, Vst);
+ create_term(ms_position, bs_get_position, [Ctx], Dst, Vst, Vst0);
valfun_4({bs_set_position, Ctx, Pos}, Vst) ->
bsm_validate_context(Ctx, Vst),
- assert_type(bs_position, Pos, Vst),
+ assert_type(ms_position, Pos, Vst),
Vst;
%% Other test instructions.
+valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) ->
+ assert_type(map, Src, Vst),
+ assert_unique_map_keys(List),
+ branch(Lbl, Vst, fun(V) -> V end);
valfun_4({test,is_atom,{f,Lbl},[Src]}, Vst) ->
- assert_term(Src, Vst),
- set_aliased_type({atom,[]}, Src, branch_state(Lbl, Vst));
+ type_test(Lbl, {atom,[]}, Src, Vst);
+valfun_4({test,is_binary,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, binary, Src, Vst);
+valfun_4({test,is_bitstr,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, binary, Src, Vst);
valfun_4({test,is_boolean,{f,Lbl},[Src]}, Vst) ->
- assert_term(Src, Vst),
- set_aliased_type(bool, Src, branch_state(Lbl, Vst));
-valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) ->
- assert_term(Float, Vst),
- set_type({float,[]}, Float, branch_state(Lbl, Vst));
-valfun_4({test,is_tuple,{f,Lbl},[Tuple]}, Vst) ->
- Type0 = get_term_type(Tuple, Vst),
- Type = upgrade_tuple_type({tuple,[0]}, Type0),
- set_aliased_type(Type, Tuple, branch_state(Lbl, Vst));
+ type_test(Lbl, bool, Src, Vst);
+valfun_4({test,is_float,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, {float,[]}, Src, Vst);
+valfun_4({test,is_tuple,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, {tuple,[0],#{}}, Src, Vst);
valfun_4({test,is_integer,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, {integer,[]}, Src, Vst);
+valfun_4({test,is_nonempty_list,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, cons, Src, Vst);
+valfun_4({test,is_number,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, number, Src, Vst);
+valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, list, Src, Vst);
+valfun_4({test,is_map,{f,Lbl},[Src]}, Vst) ->
+ type_test(Lbl, map, Src, Vst);
+valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst) ->
+ %% is_nil is an exact check against the 'nil' value, and should not be
+ %% treated as a simple type test.
assert_term(Src, Vst),
- set_aliased_type({integer,[]}, Src, branch_state(Lbl, Vst));
-valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) ->
- assert_term(Cons, Vst),
- Type = cons,
- set_aliased_type(Type, Cons, branch_state(Lbl, Vst));
+ branch(Lbl, Vst,
+ fun(FailVst) ->
+ update_ne_types(Src, nil, FailVst)
+ end,
+ fun(SuccVst) ->
+ update_eq_types(Src, nil, SuccVst)
+ end);
valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) ->
assert_type(tuple, Tuple, Vst),
- Type = {tuple,Sz},
- set_aliased_type(Type, Tuple, branch_state(Lbl, Vst));
-valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,_Atom]}, Vst) ->
- validate_src([Src], Vst),
- Type = {tuple,Sz},
- set_aliased_type(Type, Src, branch_state(Lbl, Vst));
-valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) ->
- assert_type(map, Src, Vst),
- assert_unique_map_keys(List),
- branch_state(Lbl, Vst);
-valfun_4({test,is_list,{f,Lbl},[Src]}, Vst) ->
- validate_src([Src], Vst),
- Type = case get_term_type(Src, Vst) of
- cons -> cons;
- nil -> nil;
- _ -> list
+ Type = {tuple, Sz, #{}},
+ type_test(Lbl, Type, Tuple, Vst);
+valfun_4({test,is_tagged_tuple,{f,Lbl},[Src,Sz,Atom]}, Vst) ->
+ assert_term(Src, Vst),
+ Type = {tuple, Sz, #{ {integer,1} => Atom }},
+ type_test(Lbl, Type, Src, Vst);
+valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst) ->
+ validate_src(Ss, Vst),
+ branch(Lbl, Vst,
+ fun(FailVst) ->
+ update_ne_types(Src, Val, FailVst)
end,
- set_aliased_type(Type, Src, branch_state(Lbl, Vst));
-valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) ->
- Vst = branch_state(Lbl, Vst0),
- case Src of
- {Tag,_} when Tag =:= x; Tag =:= y ->
- Type = map,
- set_aliased_type(Type, Src, Vst);
- {literal,Map} when is_map(Map) ->
- Vst0;
- _ ->
- kill_state(Vst0)
- end;
-valfun_4({test,is_nil,{f,Lbl},[Src]}, Vst0) ->
- Vst = case get_term_type(Src, Vst0) of
- list ->
- branch_state(Lbl, set_aliased_type(cons, Src, Vst0));
- _ ->
- branch_state(Lbl, Vst0)
- end,
- set_aliased_type(nil, Src, Vst);
-valfun_4({test,is_eq_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) ->
- validate_src(Ss, Vst0),
- Infer = infer_types(Src, Vst0),
- Vst1 = Infer(Val, Vst0),
- Vst2 = upgrade_ne_types(Src, Val, Vst1),
- Vst3 = branch_state(Lbl, Vst2),
- Vst = Vst3#vst{current=Vst1#vst.current},
- upgrade_eq_types(Src, Val, Vst);
-valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst0) ->
- validate_src(Ss, Vst0),
- Vst1 = upgrade_eq_types(Src, Val, Vst0),
- Vst2 = branch_state(Lbl, Vst1),
- Vst = Vst2#vst{current=Vst0#vst.current},
- upgrade_ne_types(Src, Val, Vst);
+ fun(SuccVst) ->
+ update_eq_types(Src, Val, SuccVst)
+ end);
+valfun_4({test,is_ne_exact,{f,Lbl},[Src,Val]=Ss}, Vst) ->
+ validate_src(Ss, Vst),
+ branch(Lbl, Vst,
+ fun(FailVst) ->
+ update_eq_types(Src, Val, FailVst)
+ end,
+ fun(SuccVst) ->
+ update_ne_types(Src, Val, SuccVst)
+ end);
valfun_4({test,_Op,{f,Lbl},Src}, Vst) ->
+ %% is_pid, is_reference, et cetera.
validate_src(Src, Vst),
- branch_state(Lbl, Vst);
+ branch(Lbl, Vst, fun(V) -> V end);
valfun_4({bs_add,{f,Fail},[A,B,_],Dst}, Vst) ->
assert_term(A, Vst),
assert_term(B, Vst),
- set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ create_term({integer,[]}, bs_add, [A, B], Dst, SuccVst)
+ end);
valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) ->
assert_term(A, Vst),
- set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ create_term({integer,[]}, bs_utf8_size, [A], Dst, SuccVst)
+ end);
valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) ->
assert_term(A, Vst),
- set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ create_term({integer,[]}, bs_utf16_size, [A], Dst, SuccVst)
+ end);
valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
verify_y_init(Vst0),
@@ -912,10 +958,12 @@ valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
true ->
assert_term(Sz, Vst0)
end,
- Vst1 = heap_alloc(Heap, Vst0),
- Vst2 = branch_state(Fail, Vst1),
- Vst = prune_x_regs(Live, Vst2),
- set_type_reg(binary, Dst, Vst);
+ Vst = heap_alloc(Heap, Vst0),
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ SuccVst = prune_x_regs(Live, SuccVst0),
+ create_term(binary, bs_init2, [], Dst, SuccVst, SuccVst0)
+ end);
valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
verify_live(Live, Vst0),
verify_y_init(Vst0),
@@ -925,136 +973,203 @@ valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) ->
true ->
assert_term(Sz, Vst0)
end,
- Vst1 = heap_alloc(Heap, Vst0),
- Vst2 = branch_state(Fail, Vst1),
- Vst = prune_x_regs(Live, Vst2),
- set_type_reg(binary, Dst, Vst);
+ Vst = heap_alloc(Heap, Vst0),
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ SuccVst = prune_x_regs(Live, SuccVst0),
+ create_term(binary, bs_init_bits, [], Dst, SuccVst)
+ end);
valfun_4({bs_append,{f,Fail},Bits,Heap,Live,_Unit,Bin,_Flags,Dst}, Vst0) ->
verify_live(Live, Vst0),
verify_y_init(Vst0),
assert_term(Bits, Vst0),
assert_term(Bin, Vst0),
- Vst1 = heap_alloc(Heap, Vst0),
- Vst2 = branch_state(Fail, Vst1),
- Vst = prune_x_regs(Live, Vst2),
- set_type_reg(binary, Dst, Vst);
-valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst0) ->
- assert_term(Bits, Vst0),
- assert_term(Bin, Vst0),
- Vst = branch_state(Fail, Vst0),
- set_type_reg(binary, Dst, Vst);
+ Vst = heap_alloc(Heap, Vst0),
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ SuccVst = prune_x_regs(Live, SuccVst0),
+ create_term(binary, bs_append, [Bin], Dst, SuccVst, SuccVst0)
+ end);
+valfun_4({bs_private_append,{f,Fail},Bits,_Unit,Bin,_Flags,Dst}, Vst) ->
+ assert_term(Bits, Vst),
+ assert_term(Bin, Vst),
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ create_term(binary, bs_private_append, [Bin], Dst, SuccVst)
+ end);
valfun_4({bs_put_string,Sz,_}, Vst) when is_integer(Sz) ->
Vst;
valfun_4({bs_put_binary,{f,Fail},Sz,_,_,Src}, Vst) ->
assert_term(Sz, Vst),
assert_term(Src, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ update_type(fun meet/2, binary, Src, SuccVst)
+ end);
valfun_4({bs_put_float,{f,Fail},Sz,_,_,Src}, Vst) ->
assert_term(Sz, Vst),
assert_term(Src, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ update_type(fun meet/2, {float,[]}, Src, SuccVst)
+ end);
valfun_4({bs_put_integer,{f,Fail},Sz,_,_,Src}, Vst) ->
assert_term(Sz, Vst),
assert_term(Src, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ update_type(fun meet/2, {integer,[]}, Src, SuccVst)
+ end);
valfun_4({bs_put_utf8,{f,Fail},_,Src}, Vst) ->
assert_term(Src, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ update_type(fun meet/2, {integer,[]}, Src, SuccVst)
+ end);
valfun_4({bs_put_utf16,{f,Fail},_,Src}, Vst) ->
assert_term(Src, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ update_type(fun meet/2, {integer,[]}, Src, SuccVst)
+ end);
valfun_4({bs_put_utf32,{f,Fail},_,Src}, Vst) ->
assert_term(Src, Vst),
- branch_state(Fail, Vst);
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ update_type(fun meet/2, {integer,[]}, Src, SuccVst)
+ end);
%% Map instructions.
-valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
- verify_put_map(Fail, Src, Dst, Live, List, Vst);
-valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
- verify_put_map(Fail, Src, Dst, Live, List, Vst);
+valfun_4({put_map_assoc=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
+ verify_put_map(Op, Fail, Src, Dst, Live, List, Vst);
+valfun_4({put_map_exact=Op,{f,Fail},Src,Dst,Live,{list,List}}, Vst) ->
+ verify_put_map(Op, Fail, Src, Dst, Live, List, Vst);
valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) ->
verify_get_map(Fail, Src, List, Vst);
valfun_4(_, _) ->
error(unknown_instruction).
-upgrade_ne_types(Src1, Src2, Vst0) ->
- T1 = get_durable_term_type(Src1, Vst0),
- T2 = get_durable_term_type(Src2, Vst0),
- Type = subtract(T1, T2),
- set_aliased_type(Type, Src1, Vst0).
-
-upgrade_eq_types(Src1, Src2, Vst0) ->
- T1 = get_durable_term_type(Src1, Vst0),
- T2 = get_durable_term_type(Src2, Vst0),
- Meet = meet(T1, T2),
- Vst = case T1 =/= Meet of
- true -> set_aliased_type(Meet, Src1, Vst0);
- false -> Vst0
- end,
- case T2 =/= Meet of
- true -> set_aliased_type(Meet, Src2, Vst);
- false -> Vst
- end.
-
verify_get_map(Fail, Src, List, Vst0) ->
assert_not_literal(Src), %OTP 22.
assert_type(map, Src, Vst0),
- Vst1 = foldl(fun(D, Vsti) ->
- case is_reg_defined(D,Vsti) of
- true -> set_type_reg(term,D,Vsti);
- false -> Vsti
- end
- end, Vst0, extract_map_vals(List)),
- Vst2 = branch_state(Fail, Vst1),
- Keys = extract_map_keys(List),
- assert_unique_map_keys(Keys),
- verify_get_map_pair(List, Src, Vst0, Vst2).
-
-extract_map_vals([_Key,Val|T]) ->
- [Val|extract_map_vals(T)];
-extract_map_vals([]) -> [].
+
+ branch(Fail, Vst0,
+ fun(FailVst) ->
+ clobber_map_vals(List, Src, FailVst)
+ end,
+ fun(SuccVst) ->
+ Keys = extract_map_keys(List),
+ assert_unique_map_keys(Keys),
+ extract_map_vals(List, Src, SuccVst, SuccVst)
+ end).
+
+%% get_map_elements may leave its destinations in an inconsistent state when
+%% the fail label is taken. Consider the following:
+%%
+%% {get_map_elements,{f,7},{x,1},{list,[{atom,a},{x,1},{atom,b},{x,2}]}}.
+%%
+%% If 'a' exists but not 'b', {x,1} is overwritten when we jump to {f,7}.
+clobber_map_vals([Key,Dst|T], Map, Vst0) ->
+ case is_reg_defined(Dst, Vst0) of
+ true ->
+ Vst = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vst0),
+ clobber_map_vals(T, Map, Vst);
+ false ->
+ clobber_map_vals(T, Map, Vst0)
+ end;
+clobber_map_vals([], _Map, Vst) ->
+ Vst.
extract_map_keys([Key,_Val|T]) ->
[Key|extract_map_keys(T)];
extract_map_keys([]) -> [].
-verify_get_map_pair([Src,Dst|Vs], Map, Vst0, Vsti0) ->
- assert_term(Src, Vst0),
- Vsti = set_type_reg(term, Map, Dst, Vsti0),
- verify_get_map_pair(Vs, Map, Vst0, Vsti);
-verify_get_map_pair([], _Map, _Vst0, Vst) -> Vst.
+extract_map_vals([Key,Dst|Vs], Map, Vst0, Vsti0) ->
+ assert_term(Key, Vst0),
+ Vsti = extract_term(term, {bif,map_get}, [Key, Map], Dst, Vsti0),
+ extract_map_vals(Vs, Map, Vst0, Vsti);
+extract_map_vals([], _Map, _Vst0, Vst) ->
+ Vst.
-verify_put_map(Fail, Src, Dst, Live, List, Vst0) ->
+verify_put_map(Op, Fail, Src, Dst, Live, List, Vst0) ->
assert_type(map, Src, Vst0),
verify_live(Live, Vst0),
verify_y_init(Vst0),
- foreach(fun (Term) -> assert_term(Term, Vst0) end, List),
- Vst1 = heap_alloc(0, Vst0),
- Vst2 = branch_state(Fail, Vst1),
- Vst = prune_x_regs(Live, Vst2),
- Keys = extract_map_keys(List),
- assert_unique_map_keys(Keys),
- set_type_reg(map, Dst, Vst).
+ _ = [assert_term(Term, Vst0) || Term <- List],
+ Vst = heap_alloc(0, Vst0),
+
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ SuccVst = prune_x_regs(Live, SuccVst0),
+ Keys = extract_map_keys(List),
+ assert_unique_map_keys(Keys),
+ create_term(map, Op, [Src], Dst, SuccVst, SuccVst0)
+ end).
+
+%%
+%% Common code for validating bs_start_match* instructions.
+%%
+
+validate_bs_start_match(Fail, Live, Type, Src, Dst, Vst) ->
+ verify_live(Live, Vst),
+ verify_y_init(Vst),
+
+ %% #ms{} can represent either a match context or a term, so we have to mark
+ %% the source as a term if it fails with a match context as an input. This
+ %% hack is only needed until we get proper union types.
+ branch(Fail, Vst,
+ fun(FailVst) ->
+ case get_movable_term_type(Src, FailVst) of
+ #ms{} -> override_type(term, Src, FailVst);
+ _ -> FailVst
+ end
+ end,
+ fun(SuccVst0) ->
+ SuccVst1 = update_type(fun meet/2, binary,
+ Src, SuccVst0),
+ SuccVst = prune_x_regs(Live, SuccVst1),
+ extract_term(Type, bs_start_match, [Src], Dst,
+ SuccVst, SuccVst0)
+ end).
%%
%% Common code for validating bs_get* instructions.
%%
-validate_bs_get(Fail, Ctx, Live, Type, Dst, Vst0) ->
- bsm_validate_context(Ctx, Vst0),
- verify_live(Live, Vst0),
- verify_y_init(Vst0),
- Vst1 = prune_x_regs(Live, Vst0),
- Vst = branch_state(Fail, Vst1),
- set_type_reg(Type, Dst, Vst).
+validate_bs_get(Op, Fail, Ctx, Live, Type, Dst, Vst) ->
+ bsm_validate_context(Ctx, Vst),
+ verify_live(Live, Vst),
+ verify_y_init(Vst),
+
+ branch(Fail, Vst,
+ fun(SuccVst0) ->
+ SuccVst = prune_x_regs(Live, SuccVst0),
+ extract_term(Type, Op, [Ctx], Dst, SuccVst, SuccVst0)
+ end).
%%
%% Common code for validating bs_skip_utf* instructions.
%%
-validate_bs_skip_utf(Fail, Ctx, Live, Vst0) ->
- bsm_validate_context(Ctx, Vst0),
- verify_y_init(Vst0),
- verify_live(Live, Vst0),
- Vst = prune_x_regs(Live, Vst0),
- branch_state(Fail, Vst).
+validate_bs_skip_utf(Fail, Ctx, Live, Vst) ->
+ bsm_validate_context(Ctx, Vst),
+ verify_y_init(Vst),
+ verify_live(Live, Vst),
+
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ prune_x_regs(Live, SuccVst)
+ end).
+
+%%
+%% Common code for is_$type instructions.
+%%
+type_test(Fail, Type, Reg, Vst) ->
+ assert_term(Reg, Vst),
+ branch(Fail, Vst,
+ fun(FailVst) ->
+ update_type(fun subtract/2, Type, Reg, FailVst)
+ end,
+ fun(SuccVst) ->
+ update_type(fun meet/2, Type, Reg, SuccVst)
+ end).
%%
%% Special state handling for setelement/3 and set_tuple_element/3 instructions.
@@ -1085,14 +1200,15 @@ kill_state(Vst) ->
%% A "plain" call.
%% The stackframe must be initialized.
%% The instruction will return to the instruction following the call.
-call(Name, Live, #vst{current=St}=Vst) ->
- verify_call_args(Name, Live, Vst),
- verify_y_init(Vst),
- case return_type(Name, Vst) of
- Type when Type =/= exception ->
- %% Type is never 'exception' because it has been handled earlier.
- Xs = gb_trees_from_list([{0,Type}]),
- Vst#vst{current=St#st{x=Xs,f=init_fregs(),aliases=#{}}}
+call(Name, Live, #vst{current=St0}=Vst0) ->
+ verify_call_args(Name, Live, Vst0),
+ verify_y_init(Vst0),
+ case call_return_type(Name, Vst0) of
+ Type when Type =/= exception ->
+ %% Type is never 'exception' because it has been handled earlier.
+ St = St0#st{f=init_fregs()},
+ Vst = prune_x_regs(0, Vst0#vst{current=St}),
+ create_term(Type, call, [], {x,0}, Vst)
end.
%% Tail call.
@@ -1108,42 +1224,35 @@ tail_call(Name, Live, Vst0) ->
verify_call_args(_, 0, #vst{}) ->
ok;
verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)->
- verify_local_call(Lbl, Live, Vst);
+ verify_local_args(Live - 1, Lbl, #{}, Vst);
verify_call_args(_, Live, Vst) when is_integer(Live)->
- verify_call_args_1(Live, Vst);
+ verify_remote_args_1(Live - 1, Vst);
verify_call_args(_, Live, _) ->
error({bad_number_of_live_regs,Live}).
-verify_call_args_1(0, _) -> ok;
-verify_call_args_1(N, Vst) ->
- X = N - 1,
- get_term_type({x,X}, Vst),
- verify_call_args_1(X, Vst).
+verify_remote_args_1(-1, _) ->
+ ok;
+verify_remote_args_1(X, Vst) ->
+ assert_durable_term({x, X}, Vst),
+ verify_remote_args_1(X - 1, Vst).
-verify_local_call(Lbl, Live, Vst) ->
- F = fun({R, Type}) ->
- verify_arg_type(Lbl, R, Type, Vst)
- end,
- TRegs = typed_call_regs(Live, Vst),
- verify_no_ms_aliases(TRegs),
- foreach(F, TRegs).
-
-typed_call_regs(0, _Vst) ->
- [];
-typed_call_regs(Live0, Vst) ->
- Live = Live0 - 1,
- R = {x,Live},
- [{R, get_move_term_type(R, Vst)} | typed_call_regs(Live, Vst)].
-
-%% Verifies that the same match context isn't present twice.
-verify_no_ms_aliases(Regs) ->
- CtxIds = [Id || {_, #ms{id=Id}} <- Regs],
- UniqueCtxIds = ordsets:from_list(CtxIds),
- if
- length(UniqueCtxIds) < length(CtxIds) ->
- error({multiple_match_contexts, Regs});
- length(UniqueCtxIds) =:= length(CtxIds) ->
- ok
+verify_local_args(-1, _Lbl, _CtxIds, _Vst) ->
+ ok;
+verify_local_args(X, Lbl, CtxIds, Vst) ->
+ Reg = {x, X},
+ assert_not_fragile(Reg, Vst),
+ case get_movable_term_type(Reg, Vst) of
+ #ms{id=Id}=Type ->
+ case CtxIds of
+ #{ Id := Other } ->
+ error({multiple_match_contexts, [Reg, Other]});
+ #{} ->
+ verify_arg_type(Lbl, Reg, Type, Vst),
+ verify_local_args(X - 1, Lbl, CtxIds#{ Id => Reg }, Vst)
+ end;
+ Type ->
+ verify_arg_type(Lbl, Reg, Type, Vst),
+ verify_local_args(X - 1, Lbl, CtxIds, Vst)
end.
%% Verifies that the given argument narrows to what the function expects.
@@ -1156,38 +1265,90 @@ verify_arg_type(Lbl, Reg, #ms{}, #vst{ft=Ft}) ->
end;
verify_arg_type(Lbl, Reg, GivenType, #vst{ft=Ft}) ->
case gb_trees:lookup({Lbl, Reg}, Ft) of
- {value, bool} when GivenType =:= {atom, true};
- GivenType =:= {atom, false};
- GivenType =:= {atom, []} ->
- %% We don't yet support upgrading true/false to bool, so we
- %% assume unknown atoms can be bools when validating calls.
- ok;
{value, #ms{}} ->
%% Functions that accept match contexts also accept all other
%% terms. This will change once we support union types.
ok;
{value, RequiredType} ->
- case meet(GivenType, RequiredType) of
- none -> error({bad_arg_type, Reg, GivenType, RequiredType});
- _ -> ok
+ case vat_1(GivenType, RequiredType) of
+ true -> ok;
+ false -> error({bad_arg_type, Reg, GivenType, RequiredType})
end;
none ->
ok
end.
-allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}}=Vst0) ->
+%% Checks whether the Given argument is compatible with the Required one. This
+%% is essentially a relaxed version of 'meet(Given, Req) =:= Given', where we
+%% accept that the Given value has the right type but not necessarily the exact
+%% same value; if {atom,gurka} is required, we'll consider {atom,[]} valid.
+%%
+%% This will catch all problems that could crash the emulator, like passing a
+%% 1-tuple when the callee expects a 3-tuple, but some value errors might slip
+%% through.
+vat_1(Same, Same) -> true;
+vat_1({atom,A}, {atom,B}) -> A =:= B orelse is_list(A) orelse is_list(B);
+vat_1({atom,A}, bool) -> is_boolean(A) orelse is_list(A);
+vat_1(bool, {atom,B}) -> is_boolean(B) orelse is_list(B);
+vat_1(cons, list) -> true;
+vat_1({float,A}, {float,B}) -> A =:= B orelse is_list(A) orelse is_list(B);
+vat_1({float,_}, number) -> true;
+vat_1({integer,A}, {integer,B}) -> A =:= B orelse is_list(A) orelse is_list(B);
+vat_1({integer,_}, number) -> true;
+vat_1(_, {literal,_}) -> false;
+vat_1({literal,_}=Lit, Required) -> vat_1(get_literal_type(Lit), Required);
+vat_1(nil, list) -> true;
+vat_1({tuple,SzA,EsA}, {tuple,SzB,EsB}) ->
+ if
+ is_list(SzB) ->
+ tuple_sz(SzA) >= tuple_sz(SzB) andalso vat_elements(EsA, EsB);
+ SzA =:= SzB ->
+ vat_elements(EsA, EsB);
+ SzA =/= SzB ->
+ false
+ end;
+vat_1(_, _) -> false.
+
+vat_elements(EsA, EsB) ->
+ maps:fold(fun(Key, Req, Acc) ->
+ case EsA of
+ #{ Key := Given } -> Acc andalso vat_1(Given, Req);
+ #{} -> false
+ end
+ end, true, EsB).
+
+allocate(Tag, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) ->
verify_live(Live, Vst0),
- Vst = #vst{current=St} = prune_x_regs(Live, Vst0),
- Ys = init_regs(Stk, case Zero of
- true -> initialized;
- false -> uninitialized
- end),
- heap_alloc(Heap, Vst#vst{current=St#st{y=Ys,numy=Stk}});
+ Vst1 = Vst0#vst{current=St#st{numy=Stk}},
+ Vst2 = prune_x_regs(Live, Vst1),
+ Vst = init_stack(Tag, Stk - 1, Vst2),
+ heap_alloc(Heap, Vst);
allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) ->
error({existing_stack_frame,{size,Numy}}).
deallocate(#vst{current=St}=Vst) ->
- Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}.
+ Vst#vst{current=St#st{ys=#{},numy=none}}.
+
+init_stack(_Tag, -1, Vst) ->
+ Vst;
+init_stack(Tag, Y, Vst) ->
+ init_stack(Tag, Y - 1, create_tag(Tag, allocate, [], {y,Y}, Vst)).
+
+trim_stack(From, To, Top, #st{ys=Ys0}=St) when From =:= Top ->
+ Ys = maps:filter(fun({y,Y}, _) -> Y < To end, Ys0),
+ St#st{numy=To,ys=Ys};
+trim_stack(From, To, Top, St0) ->
+ Src = {y, From},
+ Dst = {y, To},
+
+ #st{ys=Ys0} = St0,
+ Ys = case Ys0 of
+ #{ Src := Ref } -> Ys0#{ Dst => Ref };
+ #{} -> error({invalid_shift,Src,Dst})
+ end,
+ St = St0#st{ys=Ys},
+
+ trim_stack(From + 1, To + 1, Top, St).
test_heap(Heap, Live, Vst0) ->
verify_live(Live, Vst0),
@@ -1213,24 +1374,17 @@ heap_alloc_2([{floats,Floats}|T], St0) ->
heap_alloc_2(T, St);
heap_alloc_2([], St) -> St.
-prune_x_regs(Live, #vst{current=St0}=Vst)
- when is_integer(Live) ->
- #st{x=Xs0,defs=Defs0,aliases=Aliases0} = St0,
- Xs1 = gb_trees:to_list(Xs0),
- Xs = [P || {R,_}=P <- Xs1, R < Live],
- Defs = maps:filter(fun({x,X}, _) -> X < Live;
- ({y,_}, _) -> true
- end, Defs0),
- Aliases = maps:filter(fun({x,X1}, {x,X2}) ->
- X1 < Live andalso X2 < Live;
- ({x,X}, _) ->
- X < Live;
- (_, {x,X}) ->
- X < Live;
- (_, _) ->
- true
- end, Aliases0),
- St = St0#st{x=gb_trees:from_orddict(Xs),defs=Defs,aliases=Aliases},
+prune_x_regs(Live, #vst{current=St0}=Vst) when is_integer(Live) ->
+ #st{fragile=Fragile0,xs=Xs0} = St0,
+ Fragile = cerl_sets:filter(fun({x,X}) ->
+ X < Live;
+ ({y,_}) ->
+ true
+ end, Fragile0),
+ Xs = maps:filter(fun({x,X}, _) ->
+ X < Live
+ end, Xs0),
+ St = St0#st{fragile=Fragile,xs=Xs},
Vst#vst{current=St}.
%% All choices in a select_val list must be integers, floats, or atoms.
@@ -1275,8 +1429,8 @@ assert_arities(_) -> error(bad_tuple_arity_list).
%%% fmove Src {fr,_} %% Move INTO floating point register.
%%%
-float_op(Src, Dst, Vst0) ->
- foreach (fun(S) -> assert_freg_set(S, Vst0) end, Src),
+float_op(Ss, Dst, Vst0) ->
+ _ = [assert_freg_set(S, Vst0) || S <- Ss],
assert_fls(cleared, Vst0),
Vst = set_fls(cleared, Vst0),
set_freg(Dst, Vst).
@@ -1294,8 +1448,7 @@ get_fls(#vst{current=#st{fls=Fls}}) when is_atom(Fls) -> Fls.
init_fregs() -> 0.
-set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst)
- when is_integer(Fr), 0 =< Fr ->
+set_freg({fr,Fr}=Freg, #vst{current=#st{f=Fregs0}=St}=Vst) ->
check_limit(Freg),
Bit = 1 bsl Fr,
if
@@ -1331,7 +1484,10 @@ assert_unique_map_keys([]) ->
assert_unique_map_keys([_]) ->
ok;
assert_unique_map_keys([_,_|_]=Ls) ->
- Vs = [get_literal(L) || L <- Ls],
+ Vs = [begin
+ assert_literal(L),
+ L
+ end || L <- Ls],
case length(Vs) =:= sets:size(sets:from_list(Vs)) of
true -> ok;
false -> error(keys_not_unique)
@@ -1350,19 +1506,13 @@ bsm_validate_context(Reg, Vst) ->
_ = bsm_get_context(Reg, Vst),
ok.
-bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) ->
- case gb_trees:lookup(X, Xs) of
- {value,#ms{}=Ctx} -> Ctx;
- {value,{fragile,#ms{}=Ctx}} -> Ctx;
- _ -> error({no_bsm_context,Reg})
+bsm_get_context({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y->
+ case get_movable_term_type(Reg, Vst) of
+ #ms{}=Ctx -> Ctx;
+ _ -> error({no_bsm_context,Reg})
end;
-bsm_get_context({y,Y}=Reg, #vst{current=#st{y=Ys}}=_Vst) when is_integer(Y) ->
- case gb_trees:lookup(Y, Ys) of
- {value,#ms{}=Ctx} -> Ctx;
- {value,{fragile,#ms{}=Ctx}} -> Ctx;
- _ -> error({no_bsm_context,Reg})
- end;
-bsm_get_context(Reg, _) -> error({bad_source,Reg}).
+bsm_get_context(Reg, _) ->
+ error({bad_source,Reg}).
bsm_save(Reg, {atom,start}, Vst) ->
%% Save point refering to where the match started.
@@ -1373,7 +1523,7 @@ bsm_save(Reg, SavePoint, Vst) ->
case bsm_get_context(Reg, Vst) of
#ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots ->
Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots},
- set_type_reg(Ctx, Reg, Vst);
+ override_type(Ctx, Reg, Vst);
_ -> error({illegal_save,SavePoint})
end.
@@ -1392,184 +1542,362 @@ bsm_restore(Reg, SavePoint, Vst) ->
_ -> error({illegal_restore,SavePoint,range})
end.
-select_val_branches(Src, Choices, Vst) ->
- Infer = infer_types(Src, Vst),
- select_val_branches_1(Choices, Src, Infer, Vst).
-
-select_val_branches_1([Val,{f,L}|T], Src, Infer, Vst0) ->
- Vst1 = set_aliased_type(Val, Src, Infer(Val, Vst0)),
- Vst = branch_state(L, Vst1),
- select_val_branches_1(T, Src, Infer, Vst);
-select_val_branches_1([], _, _, Vst) -> Vst.
-
-infer_types(Src, Vst) ->
- case get_def(Src, Vst) of
- {bif,is_map,{f,_},[Map],_} ->
- fun({atom,true}, S) -> set_aliased_type(map, Map, S);
- (_, S) -> S
- end;
- {bif,tuple_size,{f,_},[Tuple],_} ->
- fun({integer,Arity}, S) ->
- Type0 = get_term_type(Tuple, S),
- Type = upgrade_tuple_type({tuple,Arity}, Type0),
- set_aliased_type(Type, Tuple, S);
- (_, S) -> S
- end;
- {bif,'=:=',{f,_},[ArityReg,{integer,_}=Val],_} when ArityReg =/= Src ->
- fun({atom,true}, S) ->
- Infer = infer_types(ArityReg, S),
- Infer(Val, S);
- (_, S) -> S
- end;
- _ ->
- fun(_, S) -> S end
+validate_select_val(_Fail, _Choices, _Src, #vst{current=none}=Vst) ->
+ %% We've already branched on all of Src's possible values, so we know we
+ %% can't reach the fail label or any of the remaining choices.
+ Vst;
+validate_select_val(Fail, [Val,{f,L}|T], Src, Vst0) ->
+ Vst = branch(L, Vst0,
+ fun(BranchVst) ->
+ update_eq_types(Src, Val, BranchVst)
+ end,
+ fun(FailVst) ->
+ update_ne_types(Src, Val, FailVst)
+ end),
+ validate_select_val(Fail, T, Src, Vst);
+validate_select_val(Fail, [], _, Vst) ->
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ %% The next instruction is never executed.
+ kill_state(SuccVst)
+ end).
+
+validate_select_tuple_arity(_Fail, _Choices, _Src, #vst{current=none}=Vst) ->
+ %% We've already branched on all of Src's possible values, so we know we
+ %% can't reach the fail label or any of the remaining choices.
+ Vst;
+validate_select_tuple_arity(Fail, [Arity,{f,L}|T], Tuple, Vst0) ->
+ Type = {tuple, Arity, #{}},
+ Vst = branch(L, Vst0,
+ fun(BranchVst) ->
+ update_type(fun meet/2, Type, Tuple, BranchVst)
+ end,
+ fun(FailVst) ->
+ update_type(fun subtract/2, Type, Tuple, FailVst)
+ end),
+ validate_select_tuple_arity(Fail, T, Tuple, Vst);
+validate_select_tuple_arity(Fail, [], _, #vst{}=Vst) ->
+ branch(Fail, Vst,
+ fun(SuccVst) ->
+ %% The next instruction is never executed.
+ kill_state(SuccVst)
+ end).
+
+infer_types({Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y ->
+ infer_types(get_reg_vref(Reg, Vst), Vst);
+infer_types(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) ->
+ case Vs of
+ #{ Ref := Entry } -> infer_types_1(Entry);
+ #{} -> fun(_, S) -> S end
+ end;
+infer_types(_, #vst{}) ->
+ fun(_, S) -> S end.
+
+infer_types_1(#value{op={bif,'=:='},args=[LHS,RHS]}) ->
+ fun({atom,true}, S) ->
+ Infer = infer_types(RHS, S),
+ Infer(LHS, S);
+ (_, S) -> S
+ end;
+infer_types_1(#value{op={bif,element},args=[{integer,Index}=Key,Tuple]}) ->
+ fun(Val, S) ->
+ Type = get_term_type(Val, S),
+ update_type(fun meet/2,{tuple,[Index],#{ Key => Type }}, Tuple, S)
+ end;
+infer_types_1(#value{op={bif,is_atom},args=[Src]}) ->
+ infer_type_test_bif({atom,[]}, Src);
+infer_types_1(#value{op={bif,is_boolean},args=[Src]}) ->
+ infer_type_test_bif(bool, Src);
+infer_types_1(#value{op={bif,is_binary},args=[Src]}) ->
+ infer_type_test_bif(binary, Src);
+infer_types_1(#value{op={bif,is_bitstring},args=[Src]}) ->
+ infer_type_test_bif(binary, Src);
+infer_types_1(#value{op={bif,is_float},args=[Src]}) ->
+ infer_type_test_bif(float, Src);
+infer_types_1(#value{op={bif,is_integer},args=[Src]}) ->
+ infer_type_test_bif({integer,{}}, Src);
+infer_types_1(#value{op={bif,is_list},args=[Src]}) ->
+ infer_type_test_bif(list, Src);
+infer_types_1(#value{op={bif,is_map},args=[Src]}) ->
+ infer_type_test_bif(map, Src);
+infer_types_1(#value{op={bif,is_number},args=[Src]}) ->
+ infer_type_test_bif(number, Src);
+infer_types_1(#value{op={bif,is_tuple},args=[Src]}) ->
+ infer_type_test_bif({tuple,[0],#{}}, Src);
+infer_types_1(#value{op={bif,tuple_size}, args=[Tuple]}) ->
+ fun({integer,Arity}, S) ->
+ update_type(fun meet/2, {tuple,Arity,#{}}, Tuple, S);
+ (_, S) -> S
+ end;
+infer_types_1(_) ->
+ fun(_, S) -> S end.
+
+infer_type_test_bif(Type, Src) ->
+ fun({atom,true}, S) ->
+ update_type(fun meet/2, Type, Src, S);
+ (_, S) ->
+ S
end.
%%%
%%% Keeping track of types.
%%%
-set_alias(Reg1, Reg2, #vst{current=St0}=Vst) ->
- case Reg1 of
- {Kind,_} when Kind =:= x; Kind =:= y ->
- #st{aliases=Aliases0} = St0,
- Aliases = Aliases0#{Reg1=>Reg2,Reg2=>Reg1},
- St = St0#st{aliases=Aliases},
- Vst#vst{current=St};
+%% Assigns Src to Dst and marks them as aliasing each other.
+assign({y,_}=Src, {y,_}=Dst, Vst) ->
+ %% The stack trimming optimization may generate a move from an initialized
+ %% but unassigned Y register to another Y register.
+ case get_raw_type(Src, Vst) of
+ initialized -> create_tag(initialized, init, [], Dst, Vst);
+ _ -> assign_1(Src, Dst, Vst)
+ end;
+assign({Kind,_}=Src, Dst, Vst) when Kind =:= x; Kind =:= y ->
+ assign_1(Src, Dst, Vst);
+assign(Literal, Dst, Vst) ->
+ Type = get_literal_type(Literal),
+ create_term(Type, move, [Literal], Dst, Vst).
+
+%% Creates a special tag value that isn't a regular term, such as 'initialized'
+%% or 'catchtag'
+create_tag(Tag, _Op, _Ss, {y,_}=Dst, #vst{current=#st{ys=Ys0}=St0}=Vst) ->
+ case maps:get(Dst, Ys0, uninitialized) of
+ {catchtag,_}=Prev ->
+ error(Prev);
+ {trytag,_}=Prev ->
+ error(Prev);
_ ->
- Vst
+ check_try_catch_tags(Tag, Dst, Vst),
+ Ys = Ys0#{ Dst => Tag },
+ St = St0#st{ys=Ys},
+ remove_fragility(Dst, Vst#vst{current=St})
+ end;
+create_tag(_Tag, _Op, _Ss, Dst, _Vst) ->
+ error({invalid_tag_register, Dst}).
+
+%% Wipes a special tag, leaving the register initialized but empty.
+kill_tag({y,_}=Reg, #vst{current=#st{ys=Ys0}=St0}=Vst) ->
+ _ = get_tag_type(Reg, Vst), %Assertion.
+ Ys = Ys0#{ Reg => initialized },
+ Vst#vst{current=St0#st{ys=Ys}}.
+
+%% Creates a completely new term with the given type.
+create_term(Type, Op, Ss0, Dst, Vst0) ->
+ create_term(Type, Op, Ss0, Dst, Vst0, Vst0).
+
+%% As create_term/4, but uses the incoming Vst for argument resolution in
+%% case x-regs have been pruned and the sources can no longer be found.
+create_term(Type, Op, Ss0, Dst, Vst0, OrigVst) ->
+ {Ref, Vst1} = new_value(Type, Op, resolve_args(Ss0, OrigVst), Vst0),
+ Vst = remove_fragility(Dst, Vst1),
+ set_reg_vref(Ref, Dst, Vst).
+
+%% Extracts a term from Ss, propagating fragility.
+extract_term(Type, Op, Ss0, Dst, Vst0) ->
+ extract_term(Type, Op, Ss0, Dst, Vst0, Vst0).
+
+%% As extract_term/4, but uses the incoming Vst for argument resolution in
+%% case x-regs have been pruned and the sources can no longer be found.
+extract_term(Type, Op, Ss0, Dst, Vst0, OrigVst) ->
+ {Ref, Vst1} = new_value(Type, Op, resolve_args(Ss0, OrigVst), Vst0),
+ Vst = propagate_fragility(Dst, Ss0, Vst1),
+ set_reg_vref(Ref, Dst, Vst).
+
+%% Translates instruction arguments into the argument() type, decoupling them
+%% from their registers, allowing us to infer their types after they've been
+%% clobbered or moved.
+resolve_args([{Kind,_}=Src | Args], Vst) when Kind =:= x; Kind =:= y ->
+ [get_reg_vref(Src, Vst) | resolve_args(Args, Vst)];
+resolve_args([Lit | Args], Vst) ->
+ assert_literal(Lit),
+ [Lit | resolve_args(Args, Vst)];
+resolve_args([], _Vst) ->
+ [].
+
+%% Overrides the type of Reg. This is ugly but a necessity for certain
+%% destructive operations.
+override_type(Type, Reg, Vst) ->
+ update_type(fun(_, T) -> T end, Type, Reg, Vst).
+
+%% This is used when linear code finds out more and more information about a
+%% type, so that the type gets more specialized.
+update_type(Merge, With, #value_ref{}=Ref, Vst) ->
+ %% If the old type can't be merged with the new one, the type information
+ %% is inconsistent and we know that some instructions will never be
+ %% executed at run-time. For example:
+ %%
+ %% {test,is_list,Fail,[Reg]}.
+ %% {test,is_tuple,Fail,[Reg]}.
+ %% {test,test_arity,Fail,[Reg,5]}.
+ %%
+ %% Note that the test_arity instruction can never be reached, so we need to
+ %% kill the state to avoid raising an error when we encounter it.
+ %%
+ %% Simply returning `kill_state(Vst)` is unsafe however as we might be in
+ %% the middle of an instruction, and altering the rest of the validator
+ %% (eg. prune_x_regs/2) to no-op on dead states is prone to error.
+ %%
+ %% We therefore throw a 'type_conflict' error instead, which causes
+ %% validation to fail unless we're in a context where such errors can be
+ %% handled, such as in a branch handler.
+ Current = get_raw_type(Ref, Vst),
+ case Merge(Current, With) of
+ none -> throw({type_conflict, Current, With});
+ Type -> set_type(Type, Ref, Vst)
+ end;
+update_type(Merge, With, {Kind,_}=Reg, Vst) when Kind =:= x; Kind =:= y ->
+ update_type(Merge, With, get_reg_vref(Reg, Vst), Vst);
+update_type(Merge, With, Literal, Vst) ->
+ assert_literal(Literal),
+ %% Literals always retain their type, but we still need to bail on type
+ %% conflicts.
+ case Merge(Literal, With) of
+ none -> throw({type_conflict, Literal, With});
+ _Type -> Vst
end.
-set_aliased_type(Type, Reg, #vst{current=#st{aliases=Aliases}}=Vst0) ->
- Vst1 = set_type(Type, Reg, Vst0),
- case Aliases of
- #{Reg:=OtherReg} ->
- Vst = set_type_reg(Type, OtherReg, Vst1),
- #vst{current=St} = Vst,
- Vst#vst{current=St#st{aliases=Aliases}};
- #{} ->
- Vst1
+update_ne_types(LHS, RHS, Vst) ->
+ %% While updating types on equality is fairly straightforward, inequality
+ %% is a bit trickier since all we know is that the *value* of LHS differs
+ %% from RHS, so we can't blindly subtract their types.
+ %%
+ %% Consider `number =/= {integer,[]}`; all we know is that LHS isn't equal
+ %% to some *specific integer* of unknown value, and if we were to subtract
+ %% {integer,[]} we would erroneously infer that the new type is {float,[]}.
+ %%
+ %% Therefore, we only subtract when we know that RHS has a specific value.
+ RType = get_term_type(RHS, Vst),
+ case is_literal(RType) of
+ true -> update_type(fun subtract/2, RType, LHS, Vst);
+ false -> Vst
end.
-kill_aliases(Reg, #st{aliases=Aliases0}=St) ->
- case Aliases0 of
- #{Reg:=OtherReg} ->
- Aliases = maps:without([Reg,OtherReg], Aliases0),
- St#st{aliases=Aliases};
+update_eq_types(LHS, RHS, Vst0) ->
+ Infer = infer_types(LHS, Vst0),
+ Vst1 = Infer(RHS, Vst0),
+
+ T1 = get_term_type(LHS, Vst1),
+ T2 = get_term_type(RHS, Vst1),
+
+ Vst = update_type(fun meet/2, T2, LHS, Vst1),
+ update_type(fun meet/2, T1, RHS, Vst).
+
+%% Helper functions for the above.
+
+assign_1(Src, Dst, Vst0) ->
+ assert_movable(Src, Vst0),
+ Vst = propagate_fragility(Dst, [Src], Vst0),
+ set_reg_vref(get_reg_vref(Src, Vst), Dst, Vst).
+
+set_reg_vref(Ref, {x,_}=Dst, Vst) ->
+ check_limit(Dst),
+ #vst{current=#st{xs=Xs0}=St0} = Vst,
+ St = St0#st{xs=Xs0#{ Dst => Ref }},
+ Vst#vst{current=St};
+set_reg_vref(Ref, {y,_}=Dst, #vst{current=#st{ys=Ys0}=St0} = Vst) ->
+ check_limit(Dst),
+ case Ys0 of
+ #{ Dst := {catchtag,_}=Tag } ->
+ error(Tag);
+ #{ Dst := {trytag,_}=Tag } ->
+ error(Tag);
+ #{ Dst := _ } ->
+ St = St0#st{ys=Ys0#{ Dst => Ref }},
+ Vst#vst{current=St};
#{} ->
- St
+ %% Storing into a non-existent Y register means that we haven't set
+ %% up a (sufficiently large) stack.
+ error({invalid_store, Dst})
end.
-set_type(Type, {x,_}=Reg, Vst) ->
- set_type_reg(Type, Reg, Reg, Vst);
-set_type(Type, {y,_}=Reg, Vst) ->
- set_type_reg(Type, Reg, Reg, Vst);
-set_type(_, _, #vst{}=Vst) -> Vst.
+get_reg_vref({x,_}=Src, #vst{current=#st{xs=Xs}}) ->
+ check_limit(Src),
+ case Xs of
+ #{ Src := #value_ref{}=Ref } ->
+ Ref;
+ #{} ->
+ error({uninitialized_reg, Src})
+ end;
+get_reg_vref({y,_}=Src, #vst{current=#st{ys=Ys}}) ->
+ check_limit(Src),
+ case Ys of
+ #{ Src := #value_ref{}=Ref } ->
+ Ref;
+ #{ Src := initialized } ->
+ error({unassigned, Src});
+ #{ Src := Tag } when Tag =/= uninitialized ->
+ error(Tag);
+ #{} ->
+ error({uninitialized_reg, Src})
+ end.
-set_type_reg(Type, Src, Dst, Vst) ->
- case get_term_type_1(Src, Vst) of
- {fragile,_} ->
- set_type_reg(make_fragile(Type), Dst, Vst);
- _ ->
- set_type_reg(Type, Dst, Vst)
+set_type(Type, #value_ref{}=Ref, #vst{current=#st{vs=Vs0}=St}=Vst) ->
+ case Vs0 of
+ #{ Ref := #value{}=Entry } ->
+ Vs = Vs0#{ Ref => Entry#value{type=Type} },
+ Vst#vst{current=St#st{vs=Vs}};
+ #{} ->
+ %% Dead references may happen during type inference and are not an
+ %% error in and of themselves. If a problem were to arise from this
+ %% it'll explode elsewhere.
+ Vst
end.
-set_type_reg(Type, Reg, Vst) ->
- set_type_reg_expr(Type, none, Reg, Vst).
-
-set_type_reg_expr(Type, Expr, {x,_}=Reg, Vst) ->
- set_type_x(Type, Expr, Reg, Vst);
-set_type_reg_expr(Type, Expr, Reg, Vst) ->
- set_type_y(Type, Expr, Reg, Vst).
-
-set_type_y(Type, Reg, Vst) ->
- set_type_y(Type, none, Reg, Vst).
-
-set_type_x(Type, Expr, {x,X}=Reg, #vst{current=#st{x=Xs0,defs=Defs0}=St0}=Vst)
- when is_integer(X), 0 =< X ->
- check_limit(Reg),
- Xs = case gb_trees:lookup(X, Xs0) of
- none ->
- gb_trees:insert(X, Type, Xs0);
- {value,{fragile,_}} ->
- gb_trees:update(X, make_fragile(Type), Xs0);
- {value,_} ->
- gb_trees:update(X, Type, Xs0)
- end,
- Defs = Defs0#{Reg=>Expr},
- St = kill_aliases(Reg, St0),
- Vst#vst{current=St#st{x=Xs,defs=Defs}};
-set_type_x(Type, _Expr, Reg, #vst{}) ->
- error({invalid_store,Reg,Type}).
-
-set_type_y(Type, Expr, {y,Y}=Reg, #vst{current=#st{y=Ys0,defs=Defs0}=St0}=Vst)
- when is_integer(Y), 0 =< Y ->
- check_limit(Reg),
- Ys = case gb_trees:lookup(Y, Ys0) of
- none ->
- error({invalid_store,Reg,Type});
- {value,{catchtag,_}=Tag} ->
- error(Tag);
- {value,{trytag,_}=Tag} ->
- error(Tag);
- {value,_} ->
- gb_trees:update(Y, Type, Ys0)
- end,
- check_try_catch_tags(Type, Y, Ys0),
- Defs = Defs0#{Reg=>Expr},
- St = kill_aliases(Reg, St0),
- Vst#vst{current=St#st{y=Ys,defs=Defs}};
-set_type_y(Type, _Expr, Reg, #vst{}) ->
- error({invalid_store,Reg,Type}).
-
-make_fragile({fragile,_}=Type) -> Type;
-make_fragile(Type) -> {fragile,Type}.
-
-set_catch_end({y,Y}, #vst{current=#st{y=Ys0}=St}=Vst) ->
- Ys = gb_trees:update(Y, initialized, Ys0),
- Vst#vst{current=St#st{y=Ys}}.
-
-check_try_catch_tags(Type, LastY, Ys) ->
+new_value(Type, Op, Ss, #vst{current=#st{vs=Vs0}=St,ref_ctr=Counter}=Vst) ->
+ Ref = #value_ref{id=Counter},
+ Vs = Vs0#{ Ref => #value{op=Op,args=Ss,type=Type} },
+
+ {Ref, Vst#vst{current=St#st{vs=Vs},ref_ctr=Counter+1}}.
+
+kill_catch_tag(Reg, #vst{current=#st{ct=[Fail|Fails]}=St}=Vst0) ->
+ Vst = Vst0#vst{current=St#st{ct=Fails,fls=undefined}},
+ {_, Fail} = get_tag_type(Reg, Vst), %Assertion.
+ kill_tag(Reg, Vst).
+
+check_try_catch_tags(Type, {y,N}=Reg, Vst) ->
+ %% Every catch or try/catch must use a lower Y register number than any
+ %% enclosing catch or try/catch. That will ensure that when the stack is
+ %% scanned when an exception occurs, the innermost try/catch tag is found
+ %% first.
case is_try_catch_tag(Type) of
- false ->
- ok;
true ->
- %% Every catch or try/catch must use a lower Y register
- %% number than any enclosing catch or try/catch. That will
- %% ensure that when the stack is scanned when an
- %% exception occurs, the innermost try/catch tag is found
- %% first.
- Bad = [{{y,Y},Tag} || {Y,Tag} <- gb_trees:to_list(Ys),
- Y < LastY, is_try_catch_tag(Tag)],
- case Bad of
- [] ->
- ok;
- [_|_] ->
- error({bad_try_catch_nesting,{y,LastY},Bad})
- end
+ case collect_try_catch_tags(N - 1, Vst, []) of
+ [_|_]=Bad -> error({bad_try_catch_nesting, Reg, Bad});
+ [] -> ok
+ end;
+ false ->
+ ok
end.
-is_try_catch_tag({catchtag,_}) -> true;
-is_try_catch_tag({trytag,_}) -> true;
-is_try_catch_tag(_) -> false.
-
-is_reg_defined({x,_}=Reg, Vst) -> is_type_defined_x(Reg, Vst);
-is_reg_defined({y,_}=Reg, Vst) -> is_type_defined_y(Reg, Vst);
+is_reg_defined({x,_}=Reg, #vst{current=#st{xs=Xs}}) -> is_map_key(Reg, Xs);
+is_reg_defined({y,_}=Reg, #vst{current=#st{ys=Ys}}) -> is_map_key(Reg, Ys);
is_reg_defined(V, #vst{}) -> error({not_a_register, V}).
-is_type_defined_x({x,X}, #vst{current=#st{x=Xs}}) ->
- gb_trees:is_defined(X,Xs).
-
-is_type_defined_y({y,Y}, #vst{current=#st{y=Ys}}) ->
- gb_trees:is_defined(Y,Ys).
-
assert_term(Src, Vst) ->
- get_term_type(Src, Vst),
+ _ = get_term_type(Src, Vst),
+ ok.
+
+assert_movable(Src, Vst) ->
+ _ = get_movable_term_type(Src, Vst),
ok.
-assert_not_literal({x,_}) -> ok;
-assert_not_literal({y,_}) -> ok;
-assert_not_literal(Literal) -> error({literal_not_allowed,Literal}).
+assert_literal(Src) ->
+ case is_literal(Src) of
+ true -> ok;
+ false -> error({literal_required,Src})
+ end.
+
+assert_not_literal(Src) ->
+ case is_literal(Src) of
+ true -> error({literal_not_allowed,Src});
+ false -> ok
+ end.
+
+is_literal(nil) -> true;
+is_literal({atom,A}) when is_atom(A) -> true;
+is_literal({float,F}) when is_float(F) -> true;
+is_literal({integer,I}) when is_integer(I) -> true;
+is_literal({literal,_L}) -> true;
+is_literal(_) -> false.
%% The possible types.
%%
@@ -1589,10 +1917,10 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}).
%% used by the catch instructions; NOT safe to use in other
%% instructions.
%%
-%% exception Can only be used as a type returned by return_type/2
-%% (which gives the type of the value returned by a BIF).
-%% Thus 'exception' is never stored as type descriptor
-%% for a register.
+%% exception Can only be used as a type returned by
+%% call_return_type/2 (which gives the type of the value
+%% returned by a call). Thus 'exception' is never stored
+%% as type descriptor for a register.
%%
%% #ms{} A match context for bit syntax matching. We do allow
%% it to moved/to from stack, but otherwise it must only
@@ -1613,11 +1941,12 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}).
%%
%% list List: [] or [_|_]
%%
-%% {tuple,[Sz]} Tuple. An element has been accessed using
-%% element/2 or setelement/3 so that it is known that
-%% the type is a tuple of size at least Sz.
+%% {tuple,[Sz],Es} Tuple. An element has been accessed using
+%% element/2 or setelement/3 so that it is known that
+%% the type is a tuple of size at least Sz. Es is a map
+%% containing known types by tuple index.
%%
-%% {tuple,Sz} Tuple. A test_arity instruction has been seen
+%% {tuple,Sz,Es} Tuple. A test_arity instruction has been seen
%% so that it is known that the size is exactly Sz.
%%
%% {atom,[]} Atom.
@@ -1635,16 +1964,106 @@ assert_not_literal(Literal) -> error({literal_not_allowed,Literal}).
%%
%% none A conflict in types. There will be an exception at runtime.
%%
-%% FRAGILITY
-%% ---------
-%%
-%% The loop_rec/2 instruction may return a reference to a term that is
-%% not part of the root set. That term or any part of it must not be
-%% included in a garbage collection. Therefore, the term (or any part
-%% of it) must not be stored in an Y register.
-%%
-%% Such terms are wrapped in a {fragile,Type} tuple, where Type is one
-%% of the types described above.
+
+%% join(Type1, Type2) -> Type
+%% Return the most specific type possible.
+join(Same, Same) ->
+ Same;
+join(none, Other) ->
+ Other;
+join(Other, none) ->
+ Other;
+join({literal,_}=T1, T2) ->
+ join_literal(T1, T2);
+join(T1, {literal,_}=T2) ->
+ join_literal(T2, T1);
+join({tuple,Size,EsA}, {tuple,Size,EsB}) ->
+ Es = join_tuple_elements(tuple_sz(Size), EsA, EsB),
+ {tuple, Size, Es};
+join({tuple,A,EsA}, {tuple,B,EsB}) ->
+ Size = min(tuple_sz(A), tuple_sz(B)),
+ Es = join_tuple_elements(Size, EsA, EsB),
+ {tuple, [Size], Es};
+join({Type,A}, {Type,B})
+ when Type =:= atom; Type =:= integer; Type =:= float ->
+ if A =:= B -> {Type,A};
+ true -> {Type,[]}
+ end;
+join({Type,_}, number)
+ when Type =:= integer; Type =:= float ->
+ number;
+join(number, {Type,_})
+ when Type =:= integer; Type =:= float ->
+ number;
+join({integer,_}, {float,_}) ->
+ number;
+join({float,_}, {integer,_}) ->
+ number;
+join(bool, {atom,A}) ->
+ join_bool(A);
+join({atom,A}, bool) ->
+ join_bool(A);
+join({atom,A}, {atom,B}) when is_boolean(A), is_boolean(B) ->
+ bool;
+join({atom,_}, {atom,_}) ->
+ {atom,[]};
+join(#ms{id=Id1,valid=B1,slots=Slots1},
+ #ms{id=Id2,valid=B2,slots=Slots2}) ->
+ Id = if
+ Id1 =:= Id2 -> Id1;
+ true -> make_ref()
+ end,
+ #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)};
+join(T1, T2) when T1 =/= T2 ->
+ %% We've exhaused all other options, so the type must either be a list or
+ %% a 'term'.
+ join_list(T1, T2).
+
+join_tuple_elements(Limit, EsA, EsB) ->
+ Es0 = join_elements(EsA, EsB),
+ maps:filter(fun({integer,Index}, _Type) -> Index =< Limit end, Es0).
+
+join_elements(Es1, Es2) ->
+ Keys = if
+ map_size(Es1) =< map_size(Es2) -> maps:keys(Es1);
+ map_size(Es1) > map_size(Es2) -> maps:keys(Es2)
+ end,
+ join_elements_1(Keys, Es1, Es2, #{}).
+
+join_elements_1([Key | Keys], Es1, Es2, Acc0) ->
+ Type = case {Es1, Es2} of
+ {#{ Key := Same }, #{ Key := Same }} -> Same;
+ {#{ Key := Type1 }, #{ Key := Type2 }} -> join(Type1, Type2);
+ {#{}, #{}} -> term
+ end,
+ Acc = set_element_type(Key, Type, Acc0),
+ join_elements_1(Keys, Es1, Es2, Acc);
+join_elements_1([], _Es1, _Es2, Acc) ->
+ Acc.
+
+%% Joins types of literals; note that the left argument must either be a
+%% literal or exactly equal to the second argument.
+join_literal(Same, Same) ->
+ Same;
+join_literal({literal,_}=Lit, T) ->
+ join_literal(T, get_literal_type(Lit));
+join_literal(T1, T2) ->
+ %% We're done extracting the types, try merging them again.
+ join(T1, T2).
+
+join_list(nil, cons) -> list;
+join_list(nil, list) -> list;
+join_list(cons, list) -> list;
+join_list(T, nil) -> join_list(nil, T);
+join_list(T, cons) -> join_list(cons, T);
+join_list(_, _) ->
+ %% Not a list, so it must be a term.
+ term.
+
+join_bool([]) -> {atom,[]};
+join_bool(true) -> bool;
+join_bool(false) -> bool;
+join_bool(_) -> {atom,[]}.
%% meet(Type1, Type2) -> Type
%% Return the meet of two types. The meet is a more specific type.
@@ -1656,6 +2075,19 @@ meet(term, Other) ->
Other;
meet(Other, term) ->
Other;
+meet(#ms{}, binary) ->
+ #ms{};
+meet(binary, #ms{}) ->
+ #ms{};
+meet({literal,_}, {literal,_}) ->
+ none;
+meet(T1, {literal,_}=T2) ->
+ meet(T2, T1);
+meet({literal,_}=T1, T2) ->
+ case meet(get_literal_type(T1), T2) of
+ none -> none;
+ _ -> T1
+ end;
meet(T1, T2) ->
case {erlang:min(T1, T2),erlang:max(T1, T2)} of
{{atom,_}=A,{atom,[]}} -> A;
@@ -1667,22 +2099,57 @@ meet(T1, T2) ->
{list,nil} -> nil;
{number,{integer,_}=T} -> T;
{number,{float,_}=T} -> T;
- {{tuple,Size1},{tuple,Size2}} ->
- case {Size1,Size2} of
- {[Sz1],[Sz2]} ->
- {tuple,[erlang:max(Sz1, Sz2)]};
- {Sz1,[Sz2]} when Sz2 =< Sz1 ->
- {tuple,Sz1};
- {_,_} ->
+ {{tuple,Size1,Es1},{tuple,Size2,Es2}} ->
+ Es = meet_elements(Es1, Es2),
+ case {Size1,Size2,Es} of
+ {_, _, none} ->
+ none;
+ {[Sz1],[Sz2],_} ->
+ Sz = erlang:max(Sz1, Sz2),
+ assert_tuple_elements(Sz, Es),
+ {tuple,[Sz],Es};
+ {Sz1,[Sz2],_} when Sz2 =< Sz1 ->
+ assert_tuple_elements(Sz1, Es),
+ {tuple,Sz1,Es};
+ {Sz,Sz,_} ->
+ assert_tuple_elements(Sz, Es),
+ {tuple,Sz,Es};
+ {_,_,_} ->
none
end;
{_,_} -> none
end.
+meet_elements(Es1, Es2) ->
+ Keys = maps:keys(Es1) ++ maps:keys(Es2),
+ meet_elements_1(Keys, Es1, Es2, #{}).
+
+meet_elements_1([Key | Keys], Es1, Es2, Acc) ->
+ case {Es1, Es2} of
+ {#{ Key := Type1 }, #{ Key := Type2 }} ->
+ case meet(Type1, Type2) of
+ none -> none;
+ Type -> meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type })
+ end;
+ {#{ Key := Type1 }, _} ->
+ meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type1 });
+ {_, #{ Key := Type2 }} ->
+ meet_elements_1(Keys, Es1, Es2, Acc#{ Key => Type2 })
+ end;
+meet_elements_1([], _Es1, _Es2, Acc) ->
+ Acc.
+
+%% No tuple elements may have an index above the known size.
+assert_tuple_elements(Limit, Es) ->
+ true = maps:fold(fun({integer,Index}, _T, true) ->
+ Index =< Limit
+ end, true, Es). %Assertion.
+
%% subtract(Type1, Type2) -> Type
%% Subtract Type2 from Type2. Example:
%% subtract(list, nil) -> cons
+subtract(Same, Same) -> none;
subtract(list, nil) -> cons;
subtract(list, cons) -> nil;
subtract(number, {integer,[]}) -> {float,[]};
@@ -1692,21 +2159,17 @@ subtract(bool, {atom,true}) -> {atom, false};
subtract(Type, _) -> Type.
assert_type(WantedType, Term, Vst) ->
- case get_term_type(Term, Vst) of
- {fragile,Type} ->
- assert_type(WantedType, Type);
- Type ->
- assert_type(WantedType, Type)
- end.
+ Type = get_term_type(Term, Vst),
+ assert_type(WantedType, Type).
assert_type(Correct, Correct) -> ok;
assert_type(float, {float,_}) -> ok;
-assert_type(tuple, {tuple,_}) -> ok;
+assert_type(tuple, {tuple,_,_}) -> ok;
assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok;
-assert_type({tuple_element,I}, {tuple,[Sz]})
+assert_type({tuple_element,I}, {tuple,[Sz],_})
when 1 =< I, I =< Sz ->
ok;
-assert_type({tuple_element,I}, {tuple,Sz})
+assert_type({tuple_element,I}, {tuple,Sz,_})
when is_integer(Sz), 1 =< I, I =< Sz ->
ok;
assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) ->
@@ -1716,171 +2179,297 @@ assert_type(cons, {literal,[_|_]}) ->
assert_type(Needed, Actual) ->
error({bad_type,{needed,Needed},{actual,Actual}}).
-%% upgrade_tuple_type(NewTupleType, OldType) -> TupleType.
-%% upgrade_tuple_type/2 is used when linear code finds out more and
-%% more information about a tuple type, so that the type gets more
-%% specialized. If OldType is not a tuple type, the type information
-%% is inconsistent, and we know that some instructions will never
-%% be executed at run-time.
-
-upgrade_tuple_type(NewType, {fragile,OldType}) ->
- Type = upgrade_tuple_type_1(NewType, OldType),
- make_fragile(Type);
-upgrade_tuple_type(NewType, OldType) ->
- upgrade_tuple_type_1(NewType, OldType).
-
-upgrade_tuple_type_1(NewType, OldType) ->
- case meet(NewType, OldType) of
- none ->
- %% Unoptimized code may look like this:
- %%
- %% {test,is_list,Fail,[Reg]}.
- %% {test,is_tuple,Fail,[Reg]}.
- %% {test,test_arity,Fail,[Reg,5]}.
- %%
- %% Note that the test_arity instruction can never be reached.
- %% To make sure it's not rejected, set the type of Reg to
- %% NewType instead of 'none'.
- NewType;
- Type ->
- Type
- end.
+get_element_type(Key, Src, Vst) ->
+ get_element_type_1(Key, get_term_type(Src, Vst)).
+
+get_element_type_1({integer,_}=Key, {tuple,_Sz,Es}) ->
+ case Es of
+ #{ Key := Type } -> Type;
+ #{} -> term
+ end;
+get_element_type_1(_Index, _Type) ->
+ term.
+
+set_element_type(_Key, none, Es) ->
+ Es;
+set_element_type(Key, term, Es) ->
+ maps:remove(Key, Es);
+set_element_type(Key, Type, Es) ->
+ Es#{ Key => Type }.
get_tuple_size({integer,[]}) -> 0;
get_tuple_size({integer,Sz}) -> Sz;
get_tuple_size(_) -> 0.
validate_src(Ss, Vst) when is_list(Ss) ->
- foreach(fun(S) -> get_term_type(S, Vst) end, Ss).
+ _ = [assert_term(S, Vst) || S <- Ss],
+ ok.
-%% get_durable_term_type(Src, ValidatorState) -> Type
+%% get_term_type(Src, ValidatorState) -> Type
%% Get the type of the source Src. The returned type Type will be
%% a standard Erlang type (no catch/try tags or match contexts).
-%% Fragility will be stripped.
-get_durable_term_type(Src, Vst) ->
- case get_term_type(Src, Vst) of
- {fragile,Type} -> Type;
+get_term_type(Src, Vst) ->
+ case get_movable_term_type(Src, Vst) of
+ #ms{} -> error({match_context,Src});
Type -> Type
end.
-%% get_move_term_type(Src, ValidatorState) -> Type
+%% get_movable_term_type(Src, ValidatorState) -> Type
%% Get the type of the source Src. The returned type Type will be
%% a standard Erlang type (no catch/try tags). Match contexts are OK.
-get_move_term_type(Src, Vst) ->
- case get_term_type_1(Src, Vst) of
- initialized -> error({unassigned,Src});
- {catchtag,_} -> error({catchtag,Src});
- {trytag,_} -> error({trytag,Src});
+get_movable_term_type(Src, Vst) ->
+ case get_raw_type(Src, Vst) of
+ initialized -> error({unassigned,Src});
+ uninitialized -> error({uninitialized_reg,Src});
+ {catchtag,_} -> error({catchtag,Src});
+ {trytag,_} -> error({trytag,Src});
tuple_in_progress -> error({tuple_in_progress,Src});
- Type -> Type
+ {literal,_}=Lit -> get_literal_type(Lit);
+ Type -> Type
end.
-%% get_term_type(Src, ValidatorState) -> Type
-%% Get the type of the source Src. The returned type Type will be
-%% a standard Erlang type (no catch/try tags or match contexts).
+%% get_tag_type(Src, ValidatorState) -> Type
+%% Return the tag type of a Y register, erroring out if it contains a term.
-get_term_type(Src, Vst) ->
- case get_move_term_type(Src, Vst) of
- #ms{} -> error({match_context,Src});
- Type -> Type
- end.
-
-%% get_special_y_type(Src, ValidatorState) -> Type
-%% Return the type for the Y register without doing any validity checks.
-
-get_special_y_type({y,_}=Reg, Vst) -> get_term_type_1(Reg, Vst);
-get_special_y_type(Src, _) -> error({source_not_y_reg,Src}).
-
-get_term_type_1(nil=T, _) -> T;
-get_term_type_1({atom,A}=T, _) when is_atom(A) -> T;
-get_term_type_1({float,F}=T, _) when is_float(F) -> T;
-get_term_type_1({integer,I}=T, _) when is_integer(I) -> T;
-get_term_type_1({literal,[_|_]}, _) -> cons;
-get_term_type_1({literal,Bitstring}, _) when is_bitstring(Bitstring) -> binary;
-get_term_type_1({literal,Map}, _) when is_map(Map) -> map;
-get_term_type_1({literal,Tuple}, _) when is_tuple(Tuple) ->
- {tuple,tuple_size(Tuple)};
-get_term_type_1({literal,_}=T, _) -> T;
-get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) ->
- case gb_trees:lookup(X, Xs) of
- {value,Type} -> Type;
- none -> error({uninitialized_reg,Reg})
+get_tag_type({y,_}=Src, Vst) ->
+ case get_raw_type(Src, Vst) of
+ {catchtag, _}=Tag -> Tag;
+ {trytag, _}=Tag -> Tag;
+ uninitialized=Tag -> Tag;
+ initialized=Tag -> Tag;
+ Other -> error({invalid_tag,Src,Other})
end;
-get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) ->
- case gb_trees:lookup(Y, Ys) of
- none -> error({uninitialized_reg,Reg});
- {value,uninitialized} -> error({uninitialized_reg,Reg});
- {value,Type} -> Type
+get_tag_type(Src, _) ->
+ error({invalid_tag_register,Src}).
+
+%% get_raw_type(Src, ValidatorState) -> Type
+%% Return the type of a register without doing any validity checks or
+%% conversions.
+get_raw_type({x,X}=Src, #vst{current=#st{xs=Xs}}=Vst) when is_integer(X) ->
+ check_limit(Src),
+ case Xs of
+ #{ Src := #value_ref{}=Ref } -> get_raw_type(Ref, Vst);
+ #{} -> uninitialized
end;
-get_term_type_1(Src, _) -> error({bad_source,Src}).
-
-get_def(Src, #vst{current=#st{defs=Defs}}) ->
- case Defs of
- #{Src:=Def} -> Def;
+get_raw_type({y,Y}=Src, #vst{current=#st{ys=Ys}}=Vst) when is_integer(Y) ->
+ check_limit(Src),
+ case Ys of
+ #{ Src := #value_ref{}=Ref } -> get_raw_type(Ref, Vst);
+ #{ Src := Tag } -> Tag;
+ #{} -> uninitialized
+ end;
+get_raw_type(#value_ref{}=Ref, #vst{current=#st{vs=Vs}}) ->
+ case Vs of
+ #{ Ref := #value{type=Type} } -> Type;
#{} -> none
+ end;
+get_raw_type(Src, #vst{}) ->
+ get_literal_type(Src).
+
+get_literal_type(nil=T) -> T;
+get_literal_type({atom,A}=T) when is_atom(A) -> T;
+get_literal_type({float,F}=T) when is_float(F) -> T;
+get_literal_type({integer,I}=T) when is_integer(I) -> T;
+get_literal_type({literal,[_|_]}) -> cons;
+get_literal_type({literal,Bitstring}) when is_bitstring(Bitstring) -> binary;
+get_literal_type({literal,Map}) when is_map(Map) -> map;
+get_literal_type({literal,Tuple}) when is_tuple(Tuple) -> glt_1(Tuple);
+get_literal_type({literal,_}) -> term;
+get_literal_type(T) -> error({not_literal,T}).
+
+glt_1([]) -> nil;
+glt_1(A) when is_atom(A) -> {atom, A};
+glt_1(F) when is_float(F) -> {float, F};
+glt_1(I) when is_integer(I) -> {integer, I};
+glt_1(T) when is_tuple(T) ->
+ {Es,_} = foldl(fun(Val, {Es0, Index}) ->
+ Type = glt_1(Val),
+ Es = set_element_type({integer,Index}, Type, Es0),
+ {Es, Index + 1}
+ end, {#{}, 1}, tuple_to_list(T)),
+ {tuple, tuple_size(T), Es};
+glt_1(L) ->
+ {literal, L}.
+
+%%%
+%%% Branch tracking
+%%%
+
+%% Forks the execution flow, with the provided funs returning the new state of
+%% their respective branch; the "fail" fun returns the state where the branch
+%% is taken, and the "success" fun returns the state where it's not.
+%%
+%% If either path is known not to be taken at runtime (eg. due to a type
+%% conflict), it will simply be discarded.
+-spec branch(Lbl :: label(),
+ Original :: #vst{},
+ FailFun :: BranchFun,
+ SuccFun :: BranchFun) -> #vst{} when
+ BranchFun :: fun((#vst{}) -> #vst{}).
+branch(Lbl, Vst0, FailFun, SuccFun) ->
+ #vst{current=St0} = Vst0,
+ try FailFun(Vst0) of
+ Vst1 ->
+ Vst2 = branch_state(Lbl, Vst1),
+ Vst = Vst2#vst{current=St0},
+ try SuccFun(Vst) of
+ V -> V
+ catch
+ {type_conflict, _, _} ->
+ %% The instruction is guaranteed to fail; kill the state.
+ kill_state(Vst)
+ end
+ catch
+ {type_conflict, _, _} ->
+ %% This instruction is guaranteed not to fail, so we run the
+ %% success branch *without* catching type conflicts to avoid hiding
+ %% errors in the validator itself; one of the branches must
+ %% succeed.
+ SuccFun(Vst0)
end.
-%% get_literal(Src) -> literal_value().
-get_literal(nil) -> [];
-get_literal({atom,A}) when is_atom(A) -> A;
-get_literal({float,F}) when is_float(F) -> F;
-get_literal({integer,I}) when is_integer(I) -> I;
-get_literal({literal,L}) -> L;
-get_literal(T) -> error({not_literal,T}).
-
-branch_arities([Sz,{f,L}|T], Tuple, {tuple,[_]}=Type0, Vst0) when is_integer(Sz) ->
- Vst1 = set_aliased_type({tuple,Sz}, Tuple, Vst0),
- Vst = branch_state(L, Vst1),
- branch_arities(T, Tuple, Type0, Vst);
-branch_arities([Sz,{f,L}|T], Tuple, {tuple,Sz}=Type, Vst0) when is_integer(Sz) ->
- %% The type is already correct. (This test is redundant.)
- Vst = branch_state(L, Vst0),
- branch_arities(T, Tuple, Type, Vst);
-branch_arities([Sz0,{f,_}|T], Tuple, {tuple,Sz}=Type, Vst)
- when is_integer(Sz), Sz0 =/= Sz ->
- %% We already have an established different exact size for the tuple.
- %% This label can't possibly be reached.
- branch_arities(T, Tuple, Type, Vst);
-branch_arities([], _, _, #vst{}=Vst) -> Vst.
+%% A shorthand version of branch/4 for when the state is only altered on
+%% success.
+branch(Fail, Vst, SuccFun) ->
+ branch(Fail, Vst, fun(V) -> V end, SuccFun).
+%% Directly branches off the state. This is an "internal" operation that should
+%% be used sparingly.
branch_state(0, #vst{}=Vst) ->
- %% If the instruction fails, the stack may be scanned
- %% looking for a catch tag. Therefore the Y registers
- %% must be initialized at this point.
+ %% If the instruction fails, the stack may be scanned looking for a catch
+ %% tag. Therefore the Y registers must be initialized at this point.
verify_y_init(Vst),
Vst;
-branch_state(L, #vst{current=St,branched=B}=Vst) ->
- Vst#vst{
- branched=case gb_trees:is_defined(L, B) of
- false ->
- gb_trees:insert(L, St, B);
- true ->
- MergedSt = merge_states(L, St, B),
- gb_trees:update(L, MergedSt, B)
- end}.
-
-%% merge_states/3 is used when there are more than one way to arrive
-%% at this point, and the type states for the different paths has
-%% to be merged. The type states are downgraded to the least common
-%% subset for the subsequent code.
-
-merge_states(L, St, Branched) when L =/= 0 ->
+branch_state(L, #vst{current=St,branched=B,ref_ctr=Counter0}=Vst) ->
+ case gb_trees:is_defined(L, B) of
+ true ->
+ {MergedSt, Counter} = merge_states(L, St, B, Counter0),
+ Branched = gb_trees:update(L, MergedSt, B),
+ Vst#vst{branched=Branched,ref_ctr=Counter};
+ false ->
+ Vst#vst{branched=gb_trees:insert(L, St, B)}
+ end.
+
+%% merge_states/3 is used when there's more than one way to arrive at a
+%% certain point, requiring the states to be merged down to the least
+%% common subset for the subsequent code.
+
+merge_states(L, St, Branched, Counter) when L =/= 0 ->
case gb_trees:lookup(L, Branched) of
- none -> St;
- {value,OtherSt} when St =:= none -> OtherSt;
- {value,OtherSt} -> merge_states_1(St, OtherSt)
+ none ->
+ {St, Counter};
+ {value,OtherSt} when St =:= none ->
+ {OtherSt, Counter};
+ {value,OtherSt} ->
+ merge_states_1(St, OtherSt, Counter)
+ end.
+
+merge_states_1(#st{xs=XsA,ys=YsA,vs=VsA,fragile=FragA,numy=NumYA,h=HA,ct=CtA},
+ #st{xs=XsB,ys=YsB,vs=VsB,fragile=FragB,numy=NumYB,h=HB,ct=CtB},
+ Counter0) ->
+ %% When merging registers we drop all registers that aren't defined in both
+ %% states, and resolve conflicts by creating new values (similar to phi
+ %% nodes in SSA).
+ %%
+ %% While doing this we build a "merge map" detailing which values need to
+ %% be kept and which new values need to be created to resolve conflicts.
+ %% This map is then used to create a new value database where the types of
+ %% all values have been joined.
+ {Xs, Merge0, Counter1} = merge_regs(XsA, XsB, #{}, Counter0),
+ {Ys, Merge, Counter} = merge_regs(YsA, YsB, Merge0, Counter1),
+ Vs = merge_values(Merge, VsA, VsB),
+
+ Fragile = merge_fragility(FragA, FragB),
+ NumY = merge_stk(NumYA, NumYB),
+ Ct = merge_ct(CtA, CtB),
+
+ St = #st{xs=Xs,ys=Ys,vs=Vs,fragile=Fragile,numy=NumY,h=min(HA, HB),ct=Ct},
+ {St, Counter}.
+
+%% Merges the contents of two register maps, returning the updated "merge map"
+%% and the new registers.
+merge_regs(RsA, RsB, Merge, Counter) ->
+ Keys = if
+ map_size(RsA) =< map_size(RsB) -> maps:keys(RsA);
+ map_size(RsA) > map_size(RsB) -> maps:keys(RsB)
+ end,
+ merge_regs_1(Keys, RsA, RsB, #{}, Merge, Counter).
+
+merge_regs_1([Reg | Keys], RsA, RsB, Regs, Merge0, Counter0) ->
+ case {RsA, RsB} of
+ {#{ Reg := #value_ref{}=RefA }, #{ Reg := #value_ref{}=RefB }} ->
+ {Ref, Merge, Counter} = merge_vrefs(RefA, RefB, Merge0, Counter0),
+ merge_regs_1(Keys, RsA, RsB, Regs#{ Reg => Ref }, Merge, Counter);
+ {#{ Reg := TagA }, #{ Reg := TagB }} ->
+ %% Tags describe the state of the register rather than the value it
+ %% contains, so if a register contains a tag in one state we have
+ %% to merge it as a tag regardless of whether the other state says
+ %% it's a value.
+ {y, _} = Reg, %Assertion.
+ merge_regs_1(Keys, RsA, RsB, Regs#{ Reg => merge_tags(TagA,TagB) },
+ Merge0, Counter0);
+ {#{}, #{}} ->
+ merge_regs_1(Keys, RsA, RsB, Regs, Merge0, Counter0)
+ end;
+merge_regs_1([], _, _, Regs, Merge, Counter) ->
+ {Regs, Merge, Counter}.
+
+merge_tags(Same, Same) ->
+ Same;
+merge_tags(uninitialized, _) ->
+ uninitialized;
+merge_tags(_, uninitialized) ->
+ uninitialized;
+merge_tags({catchtag,T0}, {catchtag,T1}) ->
+ {catchtag, ordsets:from_list(T0 ++ T1)};
+merge_tags({trytag,T0}, {trytag,T1}) ->
+ {trytag, ordsets:from_list(T0 ++ T1)};
+merge_tags(_A, _B) ->
+ %% All other combinations leave the register initialized. Errors arising
+ %% from this will be caught later on.
+ initialized.
+
+merge_vrefs(Ref, Ref, Merge, Counter) ->
+ %% We have two (potentially) different versions of the same value, so we
+ %% should join their types into the same value.
+ {Ref, Merge#{ Ref => Ref }, Counter};
+merge_vrefs(RefA, RefB, Merge, Counter) ->
+ %% We have two different values, so we need to create a new value from
+ %% their joined type if we haven't already done so.
+ Key = {RefA, RefB},
+ case Merge of
+ #{ Key := Ref } ->
+ {Ref, Merge, Counter};
+ #{} ->
+ Ref = #value_ref{id=Counter},
+ {Ref, Merge#{ Key => Ref }, Counter + 1}
end.
-merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0,aliases=Aliases0},
- #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1,aliases=Aliases1}) ->
- NumY = merge_stk(NumY0, NumY1),
- Xs = merge_regs(Xs0, Xs1),
- Ys = merge_y_regs(Ys0, Ys1),
- Ct = merge_ct(Ct0, Ct1),
- Aliases = merge_aliases(Aliases0, Aliases1),
- #st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct,aliases=Aliases}.
+merge_values(Merge, VsA, VsB) ->
+ maps:fold(fun(Spec, New, Acc) ->
+ merge_values_1(Spec, New, VsA, VsB, Acc)
+ end, #{}, Merge).
+
+merge_values_1(Same, Same, VsA, VsB, Acc) ->
+ %% We're merging different versions of the same value, so it's safe to
+ %% reuse old entries if the type's unchanged.
+ #value{type=TypeA}=EntryA = map_get(Same, VsA),
+ #value{type=TypeB}=EntryB = map_get(Same, VsB),
+ Entry = case join(TypeA, TypeB) of
+ TypeA -> EntryA;
+ TypeB -> EntryB;
+ JoinedType -> EntryA#value{type=JoinedType}
+ end,
+ Acc#{ Same => Entry };
+merge_values_1({RefA, RefB}, New, VsA, VsB, Acc) ->
+ #value{type=TypeA} = map_get(RefA, VsA),
+ #value{type=TypeB} = map_get(RefB, VsB),
+ Acc#{ New => #value{op=join,args=[],type=join(TypeA, TypeB)} }.
+
+merge_fragility(FragileA, FragileB) ->
+ cerl_sets:union(FragileA, FragileB).
merge_stk(S, S) -> S;
merge_stk(_, _) -> undecided.
@@ -1893,178 +2482,70 @@ merge_ct_1([C0|Ct0], [C1|Ct1]) ->
merge_ct_1([], []) -> [];
merge_ct_1(_, _) -> undecided.
-merge_regs(Rs0, Rs1) ->
- Rs = merge_regs_1(gb_trees:to_list(Rs0), gb_trees:to_list(Rs1)),
- gb_trees_from_list(Rs).
-
-merge_regs_1([Same|Rs1], [Same|Rs2]) ->
- [Same|merge_regs_1(Rs1, Rs2)];
-merge_regs_1([{R1,_}|Rs1], [{R2,_}|_]=Rs2) when R1 < R2 ->
- merge_regs_1(Rs1, Rs2);
-merge_regs_1([{R1,_}|_]=Rs1, [{R2,_}|Rs2]) when R1 > R2 ->
- merge_regs_1(Rs1, Rs2);
-merge_regs_1([{R,Type1}|Rs1], [{R,Type2}|Rs2]) ->
- [{R,join(Type1, Type2)}|merge_regs_1(Rs1, Rs2)];
-merge_regs_1([], []) -> [];
-merge_regs_1([], [_|_]) -> [];
-merge_regs_1([_|_], []) -> [].
-
-merge_y_regs(Rs0, Rs1) ->
- case {gb_trees:size(Rs0),gb_trees:size(Rs1)} of
- {Sz0,Sz1} when Sz0 < Sz1 ->
- merge_y_regs_1(Sz0-1, Rs1, Rs0);
- {_,Sz1} ->
- merge_y_regs_1(Sz1-1, Rs0, Rs1)
- end.
-
-merge_y_regs_1(Y, S, Regs0) when Y >= 0 ->
- Type0 = gb_trees:get(Y, Regs0),
- case gb_trees:get(Y, S) of
- Type0 ->
- merge_y_regs_1(Y-1, S, Regs0);
- Type1 ->
- Type = join(Type0, Type1),
- Regs = gb_trees:update(Y, Type, Regs0),
- merge_y_regs_1(Y-1, S, Regs)
- end;
-merge_y_regs_1(_, _, Regs) -> Regs.
-
-%% join(Type1, Type2) -> Type
-%% Return the most specific type possible.
-%% Note: Type1 must NOT be the same as Type2.
-join({literal,_}=T1, T2) ->
- join_literal(T1, T2);
-join(T1, {literal,_}=T2) ->
- join_literal(T2, T1);
-join({fragile,Same}=Type, Same) ->
- Type;
-join({fragile,T1}, T2) ->
- make_fragile(join(T1, T2));
-join(Same, {fragile,Same}=Type) ->
- Type;
-join(T1, {fragile,T2}) ->
- make_fragile(join(T1, T2));
-join(uninitialized=I, _) -> I;
-join(_, uninitialized=I) -> I;
-join(initialized=I, _) -> I;
-join(_, initialized=I) -> I;
-join({catchtag,T0},{catchtag,T1}) ->
- {catchtag,ordsets:from_list(T0++T1)};
-join({trytag,T0},{trytag,T1}) ->
- {trytag,ordsets:from_list(T0++T1)};
-join({tuple,A}, {tuple,B}) ->
- {tuple,[min(tuple_sz(A), tuple_sz(B))]};
-join({Type,A}, {Type,B})
- when Type =:= atom; Type =:= integer; Type =:= float ->
- if A =:= B -> {Type,A};
- true -> {Type,[]}
- end;
-join({Type,_}, number)
- when Type =:= integer; Type =:= float ->
- number;
-join(number, {Type,_})
- when Type =:= integer; Type =:= float ->
- number;
-join(bool, {atom,A}) ->
- merge_bool(A);
-join({atom,A}, bool) ->
- merge_bool(A);
-join({atom,_}, {atom,_}) ->
- {atom,[]};
-join(#ms{id=Id1,valid=B1,slots=Slots1},
- #ms{id=Id2,valid=B2,slots=Slots2}) ->
- Id = if
- Id1 =:= Id2 -> Id1;
- true -> make_ref()
- end,
- #ms{id=Id,valid=B1 band B2,slots=min(Slots1, Slots2)};
-join(T1, T2) when T1 =/= T2 ->
- %% We've exhaused all other options, so the type must either be a list or
- %% a 'term'.
- join_list(T1, T2).
+tuple_sz([Sz]) -> Sz;
+tuple_sz(Sz) -> Sz.
-%% Merges types of literals. Note that the left argument must either be a
-%% literal or exactly equal to the second argument.
-join_literal(Same, Same) ->
- Same;
-join_literal({literal,[_|_]}, T) ->
- join_literal(T, cons);
-join_literal({literal,#{}}, T) ->
- join_literal(T, map);
-join_literal({literal,Tuple}, T) when is_tuple(Tuple) ->
- join_literal(T, {tuple, tuple_size(Tuple)});
-join_literal({literal,_}, T) ->
- %% Bitstring, fun, or similar.
- join_literal(T, term);
-join_literal(T1, T2) ->
- %% We're done extracting the types, try merging them again.
- join(T1, T2).
+verify_y_init(#vst{current=#st{numy=NumY,ys=Ys}}=Vst) when is_integer(NumY) ->
+ HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys),
+ true = NumY > HighestY, %Assertion.
+ verify_y_init_1(NumY - 1, Vst),
+ ok;
+verify_y_init(#vst{current=#st{numy=undecided,ys=Ys}}=Vst) ->
+ HighestY = maps:fold(fun({y,Y}, _, Acc) -> max(Y, Acc) end, -1, Ys),
+ verify_y_init_1(HighestY, Vst);
+verify_y_init(#vst{}) ->
+ ok.
-join_list(nil, cons) -> list;
-join_list(nil, list) -> list;
-join_list(cons, list) -> list;
-join_list(T, nil) -> join_list(nil, T);
-join_list(T, cons) -> join_list(cons, T);
-join_list(_, _) ->
- %% Not a list, so it must be a term.
- term.
+verify_y_init_1(-1, _Vst) ->
+ ok;
+verify_y_init_1(Y, Vst) ->
+ Reg = {y, Y},
+ assert_not_fragile(Reg, Vst),
+ case get_raw_type(Reg, Vst) of
+ uninitialized -> error({uninitialized_reg,Reg});
+ _ -> verify_y_init_1(Y - 1, Vst)
+ end.
-tuple_sz([Sz]) -> Sz;
-tuple_sz(Sz) -> Sz.
+verify_live(0, _Vst) ->
+ ok;
+verify_live(Live, Vst) when is_integer(Live), 0 < Live, Live =< 1023 ->
+ verify_live_1(Live - 1, Vst);
+verify_live(Live, _Vst) ->
+ error({bad_number_of_live_regs,Live}).
-merge_bool([]) -> {atom,[]};
-merge_bool(true) -> bool;
-merge_bool(false) -> bool;
-merge_bool(_) -> {atom,[]}.
-
-merge_aliases(Al0, Al1) when map_size(Al0) =< map_size(Al1) ->
- maps:filter(fun(K, V) ->
- case Al1 of
- #{K:=V} -> true;
- #{} -> false
- end
- end, Al0);
-merge_aliases(Al0, Al1) ->
- merge_aliases(Al1, Al0).
-
-verify_y_init(#vst{current=#st{y=Ys}}) ->
- verify_y_init_1(gb_trees:to_list(Ys)).
-
-verify_y_init_1([]) -> ok;
-verify_y_init_1([{Y,uninitialized}|_]) ->
- error({uninitialized_reg,{y,Y}});
-verify_y_init_1([{Y,{fragile,_}}|_]) ->
- %% Unsafe. This term may be outside any heap belonging
- %% to the process and would be corrupted by a GC.
- error({fragile_message_reference,{y,Y}});
-verify_y_init_1([{_,_}|Ys]) ->
- verify_y_init_1(Ys).
-
-verify_live(0, #vst{}) -> ok;
-verify_live(N, #vst{current=#st{x=Xs}}) ->
- verify_live_1(N, Xs).
-
-verify_live_1(0, _) -> ok;
-verify_live_1(N, Xs) when is_integer(N) ->
- X = N-1,
- case gb_trees:is_defined(X, Xs) of
- false -> error({{x,X},not_live});
- true -> verify_live_1(X, Xs)
- end;
-verify_live_1(N, _) -> error({bad_number_of_live_regs,N}).
+verify_live_1(-1, _) ->
+ ok;
+verify_live_1(X, Vst) when is_integer(X) ->
+ Reg = {x, X},
+ case get_raw_type(Reg, Vst) of
+ uninitialized -> error({Reg, not_live});
+ _ -> verify_live_1(X - 1, Vst)
+ end.
-verify_no_ct(#vst{current=#st{numy=none}}) -> ok;
+verify_no_ct(#vst{current=#st{numy=none}}) ->
+ ok;
verify_no_ct(#vst{current=#st{numy=undecided}}) ->
error(unknown_size_of_stackframe);
-verify_no_ct(#vst{current=#st{y=Ys}}) ->
- case [Y || Y <- gb_trees:to_list(Ys), verify_no_ct_1(Y)] of
- [] -> ok;
- CT -> error({unfinished_catch_try,CT})
+verify_no_ct(#vst{current=St}=Vst) ->
+ case collect_try_catch_tags(St#st.numy - 1, Vst, []) of
+ [_|_]=Bad -> error({unfinished_catch_try,Bad});
+ [] -> ok
end.
-verify_no_ct_1({_, {catchtag, _}}) -> true;
-verify_no_ct_1({_, {trytag, _}}) -> true;
-verify_no_ct_1({_, _}) -> false.
+%% Collects all try/catch tags, walking down from the Nth stack position.
+collect_try_catch_tags(-1, _Vst, Acc) ->
+ Acc;
+collect_try_catch_tags(Y, Vst, Acc0) ->
+ Tag = get_raw_type({y, Y}, Vst),
+ Acc = case is_try_catch_tag(Tag) of
+ true -> [{{y, Y}, Tag} | Acc0];
+ false -> Acc0
+ end,
+ collect_try_catch_tags(Y - 1, Vst, Acc).
+
+is_try_catch_tag({catchtag,_}) -> true;
+is_try_catch_tag({trytag,_}) -> true;
+is_try_catch_tag(_) -> false.
eat_heap(N, #vst{current=#st{h=Heap0}=St}=Vst) ->
case Heap0-N of
@@ -2082,92 +2563,190 @@ eat_heap_float(#vst{current=#st{hf=HeapFloats0}=St}=Vst) ->
Vst#vst{current=St#st{hf=HeapFloats}}
end.
-remove_fragility(#vst{current=#st{x=Xs0,y=Ys0}=St0}=Vst) ->
- F = fun(_, {fragile,Type}) -> Type;
- (_, Type) -> Type
- end,
- Xs = gb_trees:map(F, Xs0),
- Ys = gb_trees:map(F, Ys0),
- St = St0#st{x=Xs,y=Ys},
+%%% FRAGILITY
+%%%
+%%% The loop_rec/2 instruction may return a reference to a term that is not
+%%% part of the root set. That term or any part of it must not be included in a
+%%% garbage collection. Therefore, the term (or any part of it) must not be
+%%% passed to another function, placed in another term, or live in a Y register
+%%% over an instruction that may GC.
+%%%
+%%% Fragility is marked on a per-register (rather than per-value) basis.
+
+%% Marks Reg as fragile.
+mark_fragile(Reg, Vst) ->
+ #vst{current=#st{fragile=Fragile0}=St0} = Vst,
+ Fragile = cerl_sets:add_element(Reg, Fragile0),
+ St = St0#st{fragile=Fragile},
Vst#vst{current=St}.
-propagate_fragility(Type, Ss, Vst) ->
- F = fun(S) ->
- case get_term_type_1(S, Vst) of
- {fragile,_} -> true;
- _ -> false
- end
- end,
- case any(F, Ss) of
- true -> make_fragile(Type);
- false -> Type
+propagate_fragility(Reg, Args, #vst{current=St0}=Vst) ->
+ #st{fragile=Fragile0} = St0,
+
+ Sources = cerl_sets:from_list(Args),
+ Fragile = case cerl_sets:is_disjoint(Sources, Fragile0) of
+ true -> cerl_sets:del_element(Reg, Fragile0);
+ false -> cerl_sets:add_element(Reg, Fragile0)
+ end,
+
+ St = St0#st{fragile=Fragile},
+ Vst#vst{current=St}.
+
+%% Marks Reg as durable, must be used when assigning a newly created value to
+%% a register.
+remove_fragility(Reg, Vst) ->
+ #vst{current=#st{fragile=Fragile0}=St0} = Vst,
+ case cerl_sets:is_element(Reg, Fragile0) of
+ true ->
+ Fragile = cerl_sets:del_element(Reg, Fragile0),
+ St = St0#st{fragile=Fragile},
+ Vst#vst{current=St};
+ false ->
+ Vst
end.
-bif_type('-', Src, Vst) ->
- arith_type(Src, Vst);
-bif_type('+', Src, Vst) ->
- arith_type(Src, Vst);
-bif_type('*', Src, Vst) ->
- arith_type(Src, Vst);
-bif_type(abs, [Num], Vst) ->
+%% Marks all registers as durable.
+remove_fragility(#vst{current=St0}=Vst) ->
+ St = St0#st{fragile=cerl_sets:new()},
+ Vst#vst{current=St}.
+
+assert_durable_term(Src, Vst) ->
+ assert_term(Src, Vst),
+ assert_not_fragile(Src, Vst).
+
+assert_not_fragile({Kind,_}=Src, Vst) when Kind =:= x; Kind =:= y ->
+ check_limit(Src),
+ #vst{current=#st{fragile=Fragile}} = Vst,
+ case cerl_sets:is_element(Src, Fragile) of
+ true -> error({fragile_message_reference, Src});
+ false -> ok
+ end;
+assert_not_fragile(Lit, #vst{}) ->
+ assert_literal(Lit),
+ ok.
+
+%%%
+%%% Return/argument types of BIFs
+%%%
+
+bif_return_type('-', Src, Vst) ->
+ arith_return_type(Src, Vst);
+bif_return_type('+', Src, Vst) ->
+ arith_return_type(Src, Vst);
+bif_return_type('*', Src, Vst) ->
+ arith_return_type(Src, Vst);
+bif_return_type(abs, [Num], Vst) ->
case get_term_type(Num, Vst) of
- {float,_}=T -> T;
- {integer,_}=T -> T;
- _ -> number
+ {float,_}=T -> T;
+ {integer,_}=T -> T;
+ _ -> number
end;
-bif_type(float, _, _) -> {float,[]};
-bif_type('/', _, _) -> {float,[]};
+bif_return_type(float, _, _) -> {float,[]};
+bif_return_type('/', _, _) -> {float,[]};
%% Binary operations
-bif_type('byte_size', _, _) -> {integer,[]};
-bif_type('bit_size', _, _) -> {integer,[]};
+bif_return_type('binary_part', [_,_], _) -> binary;
+bif_return_type('binary_part', [_,_,_], _) -> binary;
+bif_return_type('bit_size', [_], _) -> {integer,[]};
+bif_return_type('byte_size', [_], _) -> {integer,[]};
%% Integer operations.
-bif_type(ceil, [_], _) -> {integer,[]};
-bif_type('div', [_,_], _) -> {integer,[]};
-bif_type(floor, [_], _) -> {integer,[]};
-bif_type('rem', [_,_], _) -> {integer,[]};
-bif_type(length, [_], _) -> {integer,[]};
-bif_type(size, [_], _) -> {integer,[]};
-bif_type(trunc, [_], _) -> {integer,[]};
-bif_type(round, [_], _) -> {integer,[]};
-bif_type('band', [_,_], _) -> {integer,[]};
-bif_type('bor', [_,_], _) -> {integer,[]};
-bif_type('bxor', [_,_], _) -> {integer,[]};
-bif_type('bnot', [_], _) -> {integer,[]};
-bif_type('bsl', [_,_], _) -> {integer,[]};
-bif_type('bsr', [_,_], _) -> {integer,[]};
+bif_return_type(ceil, [_], _) -> {integer,[]};
+bif_return_type('div', [_,_], _) -> {integer,[]};
+bif_return_type(floor, [_], _) -> {integer,[]};
+bif_return_type('rem', [_,_], _) -> {integer,[]};
+bif_return_type(length, [_], _) -> {integer,[]};
+bif_return_type(size, [_], _) -> {integer,[]};
+bif_return_type(trunc, [_], _) -> {integer,[]};
+bif_return_type(round, [_], _) -> {integer,[]};
+bif_return_type('band', [_,_], _) -> {integer,[]};
+bif_return_type('bor', [_,_], _) -> {integer,[]};
+bif_return_type('bxor', [_,_], _) -> {integer,[]};
+bif_return_type('bnot', [_], _) -> {integer,[]};
+bif_return_type('bsl', [_,_], _) -> {integer,[]};
+bif_return_type('bsr', [_,_], _) -> {integer,[]};
%% Booleans.
-bif_type('==', [_,_], _) -> bool;
-bif_type('/=', [_,_], _) -> bool;
-bif_type('=<', [_,_], _) -> bool;
-bif_type('<', [_,_], _) -> bool;
-bif_type('>=', [_,_], _) -> bool;
-bif_type('>', [_,_], _) -> bool;
-bif_type('=:=', [_,_], _) -> bool;
-bif_type('=/=', [_,_], _) -> bool;
-bif_type('not', [_], _) -> bool;
-bif_type('and', [_,_], _) -> bool;
-bif_type('or', [_,_], _) -> bool;
-bif_type('xor', [_,_], _) -> bool;
-bif_type(is_atom, [_], _) -> bool;
-bif_type(is_boolean, [_], _) -> bool;
-bif_type(is_binary, [_], _) -> bool;
-bif_type(is_float, [_], _) -> bool;
-bif_type(is_function, [_], _) -> bool;
-bif_type(is_integer, [_], _) -> bool;
-bif_type(is_list, [_], _) -> bool;
-bif_type(is_map, [_], _) -> bool;
-bif_type(is_number, [_], _) -> bool;
-bif_type(is_pid, [_], _) -> bool;
-bif_type(is_port, [_], _) -> bool;
-bif_type(is_reference, [_], _) -> bool;
-bif_type(is_tuple, [_], _) -> bool;
+bif_return_type('==', [_,_], _) -> bool;
+bif_return_type('/=', [_,_], _) -> bool;
+bif_return_type('=<', [_,_], _) -> bool;
+bif_return_type('<', [_,_], _) -> bool;
+bif_return_type('>=', [_,_], _) -> bool;
+bif_return_type('>', [_,_], _) -> bool;
+bif_return_type('=:=', [_,_], _) -> bool;
+bif_return_type('=/=', [_,_], _) -> bool;
+bif_return_type('not', [_], _) -> bool;
+bif_return_type('and', [_,_], _) -> bool;
+bif_return_type('or', [_,_], _) -> bool;
+bif_return_type('xor', [_,_], _) -> bool;
+bif_return_type(is_atom, [_], _) -> bool;
+bif_return_type(is_boolean, [_], _) -> bool;
+bif_return_type(is_binary, [_], _) -> bool;
+bif_return_type(is_float, [_], _) -> bool;
+bif_return_type(is_function, [_], _) -> bool;
+bif_return_type(is_function, [_,_], _) -> bool;
+bif_return_type(is_integer, [_], _) -> bool;
+bif_return_type(is_list, [_], _) -> bool;
+bif_return_type(is_map, [_], _) -> bool;
+bif_return_type(is_number, [_], _) -> bool;
+bif_return_type(is_pid, [_], _) -> bool;
+bif_return_type(is_port, [_], _) -> bool;
+bif_return_type(is_reference, [_], _) -> bool;
+bif_return_type(is_tuple, [_], _) -> bool;
%% Misc.
-bif_type(node, [], _) -> {atom,[]};
-bif_type(node, [_], _) -> {atom,[]};
-bif_type(hd, [_], _) -> term;
-bif_type(tl, [_], _) -> term;
-bif_type(get, [_], _) -> term;
-bif_type(Bif, _, _) when is_atom(Bif) -> term.
+bif_return_type(tuple_size, [_], _) -> {integer,[]};
+bif_return_type(map_size, [_], _) -> {integer,[]};
+bif_return_type(node, [], _) -> {atom,[]};
+bif_return_type(node, [_], _) -> {atom,[]};
+bif_return_type(hd, [_], _) -> term;
+bif_return_type(tl, [_], _) -> term;
+bif_return_type(get, [_], _) -> term;
+bif_return_type(Bif, _, _) when is_atom(Bif) -> term.
+
+%% Generic
+bif_arg_types(tuple_size, [_]) -> [{tuple,[0],#{}}];
+bif_arg_types(map_size, [_]) -> [map];
+bif_arg_types(is_map_key, [_,_]) -> [term, map];
+bif_arg_types(map_get, [_,_]) -> [term, map];
+bif_arg_types(length, [_]) -> [list];
+bif_arg_types(hd, [_]) -> [cons];
+bif_arg_types(tl, [_]) -> [cons];
+%% Boolean
+bif_arg_types('not', [_]) -> [bool];
+bif_arg_types('and', [_,_]) -> [bool, bool];
+bif_arg_types('or', [_,_]) -> [bool, bool];
+bif_arg_types('xor', [_,_]) -> [bool, bool];
+%% Binary
+bif_arg_types('binary_part', [_,_]) ->
+ PosLen = {tuple, 2, #{ {integer,1} => {integer,[]},
+ {integer,2} => {integer,[]} }},
+ [binary, PosLen];
+bif_arg_types('binary_part', [_,_,_]) ->
+ [binary, {integer,[]}, {integer,[]}];
+bif_arg_types('bit_size', [_]) -> [binary];
+bif_arg_types('byte_size', [_]) -> [binary];
+%% Numerical
+bif_arg_types('-', [_]) -> [number];
+bif_arg_types('-', [_,_]) -> [number,number];
+bif_arg_types('+', [_]) -> [number];
+bif_arg_types('+', [_,_]) -> [number,number];
+bif_arg_types('*', [_,_]) -> [number, number];
+bif_arg_types('/', [_,_]) -> [number, number];
+bif_arg_types(abs, [_]) -> [number];
+bif_arg_types(ceil, [_]) -> [number];
+bif_arg_types(float, [_]) -> [number];
+bif_arg_types(floor, [_]) -> [number];
+bif_arg_types(trunc, [_]) -> [number];
+bif_arg_types(round, [_]) -> [number];
+%% Integer-specific
+bif_arg_types('div', [_,_]) -> [{integer,[]}, {integer,[]}];
+bif_arg_types('rem', [_,_]) -> [{integer,[]}, {integer,[]}];
+bif_arg_types('band', [_,_]) -> [{integer,[]}, {integer,[]}];
+bif_arg_types('bor', [_,_]) -> [{integer,[]}, {integer,[]}];
+bif_arg_types('bxor', [_,_]) -> [{integer,[]}, {integer,[]}];
+bif_arg_types('bnot', [_]) -> [{integer,[]}];
+bif_arg_types('bsl', [_,_]) -> [{integer,[]}, {integer,[]}];
+bif_arg_types('bsr', [_,_]) -> [{integer,[]}, {integer,[]}];
+%% Unsafe type tests that may fail if an argument doesn't have the right type.
+bif_arg_types(is_function, [_,_]) -> [term, {integer,[]}];
+bif_arg_types(_, Args) -> [term || _Arg <- Args].
is_bif_safe('/=', 2) -> true;
is_bif_safe('<', 2) -> true;
@@ -2196,102 +2775,200 @@ is_bif_safe(self, 0) -> true;
is_bif_safe(node, 0) -> true;
is_bif_safe(_, _) -> false.
-arith_type([A], Vst) ->
+arith_return_type([A], Vst) ->
%% Unary '+' or '-'.
case get_term_type(A, Vst) of
{integer,_} -> {integer,[]};
{float,_} -> {float,[]};
_ -> number
end;
-arith_type([A,B], Vst) ->
- case {get_term_type(A, Vst),get_term_type(B, Vst)} of
+arith_return_type([A,B], Vst) ->
+ TypeA = get_term_type(A, Vst),
+ TypeB = get_term_type(B, Vst),
+ case {TypeA, TypeB} of
{{integer,_},{integer,_}} -> {integer,[]};
{{float,_},_} -> {float,[]};
{_,{float,_}} -> {float,[]};
{_,_} -> number
end;
-arith_type(_, _) -> number.
+arith_return_type(_, _) -> number.
-return_type({extfunc,M,F,A}, Vst) -> return_type_1(M, F, A, Vst);
-return_type(_, _) -> term.
+%%%
+%%% Return/argument types of calls
+%%%
+
+call_return_type({extfunc,M,F,A}, Vst) -> call_return_type_1(M, F, A, Vst);
+call_return_type(_, _) -> term.
-return_type_1(erlang, setelement, 3, Vst) ->
- Tuple = {x,1},
+call_return_type_1(erlang, setelement, 3, Vst) ->
+ IndexType = get_term_type({x,0}, Vst),
TupleType =
- case get_term_type(Tuple, Vst) of
- {tuple,_}=TT ->
- TT;
- {literal,Lit} when is_tuple(Lit) ->
- {tuple,tuple_size(Lit)};
- _ ->
- {tuple,[0]}
- end,
- case get_term_type({x,0}, Vst) of
- {integer,[]} -> TupleType;
- {integer,I} -> upgrade_tuple_type({tuple,[I]}, TupleType);
- _ -> TupleType
+ case get_term_type({x,1}, Vst) of
+ {literal,Tuple}=Lit when is_tuple(Tuple) -> get_literal_type(Lit);
+ {tuple,_,_}=TT -> TT;
+ _ -> {tuple,[0],#{}}
+ end,
+ case IndexType of
+ {integer,I} when is_integer(I) ->
+ case meet({tuple,[I],#{}}, TupleType) of
+ {tuple, Sz, Es0} ->
+ ValueType = get_term_type({x,2}, Vst),
+ Es = set_element_type({integer,I}, ValueType, Es0),
+ {tuple, Sz, Es};
+ none ->
+ TupleType
+ end;
+ _ ->
+ %% The index could point anywhere, so we must discard all element
+ %% information.
+ setelement(3, TupleType, #{})
end;
-return_type_1(erlang, '++', 2, Vst) ->
+call_return_type_1(erlang, '++', 2, Vst) ->
case get_term_type({x,0}, Vst) =:= cons orelse
get_term_type({x,1}, Vst) =:= cons of
true -> cons;
false -> list
end;
-return_type_1(erlang, '--', 2, _Vst) ->
+call_return_type_1(erlang, '--', 2, _Vst) ->
list;
-return_type_1(erlang, F, A, _) ->
- return_type_erl(F, A);
-return_type_1(math, F, A, _) ->
- return_type_math(F, A);
-return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 ->
+call_return_type_1(erlang, F, A, _) ->
+ erlang_mod_return_type(F, A);
+call_return_type_1(lists, F, A, Vst) ->
+ lists_mod_return_type(F, A, Vst);
+call_return_type_1(math, F, A, _) ->
+ math_mod_return_type(F, A);
+call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 ->
term.
-return_type_erl(exit, 1) -> exception;
-return_type_erl(throw, 1) -> exception;
-return_type_erl(error, 1) -> exception;
-return_type_erl(error, 2) -> exception;
-return_type_erl(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
-
-return_type_math(cos, 1) -> {float,[]};
-return_type_math(cosh, 1) -> {float,[]};
-return_type_math(sin, 1) -> {float,[]};
-return_type_math(sinh, 1) -> {float,[]};
-return_type_math(tan, 1) -> {float,[]};
-return_type_math(tanh, 1) -> {float,[]};
-return_type_math(acos, 1) -> {float,[]};
-return_type_math(acosh, 1) -> {float,[]};
-return_type_math(asin, 1) -> {float,[]};
-return_type_math(asinh, 1) -> {float,[]};
-return_type_math(atan, 1) -> {float,[]};
-return_type_math(atanh, 1) -> {float,[]};
-return_type_math(erf, 1) -> {float,[]};
-return_type_math(erfc, 1) -> {float,[]};
-return_type_math(exp, 1) -> {float,[]};
-return_type_math(log, 1) -> {float,[]};
-return_type_math(log2, 1) -> {float,[]};
-return_type_math(log10, 1) -> {float,[]};
-return_type_math(sqrt, 1) -> {float,[]};
-return_type_math(atan2, 2) -> {float,[]};
-return_type_math(pow, 2) -> {float,[]};
-return_type_math(ceil, 1) -> {float,[]};
-return_type_math(floor, 1) -> {float,[]};
-return_type_math(fmod, 2) -> {float,[]};
-return_type_math(pi, 0) -> {float,[]};
-return_type_math(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
-
-check_limit({x,X}) when is_integer(X), X < 1023 ->
- %% Note: x(1023) is reserved for use by the BEAM loader.
- ok;
-check_limit({y,Y}) when is_integer(Y), Y < 1024 ->
- ok;
-check_limit({fr,Fr}) when is_integer(Fr), Fr < 1024 ->
- ok;
-check_limit(_) ->
- error(limit).
+erlang_mod_return_type(exit, 1) -> exception;
+erlang_mod_return_type(throw, 1) -> exception;
+erlang_mod_return_type(error, 1) -> exception;
+erlang_mod_return_type(error, 2) -> exception;
+erlang_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
+
+math_mod_return_type(cos, 1) -> {float,[]};
+math_mod_return_type(cosh, 1) -> {float,[]};
+math_mod_return_type(sin, 1) -> {float,[]};
+math_mod_return_type(sinh, 1) -> {float,[]};
+math_mod_return_type(tan, 1) -> {float,[]};
+math_mod_return_type(tanh, 1) -> {float,[]};
+math_mod_return_type(acos, 1) -> {float,[]};
+math_mod_return_type(acosh, 1) -> {float,[]};
+math_mod_return_type(asin, 1) -> {float,[]};
+math_mod_return_type(asinh, 1) -> {float,[]};
+math_mod_return_type(atan, 1) -> {float,[]};
+math_mod_return_type(atanh, 1) -> {float,[]};
+math_mod_return_type(erf, 1) -> {float,[]};
+math_mod_return_type(erfc, 1) -> {float,[]};
+math_mod_return_type(exp, 1) -> {float,[]};
+math_mod_return_type(log, 1) -> {float,[]};
+math_mod_return_type(log2, 1) -> {float,[]};
+math_mod_return_type(log10, 1) -> {float,[]};
+math_mod_return_type(sqrt, 1) -> {float,[]};
+math_mod_return_type(atan2, 2) -> {float,[]};
+math_mod_return_type(pow, 2) -> {float,[]};
+math_mod_return_type(ceil, 1) -> {float,[]};
+math_mod_return_type(floor, 1) -> {float,[]};
+math_mod_return_type(fmod, 2) -> {float,[]};
+math_mod_return_type(pi, 0) -> {float,[]};
+math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term.
+
+lists_mod_return_type(all, 2, _Vst) ->
+ bool;
+lists_mod_return_type(any, 2, _Vst) ->
+ bool;
+lists_mod_return_type(keymember, 3, _Vst) ->
+ bool;
+lists_mod_return_type(member, 2, _Vst) ->
+ bool;
+lists_mod_return_type(prefix, 2, _Vst) ->
+ bool;
+lists_mod_return_type(suffix, 2, _Vst) ->
+ bool;
+lists_mod_return_type(dropwhile, 2, _Vst) ->
+ list;
+lists_mod_return_type(duplicate, 2, _Vst) ->
+ list;
+lists_mod_return_type(filter, 2, _Vst) ->
+ list;
+lists_mod_return_type(flatten, 1, _Vst) ->
+ list;
+lists_mod_return_type(flatten, 2, _Vst) ->
+ list;
+lists_mod_return_type(map, 2, Vst) ->
+ same_length_type({x,1}, Vst);
+lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr ->
+ ListType = same_length_type({x,2}, Vst),
+ {tuple,2,#{ {integer,1} => ListType} };
+lists_mod_return_type(partition, 2, _Vst) ->
+ two_tuple(list, list);
+lists_mod_return_type(reverse, 1, Vst) ->
+ same_length_type({x,0}, Vst);
+lists_mod_return_type(seq, 2, _Vst) ->
+ list;
+lists_mod_return_type(seq, 3, _Vst) ->
+ list;
+lists_mod_return_type(sort, 1, Vst) ->
+ same_length_type({x,0}, Vst);
+lists_mod_return_type(sort, 2, Vst) ->
+ same_length_type({x,1}, Vst);
+lists_mod_return_type(splitwith, 2, _Vst) ->
+ two_tuple(list, list);
+lists_mod_return_type(takewhile, 2, _Vst) ->
+ list;
+lists_mod_return_type(unzip, 1, Vst) ->
+ ListType = same_length_type({x,0}, Vst),
+ two_tuple(ListType, ListType);
+lists_mod_return_type(usort, 1, Vst) ->
+ same_length_type({x,0}, Vst);
+lists_mod_return_type(usort, 2, Vst) ->
+ same_length_type({x,1}, Vst);
+lists_mod_return_type(zip, 2, _Vst) ->
+ list;
+lists_mod_return_type(zip3, 3, _Vst) ->
+ list;
+lists_mod_return_type(zipwith, 3, _Vst) ->
+ list;
+lists_mod_return_type(zipwith3, 4, _Vst) ->
+ list;
+lists_mod_return_type(_, _, _) ->
+ term.
+
+two_tuple(Type1, Type2) ->
+ {tuple,2,#{ {integer,1} => Type1,
+ {integer,2} => Type2 }}.
+
+same_length_type(Reg, Vst) ->
+ case get_term_type(Reg, Vst) of
+ {literal,[_|_]} -> cons;
+ cons -> cons;
+ nil -> nil;
+ _ -> list
+ end.
+
+check_limit({x,X}=Src) when is_integer(X) ->
+ if
+ %% Note: x(1023) is reserved for use by the BEAM loader.
+ 0 =< X, X < 1023 -> ok;
+ 1023 =< X -> error(limit);
+ X < 0 -> error({bad_register, Src})
+ end;
+check_limit({y,Y}=Src) when is_integer(Y) ->
+ if
+ 0 =< Y, Y < 1024 -> ok;
+ 1024 =< Y -> error(limit);
+ Y < 0 -> error({bad_register, Src})
+ end;
+check_limit({fr,Fr}=Src) when is_integer(Fr) ->
+ if
+ 0 =< Fr, Fr < 1023 -> ok;
+ 1023 =< Fr -> error(limit);
+ Fr < 0 -> error({bad_register, Src})
+ end.
min(A, B) when is_integer(A), is_integer(B), A < B -> A;
min(A, B) when is_integer(A), is_integer(B) -> B.
-gb_trees_from_list(L) -> gb_trees:from_orddict(lists:sort(L)).
+gb_trees_from_list(L) -> gb_trees:from_orddict(sort(L)).
error(Error) -> throw(Error).
diff --git a/lib/compiler/src/cerl_sets.erl b/lib/compiler/src/cerl_sets.erl
index 0361186713..f489baf238 100644
--- a/lib/compiler/src/cerl_sets.erl
+++ b/lib/compiler/src/cerl_sets.erl
@@ -204,4 +204,4 @@ fold(F, Init, D) ->
Set2 :: set(Element).
filter(F, D) ->
- maps:from_list(lists:filter(fun({K,_}) -> F(K) end, maps:to_list(D))).
+ maps:filter(fun(K,_) -> F(K) end, D).
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 53d3cec2d7..11dea9524b 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -814,8 +814,6 @@ kernel_passes() ->
%% Optimizations that must be done after all other optimizations.
[{pass,sys_core_bsm},
{iff,dcbsm,{listing,"core_bsm"}},
- {pass,sys_core_dsetel},
- {iff,dsetel,{listing,"dsetel"}},
{iff,clint,?pass(core_lint_module)},
{iff,core,?pass(save_core_code)},
@@ -827,20 +825,21 @@ kernel_passes() ->
{pass,beam_kernel_to_ssa},
{iff,dssa,{listing,"ssa"}},
{iff,ssalint,{pass,beam_ssa_lint}},
- {unless,no_share_opt,{pass,beam_ssa_share}},
- {iff,dssashare,{listing,"ssashare"}},
- {iff,ssalint,{pass,beam_ssa_lint}},
- {unless,no_bsm_opt,{pass,beam_ssa_bsm}},
- {iff,dssabsm,{listing,"ssabsm"}},
- {iff,ssalint,{pass,beam_ssa_lint}},
- {unless,no_fun_opt,{pass,beam_ssa_funs}},
- {iff,dssafuns,{listing,"ssafuns"}},
- {iff,ssalint,{pass,beam_ssa_lint}},
- {unless,no_ssa_opt,{pass,beam_ssa_opt}},
- {iff,dssaopt,{listing,"ssaopt"}},
- {iff,ssalint,{pass,beam_ssa_lint}},
- {unless,no_recv_opt,{pass,beam_ssa_recv}},
- {iff,drecv,{listing,"recv"}},
+ {delay,
+ [{unless,no_share_opt,{pass,beam_ssa_share}},
+ {iff,dssashare,{listing,"ssashare"}},
+ {iff,ssalint,{pass,beam_ssa_lint}},
+ {unless,no_bsm_opt,{pass,beam_ssa_bsm}},
+ {iff,dssabsm,{listing,"ssabsm"}},
+ {iff,ssalint,{pass,beam_ssa_lint}},
+ {unless,no_fun_opt,{pass,beam_ssa_funs}},
+ {iff,dssafuns,{listing,"ssafuns"}},
+ {iff,ssalint,{pass,beam_ssa_lint}},
+ {unless,no_ssa_opt,{pass,beam_ssa_opt}},
+ {iff,dssaopt,{listing,"ssaopt"}},
+ {iff,ssalint,{pass,beam_ssa_lint}},
+ {unless,no_recv_opt,{pass,beam_ssa_recv}},
+ {iff,drecv,{listing,"recv"}}]},
{pass,beam_ssa_pre_codegen},
{iff,dprecg,{listing,"precodegen"}},
{iff,ssalint,{pass,beam_ssa_lint}},
@@ -2121,7 +2120,6 @@ pre_load() ->
erl_scan,
sys_core_alias,
sys_core_bsm,
- sys_core_dsetel,
sys_core_fold,
v3_core,
v3_kernel],
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 108a0ca100..a086a3a8d3 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -65,7 +65,6 @@
rec_env,
sys_core_alias,
sys_core_bsm,
- sys_core_dsetel,
sys_core_fold,
sys_core_fold_lists,
sys_core_inline,
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index d925decce6..94a5dfe012 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -32,6 +32,22 @@
%% Returns `true' if the function `Module:Name/Arity' does not
%% affect the state, nor depend on the state, although its
%% evaluation is not guaranteed to complete normally for all input.
+%%
+%% NOTE: There is no need to include every new pure BIF
+%% here. Including it here means that the value of the function
+%% will be evaluated at compile-time if the arguments are
+%% constant. If that optimization is not useful/desired, there is
+%% no need to include the new BIF here.
+%%
+%% Functions whose return value could conceivably change in a
+%% future version of the runtime system must NOT be included here.
+%%
+%% Here are some example of functions that should not be
+%% included: `term_to_binary/1', hashing functions, non-trivial
+%% encode/decode functions.
+%%
+%% When unsure whether a new BIF should be included here, the
+%% conservative safe choice is NOT to include it.
-spec is_pure(atom(), atom(), arity()) -> boolean().
diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl
deleted file mode 100644
index 9ab83c210f..0000000000
--- a/lib/compiler/src/sys_core_dsetel.erl
+++ /dev/null
@@ -1,360 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2018. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-%% Purpose : Using dsetelement to make multiple-field record updates
-%% faster.
-
-%% The expansion of record field updates, when more than one field is
-%% updated, but not a majority of the fields, will create a sequence of
-%% calls to 'erlang:setelement(Index, Value, Tuple)' where Tuple in the
-%% first call is the original record tuple, and in the subsequent calls
-%% Tuple is the result of the previous call. Furthermore, all Index
-%% values are constant positive integers, and the first call to
-%% 'setelement' will have the greatest index. Thus all the following
-%% calls do not actually need to test at run-time whether Tuple has type
-%% tuple, nor that the index is within the tuple bounds.
-%%
-%% Since this introduces destructive updates in the Core Erlang code, it
-%% must be done as a last stage before going to lower-level code.
-%%
-%% NOTE: Because there are currently no write barriers in the system,
-%% this kind of optimization can only be done when we are sure that
-%% garbage collection will not be triggered between the creation of the
-%% tuple and the destructive updates - otherwise we might insert
-%% pointers from an older generation to a newer.
-%%
-%% The rewriting is done as follows:
-%%
-%% let X1 = call 'erlang':'setelement(5, Tuple, Value1)
-%% in call 'erlang':'setelement(3, X1, Value2)
-%% =>
-%% let X1 = call 'erlang':'setelement(5, Tuple, Value1)
-%% in do primop dsetelement(3, X1, Value2)
-%% X1
-%% and
-%% let X1 = call 'erlang':'setelement(5, Tuple, Value1)
-%% in let X2 = call 'erlang':'setelement(3, X1, Value2)
-%% in ...
-%% =>
-%% let X2 = call 'erlang':'setelement(5, Tuple, Value1)
-%% in do primop 'dsetelement(3, X2, Value2)
-%% ...
-%% if X1 is used exactly once.
-%% Thus, we need to track variable usage.
-%%
-
--module(sys_core_dsetel).
-
--export([module/2]).
-
--include("core_parse.hrl").
-
--spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module()}.
-
-module(M0, _Options) ->
- M = visit_module(M0),
- {ok,M}.
-
-visit_module(#c_module{defs=Ds0}=R) ->
- Env = #{},
- Ds = visit_module_1(Ds0, Env, []),
- R#c_module{defs=Ds}.
-
-visit_module_1([{Name,F0}|Fs], Env, Acc) ->
- try visit(Env, F0) of
- {F,_} ->
- visit_module_1(Fs, Env, [{Name,F}|Acc])
- catch
- Class:Error:Stack ->
- #c_var{name={Func,Arity}} = Name,
- io:fwrite("Function: ~w/~w\n", [Func,Arity]),
- erlang:raise(Class, Error, Stack)
- end;
-visit_module_1([], _, Acc) ->
- lists:reverse(Acc).
-
-visit(Env, #c_var{name={_,_}}=R) ->
- %% Ignore local function name.
- {R, Env};
-visit(Env0, #c_var{name=X}=R) ->
- %% There should not be any free variables. If there are,
- %% the case will fail with an exception.
- case Env0 of
- #{X:=N} ->
- {R, Env0#{X:=N+1}}
- end;
-visit(Env, #c_literal{}=R) ->
- {R, Env};
-visit(Env0, #c_tuple{es=Es0}=R) ->
- {Es1,Env1} = visit_list(Env0, Es0),
- {R#c_tuple{es=Es1}, Env1};
-visit(Env0, #c_map{es=Es0}=R) ->
- {Es1,Env1} = visit_list(Env0, Es0),
- {R#c_map{es=Es1}, Env1};
-visit(Env0, #c_map_pair{key=K0,val=V0}=R) ->
- {K,Env1} = visit(Env0, K0),
- {V,Env2} = visit(Env1, V0),
- {R#c_map_pair{key=K,val=V}, Env2};
-visit(Env0, #c_cons{hd=H0,tl=T0}=R) ->
- {H1,Env1} = visit(Env0, H0),
- {T1,Env2} = visit(Env1, T0),
- {R#c_cons{hd=H1,tl=T1}, Env2};
-visit(Env0, #c_binary{segments=Segs}=R) ->
- Env = visit_bin_segs(Env0, Segs),
- {R, Env};
-visit(Env0, #c_values{es=Es0}=R) ->
- {Es1,Env1} = visit_list(Env0, Es0),
- {R#c_values{es=Es1}, Env1};
-visit(Env0, #c_fun{vars=Vs, body=B0}=R) ->
- {Xs, Env1} = bind_vars(Vs, Env0),
- {B1,Env2} = visit(Env1, B0),
- {R#c_fun{body=B1}, restore_vars(Xs, Env0, Env2)};
-visit(Env0, #c_let{vars=Vs, arg=A0, body=B0}=R) ->
- {A1,Env1} = visit(Env0, A0),
- {Xs,Env2} = bind_vars(Vs, Env1),
- {B1,Env3} = visit(Env2, B0),
- rewrite(R#c_let{arg=A1,body=B1}, Env3, restore_vars(Xs, Env1, Env3));
-visit(Env0, #c_seq{arg=A0, body=B0}=R) ->
- {A1,Env1} = visit(Env0, A0),
- {B1,Env2} = visit(Env1, B0),
- {R#c_seq{arg=A1,body=B1}, Env2};
-visit(Env0, #c_case{arg=A0,clauses=Cs0}=R) ->
- {A1,Env1} = visit(Env0, A0),
- {Cs1,Env2} = visit_list(Env1, Cs0),
- {R#c_case{arg=A1,clauses=Cs1}, Env2};
-visit(Env0, #c_clause{pats=Ps,guard=G0,body=B0}=R) ->
- {Vs, Env1} = visit_pats(Ps, Env0),
- {G1,Env2} = visit(Env1, G0),
- {B1,Env3} = visit(Env2, B0),
- {R#c_clause{guard=G1,body=B1}, restore_vars(Vs, Env0, Env3)};
-visit(Env0, #c_receive{clauses=Cs0,timeout=T0,action=A0}=R) ->
- {T1,Env1} = visit(Env0, T0),
- {Cs1,Env2} = visit_list(Env1, Cs0),
- {A1,Env3} = visit(Env2, A0),
- {R#c_receive{clauses=Cs1,timeout=T1,action=A1}, Env3};
-visit(Env0, #c_apply{op=Op0, args=As0}=R) ->
- {Op1,Env1} = visit(Env0, Op0),
- {As1,Env2} = visit_list(Env1, As0),
- {R#c_apply{op=Op1,args=As1}, Env2};
-visit(Env0, #c_call{module=M0,name=N0,args=As0}=R) ->
- {M1,Env1} = visit(Env0, M0),
- {N1,Env2} = visit(Env1, N0),
- {As1,Env3} = visit_list(Env2, As0),
- {R#c_call{module=M1,name=N1,args=As1}, Env3};
-visit(Env0, #c_primop{name=N0, args=As0}=R) ->
- {N1,Env1} = visit(Env0, N0),
- {As1,Env2} = visit_list(Env1, As0),
- {R#c_primop{name=N1,args=As1}, Env2};
-visit(Env0, #c_try{arg=E0, vars=Vs, body=B0, evars=Evs, handler=H0}=R) ->
- {E1,Env1} = visit(Env0, E0),
- {Xs, Env2} = bind_vars(Vs, Env1),
- {B1,Env3} = visit(Env2, B0),
- Env4 = restore_vars(Xs, Env1, Env3),
- {Ys, Env5} = bind_vars(Evs, Env4),
- {H1,Env6} = visit(Env5, H0),
- {R#c_try{arg=E1,body=B1,handler=H1}, restore_vars(Ys, Env4, Env6)};
-visit(Env0, #c_catch{body=B0}=R) ->
- {B1,Env1} = visit(Env0, B0),
- {R#c_catch{body=B1}, Env1};
-visit(Env0, #c_letrec{defs=Ds0,body=B0}=R) ->
- {Xs, Env1} = bind_vars([V || {V,_} <- Ds0], Env0),
- {Ds1,Env2} = visit_def_list(Env1, Ds0),
- {B1,Env3} = visit(Env2, B0),
- {R#c_letrec{defs=Ds1,body=B1}, restore_vars(Xs, Env0, Env3)}.
-%% The following general code for handling modules is slow if a module
-%% contains very many functions. There is special code in visit_module/1
-%% which is much faster.
-%% visit(Env0, #c_module{defs=D0}=R) ->
-%% {R1,Env1} = visit(Env0, #c_letrec{defs=D0,body=#c_nil{}}),
-%% {R#c_module{defs=R1#c_letrec.defs}, Env1};
-
-visit_list(Env, L) ->
- lists:mapfoldl(fun (E, A) -> visit(A, E) end, Env, L).
-
-visit_def_list(Env, L) ->
- lists:mapfoldl(fun ({Name,V0}, E0) ->
- {V1,E1} = visit(E0, V0),
- {{Name,V1}, E1}
- end, Env, L).
-
-visit_bin_segs(Env, Segs) ->
- lists:foldl(fun (#c_bitstr{val=Val,size=Sz}, E0) ->
- {_, E1} = visit(E0, Val),
- {_, E2} = visit(E1, Sz),
- E2
- end, Env, Segs).
-
-bind_vars(Vs, Env) ->
- bind_vars(Vs, Env, []).
-
-bind_vars([#c_var{name=X}|Vs], Env0, Xs)->
- bind_vars(Vs, Env0#{X=>0}, [X|Xs]);
-bind_vars([], Env,Xs) ->
- {Xs, Env}.
-
-visit_pats(Ps, Env) ->
- visit_pats(Ps, Env, []).
-
-visit_pats([P|Ps], Env0, Vs0) ->
- {Vs1, Env1} = visit_pat(Env0, P, Vs0),
- visit_pats(Ps, Env1, Vs1);
-visit_pats([], Env, Vs) ->
- {Vs, Env}.
-
-visit_pat(Env0, #c_var{name=V}, Vs) ->
- {[V|Vs], Env0#{V=>0}};
-visit_pat(Env0, #c_tuple{es=Es}, Vs) ->
- visit_pats(Es, Env0, Vs);
-visit_pat(Env0, #c_map{es=Es}, Vs) ->
- visit_pats(Es, Env0, Vs);
-visit_pat(Env0, #c_map_pair{op=#c_literal{val=exact},key=V,val=K}, Vs0) ->
- {Vs1, Env1} = visit_pat(Env0, V, Vs0),
- visit_pat(Env1, K, Vs1);
-visit_pat(Env0, #c_cons{hd=H,tl=T}, Vs0) ->
- {Vs1, Env1} = visit_pat(Env0, H, Vs0),
- visit_pat(Env1, T, Vs1);
-visit_pat(Env0, #c_binary{segments=Segs}, Vs) ->
- visit_pats(Segs, Env0, Vs);
-visit_pat(Env0, #c_bitstr{val=Val,size=Sz}, Vs0) ->
- {Vs1, Env1} =
- case Sz of
- #c_var{name=V} ->
- %% We don't tolerate free variables.
- case Env0 of
- #{V:=N} ->
- {Vs0, Env0#{V:=N+1}}
- end;
- _ ->
- visit_pat(Env0, Sz, Vs0)
- end,
- visit_pat(Env1, Val, Vs1);
-visit_pat(Env0, #c_alias{pat=P,var=#c_var{name=V}}, Vs) ->
- visit_pat(Env0#{V=>0}, P, [V|Vs]);
-visit_pat(Env, #c_literal{}, Vs) ->
- {Vs, Env}.
-
-restore_vars([V|Vs], Env0, Env1) ->
- case Env0 of
- #{V:=N} ->
- restore_vars(Vs, Env0, Env1#{V=>N});
- _ ->
- restore_vars(Vs, Env0, maps:remove(V, Env1))
- end;
-restore_vars([], _, Env1) ->
- Env1.
-
-
-%% let X1 = call 'erlang':'setelement(5, Tuple, Value1)
-%% in call 'erlang':'setelement(3, X1, Value2)
-%% =>
-%% let X1 = call 'erlang':'setelement(5, Tuple, Value1)
-%% in do primop dsetelement(3, X1, Value2)
-%% X1
-
-rewrite(#c_let{vars=[#c_var{name=X}=V]=Vs,
- arg=#c_call{module=#c_literal{val='erlang'},
- name=#c_literal{val='setelement'},
- args=[#c_literal{val=Index1}, _Tuple, _Val1]
- }=A,
- body=#c_call{anno=Banno,module=#c_literal{val='erlang'},
- name=#c_literal{val='setelement'},
- args=[#c_literal{val=Index2},
- #c_var{name=X},
- Val2]
- }
- }=R,
- _BodyEnv, FinalEnv)
- when is_integer(Index1), is_integer(Index2), Index2 > 0, Index1 > Index2 ->
- case is_safe(Val2) of
- true ->
- {R#c_let{vars=Vs,
- arg=A,
- body=#c_seq{arg=#c_primop{
- anno=Banno,
- name=#c_literal{val='dsetelement'},
- args=[#c_literal{val=Index2},
- V,
- Val2]},
- body=V}
- },
- FinalEnv};
- false ->
- {R, FinalEnv}
- end;
-
-%% let X1 = call 'erlang':'setelement(5, Tuple, Value1)
-%% in let X2 = 'erlang':'setelement(3, X1, Value2)
-%% in ...
-%% =>
-%% let X2 = call 'erlang':'setelement(5, Tuple, Value1)
-%% in do primop dsetelement(3, X2, Value2)
-%% ...
-%% if X1 is used exactly once.
-
-rewrite(#c_let{vars=[#c_var{name=X1}],
- arg=#c_call{module=#c_literal{val='erlang'},
- name=#c_literal{val='setelement'},
- args=[#c_literal{val=Index1}, _Tuple, _Val1]
- }=A,
- body=#c_let{vars=[#c_var{}=V]=Vs,
- arg=#c_call{anno=Banno,
- module=#c_literal{val='erlang'},
- name=#c_literal{val='setelement'},
- args=[#c_literal{val=Index2},
- #c_var{name=X1},
- Val2]},
- body=B}
- }=R,
- BodyEnv, FinalEnv)
- when is_integer(Index1), is_integer(Index2), Index2 > 0, Index1 > Index2 ->
- case is_single_use(X1, BodyEnv) andalso is_safe(Val2) of
- true ->
- {R#c_let{vars=Vs,
- arg=A,
- body=#c_seq{arg=#c_primop{
- anno=Banno,
- name=#c_literal{val='dsetelement'},
- args=[#c_literal{val=Index2},
- V,
- Val2]},
- body=B}
- },
- FinalEnv};
- false ->
- {R, FinalEnv}
- end;
-
-rewrite(R, _, FinalEnv) ->
- {R, FinalEnv}.
-
-%% is_safe(CoreExpr) -> true|false
-%% Determines whether the Core expression can cause a GC collection at run-time.
-%% Note: Assumes that the constant pool is turned on.
-
-is_safe(#c_var{}) -> true;
-is_safe(#c_literal{}) -> true;
-is_safe(_) -> false.
-
-is_single_use(V, Env) ->
- case Env of
- #{V:=1} ->
- true;
- _ ->
- false
- end.
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 43c99be982..7e219da0af 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -961,18 +961,12 @@ fold_lit_args(Call, Module, Name, Args0) ->
%%
fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) ->
eval_is_boolean(Call, Arg, Sub);
-fold_non_lit_args(Call, erlang, element, [Arg1,Arg2], Sub) ->
- eval_element(Call, Arg1, Arg2, Sub);
fold_non_lit_args(Call, erlang, length, [Arg], _) ->
eval_length(Call, Arg);
fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) ->
eval_append(Call, Arg1, Arg2);
fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) ->
eval_append(Call, Arg1, Arg2);
-fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) ->
- eval_setelement(Call, Arg1, Arg2, Arg3);
-fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) ->
- eval_is_record(Call, Arg1, Arg2, Arg3, Sub);
fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) ->
eval_is_function_1(Call, Arg1, Sub);
fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) ->
@@ -1141,96 +1135,6 @@ eval_append(Call, #c_cons{anno=Anno,hd=H,tl=T}, List) ->
eval_append(Call, X, Y) ->
Call#c_call{args=[X,Y]}. %Rebuild call arguments.
-%% eval_element(Call, Pos, Tuple, Types) -> Val.
-%% Evaluates element/2 if the position Pos is a literal and
-%% the shape of the tuple Tuple is known.
-%%
-eval_element(Call, #c_literal{val=Pos}, Tuple, Types)
- when is_integer(Pos) ->
- case get_type(Tuple, Types) of
- none ->
- Call;
- Type ->
- Es = case cerl:is_c_tuple(Type) of
- false -> [];
- true -> cerl:tuple_es(Type)
- end,
- if
- 1 =< Pos, Pos =< length(Es) ->
- El = lists:nth(Pos, Es),
- try
- cerl:set_ann(pat_to_expr(El), [compiler_generated])
- catch
- throw:impossible ->
- Call
- end;
- true ->
- %% Index outside tuple or not a tuple.
- eval_failure(Call, badarg)
- end
- end;
-eval_element(Call, Pos, Tuple, Sub) ->
- case is_int_type(Pos, Sub) =:= no orelse
- is_tuple_type(Tuple, Sub) =:= no of
- true ->
- eval_failure(Call, badarg);
- false ->
- Call
- end.
-
-%% eval_is_record(Call, Var, Tag, Size, Types) -> Val.
-%% Evaluates is_record/3 using type information.
-%%
-eval_is_record(Call, Term, #c_literal{val=NeededTag},
- #c_literal{val=Size}, Types) ->
- case get_type(Term, Types) of
- none ->
- Call;
- Type ->
- Es = case cerl:is_c_tuple(Type) of
- false -> [];
- true -> cerl:tuple_es(Type)
- end,
- case Es of
- [#c_literal{val=Tag}|_] ->
- Bool = Tag =:= NeededTag andalso
- length(Es) =:= Size,
- #c_literal{val=Bool};
- _ ->
- #c_literal{val=false}
- end
- end;
-eval_is_record(Call, _, _, _, _) -> Call.
-
-%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core.
-%% Evaluates setelement/3 if position Pos is an integer
-%% and the shape of the tuple Tuple is known.
-%%
-eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal)
- when is_integer(Pos) ->
- case cerl:is_data(Tuple) of
- false ->
- Call;
- true ->
- Es0 = case cerl:is_c_tuple(Tuple) of
- false -> [];
- true -> cerl:tuple_es(Tuple)
- end,
- if
- 1 =< Pos, Pos =< length(Es0) ->
- Es = eval_setelement_1(Pos, Es0, NewVal),
- cerl:update_c_tuple(Tuple, Es);
- true ->
- eval_failure(Call, badarg)
- end
- end;
-eval_setelement(Call, _, _, _) -> Call.
-
-eval_setelement_1(1, [_|T], NewVal) ->
- [NewVal|T];
-eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 ->
- [H|eval_setelement_1(Pos-1, T, NewVal)].
-
%% eval_failure(Call, Reason) -> Core.
%% Warn for a call that will fail and replace the call with
%% a call to erlang:error(Reason).
@@ -1290,16 +1194,15 @@ clause(#c_clause{pats=Ps0}=Cl, Cexpr, Ctxt, Sub0) ->
end.
clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) ->
- Sub2 = update_types(Cexpr, Ps1, Sub1),
GSub = case {Cexpr,Ps1,G0} of
{_,_,#c_literal{}} ->
%% No need for substitution tricks when the guard
%% does not contain any variables.
- Sub2;
+ Sub1;
{#c_var{name='_'},_,_} ->
%% In a 'receive', Cexpr is the variable '_', which represents the
%% message being matched. We must NOT do any extra substiutions.
- Sub2;
+ Sub1;
{#c_var{},[#c_var{}=Var],_} ->
%% The idea here is to optimize expressions such as
%%
@@ -1321,16 +1224,16 @@ clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) ->
%%
case cerl:is_c_fname(Cexpr) of
false ->
- sub_set_var(Var, Cexpr, Sub2);
+ sub_set_var(Var, Cexpr, Sub1);
true ->
%% We must not copy funs, and especially not into guards.
- Sub2
+ Sub1
end;
_ ->
- Sub2
+ Sub1
end,
G1 = guard(G0, GSub),
- B1 = body(B0, Ctxt, Sub2),
+ B1 = body(B0, Ctxt, Sub1),
Cl#c_clause{pats=Ps1,guard=G1,body=B1}.
%% let_substs(LetVars, LetArg, Sub) -> {[Var],[Val],Sub}.
@@ -1414,8 +1317,7 @@ pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) ->
{Pat#c_binary{segments=V1},Osub1};
pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) ->
{V1,Osub1} = pattern(V0, Isub, Osub0),
- {P1,Osub2} = pattern(P0, Isub, Osub1),
- Osub = update_types(V1, [P1], Osub2),
+ {P1,Osub} = pattern(P0, Isub, Osub1),
{Pat#c_alias{var=V1,pat=P1},Osub}.
map_pair_pattern_list(Ps0, Isub, Osub0) ->
@@ -2137,14 +2039,9 @@ case_expand_var(E, #sub{t=Tdb}) ->
%% encountered.
coerce_to_data(C) ->
- case cerl:is_c_alias(C) of
- false ->
- case cerl:is_data(C) orelse cerl:is_c_var(C) of
- true -> C;
- false -> throw(impossible)
- end;
- true ->
- coerce_to_data(cerl:alias_pat(C))
+ case cerl:is_data(C) orelse cerl:is_c_var(C) of
+ true -> C;
+ false -> throw(impossible)
end.
%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses'
@@ -3140,14 +3037,6 @@ is_int_type(Var, Sub) ->
C -> yes_no(cerl:is_c_int(C))
end.
--spec is_tuple_type(cerl:cerl(), sub()) -> yes_no_maybe().
-
-is_tuple_type(Var, Sub) ->
- case get_type(Var, Sub) of
- none -> maybe;
- C -> yes_no(cerl:is_c_tuple(C))
- end.
-
yes_no(true) -> yes;
yes_no(false) -> no.
@@ -3209,27 +3098,23 @@ returns_integer(_, _) -> false.
%% update_types(Expr, Pattern, Sub) -> Sub'
%% Update the type database.
--spec update_types(cerl:cerl(), [type_info()], sub()) -> sub().
+-spec update_types(cerl:c_var(), [type_info()], sub()) -> sub().
-update_types(Expr, Pat, #sub{t=Tdb0}=Sub) ->
- Tdb = update_types_1(Expr, Pat, Tdb0),
+update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) ->
+ Tdb = update_types_1(V, Pat, Tdb0),
Sub#sub{t=Tdb}.
-update_types_1(#c_var{name=V}, Pat, Types) ->
- update_types_2(V, Pat, Types);
-update_types_1(_, _, Types) -> Types.
-
-update_types_2(V, [#c_tuple{}=P], Types) ->
+update_types_1(V, [#c_tuple{}=P], Types) ->
Types#{V=>P};
-update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
+update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
Types#{V=>bool};
-update_types_2(V, [#c_fun{vars=Vars}], Types) ->
+update_types_1(V, [#c_fun{vars=Vars}], Types) ->
Types#{V=>{'fun',length(Vars)}};
-update_types_2(V, [#c_var{name={_,Arity}}], Types) ->
+update_types_1(V, [#c_var{name={_,Arity}}], Types) ->
Types#{V=>{'fun',Arity}};
-update_types_2(V, [Type], Types) when is_atom(Type) ->
+update_types_1(V, [Type], Types) when is_atom(Type) ->
Types#{V=>Type};
-update_types_2(_, _, Types) -> Types.
+update_types_1(_, _, Types) -> Types.
%% kill_types(V, Tdb) -> Tdb'
%% Kill any entries that references the variable,
diff --git a/lib/compiler/src/sys_core_fold_lists.erl b/lib/compiler/src/sys_core_fold_lists.erl
index 9867fab46a..e93b435011 100644
--- a/lib/compiler/src/sys_core_fold_lists.erl
+++ b/lib/compiler/src/sys_core_fold_lists.erl
@@ -37,22 +37,27 @@ call(#c_call{anno=Anno}, lists, all, [Arg1,Arg2]) ->
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
- CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
+ CC1 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=true}], guard=#c_literal{val=true},
body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
- CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
+ CC2 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=false}], guard=#c_literal{val=true},
body=#c_literal{val=false}},
- CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ CC3 = #c_clause{anno=Anno,
+ pats=[X], guard=#c_literal{val=true},
body=match_fail(Anno, Err1)},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno,
+ pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
clauses = [CC1, CC2, CC3]}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=1}]},
body=#c_literal{val=true}},
Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true},
body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
@@ -66,16 +71,21 @@ call(#c_call{anno=Anno}, lists, any, [Arg1,Arg2]) ->
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
- CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
+ CC1 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=true}], guard=#c_literal{val=true},
body=#c_literal{val=true}},
- CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
+ CC2 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=false}], guard=#c_literal{val=true},
body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
- CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ CC3 = #c_clause{anno=Anno,
+ pats=[X], guard=#c_literal{val=true},
body=match_fail(Anno, Err1)},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno,
+ pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
clauses = [CC1, CC2, CC3]}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=1}]},
@@ -94,16 +104,17 @@ call(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2]) ->
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno,
+ pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]},
body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=1}]},
body=#c_literal{val=ok}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true},
body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
@@ -117,7 +128,8 @@ call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) ->
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
H = #c_var{name='H'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno,
+ pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_let{vars=[H], arg=#c_apply{anno=Anno,
op=F,
args=[X]},
@@ -126,7 +138,7 @@ call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) ->
tl=#c_apply{anno=Anno,
op=Loop,
args=[Xs]}}}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=1}]},
@@ -146,7 +158,8 @@ call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) ->
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
H = #c_var{name='H'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno,
+ pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_let{vars=[H],
arg=#c_apply{anno=Anno, op=F, args=[X]},
body=#c_call{anno=[compiler_generated|Anno],
@@ -156,13 +169,13 @@ call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) ->
#c_apply{anno=Anno,
op=Loop,
args=[Xs]}]}}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=1}]},
body=#c_literal{val=[]}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true},
body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
@@ -177,11 +190,13 @@ call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) ->
X = #c_var{name='X'},
B = #c_var{name='B'},
Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
- CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
+ CC1 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=true}], guard=#c_literal{val=true},
body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}},
- CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
+ CC2 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=false}], guard=#c_literal{val=true},
body=Xs},
- CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ CC3 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true},
body=match_fail(Anno, Err1)},
Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
@@ -192,13 +207,15 @@ call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) ->
op=Loop,
args=[Xs]},
body=Case}}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=1}]},
body=#c_literal{val=[]}},
Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ C3 = #c_clause{anno=Anno,
+ pats=[Xs], guard=#c_literal{val=true},
body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
@@ -212,19 +229,20 @@ call(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3]) ->
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
A = #c_var{name='A'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno,
+ pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_apply{anno=Anno,
op=Loop,
args=[Xs, #c_apply{anno=Anno,
op=F,
args=[X, A]}]}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=2}]},
body=A},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true},
body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)},
Fun = #c_fun{vars=[Xs, A],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
@@ -238,19 +256,20 @@ call(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3]) ->
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
A = #c_var{name='A'},
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno,
+ pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_apply{anno=Anno,
op=F,
args=[X, #c_apply{anno=Anno,
op=Loop,
args=[Xs, A]}]}},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=2}]},
body=A},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true},
body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)},
Fun = #c_fun{vars=[Xs, A],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
@@ -266,13 +285,14 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) ->
Avar = #c_var{name='A'},
Match =
fun (A, P, E) ->
- C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
+ C1 = #c_clause{anno=Anno, pats=[P], guard=#c_literal{val=true}, body=E},
Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
- C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ C2 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true},
body=match_fail(Anno, Err)},
#c_case{arg=A, clauses=[C1, C2]}
end,
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno,
+ pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
#c_tuple{es=[X, Avar]},
%%% Tuple passing version
@@ -292,7 +312,7 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) ->
%%% body=#c_values{es=[#c_cons{hd=X, tl=Xs},
%%% A]}}
)},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno, pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=2}]},
@@ -302,7 +322,7 @@ call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) ->
%%% Multiple-value version
%%% body=#c_values{es=[#c_literal{val=[]}, A]}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true},
body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)},
Fun = #c_fun{vars=[Xs, Avar],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
@@ -326,13 +346,13 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) ->
Avar = #c_var{name='A'},
Match =
fun (A, P, E) ->
- C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
+ C1 = #c_clause{anno=Anno, pats=[P], guard=#c_literal{val=true}, body=E},
Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
- C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
+ C2 = #c_clause{anno=Anno, pats=[X], guard=#c_literal{val=true},
body=match_fail(Anno, Err)},
#c_case{arg=A, clauses=[C1, C2]}
end,
- C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
+ C1 = #c_clause{anno=Anno, pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
%%% Tuple passing version
body=Match(#c_apply{anno=Anno,
op=Loop,
@@ -352,7 +372,8 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) ->
%%% #c_values{es=[#c_cons{hd=X, tl=Xs},
%%% A]})}
},
- C2 = #c_clause{pats=[#c_literal{val=[]}],
+ C2 = #c_clause{anno=Anno,
+ pats=[#c_literal{val=[]}],
guard=#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=is_function},
args=[F, #c_literal{val=2}]},
@@ -362,7 +383,7 @@ call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) ->
%%% Multiple-value version
%%% body=#c_values{es=[#c_literal{val=[]}, A]}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]},
- C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
+ C3 = #c_clause{anno=Anno, pats=[Xs], guard=#c_literal{val=true},
body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)},
Fun = #c_fun{vars=[Xs, Avar],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 45e0ed5088..3699c9d22e 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -330,7 +330,7 @@ gexpr({protect,Line,Arg}, Bools0, St0) ->
{#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St}
end;
gexpr({op,_,'andalso',_,_}=E0, Bools, St0) ->
- {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso', St0),
+ {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'),
Anno = lineno_anno(L, St0),
{#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
@@ -338,7 +338,7 @@ gexpr({op,_,'andalso',_,_}=E0, Bools, St0) ->
E = make_bool_switch_guard(L, E1, V, E2, False),
gexpr(E, Bools, St);
gexpr({op,_,'orelse',_,_}=E0, Bools, St0) ->
- {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse', St0),
+ {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse'),
Anno = lineno_anno(L, St0),
{#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
@@ -767,14 +767,16 @@ expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) ->
{Qs,St2} = preprocess_quals(Llc, Qs0, St1),
{Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2),
{Y,Mps++Yps,St};
-expr({op,L,'andalso',E1,E2}, St0) ->
+expr({op,_,'andalso',_,_}=E0, St0) ->
+ {op,L,'andalso',E1,E2} = right_assoc(E0, 'andalso'),
Anno = lineno_anno(L, St0),
{#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
False = {atom,L,false},
E = make_bool_switch(L, E1, V, E2, False, St0),
expr(E, St);
-expr({op,L,'orelse',E1,E2}, St0) ->
+expr({op,_,'orelse',_,_}=E0, St0) ->
+ {op,L,'orelse',E1,E2} = right_assoc(E0, 'orelse'),
Anno = lineno_anno(L, St0),
{#c_var{name=V0},St} = new_var(Anno, St0),
V = {var,L,V0},
@@ -2058,17 +2060,9 @@ fail_clause(Pats, Anno, Arg) ->
args=[Arg]}]}.
%% Optimization for Dialyzer.
-right_assoc(E, Op, St) ->
- case member(dialyzer, St#core.opts) of
- true ->
- right_assoc2(E, Op);
- false ->
- E
- end.
-
-right_assoc2({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) ->
- right_assoc2({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op);
-right_assoc2(E, _Op) -> E.
+right_assoc({op,L1,Op,{op,L2,Op,E1,E2},E3}, Op) ->
+ right_assoc({op,L2,Op,E1,{op,L1,Op,E2,E3}}, Op);
+right_assoc(E, _Op) -> E.
annotate_tuple(A, Es, St) ->
case member(dialyzer, St#core.opts) of
@@ -2627,7 +2621,8 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
[],A#a.us,St2}.
c_call_erl(Fun, Args) ->
- cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args).
+ As = [compiler_generated],
+ cerl:ann_c_call(As, cerl:c_atom(erlang), cerl:c_atom(Fun), Args).
%% lit_vars(Literal) -> [Var].
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index f7ca66b1da..e2b8787224 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1414,7 +1414,6 @@ is_remote_bif(_, _, _) -> false.
%% return multiple values. Only used in bodies where a BIF may be
%% called for effect only.
-bif_vals(dsetelement, 3) -> 0;
bif_vals(_, _) -> 1.
bif_vals(_, _, _) -> 1.
@@ -1591,19 +1590,12 @@ match_var([U|Us], Cs0, Def, St) ->
%% constructor/constant as first argument. Group the constructors
%% according to type, the order is really irrelevant but tries to be
%% smart.
-
-match_con(Us, Cs0, Def, St) ->
- %% Expand literals at the top level.
- Cs = [expand_pat_lit_clause(C) || C <- Cs0],
- match_con_1(Us, Cs, Def, St).
-
-match_con_1([U|_Us] = L, Cs, Def, St0) ->
+match_con([U|_Us] = L, Cs, Def, St0) ->
%% Extract clauses for different constructors (types).
%%ok = io:format("match_con ~p~n", [Cs]),
- Ttcs0 = select_types([k_binary], Cs) ++ select_bin_con(Cs) ++
- select_types([k_cons,k_tuple,k_map,k_atom,k_float,
- k_int,k_nil], Cs),
- Ttcs = opt_single_valued(Ttcs0),
+ Ttcs0 = select_types(Cs, [], [], [], [], [], [], [], [], []),
+ Ttcs1 = [{T, Types} || {T, [_ | _] = Types} <- Ttcs0],
+ Ttcs = opt_single_valued(Ttcs1),
%%ok = io:format("ttcs = ~p~n", [Ttcs]),
{Scs,St1} =
mapfoldl(fun ({T,Tcs}, St) ->
@@ -1614,8 +1606,41 @@ match_con_1([U|_Us] = L, Cs, Def, St0) ->
St0, Ttcs),
{build_alt_1st_no_fail(build_select(U, Scs), Def),St1}.
-select_types(Types, Cs) ->
- [{T,Tcs} || T <- Types, begin Tcs = select(T, Cs), Tcs =/= [] end].
+select_types([NoExpC | Cs], Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil) ->
+ C = expand_pat_lit_clause(NoExpC),
+ case clause_con(C) of
+ k_binary ->
+ select_types(Cs, [C |Bin], BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil);
+ k_bin_seg ->
+ select_types(Cs, Bin, [C | BinCon], Cons, Tuple, Map, Atom, Float, Int, Nil);
+ k_bin_end ->
+ select_types(Cs, Bin, [C | BinCon], Cons, Tuple, Map, Atom, Float, Int, Nil);
+ k_cons ->
+ select_types(Cs, Bin, BinCon, [C | Cons], Tuple, Map, Atom, Float, Int, Nil);
+ k_tuple ->
+ select_types(Cs, Bin, BinCon, Cons, [C | Tuple], Map, Atom, Float, Int, Nil);
+ k_map ->
+ select_types(Cs, Bin, BinCon, Cons, Tuple, [C | Map], Atom, Float, Int, Nil);
+ k_atom ->
+ select_types(Cs, Bin, BinCon, Cons, Tuple, Map, [C | Atom], Float, Int, Nil);
+ k_float ->
+ select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, [C | Float], Int, Nil);
+ k_int ->
+ select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, Float, [C | Int], Nil);
+ k_nil ->
+ select_types(Cs, Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, [C | Nil])
+ end;
+select_types([], Bin, BinCon, Cons, Tuple, Map, Atom, Float, Int, Nil) ->
+ [{k_binary, reverse(Bin)}] ++ handle_bin_con(reverse(BinCon)) ++
+ [
+ {k_cons, reverse(Cons)},
+ {k_tuple, reverse(Tuple)},
+ {k_map, reverse(Map)},
+ {k_atom, reverse(Atom)},
+ {k_float, reverse(Float)},
+ {k_int, reverse(Int)},
+ {k_nil, reverse(Nil)}
+ ].
expand_pat_lit_clause(#iclause{pats=[#ialias{pat=#k_literal{anno=A,val=Val}}=Alias|Ps]}=C) ->
P = expand_pat_lit(Val, A),
@@ -1744,20 +1769,12 @@ combine_bin_segs(#k_bin_end{}) ->
combine_bin_segs(_) ->
throw(not_possible).
-%% select_bin_con([Clause]) -> [{Type,[Clause]}].
-%% Extract clauses for the k_bin_seg constructor. As k_bin_seg
+%% handle_bin_con([Clause]) -> [{Type,[Clause]}].
+%% Handle clauses for the k_bin_seg constructor. As k_bin_seg
%% matching can overlap, the k_bin_seg constructors cannot be
%% reordered, only grouped.
-select_bin_con(Cs0) ->
- Cs1 = lists:filter(fun (C) ->
- Con = clause_con(C),
- (Con =:= k_bin_seg) or (Con =:= k_bin_end)
- end, Cs0),
- select_bin_con_1(Cs1).
-
-
-select_bin_con_1(Cs) ->
+handle_bin_con(Cs) ->
try
%% The usual way to match literals is to first extract the
%% value to a register, and then compare the register to the
@@ -1796,14 +1813,14 @@ select_bin_con_1(Cs) ->
end
catch
throw:not_possible ->
- select_bin_con_2(Cs)
+ handle_bin_con_not_possible(Cs)
end.
-select_bin_con_2([C1|Cs]) ->
+handle_bin_con_not_possible([C1|Cs]) ->
Con = clause_con(C1),
{More,Rest} = splitwith(fun (C) -> clause_con(C) =:= Con end, Cs),
- [{Con,[C1|More]}|select_bin_con_2(Rest)];
-select_bin_con_2([]) -> [].
+ [{Con,[C1|More]}|handle_bin_con_not_possible(Rest)];
+handle_bin_con_not_possible([]) -> [].
%% select_bin_int([Clause]) -> {k_bin_int,[Clause]}
%% If the first pattern in each clause selects the same integer,
@@ -1903,10 +1920,6 @@ select_utf8(Val0) ->
throw(not_possible)
end.
-%% select(Con, [Clause]) -> [Clause].
-
-select(T, Cs) -> [ C || C <- Cs, clause_con(C) =:= T ].
-
%% match_value([Var], Con, [Clause], Default, State) -> {SelectExpr,State}.
%% At this point all the clauses have the same constructor, we must
%% now separate them according to value.
@@ -2041,6 +2054,10 @@ get_match(#k_cons{}, St0) ->
get_match(#k_binary{}, St0) ->
{[V]=Mes,St1} = new_vars(1, St0),
{#k_binary{segs=V},Mes,St1};
+get_match(#k_bin_seg{size=#k_atom{val=all},next={k_bin_end,[]}}=Seg, St0) ->
+ {[S,N0],St1} = new_vars(2, St0),
+ N = set_kanno(N0, [no_usage]),
+ {Seg#k_bin_seg{seg=S,next=N},[S],St1};
get_match(#k_bin_seg{}=Seg, St0) ->
{[S,N0],St1} = new_vars(2, St0),
N = set_kanno(N0, [no_usage]),
@@ -2068,6 +2085,9 @@ new_clauses(Cs0, U, St) ->
#k_cons{hd=H,tl=T} -> [H,T|As];
#k_tuple{es=Es} -> Es ++ As;
#k_binary{segs=E} -> [E|As];
+ #k_bin_seg{size=#k_atom{val=all},
+ seg=S,next={k_bin_end,[]}} ->
+ [S|As];
#k_bin_seg{seg=S,next=N} ->
[S,N|As];
#k_bin_int{next=N} ->
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index f042a5cb51..db8eb7e2e1 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -107,6 +107,8 @@ CORE_MODULES = \
NO_MOD_OPT = $(NO_OPT)
+NO_SSA_OPT = $(NO_OPT)
+
NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE)
NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl)
POST_OPT_MODULES= $(NO_OPT:%=%_post_opt_SUITE)
@@ -117,6 +119,8 @@ R21_MODULES= $(R21:%=%_r21_SUITE)
R21_ERL_FILES= $(R21_MODULES:%=%.erl)
NO_MOD_OPT_MODULES= $(NO_MOD_OPT:%=%_no_module_opt_SUITE)
NO_MOD_OPT_ERL_FILES= $(NO_MOD_OPT_MODULES:%=%.erl)
+NO_SSA_OPT_MODULES= $(NO_SSA_OPT:%=%_no_ssa_opt_SUITE)
+NO_SSA_OPT_ERL_FILES= $(NO_SSA_OPT_MODULES:%=%.erl)
ERL_FILES= $(MODULES:%=%.erl)
CORE_FILES= $(CORE_MODULES:%=%.core)
@@ -145,13 +149,16 @@ EBIN = .
# Targets
# ----------------------------------------------------
-make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \
+make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(NO_SSA_OPT_ERL_FILES) \
$(INLINE_ERL_FILES) $(R21_ERL_FILES) $(NO_MOD_OPT_ERL_FILES)
$(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \
> $(EMAKEFILE)
$(ERL_TOP)/make/make_emakefile +no_copt +no_postopt \
+no_ssa_opt +no_recv_opt $(ERL_COMPILE_FLAGS) \
-o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE)
+ $(ERL_TOP)/make/make_emakefile +no_share_opt +no_bsm_opt +no_fun_opt \
+ +no_ssa_opt +no_recv_opt $(ERL_COMPILE_FLAGS) \
+ -o$(EBIN) $(NO_SSA_OPT_MODULES) >> $(EMAKEFILE)
$(ERL_TOP)/make/make_emakefile +no_copt $(ERL_COMPILE_FLAGS) \
-o$(EBIN) $(POST_OPT_MODULES) >> $(EMAKEFILE)
$(ERL_TOP)/make/make_emakefile +inline $(ERL_COMPILE_FLAGS) \
@@ -180,6 +187,9 @@ docs:
%_no_opt_SUITE.erl: %_SUITE.erl
sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@
+%_no_ssa_opt_SUITE.erl: %_SUITE.erl
+ sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@
+
%_post_opt_SUITE.erl: %_SUITE.erl
sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@
@@ -205,7 +215,8 @@ release_tests_spec: make_emakefile
$(EMAKEFILE) $(ERL_FILES) "$(RELSYSDIR)"
$(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \
$(INLINE_ERL_FILES) $(R21_ERL_FILES) \
- $(NO_MOD_OPT_ERL_FILES) "$(RELSYSDIR)"
+ $(NO_MOD_OPT_ERL_FILES) \
+ $(NO_SSA_OPT_ERL_FILES) "$(RELSYSDIR)"
$(INSTALL_DATA) $(CORE_FILES) "$(RELSYSDIR)"
for file in $(ERL_DUMMY_FILES); do \
module=`basename $$file .erl`; \
diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl
index da61931136..8e3b373d29 100644
--- a/lib/compiler/test/beam_except_SUITE.erl
+++ b/lib/compiler/test/beam_except_SUITE.erl
@@ -21,7 +21,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
- multiple_allocs/1,coverage/1]).
+ multiple_allocs/1,bs_get_tail/1,coverage/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -31,6 +31,7 @@ all() ->
groups() ->
[{p,[parallel],
[multiple_allocs,
+ bs_get_tail,
coverage]}].
init_per_suite(Config) ->
@@ -63,6 +64,17 @@ place(lee) ->
conditions() ->
(talking = going) = storage + [large = wanted].
+bs_get_tail(Config) ->
+ {<<"abc">>,0,0,Config} = bs_get_tail_1(id(<<0:32, "abc">>), 0, 0, Config),
+ {'EXIT',
+ {function_clause,
+ [{?MODULE,bs_get_tail_1,[<<>>,0,0,Config],_}|_]}} =
+ (catch bs_get_tail_1(id(<<>>), 0, 0, Config)),
+ ok.
+
+bs_get_tail_1(<<_:32, Rest/binary>>, Z1, Z2, F1) ->
+ {Rest,Z1,Z2,F1}.
+
coverage(_) ->
File = {file,"fake.erl"},
ok = fc(a),
@@ -72,9 +84,16 @@ coverage(_) ->
{'EXIT',{function_clause,
[{?MODULE,fc,[y],[File,{line,2}]}|_]}} =
(catch fc(y)),
- {'EXIT',{function_clause,
- [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} =
- (catch fc([a,b,c])),
+ case ?MODULE of
+ beam_except_no_opt_SUITE ->
+ %% There will be a different stack fram in
+ %% unoptimized code.
+ ok;
+ _ ->
+ {'EXIT',{function_clause,
+ [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} =
+ (catch fc([a,b,c]))
+ end,
{'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} =
(catch erlang:error(a, b, c)),
@@ -88,8 +107,19 @@ coverage(_) ->
{'EXIT',{{strange,Self},[{?MODULE,foo,[any],[File,{line,14}]}|_]}} =
(catch foo(any)),
+ {ok,succeed,1,2} = foobar(succeed, 1, 2),
+ {'EXIT',{function_clause,[{?MODULE,foobar,[[fail],1,2],
+ [{file,"fake.erl"},{line,16}]}|_]}} =
+ (catch foobar([fail], 1, 2)),
+ {'EXIT',{function_clause,[{?MODULE,fake_function_clause,[{a,b},42.0],_}|_]}} =
+ (catch fake_function_clause({a,b})),
+
ok.
+fake_function_clause(A) -> error(function_clause, [A,42.0]).
+
+id(I) -> I.
+
-file("fake.erl", 1).
fc(a) -> %Line 2
ok; %Line 3
@@ -104,3 +134,6 @@ bar(X) -> %Line 8
%% Cover collection code for function_clause exceptions.
foo(A) -> %Line 13
error({strange,self()}, [A]). %Line 14
+%% Cover beam_except:tag_literal/1.
+foobar(A, B, C) when is_atom(A) -> %Line 16
+ {ok,A,B,C}. %Line 17
diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl
index 759d884dc4..a456f31d79 100644
--- a/lib/compiler/test/beam_jump_SUITE.erl
+++ b/lib/compiler/test/beam_jump_SUITE.erl
@@ -79,12 +79,13 @@ checks(Wanted) ->
{catch case river() of sheet -> begin +Wanted, if "da" -> Wanted end end end, catch case river() of sheet -> begin + Wanted, if "da" -> Wanted end end end}.
unsafe_move_elimination(_Config) ->
- {{left,right,false},false} = unsafe_move_elimination(left, right, false),
- {{false,right,false},false} = unsafe_move_elimination(false, right, true),
- {{true,right,right},right} = unsafe_move_elimination(true, right, true),
+ {{left,right,false},false} = unsafe_move_elimination_1(left, right, false),
+ {{false,right,false},false} = unsafe_move_elimination_1(false, right, true),
+ {{true,right,right},right} = unsafe_move_elimination_1(true, right, true),
+ [ok = unsafe_move_elimination_2(I) || I <- lists:seq(0,16)],
ok.
-unsafe_move_elimination(Left, Right, Simple0) ->
+unsafe_move_elimination_1(Left, Right, Simple0) ->
id(1),
%% The move at label 29 would be removed by beam_jump, which is unsafe because
@@ -115,6 +116,44 @@ unsafe_move_elimination(Left, Right, Simple0) ->
end,
{id({Left,Right,Simple}),Simple}.
+unsafe_move_elimination_2(Int) ->
+ %% The type optimization pass would recognize that TagInt can only be
+ %% [0 .. 7], so the first 'case' would select_val over [0 .. 6] and swap
+ %% out the fail label with the block for 7.
+ %%
+ %% A later optimization would merge this block with 'expects_h' in the
+ %% second case, as the latter is only reachable from the former.
+ %%
+ %% ... but this broke down when the move elimination optimization didn't
+ %% take the fail label of the first select_val into account. This caused it
+ %% to believe that the only way to reach 'expects_h' was through the second
+ %% case when 'Tag' =:= 'h', which made it remove the move instruction
+ %% added in the first case, passing garbage to expects_h/2.
+ TagInt = Int band 2#111,
+ Tag = case TagInt of
+ 0 -> a;
+ 1 -> b;
+ 2 -> c;
+ 3 -> d;
+ 4 -> e;
+ 5 -> f;
+ 6 -> g;
+ 7 -> h
+ end,
+ case Tag of
+ g -> expects_g(TagInt, Tag);
+ h -> expects_h(TagInt, Tag);
+ _ -> Tag = id(Tag), ok
+ end.
+
+expects_g(6, Atom) ->
+ Atom = id(g),
+ ok.
+
+expects_h(7, Atom) ->
+ Atom = id(h),
+ ok.
+
-record(message2, {id, p1}).
-record(message3, {id, p1, p2}).
diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl
index 6efa98de44..a7ffc3f60a 100644
--- a/lib/compiler/test/beam_type_SUITE.erl
+++ b/lib/compiler/test/beam_type_SUITE.erl
@@ -222,6 +222,9 @@ coverage(Config) ->
booleans(_Config) ->
{'EXIT',{{case_clause,_},_}} = (catch do_booleans_1(42)),
+ ok = do_booleans_2(42, 41),
+ error = do_booleans_2(42, 42),
+
AnyAtom = id(atom),
true = is_atom(AnyAtom),
false = is_boolean(AnyAtom),
@@ -250,6 +253,19 @@ do_booleans_1(B) ->
no -> no
end.
+do_booleans_2(A, B) ->
+ Not = not do_booleans_cmp(A, B),
+ case Not of
+ true ->
+ case Not of
+ true -> error;
+ false -> ok
+ end;
+ false -> ok
+ end.
+
+do_booleans_cmp(A, B) -> A > B.
+
setelement(_Config) ->
T0 = id({a,42}),
{a,_} = T0,
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 585d0e7191..8b39fce479 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -34,7 +34,7 @@
undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1,
map_field_lists/1,cover_bin_opt/1,
val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1,
- receive_stacked/1,aliased_types/1]).
+ receive_stacked/1,aliased_types/1,type_conflict/1]).
-include_lib("common_test/include/ct.hrl").
@@ -63,7 +63,7 @@ groups() ->
undef_label,illegal_instruction,failing_gc_guard_bif,
map_field_lists,cover_bin_opt,val_dsetel,
bad_tuples,bad_try_catch_nesting,
- receive_stacked,aliased_types]}].
+ receive_stacked,aliased_types,type_conflict]}].
init_per_suite(Config) ->
test_lib:recompile(?MODULE),
@@ -107,13 +107,12 @@ xrange(Config) when is_list(Config) ->
Errors = do_val(xrange, Config),
[{{t,sum_1,2},
{{bif,'+',{f,0},[{x,-1},{x,1}],{x,0}},4,
- {uninitialized_reg,{x,-1}}}},
+ {bad_register,{x,-1}}}},
{{t,sum_2,2},
- {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4,
- {uninitialized_reg,{x,1023}}}},
+ {{bif,'+',{f,0},[{x,0},{x,1023}],{x,0}},4,limit}},
{{t,sum_3,2},
{{bif,'+',{f,0},[{x,0},{x,1}],{x,-1}},4,
- {invalid_store,{x,-1},number}}},
+ {bad_register,{x,-1}}}},
{{t,sum_4,2},
{{bif,'+',{f,0},[{x,0},{x,1}],{x,1023}},4,limit}}] = Errors,
ok.
@@ -122,15 +121,15 @@ yrange(Config) when is_list(Config) ->
Errors = do_val(yrange, Config),
[{{t,sum_1,2},
{{move,{x,1},{y,-1}},5,
- {invalid_store,{y,-1},term}}},
+ {bad_register,{y,-1}}}},
{{t,sum_2,2},
{{bif,'+',{f,0},[{x,0},{y,1024}],{x,0}},7,
- {uninitialized_reg,{y,1024}}}},
+ limit}},
{{t,sum_3,2},
{{move,{x,1},{y,1024}},5,limit}},
{{t,sum_4,2},
{{move,{x,1},{y,-1}},5,
- {invalid_store,{y,-1},term}}}] = Errors,
+ {bad_register,{y,-1}}}}] = Errors,
ok.
stack(Config) when is_list(Config) ->
@@ -157,9 +156,9 @@ call_last(Config) when is_list(Config) ->
merge_undefined(Config) when is_list(Config) ->
Errors = do_val(merge_undefined, Config),
[{{t,handle_call,2},
- {{call_ext,1,{extfunc,erlang,exit,1}},
- 10,
- {uninitialized_reg,{y,0}}}}] = Errors,
+ {{call_ext,2,{extfunc,debug,filter,2}},
+ 22,
+ {uninitialized_reg,{y,_}}}}] = Errors,
ok.
uninit(Config) when is_list(Config) ->
@@ -178,7 +177,7 @@ unsafe_catch(Config) when is_list(Config) ->
Errors = do_val(unsafe_catch, Config),
[{{t,small,2},
{{bs_put_integer,{f,0},{integer,16},1,
- {field_flags,[unsigned,big]},{y,0}},
+ {field_flags,[unsigned,big]},{y,0}},
20,
{unassigned,{y,0}}}}] = Errors,
ok.
@@ -211,19 +210,19 @@ bad_catch_try(Config) when is_list(Config) ->
Errors = do_val(bad_catch_try, Config),
[{{bad_catch_try,bad_1,1},
{{'catch',{x,0},{f,3}},
- 5,{invalid_store,{x,0},{catchtag,[3]}}}},
+ 5,{invalid_tag_register,{x,0}}}},
{{bad_catch_try,bad_2,1},
{{catch_end,{x,9}},
- 8,{source_not_y_reg,{x,9}}}},
+ 8,{invalid_tag_register,{x,9}}}},
{{bad_catch_try,bad_3,1},
- {{catch_end,{y,1}},9,{bad_type,{atom,kalle}}}},
+ {{catch_end,{y,1}},9,{invalid_tag,{y,1},{atom,kalle}}}},
{{bad_catch_try,bad_4,1},
- {{'try',{x,0},{f,15}},5,{invalid_store,{x,0},{trytag,[15]}}}},
+ {{'try',{x,0},{f,15}},5,{invalid_tag_register,{x,0}}}},
{{bad_catch_try,bad_5,1},
- {{try_case,{y,1}},12,{bad_type,term}}},
+ {{try_case,{y,1}},12,{invalid_tag,{y,1},term}}},
{{bad_catch_try,bad_6,1},
{{move,{integer,1},{y,1}},7,
- {invalid_store,{y,1},{integer,1}}}}] = Errors,
+ {invalid_store,{y,1}}}}] = Errors,
ok.
cons_guard(Config) when is_list(Config) ->
@@ -247,7 +246,7 @@ freg_range(Config) when is_list(Config) ->
{{t,sum_3,2},
{{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,-1}},
7,
- {bad_target,{fr,-1}}}},
+ {bad_register,{fr,-1}}}},
{{t,sum_4,2},
{{bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,1024}},
7,
@@ -539,37 +538,37 @@ receive_stacked(Config) ->
[{{receive_stacked,f1,0},
{{loop_rec_end,{f,3}},
17,
- {fragile_message_reference,{y,0}}}},
+ {fragile_message_reference,{y,_}}}},
{{receive_stacked,f2,0},
- {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}},
{{receive_stacked,f3,0},
- {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}},
{{receive_stacked,f4,0},
- {{test_heap,3,0},10,{fragile_message_reference,{y,1}}}},
+ {{test_heap,3,0},10,{fragile_message_reference,{y,_}}}},
{{receive_stacked,f5,0},
{{loop_rec_end,{f,23}},
23,
- {fragile_message_reference,{y,1}}}},
+ {fragile_message_reference,{y,_}}}},
{{receive_stacked,f6,0},
- {{gc_bif,byte_size,{f,29},0,[{y,0}],{x,0}},
+ {{gc_bif,byte_size,{f,29},0,[{y,_}],{x,0}},
12,
- {fragile_message_reference,{y,0}}}},
+ {fragile_message_reference,{y,_}}}},
{{receive_stacked,f7,0},
{{loop_rec_end,{f,33}},
20,
- {fragile_message_reference,{y,0}}}},
+ {fragile_message_reference,{y,_}}}},
{{receive_stacked,f8,0},
{{loop_rec_end,{f,38}},
20,
- {fragile_message_reference,{y,0}}}},
+ {fragile_message_reference,{y,_}}}},
{{receive_stacked,m1,0},
{{loop_rec_end,{f,43}},
19,
- {fragile_message_reference,{y,0}}}},
+ {fragile_message_reference,{y,_}}}},
{{receive_stacked,m2,0},
{{loop_rec_end,{f,48}},
33,
- {fragile_message_reference,{y,0}}}}] = Errors,
+ {fragile_message_reference,{y,_}}}}] = Errors,
%% Compile the original source code as a smoke test.
Data = proplists:get_value(data_dir, Config),
@@ -631,6 +630,27 @@ aliased_types_3(Bug) ->
hd(List)
end.
+
+%% ERL-867; validation proceeded after a type conflict, causing incorrect types
+%% to be joined.
+
+-record(r, { e1 = e1, e2 = e2 }).
+
+type_conflict(Config) when is_list(Config) ->
+ {e1, e2} = type_conflict_1(#r{}),
+ ok.
+
+type_conflict_1(C) ->
+ Src = id(C#r.e2),
+ TRes = try id(Src) of
+ R -> R
+ catch
+ %% C:R can never match, yet it assumed that the type of 'C' was
+ %% an atom from here on.
+ C:R -> R
+ end,
+ {C#r.e1, TRes}.
+
%%%-------------------------------------------------------------------------
transform_remove(Remove, Module) ->
diff --git a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S
index 481d55045d..aa344807e4 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S
@@ -15,8 +15,9 @@
{select_val,{x,0},{f,1},{list,[{atom,gurka},{f,3},{atom,delete},{f,4}]}}.
{label,3}.
{allocate_heap,2,6,2}.
- %% The Y registers are not initialized here.
{test,is_eq_exact,{f,5},[{x,0},{atom,ok}]}.
+ %% This is unreachable since {x,0} is known not to be 'ok'. We should not
+ %% fail with "uninitialized y registers" on erlang:exit/1
{move,{atom,nisse},{x,0}}.
{call_ext,1,{extfunc,erlang,exit,1}}.
{label,4}.
@@ -29,6 +30,7 @@
{call_ext,2,{extfunc,io,format,2}}.
{test,is_ne_exact,{f,6},[{x,0},{atom,ok}]}.
{label,5}.
+ %% The Y registers are not initialized here.
{move,{atom,logReader},{x,1}}.
{move,{atom,console},{x,0}}.
{call_ext,2,{extfunc,debug,filter,2}}.
diff --git a/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S
index 5b974119c6..a878204d16 100644
--- a/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S
+++ b/lib/compiler/test/beam_validator_SUITE_data/receive_stacked.S
@@ -240,7 +240,7 @@
{y,0}}.
{'%',{no_bin_opt,{binary_used_in,{test,is_binary,{f,34},[{y,0}]}},
[63,{file,"receive_stacked.erl"}]}}.
- {test,is_binary,{f,34},[{y,0}]}.
+ {test,is_eq_exact,{f,34},[{y,0},{literal,<<0,1,2,3>>}]}.
remove_message.
{move,{integer,42},{x,0}}.
{line,[{location,"receive_stacked.erl",64}]}.
@@ -283,7 +283,7 @@
{y,0}}.
{'%',{no_bin_opt,{[{x,1},{y,0}],{loop_rec_end,{f,38}},not_handled},
[70,{file,"receive_stacked.erl"}]}}.
- {test,is_binary,{f,39},[{x,0}]}.
+ {test,is_eq_exact,{f,39},[{x,0},{literal,<<0,1,2,3>>}]}.
remove_message.
{move,{integer,42},{x,0}}.
{line,[{location,"receive_stacked.erl",71}]}.
diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl
index 42ba5d5365..423a7666af 100644
--- a/lib/compiler/test/bif_SUITE.erl
+++ b/lib/compiler/test/bif_SUITE.erl
@@ -23,7 +23,7 @@
-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
init_per_group/2,end_per_group/2,
- beam_validator/1,trunc_and_friends/1,cover_safe_bifs/1]).
+ beam_validator/1,trunc_and_friends/1,cover_safe_and_pure_bifs/1]).
suite() ->
[{ct_hooks,[ts_install_cth]}].
@@ -35,7 +35,7 @@ groups() ->
[{p,[parallel],
[beam_validator,
trunc_and_friends,
- cover_safe_bifs
+ cover_safe_and_pure_bifs
]}].
init_per_suite(Config) ->
@@ -106,7 +106,7 @@ trunc_template(Func, Bif) ->
catch error:badarg -> ok end,
ok.").
-cover_safe_bifs(Config) ->
+cover_safe_and_pure_bifs(Config) ->
_ = get(),
_ = get_keys(a),
_ = group_leader(),
@@ -118,5 +118,6 @@ cover_safe_bifs(Config) ->
_ = processes(),
_ = registered(),
_ = term_to_binary(Config),
+ 42 = list_to_integer("2A", 16),
ok.
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 7452466666..408af80dd9 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -28,12 +28,12 @@
init_per_group/2,end_per_group/2,
app_test/1,appup_test/1,
debug_info/4, custom_debug_info/1, custom_compile_info/1,
- file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1,
+ file_1/1, forms_2/1, module_mismatch/1, outdir/1,
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, kernel_listing/1, encrypted_abstr/1,
strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1,
cover/1, env/1, core_pp/1, tuple_calls/1,
- core_roundtrip/1, asm/1, optimized_guards/1,
+ core_roundtrip/1, asm/1,
sys_pre_attributes/1, dialyzer/1,
warnings/1, pre_load_check/1, env_compiler_options/1,
bc_options/1, deterministic_include/1, deterministic_paths/1
@@ -46,11 +46,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
-spec all() -> all_return_type().
all() ->
- [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
+ [app_test, appup_test, file_1, forms_2, module_mismatch, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, kernel_listing, encrypted_abstr, tuple_calls,
strict_record, utf8_atoms, utf8_functions, extra_chunks,
- cover, env, core_pp, core_roundtrip, asm, optimized_guards,
+ cover, env, core_pp, core_roundtrip, asm,
sys_pre_attributes, dialyzer, warnings, pre_load_check,
env_compiler_options, custom_debug_info, bc_options,
custom_compile_info, deterministic_include, deterministic_paths].
@@ -104,6 +104,7 @@ file_1(Config) when is_list(Config) ->
compile_and_verify(Simple, Target, []),
compile_and_verify(Simple, Target, [native]),
compile_and_verify(Simple, Target, [debug_info]),
+ compile_and_verify(Simple, Target, [no_postopt]),
{ok,simple} = compile:file(Simple, [no_line_info]), %Coverage
{ok,simple} = compile:file(Simple, [{eprof,beam_z}]), %Coverage
@@ -231,17 +232,6 @@ module_mismatch(Config) when is_list(Config) ->
ok.
-big_file(Config) when is_list(Config) ->
- {Big,Target} = get_files(Config, big, "big_file"),
- ok = file:set_cwd(filename:dirname(Target)),
- compile_and_verify(Big, Target, []),
- compile_and_verify(Big, Target, [debug_info]),
- compile_and_verify(Big, Target, [no_postopt]),
-
- %% Cleanup.
- ok = file:delete(Target),
- ok.
-
%% Tests that the {outdir, Dir} option works.
outdir(Config) when is_list(Config) ->
@@ -370,42 +360,37 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
TargetDir = filename:join(PrivDir, listings),
ok = file:make_dir(TargetDir),
- %% Test all dedicated listing options.
- do_listing(Simple, TargetDir, 'S'),
- do_listing(Simple, TargetDir, 'E'),
- do_listing(Simple, TargetDir, 'P'),
- do_listing(Simple, TargetDir, dpp, ".pp"),
- do_listing(Simple, TargetDir, dabstr, ".abstr"),
- do_listing(Simple, TargetDir, dexp, ".expand"),
- do_listing(Simple, TargetDir, dcore, ".core"),
- do_listing(Simple, TargetDir, doldinline, ".oldinline"),
- do_listing(Simple, TargetDir, dinline, ".inline"),
- do_listing(Simple, TargetDir, dcore, ".core"),
- do_listing(Simple, TargetDir, dcopt, ".copt"),
- do_listing(Simple, TargetDir, dcbsm, ".core_bsm"),
- do_listing(Simple, TargetDir, dsetel, ".dsetel"),
- do_listing(Simple, TargetDir, dkern, ".kernel"),
- do_listing(Simple, TargetDir, dssa, ".ssa"),
- do_listing(Simple, TargetDir, dssaopt, ".ssaopt"),
- do_listing(Simple, TargetDir, dprecg, ".precodegen"),
- do_listing(Simple, TargetDir, dcg, ".codegen"),
- do_listing(Simple, TargetDir, dblk, ".block"),
- do_listing(Simple, TargetDir, dexcept, ".except"),
- do_listing(Simple, TargetDir, djmp, ".jump"),
- do_listing(Simple, TargetDir, dclean, ".clean"),
- do_listing(Simple, TargetDir, dpeep, ".peep"),
- do_listing(Simple, TargetDir, dopt, ".optimize"),
- do_listing(Simple, TargetDir, diffable, ".S"),
-
- %% First clean up.
- Listings = filename:join(PrivDir, listings),
- lists:foreach(fun(F) -> ok = file:delete(F) end,
- filelib:wildcard(filename:join(Listings, "*"))),
+ List = [{'S',".S"},
+ {'E',".E"},
+ {'P',".P"},
+ {dpp, ".pp"},
+ {dabstr, ".abstr"},
+ {dexp, ".expand"},
+ {dcore, ".core"},
+ {doldinline, ".oldinline"},
+ {dinline, ".inline"},
+ {dcore, ".core"},
+ {dcopt, ".copt"},
+ {dcbsm, ".core_bsm"},
+ {dkern, ".kernel"},
+ {dssa, ".ssa"},
+ {dssaopt, ".ssaopt"},
+ {dprecg, ".precodegen"},
+ {dcg, ".codegen"},
+ {dblk, ".block"},
+ {dexcept, ".except"},
+ {djmp, ".jump"},
+ {dclean, ".clean"},
+ {dpeep, ".peep"},
+ {dopt, ".optimize"},
+ {diffable, ".S"}],
+ p_listings(List, Simple, TargetDir),
%% Test options that produce a listing file if 'binary' is not given.
do_listing(Simple, TargetDir, to_pp, ".P"),
do_listing(Simple, TargetDir, to_exp, ".E"),
do_listing(Simple, TargetDir, to_core0, ".core"),
+ Listings = filename:join(PrivDir, listings),
ok = file:delete(filename:join(Listings, File ++ ".core")),
do_listing(Simple, TargetDir, to_core, ".core"),
do_listing(Simple, TargetDir, to_kernel, ".kernel"),
@@ -421,24 +406,35 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
listings_big(Config) when is_list(Config) ->
{Big,Target} = get_files(Config, big, listings_big),
TargetDir = filename:dirname(Target),
- do_listing(Big, TargetDir, 'S'),
- do_listing(Big, TargetDir, 'E'),
- do_listing(Big, TargetDir, 'P'),
- do_listing(Big, TargetDir, dkern, ".kernel"),
- do_listing(Big, TargetDir, dssa, ".ssa"),
- do_listing(Big, TargetDir, dssaopt, ".ssaopt"),
- do_listing(Big, TargetDir, dprecg, ".precodegen"),
- do_listing(Big, TargetDir, to_dis, ".dis"),
-
- TargetNoext = filename:rootname(Target, code:objfile_extension()),
- {ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]),
-
- %% Cleanup.
- ok = file:delete(Target),
- lists:foreach(fun(F) -> ok = file:delete(F) end,
- filelib:wildcard(filename:join(TargetDir, "*"))),
- ok = file:del_dir(TargetDir),
- ok.
+ List = [{'S',".S"},
+ {'E',".E"},
+ {'P',".P"},
+ {dkern, ".kernel"},
+ {dssa, ".ssa"},
+ {dssaopt, ".ssaopt"},
+ {dprecg, ".precodegen"},
+ {to_dis, ".dis"}],
+ p_listings(List, Big, TargetDir).
+
+p_listings(List, File, BaseDir) ->
+ Run = fun({Option,Extension}) ->
+ Uniq = erlang:unique_integer([positive]),
+ Dir = filename:join(BaseDir, integer_to_list(Uniq)),
+ ok = file:make_dir(Dir),
+ try
+ do_listing(File, Dir, Option, Extension),
+ ok
+ catch
+ Class:Error:Stk ->
+ io:format("~p:~p\n~p\n", [Class,Error,Stk]),
+ error
+ after
+ _ = [ok = file:delete(F) ||
+ F <- filelib:wildcard(filename:join(Dir, "*"))],
+ ok = file:del_dir(Dir)
+ end
+ end,
+ test_lib:p_run(Run, List).
other_output(Config) when is_list(Config) ->
{Simple,_Target} = get_files(Config, simple, "other_output"),
@@ -685,9 +681,6 @@ cover(Config) when is_list(Config) ->
io:format("~p\n", [compile:options()]),
ok.
-do_listing(Source, TargetDir, Type) ->
- do_listing(Source, TargetDir, Type, "." ++ atom_to_list(Type)).
-
do_listing(Source, TargetDir, Type, Ext) ->
io:format("Source: ~p TargetDir: ~p\n Type: ~p Ext: ~p\n",
[Source, TargetDir, Type, Ext]),
@@ -1174,85 +1167,6 @@ do_asm(Beam, Outdir) ->
error
end.
-%% Make sure that guards are fully optimized. Guards should
-%% should use 'test' instructions, not 'bif' instructions.
-
-optimized_guards(_Config) ->
- TestBeams = get_unique_beam_files(),
- test_lib:p_run(fun(F) -> do_opt_guards(F) end, TestBeams).
-
-do_opt_guards(Beam) ->
- {ok,{M,[{abstract_code,{raw_abstract_v1,A}}]}} =
- beam_lib:chunks(Beam, [abstract_code]),
- try
- {ok,M,Asm} = compile:forms(A, ['S']),
- do_opt_guards_mod(Asm)
- catch Class:Error:Stk ->
- io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),
- error
- end.
-
-do_opt_guards_mod({Mod,_Exp,_Attr,Asm,_NumLabels}) ->
- case do_opt_guards_fs(Mod, Asm) of
- [] ->
- ok;
- [_|_]=Bifs ->
- io:format("ERRORS FOR ~p:\n~p\n", [Mod,Bifs]),
- error
- end.
-
-do_opt_guards_fs(Mod, [{function,Name,Arity,_,Is}|Fs]) ->
- Bifs0 = do_opt_guards_fun(Is),
-
- %% The compiler does not attempt to optimize 'xor'.
- %% Therefore, ignore all functions that use 'xor' in
- %% a guard.
- Bifs = case lists:any(fun({bif,'xor',_,_,_}) -> true;
- (_) -> false
- end, Bifs0) of
- true -> [];
- false -> Bifs0
- end,
-
- %% Filter out the allowed exceptions.
- FA = {Name,Arity},
- case {Bifs,is_exception(Mod, FA)} of
- {[_|_],true} ->
- io:format("~p:~p/~p IGNORED:\n~p\n",
- [Mod,Name,Arity,Bifs]),
- do_opt_guards_fs(Mod, Fs);
- {[_|_],false} ->
- [{FA,Bifs}|do_opt_guards_fs(Mod, Fs)];
- {[],false} ->
- do_opt_guards_fs(Mod, Fs);
- {[],true} ->
- io:format("Redundant exception for ~p:~p/~p\n",
- [Mod,Name,Arity]),
- error(redundant)
- end;
-do_opt_guards_fs(_, []) -> [].
-
-do_opt_guards_fun([{bif,Name,{f,F},As,_}=I|Is]) when F =/= 0 ->
- Arity = length(As),
- case erl_internal:comp_op(Name, Arity) orelse
- erl_internal:bool_op(Name, Arity) orelse
- erl_internal:new_type_test(Name, Arity) of
- true ->
- [I|do_opt_guards_fun(Is)];
- false ->
- do_opt_guards_fun(Is)
- end;
-do_opt_guards_fun([_|Is]) ->
- do_opt_guards_fun(Is);
-do_opt_guards_fun([]) -> [].
-
-is_exception(guard_SUITE, {'-complex_not/1-fun-4-',1}) -> true;
-is_exception(guard_SUITE, {'-complex_not/1-fun-5-',1}) -> true;
-is_exception(guard_SUITE, {bad_guards,1}) -> true;
-is_exception(guard_SUITE, {nested_not_2b,6}) -> true; %% w/o type optimization
-is_exception(guard_SUITE, {nested_not_2b,2}) -> true; %% with type optimization
-is_exception(_, _) -> false.
-
sys_pre_attributes(Config) ->
DataDir = proplists:get_value(data_dir, Config),
File = filename:join(DataDir, "attributes.erl"),
@@ -1469,44 +1383,49 @@ env_compiler_options(_Config) ->
bc_options(Config) ->
DataDir = proplists:get_value(data_dir, Config),
- 101 = highest_opcode(DataDir, small_float, [no_get_hd_tl,no_line_info]),
-
- 103 = highest_opcode(DataDir, big,
- [no_put_tuple2,
- no_get_hd_tl,no_ssa_opt_record,
- no_line_info,no_stack_trimming]),
-
- 125 = highest_opcode(DataDir, small_float,
- [no_get_hd_tl,no_line_info,no_ssa_opt_float]),
-
- 132 = highest_opcode(DataDir, small,
- [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
- no_ssa_opt_float,no_line_info,no_bsm3]),
-
- 153 = highest_opcode(DataDir, small, [r20]),
- 153 = highest_opcode(DataDir, small, [r21]),
-
- 136 = highest_opcode(DataDir, big, [no_put_tuple2,no_get_hd_tl,
- no_ssa_opt_record,no_line_info]),
-
- 153 = highest_opcode(DataDir, big, [no_put_tuple2,no_get_hd_tl,
- no_ssa_opt_record]),
- 153 = highest_opcode(DataDir, big, [r16]),
- 153 = highest_opcode(DataDir, big, [r17]),
- 153 = highest_opcode(DataDir, big, [r18]),
- 153 = highest_opcode(DataDir, big, [r19]),
- 153 = highest_opcode(DataDir, small_float, [r16]),
- 153 = highest_opcode(DataDir, small_float, []),
-
- 158 = highest_opcode(DataDir, small_maps, [r17]),
- 158 = highest_opcode(DataDir, small_maps, [r18]),
- 158 = highest_opcode(DataDir, small_maps, [r19]),
- 158 = highest_opcode(DataDir, small_maps, [r20]),
- 158 = highest_opcode(DataDir, small_maps, [r21]),
-
- 164 = highest_opcode(DataDir, small_maps, []),
- 164 = highest_opcode(DataDir, big, []),
-
+ L = [{101, small_float, [no_get_hd_tl,no_line_info]},
+ {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
+ no_line_info,no_stack_trimming]},
+ {125, small_float, [no_get_hd_tl,no_line_info,no_ssa_opt_float]},
+
+ {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
+ no_ssa_opt_float,no_line_info,no_bsm3]},
+
+ {153, small, [r20]},
+ {153, small, [r21]},
+
+ {136, big, [no_put_tuple2,no_get_hd_tl,
+ no_ssa_opt_record,no_line_info]},
+
+ {153, big, [no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]},
+ {153, big, [r16]},
+ {153, big, [r17]},
+ {153, big, [r18]},
+ {153, big, [r19]},
+ {153, small_float, [r16]},
+ {153, small_float, []},
+
+ {158, small_maps, [r17]},
+ {158, small_maps, [r18]},
+ {158, small_maps, [r19]},
+ {158, small_maps, [r20]},
+ {158, small_maps, [r21]},
+
+ {164, small_maps, []},
+ {164, big, []}
+ ],
+
+ Test = fun({Expected,Mod,Options}) ->
+ case highest_opcode(DataDir, Mod, Options) of
+ Expected ->
+ ok;
+ Got ->
+ io:format("*** module ~p, options ~p => got ~p; expected ~p\n",
+ [Mod,Options,Got,Expected]),
+ error
+ end
+ end,
+ test_lib:p_run(Test, L),
ok.
highest_opcode(DataDir, Mod, Opt) ->
diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover
index 3fd7fc1937..fac0f9947c 100644
--- a/lib/compiler/test/compiler.cover
+++ b/lib/compiler/test/compiler.cover
@@ -1,5 +1,4 @@
-{incl_app,compiler,details}.
-
%% -*- erlang -*-
+{local_only,compiler,true}.
+{incl_app,compiler,details}.
{excl_mods,compiler,[core_scan,core_parse]}.
-
diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl
index 831e8279aa..0fa8070dc8 100644
--- a/lib/compiler/test/float_SUITE.erl
+++ b/lib/compiler/test/float_SUITE.erl
@@ -21,15 +21,16 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1,
- subtract_number_type/1]).
+ subtract_number_type/1,float_followed_by_guard/1]).
-include_lib("common_test/include/ct.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
+all() ->
[pending, bif_calls, math_functions,
- mixed_float_and_int, subtract_number_type].
+ mixed_float_and_int, subtract_number_type,
+ float_followed_by_guard].
groups() ->
[].
@@ -187,5 +188,21 @@ fact(0, P) -> P;
fact(1, P) -> P;
fact(N, P) -> fact(N-1, P*N).
+float_followed_by_guard(Config) when is_list(Config) ->
+ true = ffbg_1(5, 1),
+ false = ffbg_1(1, 5),
+ ok.
+
+ffbg_1(A, B0) ->
+ %% This is a non-guard block followed by a *guard block* that starts with a
+ %% floating point operation, and the compiler erroneously assumed that it
+ %% was safe to skip fcheckerror because the next block started with a float
+ %% op.
+ B = id(B0) / 1.0,
+ if
+ A - B > 0.0 -> true;
+ A - B =< 0.0 -> false
+ end.
+
id(I) -> I.
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index 69c9dcba69..aff1a56c47 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -42,13 +42,9 @@ groups() ->
init_per_suite(Config) ->
test_lib:recompile(?MODULE),
- Pa = "-pa " ++ filename:dirname(code:which(?MODULE)),
- {ok,Node} = start_node(compiler, Pa),
- [{testing_node,Node}|Config].
+ Config.
-end_per_suite(Config) ->
- Node = proplists:get_value(testing_node, Config),
- test_server:stop_node(Node),
+end_per_suite(_Config) ->
ok.
init_per_group(_GroupName, Config) ->
@@ -89,7 +85,6 @@ attribute(Config) when is_list(Config) ->
?comp(maps_inline_test).
try_inline(Mod, Config) ->
- Node = proplists:get_value(testing_node, Config),
Src = filename:join(proplists:get_value(data_dir, Config),
atom_to_list(Mod)),
Out = proplists:get_value(priv_dir,Config),
@@ -100,7 +95,7 @@ try_inline(Mod, Config) ->
bin_opt_info,clint,ssalint]),
ct:timetrap({minutes,10}),
- NormalResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]),
+ NormalResult = load_and_call(Out, Mod),
%% Inlining.
io:format("Compiling with old inliner: ~s\n", [Src]),
@@ -109,7 +104,7 @@ try_inline(Mod, Config) ->
%% Run inlined code.
ct:timetrap({minutes,10}),
- OldInlinedResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]),
+ OldInlinedResult = load_and_call(Out, Mod),
%% Compare results.
compare(NormalResult, OldInlinedResult),
@@ -122,7 +117,7 @@ try_inline(Mod, Config) ->
%% Run inlined code.
ct:timetrap({minutes,10}),
- InlinedResult = rpc:call(Node, ?MODULE, load_and_call, [Out,Mod]),
+ InlinedResult = load_and_call(Out, Mod),
%% Compare results.
compare(NormalResult, InlinedResult),
@@ -131,6 +126,11 @@ try_inline(Mod, Config) ->
%% Delete Beam file.
ok = file:delete(filename:join(Out, atom_to_list(Mod)++code:objfile_extension())),
+ %% Delete loaded module.
+ _ = code:purge(Mod),
+ _ = code:delete(Mod),
+ _ = code:purge(Mod),
+
ok.
compare(Same, Same) -> ok;
@@ -144,12 +144,6 @@ compare([H1|_], [H2|_]) ->
ct:fail(different);
compare([], []) -> ok.
-start_node(Name, Args) ->
- case test_server:start_node(Name, slave, [{args,Args}]) of
- {ok,Node} -> {ok, Node};
- Error -> ct:fail(Error)
- end.
-
load_and_call(Out, Module) ->
io:format("Loading...\n",[]),
code:purge(Module),
@@ -350,10 +344,8 @@ otp_7223_2({a}) ->
1.
coverage(Config) when is_list(Config) ->
- Mod = bsdecode,
+ Mod = attribute,
Src = filename:join(proplists:get_value(data_dir, Config), Mod),
{ok,Mod,_} = compile:file(Src, [binary,report,{inline,0},
clint,ssalint]),
- {ok,Mod,_} = compile:file(Src, [binary,report,{inline,20},
- verbose,clint,ssalint]),
ok.
diff --git a/lib/compiler/test/inline_SUITE_data/barnes2.erl b/lib/compiler/test/inline_SUITE_data/barnes2.erl
index a986331060..49e9bdfb6b 100644
--- a/lib/compiler/test/inline_SUITE_data/barnes2.erl
+++ b/lib/compiler/test/inline_SUITE_data/barnes2.erl
@@ -6,7 +6,7 @@
?MODULE() ->
Stars = create_scenario(1000, 1.0),
R = hd(loop(10,1000.0,Stars,0)),
- Str = lists:flatten(io:lib_format("~s", [R])),
+ Str = lists:flatten(io_lib:format("~p", [R])),
{R,Str =:= {1.00000,-1.92269e+4,-1.92269e+4,2.86459e-2,2.86459e-2}}.
create_scenario(N, M) ->
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 60ab969929..94bfbb0efe 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -25,7 +25,7 @@
match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1,
selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1,
coverage/1,grab_bag/1,literal_binary/1,
- unary_op/1,eq_types/1]).
+ unary_op/1,eq_types/1,match_after_return/1]).
-include_lib("common_test/include/ct.hrl").
@@ -40,7 +40,8 @@ groups() ->
match_in_call,untuplify,
shortcut_boolean,letify_guard,selectify,deselectify,
underscore,match_map,map_vars_used,coverage,
- grab_bag,literal_binary,unary_op,eq_types]}].
+ grab_bag,literal_binary,unary_op,eq_types,
+ match_after_return]}].
init_per_suite(Config) ->
@@ -890,5 +891,15 @@ eq_types(A, B) ->
Ref22.
+match_after_return(Config) when is_list(Config) ->
+ %% The return type of the following call will never match the 'wont_happen'
+ %% clauses below, and the beam_ssa_type was clever enough to see that but
+ %% didn't remove the blocks, so it crashed when trying to extract A.
+ ok = case mar_test_tuple(erlang:unique_integer()) of
+ {gurka, never_matches, A} -> {wont_happen, A};
+ _ -> ok
+ end.
+
+mar_test_tuple(I) -> {gurka, I}.
id(I) -> I.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index e999c8ffae..a0b415ceaa 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -161,14 +161,13 @@ md5_1(Beam) ->
%% Cover some code that handles internal errors.
silly_coverage(Config) when is_list(Config) ->
- %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel
+ %% sys_core_fold, sys_core_alias, sys_core_bsm, v3_kernel
BadCoreErlang = {c_module,[],
name,[],[],
[{{c_var,[],{foo,2}},seriously_bad_body}]},
expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end),
expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end),
expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end),
- expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end),
expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end),
%% beam_kernel_to_ssa
@@ -185,7 +184,6 @@ silly_coverage(Config) when is_list(Config) ->
%% beam_ssa_recv
%% beam_ssa_share
%% beam_ssa_pre_codegen
- %% beam_ssa_opt
%% beam_ssa_codegen
BadSSA = {b_module,#{},a,b,c,
[{b_function,#{func_info=>{mod,foo,0}},args,bad_blocks,0}]},
@@ -193,9 +191,15 @@ silly_coverage(Config) when is_list(Config) ->
expect_error(fun() -> beam_ssa_recv:module(BadSSA, []) end),
expect_error(fun() -> beam_ssa_share:module(BadSSA, []) end),
expect_error(fun() -> beam_ssa_pre_codegen:module(BadSSA, []) end),
- expect_error(fun() -> beam_ssa_opt:module(BadSSA, []) end),
expect_error(fun() -> beam_ssa_codegen:module(BadSSA, []) end),
+ %% beam_ssa_opt
+ BadSSABlocks = #{0 => {b_blk,#{},[bad_code],{b_ret,#{},arg}}},
+ BadSSAOpt = {b_module,#{},a,[],c,
+ [{b_function,#{func_info=>{mod,foo,0}},[],
+ BadSSABlocks,0}]},
+ expect_error(fun() -> beam_ssa_opt:module(BadSSAOpt, []) end),
+
%% beam_ssa_lint, beam_ssa_pp
{error,[{_,Errors}]} = beam_ssa_lint:module(bad_ssa_lint_input(), []),
_ = [io:put_chars(Mod:format_error(Reason)) ||
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index 12108445f0..0038eb1a4b 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -25,7 +25,8 @@
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1,
- wait/1,recv_in_try/1,double_recv/1,receive_var_zero/1]).
+ wait/1,recv_in_try/1,double_recv/1,receive_var_zero/1,
+ match_built_terms/1]).
-include_lib("common_test/include/ct.hrl").
@@ -45,7 +46,8 @@ all() ->
groups() ->
[{p,test_lib:parallel(),
[recv,coverage,otp_7980,ref_opt,export,wait,
- recv_in_try,double_recv,receive_var_zero]}].
+ recv_in_try,double_recv,receive_var_zero,
+ match_built_terms]}].
init_per_suite(Config) ->
@@ -400,5 +402,29 @@ receive_var_zero(Config) when is_list(Config) ->
zero() -> 0.
+%% ERL-862; the validator would explode when a term was constructed in a
+%% receive guard.
+
+-define(MATCH_BUILT_TERM(Ref, Expr),
+ (fun() ->
+ Ref = make_ref(),
+ A = id($a),
+ B = id($b),
+ Built = id(Expr),
+ self() ! {Ref, A, B},
+ receive
+ {Ref, A, B} when Expr =:= Built ->
+ ok
+ after 5000 ->
+ ct:fail("Failed to match message with term built in "
+ "receive guard.")
+ end
+ end)()).
+
+match_built_terms(Config) when is_list(Config) ->
+ ?MATCH_BUILT_TERM(Ref, [A, B]),
+ ?MATCH_BUILT_TERM(Ref, {A, B}),
+ ?MATCH_BUILT_TERM(Ref, <<A, B>>),
+ ?MATCH_BUILT_TERM(Ref, #{ 1 => A, 2 => B}).
id(I) -> I.
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 26149e11e6..39c26c6142 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -50,12 +50,8 @@ smoke_disasm(File) when is_list(File) ->
Res = beam_disasm:file(File),
{beam_file,_Mod} = {element(1, Res),element(2, Res)}.
-%% If we are running cover, we don't want to run test cases that
-%% invokes the compiler in parallel, as doing so would probably
-%% be slower than running them sequentially.
-
parallel() ->
- case test_server:is_cover() orelse erlang:system_info(schedulers) =:= 1 of
+ case erlang:system_info(schedulers) =:= 1 of
true -> [];
false -> [parallel]
end.
@@ -70,21 +66,24 @@ uniq() ->
opt_opts(Mod) ->
Comp = Mod:module_info(compile),
{options,Opts} = lists:keyfind(options, 1, Comp),
- lists:filter(fun(no_copt) -> true;
- (no_postopt) -> true;
- (no_ssa_opt) -> true;
- (no_recv_opt) -> true;
- (no_ssa_float) -> true;
- (no_stack_trimming) -> true;
- (debug_info) -> true;
- (inline) -> true;
- (no_put_tuple2) -> true;
- (no_bsm3) -> true;
- (no_bsm_opt) -> true;
- (no_module_opt) -> true;
- (no_type_opt) -> true;
- (_) -> false
- end, Opts).
+ lists:filter(fun
+ (debug_info) -> true;
+ (inline) -> true;
+ (no_bsm3) -> true;
+ (no_bsm_opt) -> true;
+ (no_copt) -> true;
+ (no_fun_opt) -> true;
+ (no_module_opt) -> true;
+ (no_postopt) -> true;
+ (no_put_tuple2) -> true;
+ (no_recv_opt) -> true;
+ (no_share_opt) -> true;
+ (no_ssa_float) -> true;
+ (no_ssa_opt) -> true;
+ (no_stack_trimming) -> true;
+ (no_type_opt) -> true;
+ (_) -> false
+ end, Opts).
%% Some test suites gets cloned (e.g. to "record_SUITE" to
%% "record_no_opt_SUITE"), but the data directory is not cloned.
@@ -97,18 +96,20 @@ get_data_dir(Config) ->
Data2 = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts),
Data3 = re:replace(Data2, "_inline_SUITE", "_SUITE", Opts),
Data4 = re:replace(Data3, "_r21_SUITE", "_SUITE", Opts),
- re:replace(Data4, "_no_module_opt_SUITE", "_SUITE", Opts).
+ Data = re:replace(Data4, "_no_module_opt_SUITE", "_SUITE", Opts),
+ re:replace(Data, "_no_ssa_opt_SUITE", "_SUITE", Opts).
is_cloned_mod(Mod) ->
is_cloned_mod_1(atom_to_list(Mod)).
%% Test whether Mod is a cloned module.
-is_cloned_mod_1("no_opt_SUITE") -> true;
-is_cloned_mod_1("post_opt_SUITE") -> true;
-is_cloned_mod_1("inline_SUITE") -> true;
-is_cloned_mod_1("21_SUITE") -> true;
-is_cloned_mod_1("no_module_opt_SUITE") -> true;
+is_cloned_mod_1("_no_opt_SUITE") -> true;
+is_cloned_mod_1("_no_ssa_opt_SUITE") -> true;
+is_cloned_mod_1("_post_opt_SUITE") -> true;
+is_cloned_mod_1("_inline_SUITE") -> true;
+is_cloned_mod_1("_21_SUITE") -> true;
+is_cloned_mod_1("_no_module_opt_SUITE") -> true;
is_cloned_mod_1([_|T]) -> is_cloned_mod_1(T);
is_cloned_mod_1([]) -> false.
@@ -117,18 +118,7 @@ is_cloned_mod_1([]) -> false.
p_run(Test, List) ->
S = erlang:system_info(schedulers),
- N = case test_server:is_cover() of
- false ->
- S + 1;
- true ->
- %% Cover is running. Using too many processes
- %% could slow us down. Measurements on my computer
- %% showed that using 4 parallel processes was
- %% slightly faster than using 3. Using more than
- %% 4 would not buy us much and could actually be
- %% slower.
- min(S, 4)
- end,
+ N = S + 1,
io:format("p_run: ~p parallel processes\n", [N]),
p_run_loop(Test, List, N, [], 0, 0).
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index 1f39348998..70b7100451 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -42,7 +42,7 @@
comprehensions/1,maps/1,maps_bin_opt_info/1,
redundant_boolean_clauses/1,
latin1_fallback/1,underscore/1,no_warnings/1,
- bit_syntax/1,inlining/1]).
+ bit_syntax/1,inlining/1,tuple_calls/1]).
init_per_testcase(_Case, Config) ->
Config.
@@ -64,7 +64,8 @@ groups() ->
bin_opt_info,bin_construction,comprehensions,maps,
maps_bin_opt_info,
redundant_boolean_clauses,latin1_fallback,
- underscore,no_warnings,bit_syntax,inlining]}].
+ underscore,no_warnings,bit_syntax,inlining,
+ tuple_calls]}].
init_per_suite(Config) ->
test_lib:recompile(?MODULE),
@@ -239,19 +240,7 @@ guard(Config) when is_list(Config) ->
{4,sys_core_fold,nomatch_guard},
{6,sys_core_fold,no_clause_match},
{6,sys_core_fold,nomatch_guard},
- {6,sys_core_fold,{eval_failure,badarg}},
- {8,sys_core_fold,no_clause_match},
- {8,sys_core_fold,nomatch_guard},
- {8,sys_core_fold,{eval_failure,badarg}},
- {9,sys_core_fold,no_clause_match},
- {9,sys_core_fold,nomatch_guard},
- {9,sys_core_fold,{eval_failure,badarg}},
- {10,sys_core_fold,no_clause_match},
- {10,sys_core_fold,nomatch_guard},
- {10,sys_core_fold,{eval_failure,badarg}},
- {11,sys_core_fold,no_clause_match},
- {11,sys_core_fold,nomatch_guard},
- {11,sys_core_fold,{eval_failure,badarg}}
+ {6,sys_core_fold,{eval_failure,badarg}}
]}}],
[] = run(Config, Ts),
@@ -970,6 +959,20 @@ inlining(Config) ->
run(Config, Ts),
ok.
+tuple_calls(Config) ->
+ %% Make sure that no spurious warnings are generated.
+ Ts = [{inlining_1,
+ <<"-compile(tuple_calls).
+ dispatch(X) ->
+ (list_to_atom(\"prefix_\" ++
+ atom_to_list(suffix))):doit(X).
+ ">>,
+ [],
+ []}
+ ],
+ run(Config, Ts),
+ ok.
+
%%%
%%% End of test cases.
%%%
diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk
index efedb414ad..a523627384 100644
--- a/lib/compiler/vsn.mk
+++ b/lib/compiler/vsn.mk
@@ -1 +1 @@
-COMPILER_VSN = 7.3.1
+COMPILER_VSN = 7.3.2
diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in
index 508e1c40ee..e1e7f71538 100644
--- a/lib/crypto/c_src/Makefile.in
+++ b/lib/crypto/c_src/Makefile.in
@@ -75,6 +75,7 @@ CRYPTO_OBJS = $(OBJDIR)/crypto$(TYPEMARKER).o \
$(OBJDIR)/aead$(TYPEMARKER).o \
$(OBJDIR)/aes$(TYPEMARKER).o \
$(OBJDIR)/algorithms$(TYPEMARKER).o \
+ $(OBJDIR)/api_ng$(TYPEMARKER).o \
$(OBJDIR)/atoms$(TYPEMARKER).o \
$(OBJDIR)/block$(TYPEMARKER).o \
$(OBJDIR)/bn$(TYPEMARKER).o \
diff --git a/lib/crypto/c_src/aead.c b/lib/crypto/c_src/aead.c
index b7ed06e3bc..3ee04f1be9 100644
--- a/lib/crypto/c_src/aead.c
+++ b/lib/crypto/c_src/aead.c
@@ -20,105 +20,111 @@
#include "aead.h"
#include "aes.h"
+#include "cipher.h"
ERL_NIF_TERM aead_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type,Key,Iv,AAD,In) */
#if defined(HAVE_AEAD)
- EVP_CIPHER_CTX *ctx;
+ const struct cipher_type_t *cipherp;
+ EVP_CIPHER_CTX *ctx = NULL;
const EVP_CIPHER *cipher = NULL;
ErlNifBinary key, iv, aad, in;
unsigned int tag_len;
unsigned char *outp, *tagp;
- ERL_NIF_TERM type, out, out_tag;
- int len, ctx_ctrl_set_ivlen, ctx_ctrl_get_tag;
+ ERL_NIF_TERM type, out, out_tag, ret;
+ int len, ctx_ctrl_set_ivlen, ctx_ctrl_get_tag, ctx_ctrl_set_tag;
type = argv[0];
- if (!enif_is_atom(env, type)
- || !enif_inspect_iolist_as_binary(env, argv[1], &key)
- || !enif_inspect_binary(env, argv[2], &iv)
- || !enif_inspect_iolist_as_binary(env, argv[3], &aad)
- || !enif_inspect_iolist_as_binary(env, argv[4], &in)
- || !enif_get_uint(env, argv[5], &tag_len)) {
- return enif_make_badarg(env);
- }
-
- /* Use cipher_type some day. Must check block_encrypt|decrypt first */
-#if defined(HAVE_GCM)
- if (type == atom_aes_gcm) {
- if ((iv.size > 0)
- && (1 <= tag_len && tag_len <= 16)) {
- ctx_ctrl_set_ivlen = EVP_CTRL_GCM_SET_IVLEN;
- ctx_ctrl_get_tag = EVP_CTRL_GCM_GET_TAG;
- if (key.size == 16) cipher = EVP_aes_128_gcm();
- else if (key.size == 24) cipher = EVP_aes_192_gcm();
- else if (key.size == 32) cipher = EVP_aes_256_gcm();
- else enif_make_badarg(env);
- } else
- enif_make_badarg(env);
- } else
-#endif
-#if defined(HAVE_CCM)
- if (type == atom_aes_ccm) {
- if ((7 <= iv.size && iv.size <= 13)
- && (4 <= tag_len && tag_len <= 16)
- && ((tag_len & 1) == 0)
- ) {
- ctx_ctrl_set_ivlen = EVP_CTRL_CCM_SET_IVLEN;
- ctx_ctrl_get_tag = EVP_CTRL_CCM_GET_TAG;
- if (key.size == 16) cipher = EVP_aes_128_ccm();
- else if (key.size == 24) cipher = EVP_aes_192_ccm();
- else if (key.size == 32) cipher = EVP_aes_256_ccm();
- else enif_make_badarg(env);
- } else
- enif_make_badarg(env);
- } else
-#endif
-#if defined(HAVE_CHACHA20_POLY1305)
- if (type == atom_chacha20_poly1305) {
- if ((key.size == 32)
- && (1 <= iv.size && iv.size <= 16)
- && (tag_len == 16)
- ) {
- ctx_ctrl_set_ivlen = EVP_CTRL_AEAD_SET_IVLEN;
- ctx_ctrl_get_tag = EVP_CTRL_AEAD_GET_TAG,
- cipher = EVP_chacha20_poly1305();
- } else enif_make_badarg(env);
- } else
-#endif
+ ASSERT(argc == 6);
+
+ if (!enif_is_atom(env, type))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key))
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[2], &iv))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[3], &aad))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[4], &in))
+ goto bad_arg;
+ if (!enif_get_uint(env, argv[5], &tag_len))
+ goto bad_arg;
+
+ if (tag_len > INT_MAX
+ || iv.size > INT_MAX
+ || in.size > INT_MAX
+ || aad.size > INT_MAX)
+ goto bad_arg;
+
+ if ((cipherp = get_cipher_type(type, key.size)) == NULL)
+ goto bad_arg;
+ if (cipherp->flags & NON_EVP_CIPHER)
+ goto bad_arg;
+ if (! (cipherp->flags & AEAD_CIPHER) )
+ goto bad_arg;
+ if ((cipher = cipherp->cipher.p) == NULL)
return enif_raise_exception(env, atom_notsup);
-
- ctx = EVP_CIPHER_CTX_new();
- if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) goto out_err;
- if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, iv.size, NULL) != 1) goto out_err;
+
+ ctx_ctrl_set_ivlen = cipherp->extra.aead.ctx_ctrl_set_ivlen;
+ ctx_ctrl_get_tag = cipherp->extra.aead.ctx_ctrl_get_tag;
+ ctx_ctrl_set_tag = cipherp->extra.aead.ctx_ctrl_set_tag;
+
+ if ((ctx = EVP_CIPHER_CTX_new()) == NULL)
+ goto err;
+
+ if (EVP_EncryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1)
+ goto err;
+ if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1)
+ goto err;
#if defined(HAVE_CCM)
if (type == atom_aes_ccm) {
- if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_CCM_SET_TAG, tag_len, NULL) != 1) goto out_err;
- if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err;
- if (EVP_EncryptUpdate(ctx, NULL, &len, NULL, in.size) != 1) goto out_err;
+ if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag_len, NULL) != 1)
+ goto err;
+ if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1)
+ goto err;
+ if (EVP_EncryptUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1)
+ goto err;
} else
#endif
- if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err;
+ {
+ if (EVP_EncryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1)
+ goto err;
+ }
- if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) goto out_err;
+ if (EVP_EncryptUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1)
+ goto err;
- outp = enif_make_new_binary(env, in.size, &out);
+ if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL)
+ goto err;
- if (EVP_EncryptUpdate(ctx, outp, &len, in.data, in.size) != 1) goto out_err;
- if (EVP_EncryptFinal_ex(ctx, outp/*+len*/, &len) != 1) goto out_err;
+ if (EVP_EncryptUpdate(ctx, outp, &len, in.data, (int)in.size) != 1)
+ goto err;
+ if (EVP_EncryptFinal_ex(ctx, outp/*+len*/, &len) != 1)
+ goto err;
- tagp = enif_make_new_binary(env, tag_len, &out_tag);
+ if ((tagp = enif_make_new_binary(env, tag_len, &out_tag)) == NULL)
+ goto err;
- if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_get_tag, tag_len, tagp) != 1) goto out_err;
+ if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_get_tag, (int)tag_len, tagp) != 1)
+ goto err;
- EVP_CIPHER_CTX_free(ctx);
CONSUME_REDS(env, in);
- return enif_make_tuple2(env, out, out_tag);
+ ret = enif_make_tuple2(env, out, out_tag);
+ goto done;
+
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
-out_err:
- EVP_CIPHER_CTX_free(ctx);
- return atom_error;
+ err:
+ ret = atom_error;
+
+ done:
+ if (ctx)
+ EVP_CIPHER_CTX_free(ctx);
+ return ret;
#else
return enif_raise_exception(env, atom_notsup);
@@ -128,105 +134,109 @@ out_err:
ERL_NIF_TERM aead_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type,Key,Iv,AAD,In,Tag) */
#if defined(HAVE_AEAD)
- EVP_CIPHER_CTX *ctx;
+ const struct cipher_type_t *cipherp;
+ EVP_CIPHER_CTX *ctx = NULL;
const EVP_CIPHER *cipher = NULL;
ErlNifBinary key, iv, aad, in, tag;
unsigned char *outp;
- ERL_NIF_TERM type, out;
+ ERL_NIF_TERM type, out, ret;
int len, ctx_ctrl_set_ivlen, ctx_ctrl_set_tag;
+ ASSERT(argc == 6);
+
type = argv[0];
#if defined(HAVE_GCM_EVP_DECRYPT_BUG)
if (type == atom_aes_gcm)
return aes_gcm_decrypt_NO_EVP(env, argc, argv);
#endif
- if (!enif_is_atom(env, type)
- || !enif_inspect_iolist_as_binary(env, argv[1], &key)
- || !enif_inspect_binary(env, argv[2], &iv)
- || !enif_inspect_iolist_as_binary(env, argv[3], &aad)
- || !enif_inspect_iolist_as_binary(env, argv[4], &in)
- || !enif_inspect_iolist_as_binary(env, argv[5], &tag)) {
- return enif_make_badarg(env);
- }
-
- /* Use cipher_type some day. Must check block_encrypt|decrypt first */
-#if defined(HAVE_GCM)
- if (type == atom_aes_gcm) {
- if (iv.size > 0) {
- ctx_ctrl_set_ivlen = EVP_CTRL_GCM_SET_IVLEN;
- ctx_ctrl_set_tag = EVP_CTRL_GCM_SET_TAG;
- if (key.size == 16) cipher = EVP_aes_128_gcm();
- else if (key.size == 24) cipher = EVP_aes_192_gcm();
- else if (key.size == 32) cipher = EVP_aes_256_gcm();
- else enif_make_badarg(env);
- } else
- enif_make_badarg(env);
- } else
-#endif
-#if defined(HAVE_CCM)
- if (type == atom_aes_ccm) {
- if (iv.size > 0) {
- ctx_ctrl_set_ivlen = EVP_CTRL_CCM_SET_IVLEN;
- if (key.size == 16) cipher = EVP_aes_128_ccm();
- else if (key.size == 24) cipher = EVP_aes_192_ccm();
- else if (key.size == 32) cipher = EVP_aes_256_ccm();
- else enif_make_badarg(env);
- } else
- enif_make_badarg(env);
- } else
-#endif
-#if defined(HAVE_CHACHA20_POLY1305)
- if (type == atom_chacha20_poly1305) {
- if ((key.size == 32)
- && (1 <= iv.size && iv.size <= 16)
- && tag.size == 16
- ) {
- ctx_ctrl_set_ivlen = EVP_CTRL_AEAD_SET_IVLEN;
- ctx_ctrl_set_tag = EVP_CTRL_AEAD_SET_TAG;
- cipher = EVP_chacha20_poly1305();
- } else enif_make_badarg(env);
- } else
-#endif
+ if (!enif_is_atom(env, type))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key))
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[2], &iv))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[3], &aad))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[4], &in))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[5], &tag))
+ goto bad_arg;
+
+ if (tag.size > INT_MAX
+ || key.size > INT_MAX
+ || iv.size > INT_MAX
+ || in.size > INT_MAX
+ || aad.size > INT_MAX)
+ goto bad_arg;
+
+ if ((cipherp = get_cipher_type(type, key.size)) == NULL)
+ goto bad_arg;
+ if (cipherp->flags & NON_EVP_CIPHER)
+ goto bad_arg;
+ if ( !(cipherp->flags & AEAD_CIPHER) )
+ goto bad_arg;
+ if ((cipher = cipherp->cipher.p) == NULL)
return enif_raise_exception(env, atom_notsup);
- outp = enif_make_new_binary(env, in.size, &out);
+ ctx_ctrl_set_ivlen = cipherp->extra.aead.ctx_ctrl_set_ivlen;
+ ctx_ctrl_set_tag = cipherp->extra.aead.ctx_ctrl_set_tag;
- ctx = EVP_CIPHER_CTX_new();
- if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1) goto out_err;
- if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, iv.size, NULL) != 1) goto out_err;
+ if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL)
+ goto err;
-#if defined(HAVE_CCM)
- if (type == atom_aes_ccm) {
- if (EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_CCM_SET_TAG, tag.size, tag.data) != 1) goto out_err;
- }
-#endif
-
- if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1) goto out_err;
+ if ((ctx = EVP_CIPHER_CTX_new()) == NULL)
+ goto err;
+ if (EVP_DecryptInit_ex(ctx, cipher, NULL, NULL, NULL) != 1)
+ goto err;
+ if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_ivlen, (int)iv.size, NULL) != 1)
+ goto err;
#if defined(HAVE_CCM)
if (type == atom_aes_ccm) {
- if (1 != EVP_DecryptUpdate(ctx, NULL, &len, NULL, in.size)) goto out_err;
+ if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag.size, tag.data) != 1)
+ goto err;
+ if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1)
+ goto err;
+ if (EVP_DecryptUpdate(ctx, NULL, &len, NULL, (int)in.size) != 1)
+ goto err;
}
+ else
#endif
+ {
+ if (EVP_DecryptInit_ex(ctx, NULL, NULL, key.data, iv.data) != 1)
+ goto err;
+ }
- if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, aad.size) != 1) goto out_err;
- if (EVP_DecryptUpdate(ctx, outp, &len, in.data, in.size) != 1) goto out_err;
+ if (EVP_DecryptUpdate(ctx, NULL, &len, aad.data, (int)aad.size) != 1)
+ goto err;
+ if (EVP_DecryptUpdate(ctx, outp, &len, in.data, (int)in.size) != 1)
+ goto err;
-#if defined(HAVE_GCM) || defined(HAVE_CHACHA20_POLY1305)
+#if defined(HAVE_GCM)
if (type == atom_aes_gcm) {
- if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, tag.size, tag.data) != 1) goto out_err;
- if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1) goto out_err;
+ if (EVP_CIPHER_CTX_ctrl(ctx, ctx_ctrl_set_tag, (int)tag.size, tag.data) != 1)
+ goto err;
+ if (EVP_DecryptFinal_ex(ctx, outp+len, &len) != 1)
+ goto err;
}
#endif
- EVP_CIPHER_CTX_free(ctx);
-
CONSUME_REDS(env, in);
- return out;
+ ret = out;
+ goto done;
+
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ err:
+ ret = atom_error;
+
+ done:
+ if (ctx)
+ EVP_CIPHER_CTX_free(ctx);
+ return ret;
-out_err:
- EVP_CIPHER_CTX_free(ctx);
- return atom_error;
#else
return enif_raise_exception(env, atom_notsup);
#endif
diff --git a/lib/crypto/c_src/aes.c b/lib/crypto/c_src/aes.c
index 36cd02933f..ee2bb70fb7 100644
--- a/lib/crypto/c_src/aes.c
+++ b/lib/crypto/c_src/aes.c
@@ -28,24 +28,40 @@ ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
unsigned char ivec_clone[16]; /* writable copy */
int new_ivlen = 0;
ERL_NIF_TERM ret;
+ unsigned char *outp;
CHECK_NO_FIPS_MODE();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !(key.size == 16 || key.size == 24 || key.size == 32)
- || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16
- || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 4);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key))
+ goto bad_arg;
+ if (key.size != 16 && key.size != 24 && key.size != 32)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[1], &ivec))
+ goto bad_arg;
+ if (ivec.size != 16)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[2], &text))
+ goto bad_arg;
memcpy(ivec_clone, ivec.data, 16);
- AES_set_encrypt_key(key.data, key.size * 8, &aes_key);
+
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (AES_set_encrypt_key(key.data, (int)key.size * 8, &aes_key) != 0)
+ goto err;
+ if ((outp = enif_make_new_binary(env, text.size, &ret)) == NULL)
+ goto err;
AES_cfb8_encrypt((unsigned char *) text.data,
- enif_make_new_binary(env, text.size, &ret),
+ outp,
text.size, &aes_key, ivec_clone, &new_ivlen,
(argv[3] == atom_true));
CONSUME_REDS(env,text);
return ret;
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
}
ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -55,22 +71,39 @@ ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
unsigned char ivec_clone[16]; /* writable copy */
int new_ivlen = 0;
ERL_NIF_TERM ret;
+ unsigned char *outp;
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key)
- || !(key.size == 16 || key.size == 24 || key.size == 32)
- || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16
- || !enif_inspect_iolist_as_binary(env, argv[2], &text)) {
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 4);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key))
+ goto bad_arg;
+ if (key.size != 16 && key.size != 24 && key.size != 32)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[1], &ivec))
+ goto bad_arg;
+ if (ivec.size != 16)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[2], &text))
+ goto bad_arg;
memcpy(ivec_clone, ivec.data, 16);
- AES_set_encrypt_key(key.data, key.size * 8, &aes_key);
+
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (AES_set_encrypt_key(key.data, (int)key.size * 8, &aes_key) != 0)
+ goto err;
+
+ if ((outp = enif_make_new_binary(env, text.size, &ret)) == NULL)
+ goto err;
AES_cfb128_encrypt((unsigned char *) text.data,
- enif_make_new_binary(env, text.size, &ret),
+ outp,
text.size, &aes_key, ivec_clone, &new_ivlen,
(argv[3] == atom_true));
CONSUME_REDS(env,text);
return ret;
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
}
ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -79,98 +112,164 @@ ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
ErlNifBinary key_bin, ivec_bin, data_bin;
AES_KEY aes_key;
unsigned char ivec[32];
- int i;
+ int type;
unsigned char* ret_ptr;
ERL_NIF_TERM ret;
CHECK_NO_FIPS_MODE();
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || (key_bin.size != 16 && key_bin.size != 32)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || ivec_bin.size != 32
- || !enif_inspect_iolist_as_binary(env, argv[2], &data_bin)
- || data_bin.size % 16 != 0) {
-
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 4);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin))
+ goto bad_arg;
+ if (key_bin.size != 16 && key_bin.size != 32)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[1], &ivec_bin))
+ goto bad_arg;
+ if (ivec_bin.size != 32)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[2], &data_bin))
+ goto bad_arg;
+ if (data_bin.size % 16 != 0)
+ goto bad_arg;
if (argv[3] == atom_true) {
- i = AES_ENCRYPT;
- AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key);
+ type = AES_ENCRYPT;
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (AES_set_encrypt_key(key_bin.data, (int)key_bin.size * 8, &aes_key) != 0)
+ goto err;
}
else {
- i = AES_DECRYPT;
- AES_set_decrypt_key(key_bin.data, key_bin.size*8, &aes_key);
+ type = AES_DECRYPT;
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (AES_set_decrypt_key(key_bin.data, (int)key_bin.size * 8, &aes_key) != 0)
+ goto err;
}
- ret_ptr = enif_make_new_binary(env, data_bin.size, &ret);
+ if ((ret_ptr = enif_make_new_binary(env, data_bin.size, &ret)) == NULL)
+ goto err;
+
memcpy(ivec, ivec_bin.data, 32); /* writable copy */
- AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, i);
+
+ AES_ige_encrypt(data_bin.data, ret_ptr, data_bin.size, &aes_key, ivec, type);
+
CONSUME_REDS(env,data_bin);
return ret;
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
+
#else
return atom_notsup;
#endif
}
-/* Initializes state for ctr streaming (de)encryption
-*/
#ifdef HAVE_EVP_AES_CTR
ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, IVec) */
ErlNifBinary key_bin, ivec_bin;
- struct evp_cipher_ctx *ctx;
+ struct evp_cipher_ctx *ctx = NULL;
const EVP_CIPHER *cipher;
ERL_NIF_TERM ret;
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || ivec_bin.size != 16) {
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 2);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin))
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[1], &ivec_bin))
+ goto bad_arg;
+ if (ivec_bin.size != 16)
+ goto bad_arg;
switch (key_bin.size)
{
- case 16: cipher = EVP_aes_128_ctr(); break;
- case 24: cipher = EVP_aes_192_ctr(); break;
- case 32: cipher = EVP_aes_256_ctr(); break;
- default: return enif_make_badarg(env);
+ case 16:
+ cipher = EVP_aes_128_ctr();
+ break;
+ case 24:
+ cipher = EVP_aes_192_ctr();
+ break;
+ case 32:
+ cipher = EVP_aes_256_ctr();
+ break;
+ default:
+ goto bad_arg;
}
- ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx));
- ctx->ctx = EVP_CIPHER_CTX_new();
- EVP_CipherInit_ex(ctx->ctx, cipher, NULL,
- key_bin.data, ivec_bin.data, 1);
- EVP_CIPHER_CTX_set_padding(ctx->ctx, 0);
+ if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL)
+ goto err;
+ if ((ctx->ctx = EVP_CIPHER_CTX_new()) == NULL)
+ goto err;
+
+ if (EVP_CipherInit_ex(ctx->ctx, cipher, NULL,
+ key_bin.data, ivec_bin.data, 1) != 1)
+ goto err;
+
+ if (EVP_CIPHER_CTX_set_padding(ctx->ctx, 0) != 1)
+ goto err;
+
ret = enif_make_resource(env, ctx);
- enif_release_resource(ctx);
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (ctx)
+ enif_release_resource(ctx);
return ret;
}
ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context, Data) */
- struct evp_cipher_ctx *ctx, *new_ctx;
+ struct evp_cipher_ctx *ctx = NULL, *new_ctx = NULL;
ErlNifBinary data_bin;
ERL_NIF_TERM ret, cipher_term;
unsigned char *out;
int outl = 0;
- if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
- return enif_make_badarg(env);
- }
- new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx));
- new_ctx->ctx = EVP_CIPHER_CTX_new();
- EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx);
- out = enif_make_new_binary(env, data_bin.size, &cipher_term);
- EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, data_bin.size);
- ASSERT(outl == data_bin.size);
+ ASSERT(argc == 2);
+
+ if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin))
+ goto bad_arg;
+ if (data_bin.size > INT_MAX)
+ goto bad_arg;
+
+ if ((new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL)
+ goto err;
+ if ((new_ctx->ctx = EVP_CIPHER_CTX_new()) == NULL)
+ goto err;
+
+ if (EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx) != 1)
+ goto err;
+
+ if ((out = enif_make_new_binary(env, data_bin.size, &cipher_term)) == NULL)
+ goto err;
+
+ if (EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, (int)data_bin.size) != 1)
+ goto err;
+ ASSERT(outl >= 0 && (size_t)outl == data_bin.size);
ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term);
- enif_release_resource(new_ctx);
CONSUME_REDS(env,data_bin);
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (new_ctx)
+ enif_release_resource(new_ctx);
return ret;
}
@@ -178,22 +277,46 @@ ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM
ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, IVec) */
+ ASSERT(argc == 2);
+
+ return aes_ctr_stream_init_compat(env, argv[0], argv[1]);
+}
+
+
+ERL_NIF_TERM aes_ctr_stream_init_compat(ErlNifEnv* env, const ERL_NIF_TERM key_term, const ERL_NIF_TERM iv_term)
+{
ErlNifBinary key_bin, ivec_bin;
ERL_NIF_TERM ecount_bin;
+ unsigned char *outp;
+
+ if (!enif_inspect_iolist_as_binary(env, key_term, &key_bin))
+ goto bad_arg;
+ if (key_bin.size != 16 && key_bin.size != 24 && key_bin.size != 32)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, iv_term, &ivec_bin))
+ goto bad_arg;
+ if (ivec_bin.size != 16)
+ goto bad_arg;
+ if ((outp = enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin)) == NULL)
+ goto err;
+ memset(outp, 0, AES_BLOCK_SIZE);
+
+ return enif_make_tuple4(env, key_term, iv_term, ecount_bin, enif_make_int(env, 0));
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
+}
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || !(key_bin.size == 16 || key_bin.size == 24 || key_bin.size ==32)
- || ivec_bin.size != 16) {
- return enif_make_badarg(env);
- }
+ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ASSERT(argc == 2);
- memset(enif_make_new_binary(env, AES_BLOCK_SIZE, &ecount_bin),
- 0, AES_BLOCK_SIZE);
- return enif_make_tuple4(env, argv[0], argv[1], ecount_bin, enif_make_int(env, 0));
+ return aes_ctr_stream_encrypt_compat(env, argv[0], argv[1]);
}
-ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+
+ERL_NIF_TERM aes_ctr_stream_encrypt_compat(ErlNifEnv* env, const ERL_NIF_TERM state_arg, const ERL_NIF_TERM data_arg)
{/* ({Key, IVec, ECount, Num}, Data) */
ErlNifBinary key_bin, ivec_bin, text_bin, ecount_bin;
AES_KEY aes_key;
@@ -203,26 +326,46 @@ ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM
const ERL_NIF_TERM *state_term;
unsigned char * ivec2_buf;
unsigned char * ecount2_buf;
+ unsigned char *outp;
- if (!enif_get_tuple(env, argv[0], &state_arity, &state_term)
- || state_arity != 4
- || !enif_inspect_iolist_as_binary(env, state_term[0], &key_bin)
- || AES_set_encrypt_key(key_bin.data, key_bin.size*8, &aes_key) != 0
- || !enif_inspect_binary(env, state_term[1], &ivec_bin) || ivec_bin.size != 16
- || !enif_inspect_binary(env, state_term[2], &ecount_bin) || ecount_bin.size != AES_BLOCK_SIZE
- || !enif_get_uint(env, state_term[3], &num)
- || !enif_inspect_iolist_as_binary(env, argv[1], &text_bin)) {
- return enif_make_badarg(env);
- }
-
- ivec2_buf = enif_make_new_binary(env, ivec_bin.size, &ivec2_term);
- ecount2_buf = enif_make_new_binary(env, ecount_bin.size, &ecount2_term);
+ if (!enif_get_tuple(env, state_arg, &state_arity, &state_term))
+ goto bad_arg;
+ if (state_arity != 4)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, state_term[0], &key_bin))
+ goto bad_arg;
+ if (key_bin.size > INT_MAX / 8)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, state_term[1], &ivec_bin))
+ goto bad_arg;
+ if (ivec_bin.size != 16)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, state_term[2], &ecount_bin))
+ goto bad_arg;
+ if (ecount_bin.size != AES_BLOCK_SIZE)
+ goto bad_arg;
+ if (!enif_get_uint(env, state_term[3], &num))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, data_arg, &text_bin))
+ goto bad_arg;
+
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (AES_set_encrypt_key(key_bin.data, (int)key_bin.size * 8, &aes_key) != 0)
+ goto bad_arg;
+
+ if ((ivec2_buf = enif_make_new_binary(env, ivec_bin.size, &ivec2_term)) == NULL)
+ goto err;
+ if ((ecount2_buf = enif_make_new_binary(env, ecount_bin.size, &ecount2_term)) == NULL)
+ goto err;
memcpy(ivec2_buf, ivec_bin.data, 16);
memcpy(ecount2_buf, ecount_bin.data, ecount_bin.size);
+ if ((outp = enif_make_new_binary(env, text_bin.size, &cipher_term)) == NULL)
+ goto err;
+
AES_ctr128_encrypt((unsigned char *) text_bin.data,
- enif_make_new_binary(env, text_bin.size, &cipher_term),
+ outp,
text_bin.size, &aes_key, ivec2_buf, ecount2_buf, &num);
num2_term = enif_make_uint(env, num);
@@ -230,53 +373,79 @@ ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM
ret = enif_make_tuple2(env, new_state_term, cipher_term);
CONSUME_REDS(env,text_bin);
return ret;
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
}
#endif /* !HAVE_EVP_AES_CTR */
#ifdef HAVE_GCM_EVP_DECRYPT_BUG
ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type,Key,Iv,AAD,In,Tag) */
- GCM128_CONTEXT *ctx;
+ GCM128_CONTEXT *ctx = NULL;
ErlNifBinary key, iv, aad, in, tag;
AES_KEY aes_key;
unsigned char *outp;
- ERL_NIF_TERM out;
-
- if (!enif_inspect_iolist_as_binary(env, argv[1], &key)
- || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0
- || !enif_inspect_binary(env, argv[2], &iv) || iv.size == 0
- || !enif_inspect_iolist_as_binary(env, argv[3], &aad)
- || !enif_inspect_iolist_as_binary(env, argv[4], &in)
- || !enif_inspect_iolist_as_binary(env, argv[5], &tag)) {
- return enif_make_badarg(env);
- }
-
- if (!(ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt)))
- return atom_error;
+ ERL_NIF_TERM out, ret;
+
+ ASSERT(argc == 6);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key))
+ goto bad_arg;
+ if (key.size > INT_MAX / 8)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[2], &iv))
+ goto bad_arg;
+ if (iv.size == 0)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[3], &aad))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[4], &in))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[5], &tag))
+ goto bad_arg;
+
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (AES_set_encrypt_key(key.data, (int)key.size * 8, &aes_key) != 0)
+ goto bad_arg;
+
+ if ((ctx = CRYPTO_gcm128_new(&aes_key, (block128_f)AES_encrypt)) == NULL)
+ goto err;
CRYPTO_gcm128_setiv(ctx, iv.data, iv.size);
- if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size))
- goto out_err;
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (CRYPTO_gcm128_aad(ctx, aad.data, aad.size) != 0)
+ goto err;
- outp = enif_make_new_binary(env, in.size, &out);
+ if ((outp = enif_make_new_binary(env, in.size, &out)) == NULL)
+ goto err;
- /* decrypt */
- if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size))
- goto out_err;
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (CRYPTO_gcm128_decrypt(ctx, in.data, outp, in.size) != 0)
+ goto err;
/* calculate and check the tag */
- if (CRYPTO_gcm128_finish(ctx, tag.data, tag.size))
- goto out_err;
+ /* NOTE: This function returns 0 on success unlike most OpenSSL functions */
+ if (CRYPTO_gcm128_finish(ctx, tag.data, tag.size) != 0)
+ goto err;
- CRYPTO_gcm128_release(ctx);
CONSUME_REDS(env, in);
+ ret = out;
+ goto done;
+
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
- return out;
+ err:
+ ret = atom_error;
-out_err:
- CRYPTO_gcm128_release(ctx);
- return atom_error;
+ done:
+ if (ctx)
+ CRYPTO_gcm128_release(ctx);
+ return ret;
}
#endif /* HAVE_GCM_EVP_DECRYPT_BUG */
diff --git a/lib/crypto/c_src/aes.h b/lib/crypto/c_src/aes.h
index 09c984f84a..527d041410 100644
--- a/lib/crypto/c_src/aes.h
+++ b/lib/crypto/c_src/aes.h
@@ -26,8 +26,13 @@
ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
ERL_NIF_TERM aes_cfb_128_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+#if !defined(HAVE_EVP_AES_CTR)
+ERL_NIF_TERM aes_ctr_stream_init_compat(ErlNifEnv* env, const ERL_NIF_TERM key_term, const ERL_NIF_TERM iv_term);
+ERL_NIF_TERM aes_ctr_stream_encrypt_compat(ErlNifEnv* env, const ERL_NIF_TERM state_arg, const ERL_NIF_TERM data_arg);
+#endif
#ifdef HAVE_GCM_EVP_DECRYPT_BUG
ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
diff --git a/lib/crypto/c_src/algorithms.c b/lib/crypto/c_src/algorithms.c
index a6e61cc9b2..06cd109fc1 100644
--- a/lib/crypto/c_src/algorithms.c
+++ b/lib/crypto/c_src/algorithms.c
@@ -19,18 +19,17 @@
*/
#include "algorithms.h"
+#include "cipher.h"
-static int algo_hash_cnt, algo_hash_fips_cnt;
-static ERL_NIF_TERM algo_hash[12]; /* increase when extending the list */
-static int algo_pubkey_cnt, algo_pubkey_fips_cnt;
+static unsigned int algo_hash_cnt, algo_hash_fips_cnt;
+static ERL_NIF_TERM algo_hash[14]; /* increase when extending the list */
+static unsigned int algo_pubkey_cnt, algo_pubkey_fips_cnt;
static ERL_NIF_TERM algo_pubkey[12]; /* increase when extending the list */
-static int algo_cipher_cnt, algo_cipher_fips_cnt;
-static ERL_NIF_TERM algo_cipher[25]; /* increase when extending the list */
-static int algo_mac_cnt, algo_mac_fips_cnt;
+static unsigned int algo_mac_cnt, algo_mac_fips_cnt;
static ERL_NIF_TERM algo_mac[3]; /* increase when extending the list */
-static int algo_curve_cnt, algo_curve_fips_cnt;
+static unsigned int algo_curve_cnt, algo_curve_fips_cnt;
static ERL_NIF_TERM algo_curve[89]; /* increase when extending the list */
-static int algo_rsa_opts_cnt, algo_rsa_opts_fips_cnt;
+static unsigned int algo_rsa_opts_cnt, algo_rsa_opts_fips_cnt;
static ERL_NIF_TERM algo_rsa_opts[11]; /* increase when extending the list */
void init_algorithms_types(ErlNifEnv* env)
@@ -62,6 +61,11 @@ void init_algorithms_types(ErlNifEnv* env)
#ifdef HAVE_SHA3_512
algo_hash[algo_hash_cnt++] = enif_make_atom(env, "sha3_512");
#endif
+#ifdef HAVE_BLAKE2
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "blake2b");
+ algo_hash[algo_hash_cnt++] = enif_make_atom(env, "blake2s");
+#endif
+
// Non-validated algorithms follow
algo_hash_fips_cnt = algo_hash_cnt;
algo_hash[algo_hash_cnt++] = enif_make_atom(env, "md4");
@@ -87,55 +91,6 @@ void init_algorithms_types(ErlNifEnv* env)
#endif
algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "srp");
- // Validated algorithms first
- algo_cipher_cnt = 0;
-#ifndef OPENSSL_NO_DES
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbc");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des_ede3");
-#ifdef HAVE_DES_ede3_cfb_encrypt
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cbf");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "des3_cfb");
-#endif
-#endif
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc128");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb8");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cfb128");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_cbc256");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ctr");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env, "aes_ecb");
-#if defined(HAVE_GCM)
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_gcm");
-#endif
-#if defined(HAVE_CCM)
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ccm");
-#endif
- // Non-validated algorithms follow
- algo_cipher_fips_cnt = algo_cipher_cnt;
-#ifdef HAVE_AES_IGE
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"aes_ige256");
-#endif
-#ifndef OPENSSL_NO_DES
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cbc");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_cfb");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"des_ecb");
-#endif
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_cbc");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_cfb64");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_ofb64");
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"blowfish_ecb");
-#ifndef OPENSSL_NO_RC2
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc2_cbc");
-#endif
-#ifndef OPENSSL_NO_RC4
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"rc4");
-#endif
-#if defined(HAVE_CHACHA20_POLY1305)
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20_poly1305");
-#endif
-#if defined(HAVE_CHACHA20)
- algo_cipher[algo_cipher_cnt++] = enif_make_atom(env,"chacha20");
-#endif
// Validated algorithms first
algo_mac_cnt = 0;
@@ -285,7 +240,6 @@ void init_algorithms_types(ErlNifEnv* env)
// Check that the max number of algos is updated
ASSERT(algo_hash_cnt <= sizeof(algo_hash)/sizeof(ERL_NIF_TERM));
ASSERT(algo_pubkey_cnt <= sizeof(algo_pubkey)/sizeof(ERL_NIF_TERM));
- ASSERT(algo_cipher_cnt <= sizeof(algo_cipher)/sizeof(ERL_NIF_TERM));
ASSERT(algo_mac_cnt <= sizeof(algo_mac)/sizeof(ERL_NIF_TERM));
ASSERT(algo_curve_cnt <= sizeof(algo_curve)/sizeof(ERL_NIF_TERM));
ASSERT(algo_rsa_opts_cnt <= sizeof(algo_rsa_opts)/sizeof(ERL_NIF_TERM));
@@ -295,24 +249,23 @@ ERL_NIF_TERM algorithms(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
#ifdef FIPS_SUPPORT
int fips_mode = FIPS_mode();
- int hash_cnt = fips_mode ? algo_hash_fips_cnt : algo_hash_cnt;
- int pubkey_cnt = fips_mode ? algo_pubkey_fips_cnt : algo_pubkey_cnt;
- int cipher_cnt = fips_mode ? algo_cipher_fips_cnt : algo_cipher_cnt;
- int mac_cnt = fips_mode ? algo_mac_fips_cnt : algo_mac_cnt;
- int curve_cnt = fips_mode ? algo_curve_fips_cnt : algo_curve_cnt;
- int rsa_opts_cnt = fips_mode ? algo_rsa_opts_fips_cnt : algo_rsa_opts_cnt;
+
+ unsigned int hash_cnt = fips_mode ? algo_hash_fips_cnt : algo_hash_cnt;
+ unsigned int pubkey_cnt = fips_mode ? algo_pubkey_fips_cnt : algo_pubkey_cnt;
+ unsigned int mac_cnt = fips_mode ? algo_mac_fips_cnt : algo_mac_cnt;
+ unsigned int curve_cnt = fips_mode ? algo_curve_fips_cnt : algo_curve_cnt;
+ unsigned int rsa_opts_cnt = fips_mode ? algo_rsa_opts_fips_cnt : algo_rsa_opts_cnt;
#else
- int hash_cnt = algo_hash_cnt;
- int pubkey_cnt = algo_pubkey_cnt;
- int cipher_cnt = algo_cipher_cnt;
- int mac_cnt = algo_mac_cnt;
- int curve_cnt = algo_curve_cnt;
- int rsa_opts_cnt = algo_rsa_opts_cnt;
+ unsigned int hash_cnt = algo_hash_cnt;
+ unsigned int pubkey_cnt = algo_pubkey_cnt;
+ unsigned int mac_cnt = algo_mac_cnt;
+ unsigned int curve_cnt = algo_curve_cnt;
+ unsigned int rsa_opts_cnt = algo_rsa_opts_cnt;
#endif
return enif_make_tuple6(env,
enif_make_list_from_array(env, algo_hash, hash_cnt),
enif_make_list_from_array(env, algo_pubkey, pubkey_cnt),
- enif_make_list_from_array(env, algo_cipher, cipher_cnt),
+ cipher_types_as_list(env),
enif_make_list_from_array(env, algo_mac, mac_cnt),
enif_make_list_from_array(env, algo_curve, curve_cnt),
enif_make_list_from_array(env, algo_rsa_opts, rsa_opts_cnt)
diff --git a/lib/crypto/c_src/api_ng.c b/lib/crypto/c_src/api_ng.c
new file mode 100644
index 0000000000..c4114d1626
--- /dev/null
+++ b/lib/crypto/c_src/api_ng.c
@@ -0,0 +1,223 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2010-2018. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "api_ng.h"
+#include "aes.h"
+#include "cipher.h"
+
+/*
+ * A unified set of functions for encryption/decryption.
+ *
+ * EXPERIMENTAL!!
+ *
+ */
+ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
+
+
+/* Try better error messages in new functions */
+#define ERROR_Term(Env, ReasonTerm) enif_make_tuple2((Env), atom_error, (ReasonTerm))
+#define ERROR_Str(Env, ReasonString) ERROR_Term((Env), enif_make_string((Env),(ReasonString),(ERL_NIF_LATIN1)))
+
+/* Initializes state for (de)encryption
+ */
+ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Cipher, Key, IVec, Encrypt) % if no IV for the Cipher, set IVec = <<>>
+ */
+ ErlNifBinary key_bin, ivec_bin;
+ unsigned char *iv = NULL;
+ struct evp_cipher_ctx *ctx;
+ const struct cipher_type_t *cipherp;
+ const EVP_CIPHER *cipher;
+ ERL_NIF_TERM enc_flg_arg, ret;
+ int enc;
+ unsigned iv_len;
+
+ enc_flg_arg = argv[argc-1];
+ if (enc_flg_arg == atom_true)
+ enc = 1;
+ else if (enc_flg_arg == atom_false)
+ enc = 0;
+ else if (enc_flg_arg == atom_undefined)
+ /* For compat funcs in crypto.erl */
+ enc = -1;
+ else
+ return ERROR_Str(env, "Bad enc flag");
+
+ if (!enif_inspect_binary(env, argv[1], &key_bin))
+ return ERROR_Str(env, "Bad key");
+
+ if (!(cipherp = get_cipher_type(argv[0], key_bin.size)))
+ return ERROR_Str(env, "Unknown cipher or bad key size");
+
+ if (FORBIDDEN_IN_FIPS(cipherp))
+ return enif_raise_exception(env, atom_notsup);
+
+ if (enc == -1)
+ return atom_undefined;
+
+ if (!(cipher = cipherp->cipher.p)) {
+#if !defined(HAVE_EVP_AES_CTR)
+ if (cipherp->flags & AES_CTR_COMPAT)
+ return aes_ctr_stream_init_compat(env, argv[1], argv[2]);
+ else
+#endif
+ return enif_raise_exception(env, atom_notsup);
+ }
+
+#ifdef HAVE_ECB_IVEC_BUG
+ if (cipherp->flags & ECB_BUG_0_9_8L)
+ iv_len = 0; /* <= 0.9.8l returns faulty ivec length */
+ else
+#endif
+ iv_len = EVP_CIPHER_iv_length(cipher);
+
+ if (iv_len) {
+ if (!enif_inspect_binary(env, argv[2], &ivec_bin))
+ return ERROR_Str(env, "Bad iv type");
+
+ if (iv_len != ivec_bin.size)
+ return ERROR_Str(env, "Bad iv size");
+
+ iv = ivec_bin.data;
+ }
+
+ if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL)
+ return ERROR_Str(env, "Can't allocate resource");
+
+ ctx->ctx = EVP_CIPHER_CTX_new();
+ if (! ctx->ctx)
+ return ERROR_Str(env, "Can't allocate context");
+
+ if (!EVP_CipherInit_ex(ctx->ctx, cipher, NULL, NULL, NULL, enc)) {
+ enif_release_resource(ctx);
+ return ERROR_Str(env, "Can't initialize context, step 1");
+ }
+
+ if (!EVP_CIPHER_CTX_set_key_length(ctx->ctx, (int)key_bin.size)) {
+ enif_release_resource(ctx);
+ return ERROR_Str(env, "Can't initialize context, key_length");
+ }
+
+ if (EVP_CIPHER_type(cipher) == NID_rc2_cbc) {
+ if (key_bin.size > INT_MAX / 8) {
+ enif_release_resource(ctx);
+ return ERROR_Str(env, "To large rc2_cbc key");
+ }
+ if (!EVP_CIPHER_CTX_ctrl(ctx->ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key_bin.size * 8, NULL)) {
+ enif_release_resource(ctx);
+ return ERROR_Str(env, "ctrl rc2_cbc key");
+ }
+ }
+
+ if (!EVP_CipherInit_ex(ctx->ctx, NULL, NULL, key_bin.data, iv, enc)) {
+ enif_release_resource(ctx);
+ return ERROR_Str(env, "Can't initialize key and/or iv");
+ }
+
+ EVP_CIPHER_CTX_set_padding(ctx->ctx, 0);
+
+ ret = enif_make_resource(env, ctx);
+ enif_release_resource(ctx);
+ return ret;
+}
+
+ERL_NIF_TERM ng_crypto_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Context, Data)
+ (Context, Data, IV) */
+ struct evp_cipher_ctx *ctx;
+ ErlNifBinary in_data_bin, ivec_bin, out_data_bin;
+ int out_len, block_size;
+
+#if !defined(HAVE_EVP_AES_CTR)
+ const ERL_NIF_TERM *state_term;
+ int state_arity;
+
+ if (enif_get_tuple(env, argv[0], &state_arity, &state_term) && (state_arity == 4)) {
+ return aes_ctr_stream_encrypt_compat(env, argv[0], argv[1]);
+ }
+#endif
+
+ if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx))
+ return ERROR_Str(env, "Bad 1:st arg");
+
+ if (!enif_inspect_binary(env, argv[1], &in_data_bin) )
+ return ERROR_Str(env, "Bad 2:nd arg");
+
+ /* arg[1] was checked by the caller */
+ ASSERT(in_data_bin.size =< INT_MAX);
+
+ block_size = EVP_CIPHER_CTX_block_size(ctx->ctx);
+ if (in_data_bin.size % (size_t)block_size != 0)
+ return ERROR_Str(env, "Data not a multiple of block size");
+
+ if (argc==3) {
+ if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec_bin))
+ return ERROR_Str(env, "Not binary IV");
+
+ if (ivec_bin.size > INT_MAX)
+ return ERROR_Str(env, "Too big IV");
+
+ if (!EVP_CipherInit_ex(ctx->ctx, NULL, NULL, NULL, ivec_bin.data, -1))
+ return ERROR_Str(env, "Can't set IV");
+ }
+
+ if (!enif_alloc_binary((size_t)in_data_bin.size+block_size, &out_data_bin))
+ return ERROR_Str(env, "Can't allocate outdata");
+
+ if (!EVP_CipherUpdate(ctx->ctx, out_data_bin.data, &out_len, in_data_bin.data, in_data_bin.size))
+ return ERROR_Str(env, "Can't update");
+
+ if (!enif_realloc_binary(&out_data_bin, (size_t)out_len))
+ return ERROR_Str(env, "Can't reallocate");
+
+ CONSUME_REDS(env, in_data_bin);
+ return enif_make_binary(env, &out_data_bin);
+}
+
+
+ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Context, Data)
+ (Context, Data, IV) */
+ int i;
+ ErlNifBinary data_bin;
+ ERL_NIF_TERM new_argv[3];
+
+ ASSERT(argc =< 3);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin))
+ return ERROR_Str(env, "iodata expected as data");
+
+ if (data_bin.size > INT_MAX)
+ return ERROR_Str(env, "to long data");
+
+ for (i=0; i<argc; i++) new_argv[i] = argv[i];
+ new_argv[1] = enif_make_binary(env, &data_bin);
+
+ /* Run long jobs on a dirty scheduler to not block the current emulator thread */
+ if (data_bin.size > MAX_BYTES_TO_NIF) {
+ return enif_schedule_nif(env, "ng_crypto_update",
+ ERL_NIF_DIRTY_JOB_CPU_BOUND,
+ ng_crypto_update, argc, new_argv);
+ }
+
+ return ng_crypto_update(env, argc, new_argv);
+}
+
diff --git a/lib/crypto/c_src/api_ng.h b/lib/crypto/c_src/api_ng.h
new file mode 100644
index 0000000000..a3b40fe7fc
--- /dev/null
+++ b/lib/crypto/c_src/api_ng.h
@@ -0,0 +1,29 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2010-2018. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#ifndef E_API_NG_H__
+#define E_API_NG_H__ 1
+
+#include "common.h"
+
+ERL_NIF_TERM ng_crypto_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+ERL_NIF_TERM ng_crypto_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
+#endif /* E_AES_H__ */
diff --git a/lib/crypto/c_src/atoms.c b/lib/crypto/c_src/atoms.c
index 3a028b9a67..798c26c9bb 100644
--- a/lib/crypto/c_src/atoms.c
+++ b/lib/crypto/c_src/atoms.c
@@ -31,12 +31,6 @@ ERL_NIF_TERM atom_signature_md;
ERL_NIF_TERM atom_undefined;
ERL_NIF_TERM atom_ok;
-ERL_NIF_TERM atom_not_prime;
-ERL_NIF_TERM atom_not_strong_prime;
-ERL_NIF_TERM atom_unable_to_check_generator;
-ERL_NIF_TERM atom_not_suitable_generator;
-ERL_NIF_TERM atom_check_failed;
-ERL_NIF_TERM atom_unknown;
ERL_NIF_TERM atom_none;
ERL_NIF_TERM atom_notsup;
ERL_NIF_TERM atom_digest;
@@ -47,8 +41,19 @@ ERL_NIF_TERM atom_not_enabled;
ERL_NIF_TERM atom_not_supported;
#endif
+ERL_NIF_TERM atom_type;
+ERL_NIF_TERM atom_size;
+ERL_NIF_TERM atom_block_size;
+ERL_NIF_TERM atom_key_length;
+ERL_NIF_TERM atom_iv_length;
+ERL_NIF_TERM atom_mode;
+ERL_NIF_TERM atom_ecb_mode;
+ERL_NIF_TERM atom_cbc_mode;
+ERL_NIF_TERM atom_cfb_mode;
+ERL_NIF_TERM atom_ofb_mode;
+ERL_NIF_TERM atom_stream_cipher;
+
#if defined(HAVE_EC)
-ERL_NIF_TERM atom_ec;
ERL_NIF_TERM atom_prime_field;
ERL_NIF_TERM atom_characteristic_two_field;
ERL_NIF_TERM atom_tpbasis;
@@ -64,14 +69,6 @@ ERL_NIF_TERM atom_aes_gcm;
#ifdef HAVE_CCM
ERL_NIF_TERM atom_aes_ccm;
#endif
-#ifdef HAVE_CHACHA20_POLY1305
-ERL_NIF_TERM atom_chacha20_poly1305;
-#endif
-#ifdef HAVE_ECB_IVEC_BUG
-ERL_NIF_TERM atom_aes_ecb;
-ERL_NIF_TERM atom_des_ecb;
-ERL_NIF_TERM atom_blowfish_ecb;
-#endif
ERL_NIF_TERM atom_rsa;
ERL_NIF_TERM atom_dss;
@@ -99,26 +96,13 @@ ERL_NIF_TERM atom_rsa_sslv23_padding;
#endif
ERL_NIF_TERM atom_rsa_x931_padding;
ERL_NIF_TERM atom_rsa_pss_saltlen;
-ERL_NIF_TERM atom_sha224;
-ERL_NIF_TERM atom_sha256;
-ERL_NIF_TERM atom_sha384;
-ERL_NIF_TERM atom_sha512;
-ERL_NIF_TERM atom_sha3_224;
-ERL_NIF_TERM atom_sha3_256;
-ERL_NIF_TERM atom_sha3_384;
-ERL_NIF_TERM atom_sha3_512;
-ERL_NIF_TERM atom_md5;
-ERL_NIF_TERM atom_ripemd160;
+
+#ifdef HAVE_BLAKE2
+ERL_NIF_TERM atom_blake2b;
+ERL_NIF_TERM atom_blake2s;
+#endif
#ifdef HAS_ENGINE_SUPPORT
-ERL_NIF_TERM atom_bad_engine_method;
-ERL_NIF_TERM atom_bad_engine_id;
-ERL_NIF_TERM atom_ctrl_cmd_failed;
-ERL_NIF_TERM atom_engine_init_failed;
-ERL_NIF_TERM atom_register_engine_failed;
-ERL_NIF_TERM atom_add_engine_failed;
-ERL_NIF_TERM atom_remove_engine_failed;
-ERL_NIF_TERM atom_engine_method_not_supported;
ERL_NIF_TERM atom_engine_method_rsa;
ERL_NIF_TERM atom_engine_method_dsa;
@@ -164,18 +148,23 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM
atom_signature_md = enif_make_atom(env,"signature_md");
atom_undefined = enif_make_atom(env,"undefined");
atom_ok = enif_make_atom(env,"ok");
- atom_not_prime = enif_make_atom(env,"not_prime");
- atom_not_strong_prime = enif_make_atom(env,"not_strong_prime");
- atom_unable_to_check_generator = enif_make_atom(env,"unable_to_check_generator");
- atom_not_suitable_generator = enif_make_atom(env,"not_suitable_generator");
- atom_check_failed = enif_make_atom(env,"check_failed");
- atom_unknown = enif_make_atom(env,"unknown");
atom_none = enif_make_atom(env,"none");
atom_notsup = enif_make_atom(env,"notsup");
atom_digest = enif_make_atom(env,"digest");
+ atom_type = enif_make_atom(env,"type");
+ atom_size = enif_make_atom(env,"size");
+ atom_block_size = enif_make_atom(env,"block_size");
+ atom_key_length = enif_make_atom(env,"key_length");
+ atom_iv_length = enif_make_atom(env,"iv_length");
+ atom_mode = enif_make_atom(env,"mode");
+ atom_ecb_mode = enif_make_atom(env,"ecb_mode");
+ atom_cbc_mode = enif_make_atom(env,"cbc_mode");
+ atom_cfb_mode = enif_make_atom(env,"cfb_mode");
+ atom_ofb_mode = enif_make_atom(env,"ofb_mode");
+ atom_stream_cipher = enif_make_atom(env,"stream_cipher");
+
#if defined(HAVE_EC)
- atom_ec = enif_make_atom(env,"ec");
atom_prime_field = enif_make_atom(env,"prime_field");
atom_characteristic_two_field = enif_make_atom(env,"characteristic_two_field");
atom_tpbasis = enif_make_atom(env,"tpbasis");
@@ -191,14 +180,6 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM
#ifdef HAVE_CCM
atom_aes_ccm = enif_make_atom(env, "aes_ccm");
#endif
-#ifdef HAVE_CHACHA20_POLY1305
- atom_chacha20_poly1305 = enif_make_atom(env,"chacha20_poly1305");
-#endif
-#ifdef HAVE_ECB_IVEC_BUG
- atom_aes_ecb = enif_make_atom(env, "aes_ecb");
- atom_des_ecb = enif_make_atom(env, "des_ecb");
- atom_blowfish_ecb = enif_make_atom(env, "blowfish_ecb");
-#endif
#ifdef FIPS_SUPPORT
atom_enabled = enif_make_atom(env,"enabled");
@@ -209,6 +190,7 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM
atom_rsa = enif_make_atom(env,"rsa");
atom_dss = enif_make_atom(env,"dss");
atom_ecdsa = enif_make_atom(env,"ecdsa");
+
#ifdef HAVE_ED_CURVE_DH
atom_x25519 = enif_make_atom(env,"x25519");
atom_x448 = enif_make_atom(env,"x448");
@@ -229,25 +211,8 @@ int init_atoms(ErlNifEnv *env, const ERL_NIF_TERM fips_mode, const ERL_NIF_TERM
#endif
atom_rsa_x931_padding = enif_make_atom(env,"rsa_x931_padding");
atom_rsa_pss_saltlen = enif_make_atom(env,"rsa_pss_saltlen");
- atom_sha224 = enif_make_atom(env,"sha224");
- atom_sha256 = enif_make_atom(env,"sha256");
- atom_sha384 = enif_make_atom(env,"sha384");
- atom_sha512 = enif_make_atom(env,"sha512");
- atom_sha3_224 = enif_make_atom(env,"sha3_224");
- atom_sha3_256 = enif_make_atom(env,"sha3_256");
- atom_sha3_384 = enif_make_atom(env,"sha3_384");
- atom_sha3_512 = enif_make_atom(env,"sha3_512");
- atom_md5 = enif_make_atom(env,"md5");
- atom_ripemd160 = enif_make_atom(env,"ripemd160");
#ifdef HAS_ENGINE_SUPPORT
- atom_bad_engine_method = enif_make_atom(env,"bad_engine_method");
- atom_bad_engine_id = enif_make_atom(env,"bad_engine_id");
- atom_ctrl_cmd_failed = enif_make_atom(env,"ctrl_cmd_failed");
- atom_engine_init_failed = enif_make_atom(env,"engine_init_failed");
- atom_engine_method_not_supported = enif_make_atom(env,"engine_method_not_supported");
- atom_add_engine_failed = enif_make_atom(env,"add_engine_failed");
- atom_remove_engine_failed = enif_make_atom(env,"remove_engine_failed");
atom_engine_method_rsa = enif_make_atom(env,"engine_method_rsa");
atom_engine_method_dsa = enif_make_atom(env,"engine_method_dsa");
diff --git a/lib/crypto/c_src/atoms.h b/lib/crypto/c_src/atoms.h
index 9ddf0131ac..f8e9211459 100644
--- a/lib/crypto/c_src/atoms.h
+++ b/lib/crypto/c_src/atoms.h
@@ -35,12 +35,6 @@ extern ERL_NIF_TERM atom_signature_md;
extern ERL_NIF_TERM atom_undefined;
extern ERL_NIF_TERM atom_ok;
-extern ERL_NIF_TERM atom_not_prime;
-extern ERL_NIF_TERM atom_not_strong_prime;
-extern ERL_NIF_TERM atom_unable_to_check_generator;
-extern ERL_NIF_TERM atom_not_suitable_generator;
-extern ERL_NIF_TERM atom_check_failed;
-extern ERL_NIF_TERM atom_unknown;
extern ERL_NIF_TERM atom_none;
extern ERL_NIF_TERM atom_notsup;
extern ERL_NIF_TERM atom_digest;
@@ -51,8 +45,19 @@ extern ERL_NIF_TERM atom_not_enabled;
extern ERL_NIF_TERM atom_not_supported;
#endif
+extern ERL_NIF_TERM atom_type;
+extern ERL_NIF_TERM atom_size;
+extern ERL_NIF_TERM atom_block_size;
+extern ERL_NIF_TERM atom_key_length;
+extern ERL_NIF_TERM atom_iv_length;
+extern ERL_NIF_TERM atom_mode;
+extern ERL_NIF_TERM atom_ecb_mode;
+extern ERL_NIF_TERM atom_cbc_mode;
+extern ERL_NIF_TERM atom_cfb_mode;
+extern ERL_NIF_TERM atom_ofb_mode;
+extern ERL_NIF_TERM atom_stream_cipher;
+
#if defined(HAVE_EC)
-extern ERL_NIF_TERM atom_ec;
extern ERL_NIF_TERM atom_prime_field;
extern ERL_NIF_TERM atom_characteristic_two_field;
extern ERL_NIF_TERM atom_tpbasis;
@@ -68,14 +73,6 @@ extern ERL_NIF_TERM atom_aes_gcm;
#ifdef HAVE_CCM
extern ERL_NIF_TERM atom_aes_ccm;
#endif
-#ifdef HAVE_CHACHA20_POLY1305
-extern ERL_NIF_TERM atom_chacha20_poly1305;
-#endif
-#ifdef HAVE_ECB_IVEC_BUG
-extern ERL_NIF_TERM atom_aes_ecb;
-extern ERL_NIF_TERM atom_des_ecb;
-extern ERL_NIF_TERM atom_blowfish_ecb;
-#endif
extern ERL_NIF_TERM atom_rsa;
extern ERL_NIF_TERM atom_dss;
@@ -103,26 +100,8 @@ extern ERL_NIF_TERM atom_rsa_sslv23_padding;
#endif
extern ERL_NIF_TERM atom_rsa_x931_padding;
extern ERL_NIF_TERM atom_rsa_pss_saltlen;
-extern ERL_NIF_TERM atom_sha224;
-extern ERL_NIF_TERM atom_sha256;
-extern ERL_NIF_TERM atom_sha384;
-extern ERL_NIF_TERM atom_sha512;
-extern ERL_NIF_TERM atom_sha3_224;
-extern ERL_NIF_TERM atom_sha3_256;
-extern ERL_NIF_TERM atom_sha3_384;
-extern ERL_NIF_TERM atom_sha3_512;
-extern ERL_NIF_TERM atom_md5;
-extern ERL_NIF_TERM atom_ripemd160;
#ifdef HAS_ENGINE_SUPPORT
-extern ERL_NIF_TERM atom_bad_engine_method;
-extern ERL_NIF_TERM atom_bad_engine_id;
-extern ERL_NIF_TERM atom_ctrl_cmd_failed;
-extern ERL_NIF_TERM atom_engine_init_failed;
-extern ERL_NIF_TERM atom_register_engine_failed;
-extern ERL_NIF_TERM atom_add_engine_failed;
-extern ERL_NIF_TERM atom_remove_engine_failed;
-extern ERL_NIF_TERM atom_engine_method_not_supported;
extern ERL_NIF_TERM atom_engine_method_rsa;
extern ERL_NIF_TERM atom_engine_method_dsa;
diff --git a/lib/crypto/c_src/block.c b/lib/crypto/c_src/block.c
index 2ba3290e9f..0a4fd72623 100644
--- a/lib/crypto/c_src/block.c
+++ b/lib/crypto/c_src/block.c
@@ -24,82 +24,126 @@
ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type, Key, Ivec, Text, IsEncrypt) or (Type, Key, Text, IsEncrypt) */
- struct cipher_type_t *cipherp = NULL;
+ const struct cipher_type_t *cipherp;
const EVP_CIPHER *cipher;
ErlNifBinary key, ivec, text;
- EVP_CIPHER_CTX* ctx;
+ EVP_CIPHER_CTX *ctx = NULL;
ERL_NIF_TERM ret;
unsigned char *out;
int ivec_size, out_size = 0;
+ int cipher_len;
- if (!enif_inspect_iolist_as_binary(env, argv[1], &key)
- || !(cipherp = get_cipher_type(argv[0], key.size))
- || !enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) {
- return enif_make_badarg(env);
- }
- cipher = cipherp->cipher.p;
- if (!cipher) {
+ ASSERT(argc == 4 || argc == 5);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key))
+ goto bad_arg;
+ if (key.size > INT_MAX)
+ goto bad_arg;
+ if ((cipherp = get_cipher_type(argv[0], key.size)) == NULL)
+ goto bad_arg;
+ if (cipherp->flags & (NON_EVP_CIPHER | AEAD_CIPHER))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[argc - 2], &text))
+ goto bad_arg;
+ if (text.size > INT_MAX)
+ goto bad_arg;
+
+ if (FORBIDDEN_IN_FIPS(cipherp))
+ return enif_raise_exception(env, atom_notsup);
+ if ((cipher = cipherp->cipher.p) == NULL)
return enif_raise_exception(env, atom_notsup);
- }
- if (argv[0] == atom_aes_cfb8
- && (key.size == 24 || key.size == 32)) {
- /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes?
- * Fall back on low level API
- */
- return aes_cfb_8_crypt(env, argc-1, argv+1);
+ if (cipherp->flags & AES_CFBx) {
+ if (argv[0] == atom_aes_cfb8
+ && (key.size == 24 || key.size == 32)) {
+ /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes?
+ * Fall back on low level API
+ */
+ return aes_cfb_8_crypt(env, argc-1, argv+1);
+ }
+ else if (argv[0] == atom_aes_cfb128
+ && (key.size == 24 || key.size == 32)) {
+ /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes?
+ * Fall back on low level API
+ */
+ return aes_cfb_128_crypt_nif(env, argc-1, argv+1);
+ }
}
- else if (argv[0] == atom_aes_cfb128
- && (key.size == 24 || key.size == 32)) {
- /* Why do EVP_CIPHER_CTX_set_key_length() fail on these key sizes?
- * Fall back on low level API
- */
- return aes_cfb_128_crypt_nif(env, argc-1, argv+1);
- }
ivec_size = EVP_CIPHER_iv_length(cipher);
#ifdef HAVE_ECB_IVEC_BUG
- if (argv[0] == atom_aes_ecb || argv[0] == atom_blowfish_ecb ||
- argv[0] == atom_des_ecb)
- ivec_size = 0; /* 0.9.8l returns faulty ivec_size */
+ if (cipherp->flags & ECB_BUG_0_9_8L)
+ ivec_size = 0; /* 0.9.8l returns faulty ivec_size */
#endif
- if (text.size % EVP_CIPHER_block_size(cipher) != 0 ||
- (ivec_size == 0 ? argc != 4
- : (argc != 5 ||
- !enif_inspect_iolist_as_binary(env, argv[2], &ivec) ||
- ivec.size != ivec_size))) {
- return enif_make_badarg(env);
+ if (ivec_size < 0)
+ goto bad_arg;
+
+ if ((cipher_len = EVP_CIPHER_block_size(cipher)) < 0)
+ goto bad_arg;
+ if (text.size % (size_t)cipher_len != 0)
+ goto bad_arg;
+
+ if (ivec_size == 0) {
+ if (argc != 4)
+ goto bad_arg;
+ } else {
+ if (argc != 5)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[2], &ivec))
+ goto bad_arg;
+ if (ivec.size != (size_t)ivec_size)
+ goto bad_arg;
}
- out = enif_make_new_binary(env, text.size, &ret);
+ if ((out = enif_make_new_binary(env, text.size, &ret)) == NULL)
+ goto err;
+ if ((ctx = EVP_CIPHER_CTX_new()) == NULL)
+ goto err;
- ctx = EVP_CIPHER_CTX_new();
if (!EVP_CipherInit_ex(ctx, cipher, NULL, NULL, NULL,
- (argv[argc - 1] == atom_true)) ||
- !EVP_CIPHER_CTX_set_key_length(ctx, key.size) ||
- !(EVP_CIPHER_type(cipher) != NID_rc2_cbc ||
- EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_SET_RC2_KEY_BITS, key.size * 8, NULL)) ||
- !EVP_CipherInit_ex(ctx, NULL, NULL,
- key.data, ivec_size ? ivec.data : NULL, -1) ||
- !EVP_CIPHER_CTX_set_padding(ctx, 0)) {
+ (argv[argc - 1] == atom_true)))
+ goto err;
+ if (!EVP_CIPHER_CTX_set_key_length(ctx, (int)key.size))
+ goto err;
- EVP_CIPHER_CTX_free(ctx);
- return enif_raise_exception(env, atom_notsup);
+ if (EVP_CIPHER_type(cipher) == NID_rc2_cbc) {
+ if (key.size > INT_MAX / 8)
+ goto err;
+ if (!EVP_CIPHER_CTX_ctrl(ctx, EVP_CTRL_SET_RC2_KEY_BITS, (int)key.size * 8, NULL))
+ goto err;
}
- if (text.size > 0 && /* OpenSSL 0.9.8h asserts text.size > 0 */
- (!EVP_CipherUpdate(ctx, out, &out_size, text.data, text.size)
- || (ASSERT(out_size == text.size), 0)
- || !EVP_CipherFinal_ex(ctx, out + out_size, &out_size))) {
+ if (!EVP_CipherInit_ex(ctx, NULL, NULL, key.data,
+ ivec_size ? ivec.data : NULL, -1))
+ goto err;
+ if (!EVP_CIPHER_CTX_set_padding(ctx, 0))
+ goto err;
- EVP_CIPHER_CTX_free(ctx);
- return enif_raise_exception(env, atom_notsup);
+ /* OpenSSL 0.9.8h asserts text.size > 0 */
+ if (text.size > 0) {
+ if (!EVP_CipherUpdate(ctx, out, &out_size, text.data, (int)text.size))
+ goto err;
+ if (ASSERT(out_size == text.size), 0)
+ goto err;
+ if (!EVP_CipherFinal_ex(ctx, out + out_size, &out_size))
+ goto err;
}
+
ASSERT(out_size == 0);
- EVP_CIPHER_CTX_free(ctx);
CONSUME_REDS(env, text);
+ goto done;
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ err:
+ ret = enif_raise_exception(env, atom_notsup);
+
+ done:
+ if (ctx)
+ EVP_CIPHER_CTX_free(ctx);
return ret;
}
diff --git a/lib/crypto/c_src/bn.c b/lib/crypto/c_src/bn.c
index b576c46e1e..34ed4f7ebc 100644
--- a/lib/crypto/c_src/bn.c
+++ b/lib/crypto/c_src/bn.c
@@ -23,29 +23,53 @@
int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp)
{
+ BIGNUM *ret;
ErlNifBinary bin;
int sz;
- if (!enif_inspect_binary(env,term,&bin)) {
- return 0;
- }
+
+ if (!enif_inspect_binary(env, term, &bin))
+ goto err;
+ if (bin.size > INT_MAX - 4)
+ goto err;
+
ERL_VALGRIND_ASSERT_MEM_DEFINED(bin.data, bin.size);
- sz = bin.size - 4;
- if (sz < 0 || get_int32(bin.data) != sz) {
- return 0;
- }
- *bnp = BN_bin2bn(bin.data+4, sz, NULL);
+
+ if (bin.size < 4)
+ goto err;
+ sz = (int)bin.size - 4;
+ if (get_int32(bin.data) != sz)
+ goto err;
+
+ if ((ret = BN_bin2bn(bin.data+4, sz, NULL)) == NULL)
+ goto err;
+
+ *bnp = ret;
return 1;
+
+ err:
+ return 0;
}
int get_bn_from_bin(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp)
{
+ BIGNUM *ret;
ErlNifBinary bin;
- if (!enif_inspect_binary(env,term,&bin)) {
- return 0;
- }
+
+ if (!enif_inspect_binary(env, term, &bin))
+ goto err;
+ if (bin.size > INT_MAX)
+ goto err;
+
ERL_VALGRIND_ASSERT_MEM_DEFINED(bin.data, bin.size);
- *bnp = BN_bin2bn(bin.data, bin.size, NULL);
+
+ if ((ret = BN_bin2bn(bin.data, (int)bin.size, NULL)) == NULL)
+ goto err;
+
+ *bnp = ret;
return 1;
+
+ err:
+ return 0;
}
ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn)
@@ -55,67 +79,108 @@ ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn)
ERL_NIF_TERM term;
/* Copy the bignum into an erlang binary. */
- bn_len = BN_num_bytes(bn);
- bin_ptr = enif_make_new_binary(env, bn_len, &term);
- BN_bn2bin(bn, bin_ptr);
+ if ((bn_len = BN_num_bytes(bn)) < 0)
+ goto err;
+ if ((bin_ptr = enif_make_new_binary(env, (size_t)bn_len, &term)) == NULL)
+ goto err;
+
+ if (BN_bn2bin(bn, bin_ptr) < 0)
+ goto err;
return term;
+
+ err:
+ return atom_error;
}
ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Base,Exponent,Modulo,bin_hdr) */
- BIGNUM *bn_base=NULL, *bn_exponent=NULL, *bn_modulo=NULL, *bn_result;
- BN_CTX *bn_ctx;
+ BIGNUM *bn_base = NULL, *bn_exponent = NULL, *bn_modulo = NULL, *bn_result = NULL;
+ BN_CTX *bn_ctx = NULL;
unsigned char* ptr;
- unsigned dlen;
+ int dlen;
unsigned bin_hdr; /* return type: 0=plain binary, 4: mpint */
unsigned extra_byte;
ERL_NIF_TERM ret;
- if (!get_bn_from_bin(env, argv[0], &bn_base)
- || !get_bn_from_bin(env, argv[1], &bn_exponent)
- || !get_bn_from_bin(env, argv[2], &bn_modulo)
- || !enif_get_uint(env,argv[3],&bin_hdr) || (bin_hdr & ~4)) {
+ ASSERT(argc == 4);
+
+ if (!get_bn_from_bin(env, argv[0], &bn_base))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[1], &bn_exponent))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[2], &bn_modulo))
+ goto bad_arg;
+ if (!enif_get_uint(env, argv[3], &bin_hdr))
+ goto bad_arg;
+ if (bin_hdr != 0 && bin_hdr != 4)
+ goto bad_arg;
+
+ if ((bn_result = BN_new()) == NULL)
+ goto err;
+ if ((bn_ctx = BN_CTX_new()) == NULL)
+ goto err;
+
+ if (!BN_mod_exp(bn_result, bn_base, bn_exponent, bn_modulo, bn_ctx))
+ goto err;
- if (bn_base) BN_free(bn_base);
- if (bn_exponent) BN_free(bn_exponent);
- if (bn_modulo) BN_free(bn_modulo);
- return enif_make_badarg(env);
- }
- bn_result = BN_new();
- bn_ctx = BN_CTX_new();
- BN_mod_exp(bn_result, bn_base, bn_exponent, bn_modulo, bn_ctx);
dlen = BN_num_bytes(bn_result);
- extra_byte = bin_hdr && BN_is_bit_set(bn_result, dlen*8-1);
- ptr = enif_make_new_binary(env, bin_hdr+extra_byte+dlen, &ret);
+ if (dlen < 0 || dlen > INT_MAX / 8)
+ goto bad_arg;
+ extra_byte = bin_hdr && BN_is_bit_set(bn_result, dlen * 8 - 1);
+
+ if ((ptr = enif_make_new_binary(env, bin_hdr + extra_byte + (unsigned int)dlen, &ret)) == NULL)
+ goto err;
+
if (bin_hdr) {
- put_int32(ptr, extra_byte+dlen);
- ptr[4] = 0; /* extra zeroed byte to ensure a positive mpint */
- ptr += bin_hdr + extra_byte;
+ put_uint32(ptr, extra_byte + (unsigned int)dlen);
+ ptr[4] = 0; /* extra zeroed byte to ensure a positive mpint */
+ ptr += bin_hdr + extra_byte;
}
+
BN_bn2bin(bn_result, ptr);
- BN_free(bn_result);
- BN_CTX_free(bn_ctx);
- BN_free(bn_modulo);
- BN_free(bn_exponent);
- BN_free(bn_base);
+ goto done;
+
+ bad_arg:
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (bn_base)
+ BN_free(bn_base);
+ if (bn_exponent)
+ BN_free(bn_exponent);
+ if (bn_modulo)
+ BN_free(bn_modulo);
+ if (bn_result)
+ BN_free(bn_result);
+ if (bn_ctx)
+ BN_CTX_free(bn_ctx);
return ret;
}
#ifdef HAVE_EC
ERL_NIF_TERM bn2term(ErlNifEnv* env, const BIGNUM *bn)
{
- unsigned dlen;
+ int dlen;
unsigned char* ptr;
ERL_NIF_TERM ret;
- if (!bn)
- return atom_undefined;
+ if (bn == NULL)
+ return atom_undefined;
dlen = BN_num_bytes(bn);
- ptr = enif_make_new_binary(env, dlen, &ret);
+ if (dlen < 0)
+ goto err;
+ if ((ptr = enif_make_new_binary(env, (size_t)dlen, &ret)) == NULL)
+ goto err;
+
BN_bn2bin(bn, ptr);
+
ERL_VALGRIND_MAKE_MEM_DEFINED(ptr, dlen);
return ret;
+
+ err:
+ return enif_make_badarg(env);
}
#endif
diff --git a/lib/crypto/c_src/chacha20.c b/lib/crypto/c_src/chacha20.c
index 8b21a0c7af..cfcc395dca 100644
--- a/lib/crypto/c_src/chacha20.c
+++ b/lib/crypto/c_src/chacha20.c
@@ -25,59 +25,100 @@ ERL_NIF_TERM chacha20_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
{/* (Key, IV) */
#if defined(HAVE_CHACHA20)
ErlNifBinary key_bin, ivec_bin;
- struct evp_cipher_ctx *ctx;
+ struct evp_cipher_ctx *ctx = NULL;
const EVP_CIPHER *cipher;
ERL_NIF_TERM ret;
- if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin)
- || !enif_inspect_binary(env, argv[1], &ivec_bin)
- || key_bin.size != 32
- || ivec_bin.size != 16) {
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 2);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key_bin))
+ goto bad_arg;
+ if (key_bin.size != 32)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[1], &ivec_bin))
+ goto bad_arg;
+ if (ivec_bin.size != 16)
+ goto bad_arg;
cipher = EVP_chacha20();
- ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx));
- ctx->ctx = EVP_CIPHER_CTX_new();
+ if ((ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL)
+ goto err;
+ if ((ctx->ctx = EVP_CIPHER_CTX_new()) == NULL)
+ goto err;
+ if (EVP_CipherInit_ex(ctx->ctx, cipher, NULL,
+ key_bin.data, ivec_bin.data, 1) != 1)
+ goto err;
+ if (EVP_CIPHER_CTX_set_padding(ctx->ctx, 0) != 1)
+ goto err;
- EVP_CipherInit_ex(ctx->ctx, cipher, NULL,
- key_bin.data, ivec_bin.data, 1);
- EVP_CIPHER_CTX_set_padding(ctx->ctx, 0);
ret = enif_make_resource(env, ctx);
- enif_release_resource(ctx);
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (ctx)
+ enif_release_resource(ctx);
return ret;
+
#else
return enif_raise_exception(env, atom_notsup);
#endif
-};
+}
ERL_NIF_TERM chacha20_stream_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (State, Data) */
#if defined(HAVE_CHACHA20)
- struct evp_cipher_ctx *ctx, *new_ctx;
+ struct evp_cipher_ctx *ctx = NULL, *new_ctx = NULL;
ErlNifBinary data_bin;
ERL_NIF_TERM ret, cipher_term;
unsigned char *out;
int outl = 0;
- if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data_bin)) {
- return enif_make_badarg(env);
- }
- new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx));
- new_ctx->ctx = EVP_CIPHER_CTX_new();
- EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx);
- out = enif_make_new_binary(env, data_bin.size, &cipher_term);
- EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, data_bin.size);
- ASSERT(outl == data_bin.size);
+ ASSERT(argc == 2);
+
+ if (!enif_get_resource(env, argv[0], evp_cipher_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &data_bin))
+ goto bad_arg;
+ if (data_bin.size > INT_MAX)
+ goto bad_arg;
+
+ if ((new_ctx = enif_alloc_resource(evp_cipher_ctx_rtype, sizeof(struct evp_cipher_ctx))) == NULL)
+ goto err;
+ if ((new_ctx->ctx = EVP_CIPHER_CTX_new()) == NULL)
+ goto err;
+
+ if (EVP_CIPHER_CTX_copy(new_ctx->ctx, ctx->ctx) != 1)
+ goto err;
+ if ((out = enif_make_new_binary(env, data_bin.size, &cipher_term)) == NULL)
+ goto err;
+ if (EVP_CipherUpdate(new_ctx->ctx, out, &outl, data_bin.data, (int)data_bin.size) != 1)
+ goto err;
+ ASSERT(outl >= 0 && (size_t)outl == data_bin.size);
ret = enif_make_tuple2(env, enif_make_resource(env, new_ctx), cipher_term);
- enif_release_resource(new_ctx);
- CONSUME_REDS(env,data_bin);
+ CONSUME_REDS(env, data_bin);
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (new_ctx)
+ enif_release_resource(new_ctx);
return ret;
+
#else
return enif_raise_exception(env, atom_notsup);
#endif
-};
+}
diff --git a/lib/crypto/c_src/check_erlang.cocci b/lib/crypto/c_src/check_erlang.cocci
new file mode 100644
index 0000000000..b2a981f2ac
--- /dev/null
+++ b/lib/crypto/c_src/check_erlang.cocci
@@ -0,0 +1,196 @@
+// %CopyrightBegin%
+//
+// Copyright Doug Hogan 2019. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+
+// Coccinelle script to help verify Erlang calls.
+// http://coccinelle.lip6.fr
+// https://github.com/coccinelle/coccinelle
+//
+// These work with the Erlang code because it has a rigid coding pattern.
+// $ spatch.opt --all-includes -sp_file check_erlang.cocci -dir .
+
+// Make sure resources are cleaned up properly in all paths.
+// Need 'strict' so it's also checked in error handling paths.
+@enif_alloc_resource@
+type T;
+identifier CTX, L;
+identifier virtual.enif_alloc_resource, virtual.enif_release_resource;
+position p, pr;
+@@
+
+ T *CTX = NULL;
+
+ ...
+ if ((CTX = enif_alloc_resource(...)@p) == NULL)
+ goto L;
+
+ ... when strict, forall
+ if (CTX)
+ enif_release_resource(CTX)@pr;
+
+
+// After calling enif_alloc_binary(), you must either release it with
+// enif_release_binary() or transfer ownership to Erlang via enif_make_binary().
+@enif_alloc_binary@
+expression SZ;
+identifier BIN, RET, ENV, X, L;
+identifier TUPLE =~ "^enif_make_tuple[0-9]+$";
+identifier virtual.enif_alloc_binary, virtual.enif_make_binary;
+identifier virtual.enif_release_binary;
+position pa, pm, pr;
+@@
+
+// This construct is used in engine.c
+(
+ if (!enif_alloc_binary(SZ, &BIN)@pa)
+ goto L;
+
+ ... when strict, forall
+ return
+(
+ enif_make_binary(ENV, &BIN)@pm
+|
+ TUPLE(..., enif_make_binary(ENV, &BIN)@pm)@pm
+);
+
+|
+// This is the typical way we allocate and use binaries.
+ int X = 0;
+
+ ...
+ if (!enif_alloc_binary(SZ, &BIN)@pa)
+ goto L;
+ X = 1;
+
+ ... when strict, forall
+(
+ RET = enif_make_binary(ENV, &BIN)@pm;
+ X = 0;
+|
+ if (X)
+ enif_release_binary(&BIN)@pr;
+|
+ return enif_make_binary(ENV, &BIN)@pm;
+)
+)
+
+// TODO: These don't have single checks that handle all cases.
+//
+// enif_consume_timeslice returns 1 if exhausted or else 0
+// enif_has_pending_exception returns true if exception pending
+
+@erlang_check_void@
+identifier FUNCVOID =~ "^(enif_mutex_destroy|enif_mutex_lock|enif_mutex_unlock|enif_rwlock_destroy|enif_rwlock_rlock|enif_rwlock_runlock|enif_rwlock_rwlock|enif_rwlock_rwunlock|enif_system_info)$";
+position p;
+@@
+
+ FUNCVOID(...)@p;
+
+
+@erlang_check_null@
+expression X;
+identifier L;
+identifier FUNCNULL =~ "^(enif_alloc|enif_alloc_resource|enif_dlopen|enif_dlsym|enif_make_new_binary|enif_mutex_create|enif_open_resource_type|enif_realloc|enif_rwlock_create)$";
+position p;
+@@
+
+(
+ if ((X = FUNCNULL(...)@p) == NULL)
+ goto L;
+|
+ X = FUNCNULL(...)@p;
+ if (X == NULL)
+ goto L;
+|
+ return FUNCNULL(...)@p;
+)
+
+
+@erlang_check_not@
+identifier L;
+identifier FUNCNOT =~ "^(enif_alloc_binary|enif_get_int|enif_get_list_cell|enif_get_list_length|enif_get_long|enif_get_map_value|enif_get_resource|enif_get_tuple|enif_get_uint|enif_get_ulong|enif_inspect_binary|enif_inspect_iolist_as_binary|enif_is_atom|enif_is_binary|enif_is_current_process_alive|enif_is_empty_list|enif_is_list|enif_is_map|enif_is_tuple|enif_realloc_binary)$";
+position p;
+@@
+
+(
+ if (!FUNCNOT(...)@p)
+ goto L;
+|
+ return FUNCNOT(...)@p;
+)
+
+
+@erlang_check_null_free@
+expression X;
+identifier FUNCFREE =~ "^(enif_free|enif_free_env|enif_free_iovec|enif_release_binary|enif_release_resource)$";
+position p;
+@@
+
+ if (
+(
+ X
+|
+ X != NULL
+)
+ )
+ FUNCFREE(X)@p;
+
+
+@erlang_check_new@
+expression RET;
+identifier FUNCNEW =~ "^(enif_make_atom|enif_make_badarg|enif_make_binary|enif_make_int|enif_make_list|enif_make_list_from_array|enif_make_resource|enif_make_tuple|enif_raise_exception|enif_schedule_nif|enif_thread_self)$";
+position p;
+@@
+
+(
+ RET = FUNCNEW(...)@p;
+|
+ return FUNCNEW(...)@p;
+)
+
+
+// Flag any calls that aren't part of the above pattern.
+@enif_alloc_not_free@
+
+identifier FUNCVOID =~ "^(enif_mutex_destroy|enif_mutex_lock|enif_mutex_unlock|enif_rwlock_destroy|enif_rwlock_rlock|enif_rwlock_runlock|enif_rwlock_rwlock|enif_rwlock_rwunlock|enif_system_info)$";
+position pvoid != {erlang_check_void.p,enif_alloc_binary.pr};
+
+identifier FUNCNULL =~ "^(enif_alloc|enif_alloc_resource|enif_dlopen|enif_dlsym|enif_make_new_binary|enif_mutex_create|enif_open_resource_type|enif_realloc|enif_rwlock_create)$";
+position pnull != {erlang_check_null.p,enif_alloc_resource.p};
+
+identifier FUNCNOT =~ "^(enif_alloc_binary|enif_get_int|enif_get_list_cell|enif_get_list_length|enif_get_long|enif_get_map_value|enif_get_resource|enif_get_tuple|enif_get_uint|enif_get_ulong|enif_inspect_binary|enif_inspect_iolist_as_binary|enif_is_atom|enif_is_binary|enif_is_current_process_alive|enif_is_empty_list|enif_is_list|enif_is_map|enif_is_tuple|enif_realloc_binary)$";
+position pnot != {erlang_check_not.p,enif_alloc_binary.pa};
+
+identifier FUNCNEW =~ "^(enif_make_atom|enif_make_badarg|enif_make_binary|enif_make_int|enif_make_list|enif_make_list_from_array|enif_make_resource|enif_make_tuple|enif_raise_exception|enif_schedule_nif|enif_thread_self)$";
+position pnew != {erlang_check_new.p,enif_alloc_binary.pm};
+
+identifier FUNCFREE =~ "^(enif_free|enif_free_env|enif_free_iovec|enif_release_binary|enif_release_resource)$";
+position pfree != {enif_alloc_resource.pr,enif_alloc_binary.pr,erlang_check_null_free.p};
+
+@@
+
+(
+* FUNCVOID(...)@pvoid
+|
+* FUNCNULL(...)@pnull
+|
+* FUNCNOT(...)@pnot
+|
+* FUNCNEW(...)@pnew
+|
+* FUNCFREE(...)@pfree
+)
diff --git a/lib/crypto/c_src/check_openssl.cocci b/lib/crypto/c_src/check_openssl.cocci
new file mode 100644
index 0000000000..75d1a6e44b
--- /dev/null
+++ b/lib/crypto/c_src/check_openssl.cocci
@@ -0,0 +1,281 @@
+// %CopyrightBegin%
+//
+// Copyright Doug Hogan 2019. All Rights Reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+// http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+//
+// %CopyrightEnd%
+
+// Coccinelle script to help verify the subset of OpenSSL calls used by Erlang.
+// http://coccinelle.lip6.fr
+// https://github.com/coccinelle/coccinelle
+//
+// These work with the Erlang code because it has a rigid coding pattern.
+// $ spatch.opt --all-includes -sp_file check_openssl.cocci -dir .
+
+// TODO: These APIs may not have a single check that covers all cases
+// or may not be necessary to check.
+//
+// BN_GENCB_get_arg
+// BN_bn2bin
+// BN_cmp
+// BN_is_bit_set
+// BN_is_negative
+// BN_is_zero
+// BN_num_bits
+// DH_get0_key
+// DH_size
+// EC_GROUP_get_degree
+// EC_KEY_get0_group
+// EC_KEY_get0_private_key
+// EC_KEY_get0_public_key
+// EC_KEY_get_conv_form
+// EVP_CIPHER_block_size
+// EVP_CIPHER_iv_length
+// EVP_CIPHER_type
+// EVP_MD_CTX_md
+// EVP_MD_size
+// EVP_aes_128_cbc
+// EVP_aes_128_ccm
+// EVP_aes_128_cfb128
+// EVP_aes_128_cfb8
+// EVP_aes_128_ctr
+// EVP_aes_128_ecb
+// EVP_aes_128_gcm
+// EVP_aes_192_cbc
+// EVP_aes_192_ccm
+// EVP_aes_192_ctr
+// EVP_aes_192_ecb
+// EVP_aes_192_gcm
+// EVP_aes_256_cbc
+// EVP_aes_256_ccm
+// EVP_aes_256_ctr
+// EVP_aes_256_ecb
+// EVP_aes_256_gcm
+// EVP_bf_cbc
+// EVP_bf_cfb64
+// EVP_bf_ecb
+// EVP_bf_ofb
+// EVP_chacha20
+// EVP_chacha20_poly1305
+// EVP_des_cbc
+// EVP_des_cfb8
+// EVP_des_ecb
+// EVP_des_ede3_cbc
+// EVP_des_ede3_cfb8
+// EVP_md4
+// EVP_md5
+// EVP_rc2_cbc
+// EVP_ripemd160
+// EVP_sha1
+// EVP_sha224
+// EVP_sha256
+// EVP_sha384
+// EVP_sha3_224
+// EVP_sha3_256
+// EVP_sha3_384
+// EVP_sha3_512
+// EVP_sha512
+// OpenSSL_version
+// OpenSSL_version_num
+// PEM_read_PrivateKey
+// PEM_read_PUBKEY
+// RSA_size
+
+// Unusual API for OpenSSL: 0 or positive on success and negative value(s) on error.
+@openssl_check_negative@
+identifier FUNCNEG =~ "^(DH_compute_key|RSA_padding_check_SSLv23)$";
+expression X;
+identifier L;
+position p;
+@@
+
+ if (
+(
+ FUNCNEG(...)@p < 0
+|
+ (X = FUNCNEG(...)@p) < 0
+)
+ )
+ goto L;
+
+// Unusual API for OpenSSL: positive on success or else error
+@openssl_check_positive@
+identifier FUNCPOS =~ "^(ECDH_compute_key|EVP_CIPHER_asn1_to_param|EVP_CIPHER_param_to_asn1|EVP_PKEY_CTX_ctrl|RSA_pkey_ctx_ctrl)$";
+identifier L;
+expression X;
+position p;
+@@
+
+ if (
+(
+ FUNCPOS(...)@p < 1
+|
+ (X = FUNCPOS(...)@p) < 1
+)
+ )
+ goto L;
+
+// Unusual API for OpenSSL: 0=success.
+@openssl_check_0@
+identifier L;
+expression X;
+identifier FUNC0 =~ "^(AES_set_decrypt_key|AES_set_encrypt_key|CRYPTO_gcm128_aad|CRYPTO_gcm128_decrypt|CRYPTO_gcm128_finish)$";
+position p;
+@@
+
+ if (
+(
+ FUNC0(...)@p != 0
+|
+ (X = FUNC0(...)@p) != 0
+)
+ )
+ goto L;
+
+// These do not necessarily allocate resources but they may return NULL.
+@openssl_check_null@
+expression X;
+identifier L;
+identifier FUNCNULL =~ "^(BN_CTX_new|BN_GENCB_new|BN_MONT_CTX_new|BN_bin2bn|BN_dup|BN_generate_prime|BN_new|CMAC_CTX_new|CRYPTO_clear_realloc|CRYPTO_gcm128_new|CRYPTO_malloc|CRYPTO_realloc|CRYPTO_zalloc|DH_generate_parameters|DH_new|DSA_new|EC_GROUP_dup|EC_GROUP_get0_generator|EC_GROUP_method_of|EC_GROUP_new_curve_GFm|EC_GROUP_new_curve_GFp|EC_KEY_copy|EC_KEY_dup|EC_KEY_get0_engine|EC_KEY_new|EC_KEY_new_by_curve_name|EC_POINT_bn2point|EC_POINT_dup|EC_POINT_new|EC_POINT_point2bn|ENGINE_by_id|ENGINE_get_cipher_engine|ENGINE_get_default_DH|ENGINE_get_default_DSA|ENGINE_get_default_RAND|ENGINE_get_default_RSA|ENGINE_get_digest_engine|ENGINE_get_first|ENGINE_get_id|ENGINE_get_last|ENGINE_get_name|ENGINE_get_next|ENGINE_get_prev|ENGINE_load_private_key|ENGINE_load_public_key|ENGINE_new|EVP_CIPHER_CTX_new|EVP_MAC_CTX_new|EVP_MAC_CTX_new_id|EVP_MD_CTX_new|EVP_MD_meth_new|EVP_PKEY_CTX_new|EVP_PKEY_CTX_new_id|EVP_PKEY_get1_DH|EVP_PKEY_get1_DSA|EVP_PKEY_get1_EC_KEY|EVP_PKEY_get1_RSA|EVP_PKEY_new|EVP_PKEY_new_raw_private_key|EVP_PKEY_new_raw_public_key|EVP_get_cipherbyname|EVP_get_cipherbynid|EVP_get_cipherbyobj|EVP_get_macbyname|EVP_get_macbynid|EVP_get_macbyobj|HMAC|HMAC_CTX_new|OPENSSL_buf2hexstr|OPENSSL_clear_realloc|OPENSSL_hexstr2buf|OPENSSL_malloc|OPENSSL_realloc|OPENSSL_strdup|OPENSSL_strndup|OPENSSL_zalloc|RSA_meth_dup|RSA_meth_new|RSA_new)$";
+position p;
+@@
+
+(
+ if ((X = FUNCNULL(...)@p) == NULL)
+ goto L;
+|
+ X = FUNCNULL(...)@p;
+ if (X == NULL)
+ goto L;
+)
+
+// non-zero=success, 0=failure. These can be safely used with !
+@openssl_check_not@
+expression X;
+identifier L;
+identifier FUNCNOT =~ "^(BN_add|BN_div|BN_exp|BN_from_montgomery|BN_gcd|BN_generate_prime_ex|BN_mod|BN_mod_add|BN_mod_exp|BN_mod_mul|BN_mod_mul_montgomery|BN_mod_sqr|BN_mod_sub|BN_mul|BN_nnmod|BN_priv_rand|BN_priv_rand_range|BN_pseudo_rand|BN_pseudo_rand_range|BN_rand|BN_rand_range|BN_set_bit|BN_set_word|BN_sqr|BN_sub|BN_to_montgomery|CMAC_Final|CMAC_Init|CMAC_Update|CRYPTO_set_mem_debug|CRYPTO_set_mem_functions|DH_check|DH_check_ex|DH_check_params|DH_check_pub_key_ex|DH_generate_key|DH_generate_parameters_ex|DH_set0_key|DH_set0_pqg|DH_set_length|DSA_set0_key|DSA_set0_pqg|EC_GROUP_check|EC_GROUP_check_discriminant|EC_GROUP_copy|EC_GROUP_get_curve_name|EC_GROUP_get_pentanomial_basis|EC_GROUP_get_trinomial_basis|EC_GROUP_precompute_mult|EC_GROUP_set_generator|EC_GROUP_set_seed|EC_KEY_check_key|EC_KEY_generate_key|EC_KEY_key2buf|EC_KEY_oct2key|EC_KEY_oct2priv|EC_KEY_precompute_mult|EC_KEY_priv2buf|EC_KEY_priv2oct|EC_KEY_set_group|EC_KEY_set_private_key|EC_KEY_set_public_key|EC_KEY_set_public_key_affine_coordinates|EC_KEY_up_ref|EC_POINT_add|EC_POINT_copy|EC_POINT_dbl|EC_POINT_get_Jprojective_coordinates_GFp|EC_POINT_get_affine_coordinates_GF2m|EC_POINT_get_affine_coordinates_GFp|EC_POINT_invert|EC_POINT_make_affine|EC_POINT_mul|EC_POINT_oct2point|EC_POINT_point2oct|EC_POINT_set_Jprojective_coordinates_GFp|EC_POINT_set_affine_coordinates_GF2m|EC_POINT_set_affine_coordinates_GFp|EC_POINT_set_compressed_coordinates_GF2m|EC_POINT_set_compressed_coordinates_GFp|EC_POINT_set_to_infinity|EC_POINTs_make_affine|EC_POINTs_mul|ENGINE_add|ENGINE_ctrl_cmd|ENGINE_ctrl_cmd_string|ENGINE_finish|ENGINE_free|ENGINE_init|ENGINE_register_DH|ENGINE_register_DSA|ENGINE_register_EC|ENGINE_register_RAND|ENGINE_register_RSA|ENGINE_register_all_complete|ENGINE_register_ciphers|ENGINE_register_complete|ENGINE_register_digests|ENGINE_register_pkey_asn1_meths|ENGINE_register_pkey_meths|ENGINE_remove|ENGINE_set_RSA|ENGINE_set_default|ENGINE_set_default_DH|ENGINE_set_default_DSA|ENGINE_set_default_EC|ENGINE_set_default_RAND|ENGINE_set_default_RSA|ENGINE_set_digests|ENGINE_set_id|ENGINE_set_init_function|ENGINE_set_load_privkey_function|ENGINE_set_load_pubkey_function|ENGINE_set_name|ENGINE_up_ref|HMAC_CTX_copy|HMAC_CTX_reset|HMAC_Final|HMAC_Init_ex|HMAC_Update|MD2_Init|MD2_Update|MD2_Final|MD4_Init|MD4_Update|MD4_Final|MD5_Init|MD5_Update|MD5_Final|OPENSSL_init_crypto|OPENSSL_mem_debug_pop|OPENSSL_mem_debug_push|RSA_generate_key_ex|RSA_generate_multi_prime_key|RSA_meth_set_finish|RSA_meth_set_sign|RSA_meth_set_verify|RSA_padding_add_SSLv23|RSA_set0_crt_params|RSA_set0_factors|RSA_set0_key|RSA_set0_multi_prime_params)$";
+position p;
+@@
+
+ if (
+(
+ !FUNCNOT(...)@p
+|
+ !(X = FUNCNOT)@p
+)
+ )
+ goto L;
+
+// 1=success. These may have == 0 or <= 0 or non-one failure so we explicitly check for success.
+// Since some EVP_* functions use failure == 0 and others use <= 0, we consolidate all
+// EVP_* calls into here so it's less error prone. In such cases, they all use 1 for success.
+@openssl_check_1@
+expression X;
+identifier L;
+identifier FUNC1 =~ "^(EVP_CIPHER_CTX_copy|EVP_CIPHER_CTX_ctrl|EVP_CIPHER_CTX_rand_key|EVP_CIPHER_CTX_reset|EVP_CIPHER_CTX_set_key_length|EVP_CIPHER_CTX_set_padding|EVP_CipherFinal_ex|EVP_CipherInit_ex|EVP_CipherUpdate|EVP_DecryptFinal_ex|EVP_DecryptInit_ex|EVP_DecryptUpdate|EVP_Digest|EVP_DigestFinal|EVP_DigestFinal_ex|EVP_DigestInit|EVP_DigestInit_ex|EVP_DigestSign|EVP_DigestSignInit|EVP_DigestSignUpdate|EVP_DigestSignaFinal|EVP_DigestUpdate|EVP_DigestVerify|EVP_DigestVerifyInit|EVP_EncryptFinal_ex|EVP_EncryptInit_ex|EVP_EncryptUpdate|EVP_MAC_CTX_copy|EVP_MAC_ctrl|EVP_MAC_ctrl_str|EVP_MAC_hex2ctrl|EVP_MAC_init|EVP_MAC_reset|EVP_MAC_str2ctrl|EVP_MAC_update|EVP_MD_CTX_copy|EVP_MD_CTX_copy_ex|EVP_MD_CTX_ctrl|EVP_MD_meth_set_app_datasize|EVP_MD_meth_set_cleanup|EVP_MD_meth_set_copy|EVP_MD_meth_set_ctrl|EVP_MD_meth_set_final|EVP_MD_meth_set_flags|EVP_MD_meth_set_init|EVP_MD_meth_set_input_blocksize|EVP_MD_meth_set_result_size|EVP_MD_meth_set_update|EVP_PKEY_CTX_set_rsa_mgf1_md|EVP_PKEY_CTX_set_rsa_padding|EVP_PKEY_CTX_set_rsa_pss_saltlen|EVP_PKEY_CTX_set_signature|EVP_PKEY_assign|EVP_PKEY_assign_DSA|EVP_PKEY_assign_EC_KEY|EVP_PKEY_assign_RSA|EVP_PKEY_decrypt|EVP_PKEY_decrypt_init|EVP_PKEY_derive|EVP_PKEY_derive_init|EVP_PKEY_derive_set_peer|EVP_PKEY_encrypt|EVP_PKEY_encrypt_init|EVP_PKEY_get1_DH|EVP_PKEY_get_raw_private_key|EVP_PKEY_get_raw_public_key|EVP_PKEY_keygen|EVP_PKEY_keygen_init|EVP_PKEY_set1_DH|EVP_PKEY_sign|EVP_PKEY_sign_init|EVP_PKEY_verify|EVP_PKEY_verify_init|EVP_PKEY_verify_recover|EVP_PKEY_verify_recover_init|EVP_add_mac|RAND_bytes|RAND_priv_bytes)$";
+position p;
+@@
+
+ if (
+(
+ FUNC1(...)@p != 1
+|
+ (X = FUNC1(...)@p) != 1
+)
+ )
+ goto L;
+
+
+// These are void but here for completeness
+@openssl_void@
+identifier FUNCVOID =~ "^(AES_cfb128_encrypt|AES_cfb8_encrypt|AES_ige_encrypt|BN_GENCB_set|DSA_get0_key|DSA_get0_pqg|EC_GROUP_set_asn1_flag|EC_GROUP_set_point_conversion_form|ENGINE_get_static_state|ENGINE_unregister_DH|ENGINE_unregister_DSA|ENGINE_unregister_EC|ENGINE_unregister_RAND|ENGINE_unregister_RSA|ENGINE_unregister_ciphers|ENGINE_unregister_digests|ENGINE_unregister_pkey_asn1_meths|ENGINE_unregister_pkey_meths|OpenSSL_add_all_ciphers|OpenSSL_add_all_digests|RAND_seed|RC4|RC4_set_key|RSA_get0_crt_params|RSA_get0_factors|RSA_get0_key)$";
+position p;
+@@
+
+ FUNCVOID(...)@p;
+
+
+// Traditionally, OpenSSL didn't adhere to the semantics of free() calls
+// allowing for NULL. However, they have been changing it over time.
+// Since Erlang allows for unmaintained versions of OpenSSL, be conservative
+// and assume the worst.
+@openssl_free@
+expression X;
+identifier FUNCFREE =~ "^(BN_CTX_free|BN_GENCB_free|BN_clear_free|BN_free|CMAC_CTX_free|CRYPTO_free|DH_free|DSA_free|EC_GROUP_free|EC_KEY_free|EC_POINT_free|EVP_CIPHER_CTX_free|EVP_MD_CTX_free|EVP_PKEY_CTX_free|EVP_PKEY_free|HMAC_CTX_free|RSA_free|RSA_meth_free)$";
+position p;
+@@
+
+ if (
+(
+ X
+|
+ X != NULL
+)
+ )
+ FUNCFREE(X)@p;
+
+
+// NOTE: Keep these in sync with the above definitions!
+//
+// Find all of the cases that we haven't marked safe positions of.
+//
+// This will flag a few false positives because the code isn't using the
+// standard pattern.
+//
+// NOTE: You have to copy the regexps because there doesn't appear to be a way in
+// coccinelle to reference a regexp identifier from another rule properly.
+@openssl_check_NOT_SAFE@
+
+identifier FUNCNEG =~ "^(DH_compute_key|RSA_padding_check_SSLv23)$";
+position pneg != openssl_check_negative.p;
+
+identifier FUNCPOS =~ "^(ECDH_compute_key|EVP_CIPHER_asn1_to_param|EVP_CIPHER_param_to_asn1|EVP_PKEY_CTX_ctrl|RSA_pkey_ctx_ctrl)$";
+position ppos != openssl_check_positive.p;
+
+identifier FUNC0 =~ "^(AES_set_decrypt_key|AES_set_encrypt_key|CRYPTO_gcm128_aad|CRYPTO_gcm128_decrypt|CRYPTO_gcm128_finish)$";
+position p0 != openssl_check_0.p;
+
+identifier FUNCNULL =~ "^(BN_CTX_new|BN_GENCB_new|BN_MONT_CTX_new|BN_bin2bn|BN_dup|BN_generate_prime|BN_new|CMAC_CTX_new|CRYPTO_clear_realloc|CRYPTO_gcm128_new|CRYPTO_malloc|CRYPTO_realloc|CRYPTO_zalloc|DH_generate_parameters|DH_new|DSA_new|EC_GROUP_dup|EC_GROUP_get0_generator|EC_GROUP_method_of|EC_GROUP_new_curve_GFm|EC_GROUP_new_curve_GFp|EC_KEY_copy|EC_KEY_dup|EC_KEY_get0_engine|EC_KEY_new|EC_KEY_new_by_curve_name|EC_POINT_bn2point|EC_POINT_dup|EC_POINT_new|EC_POINT_point2bn|ENGINE_by_id|ENGINE_get_cipher_engine|ENGINE_get_default_DH|ENGINE_get_default_DSA|ENGINE_get_default_RAND|ENGINE_get_default_RSA|ENGINE_get_digest_engine|ENGINE_get_first|ENGINE_get_id|ENGINE_get_last|ENGINE_get_name|ENGINE_get_next|ENGINE_get_prev|ENGINE_load_private_key|ENGINE_load_public_key|ENGINE_new|EVP_CIPHER_CTX_new|EVP_MAC_CTX_new|EVP_MAC_CTX_new_id|EVP_MD_CTX_new|EVP_MD_meth_new|EVP_PKEY_CTX_new|EVP_PKEY_CTX_new_id|EVP_PKEY_get1_DH|EVP_PKEY_get1_DSA|EVP_PKEY_get1_EC_KEY|EVP_PKEY_get1_RSA|EVP_PKEY_new|EVP_PKEY_new_raw_private_key|EVP_PKEY_new_raw_public_key|EVP_get_cipherbyname|EVP_get_cipherbynid|EVP_get_cipherbyobj|EVP_get_macbyname|EVP_get_macbynid|EVP_get_macbyobj|HMAC|HMAC_CTX_new|OPENSSL_buf2hexstr|OPENSSL_clear_realloc|OPENSSL_hexstr2buf|OPENSSL_malloc|OPENSSL_realloc|OPENSSL_strdup|OPENSSL_strndup|OPENSSL_zalloc|RSA_meth_dup|RSA_meth_new|RSA_new)$";
+position pnull != openssl_check_null.p;
+
+identifier FUNCNOT =~ "^(BN_add|BN_div|BN_exp|BN_from_montgomery|BN_gcd|BN_generate_prime_ex|BN_mod|BN_mod_add|BN_mod_exp|BN_mod_mul|BN_mod_mul_montgomery|BN_mod_sqr|BN_mod_sub|BN_mul|BN_nnmod|BN_priv_rand|BN_priv_rand_range|BN_pseudo_rand|BN_pseudo_rand_range|BN_rand|BN_rand_range|BN_set_bit|BN_set_word|BN_sqr|BN_sub|BN_to_montgomery|CMAC_Final|CMAC_Init|CMAC_Update|CRYPTO_set_mem_debug|CRYPTO_set_mem_functions|DH_check|DH_check_ex|DH_check_params|DH_check_pub_key_ex|DH_generate_key|DH_generate_parameters_ex|DH_set0_key|DH_set0_pqg|DH_set_length|DSA_set0_key|DSA_set0_pqg|EC_GROUP_check|EC_GROUP_check_discriminant|EC_GROUP_copy|EC_GROUP_get_curve_name|EC_GROUP_get_pentanomial_basis|EC_GROUP_get_trinomial_basis|EC_GROUP_precompute_mult|EC_GROUP_set_generator|EC_GROUP_set_seed|EC_KEY_check_key|EC_KEY_generate_key|EC_KEY_key2buf|EC_KEY_oct2key|EC_KEY_oct2priv|EC_KEY_precompute_mult|EC_KEY_priv2buf|EC_KEY_priv2oct|EC_KEY_set_group|EC_KEY_set_private_key|EC_KEY_set_public_key|EC_KEY_set_public_key_affine_coordinates|EC_KEY_up_ref|EC_POINT_add|EC_POINT_copy|EC_POINT_dbl|EC_POINT_get_Jprojective_coordinates_GFp|EC_POINT_get_affine_coordinates_GF2m|EC_POINT_get_affine_coordinates_GFp|EC_POINT_invert|EC_POINT_make_affine|EC_POINT_mul|EC_POINT_oct2point|EC_POINT_point2oct|EC_POINT_set_Jprojective_coordinates_GFp|EC_POINT_set_affine_coordinates_GF2m|EC_POINT_set_affine_coordinates_GFp|EC_POINT_set_compressed_coordinates_GF2m|EC_POINT_set_compressed_coordinates_GFp|EC_POINT_set_to_infinity|EC_POINTs_make_affine|EC_POINTs_mul|ENGINE_add|ENGINE_ctrl_cmd|ENGINE_ctrl_cmd_string|ENGINE_finish|ENGINE_free|ENGINE_init|ENGINE_register_DH|ENGINE_register_DSA|ENGINE_register_EC|ENGINE_register_RAND|ENGINE_register_RSA|ENGINE_register_all_complete|ENGINE_register_ciphers|ENGINE_register_complete|ENGINE_register_digests|ENGINE_register_pkey_asn1_meths|ENGINE_register_pkey_meths|ENGINE_remove|ENGINE_set_RSA|ENGINE_set_default|ENGINE_set_default_DH|ENGINE_set_default_DSA|ENGINE_set_default_EC|ENGINE_set_default_RAND|ENGINE_set_default_RSA|ENGINE_set_digests|ENGINE_set_id|ENGINE_set_init_function|ENGINE_set_load_privkey_function|ENGINE_set_load_pubkey_function|ENGINE_set_name|ENGINE_up_ref|HMAC_CTX_copy|HMAC_CTX_reset|HMAC_Final|HMAC_Init_ex|HMAC_Update|MD2_Init|MD2_Update|MD2_Final|MD4_Init|MD4_Update|MD4_Final|MD5_Init|MD5_Update|MD5_Final|OPENSSL_init_crypto|OPENSSL_mem_debug_pop|OPENSSL_mem_debug_push|RSA_generate_key_ex|RSA_generate_multi_prime_key|RSA_meth_set_finish|RSA_meth_set_sign|RSA_meth_set_verify|RSA_padding_add_SSLv23|RSA_set0_crt_params|RSA_set0_factors|RSA_set0_key|RSA_set0_multi_prime_params)$";
+position pnot != openssl_check_not.p;
+
+identifier FUNC1 =~ "^(EVP_CIPHER_CTX_copy|EVP_CIPHER_CTX_ctrl|EVP_CIPHER_CTX_rand_key|EVP_CIPHER_CTX_reset|EVP_CIPHER_CTX_set_key_length|EVP_CIPHER_CTX_set_padding|EVP_CipherFinal_ex|EVP_CipherInit_ex|EVP_CipherUpdate|EVP_DecryptFinal_ex|EVP_DecryptInit_ex|EVP_DecryptUpdate|EVP_Digest|EVP_DigestFinal|EVP_DigestFinal_ex|EVP_DigestInit|EVP_DigestInit_ex|EVP_DigestSign|EVP_DigestSignInit|EVP_DigestSignUpdate|EVP_DigestSignaFinal|EVP_DigestUpdate|EVP_DigestVerify|EVP_DigestVerifyInit|EVP_EncryptFinal_ex|EVP_EncryptInit_ex|EVP_EncryptUpdate|EVP_MAC_CTX_copy|EVP_MAC_ctrl|EVP_MAC_ctrl_str|EVP_MAC_hex2ctrl|EVP_MAC_init|EVP_MAC_reset|EVP_MAC_str2ctrl|EVP_MAC_update|EVP_MD_CTX_copy|EVP_MD_CTX_copy_ex|EVP_MD_CTX_ctrl|EVP_MD_meth_set_app_datasize|EVP_MD_meth_set_cleanup|EVP_MD_meth_set_copy|EVP_MD_meth_set_ctrl|EVP_MD_meth_set_final|EVP_MD_meth_set_flags|EVP_MD_meth_set_init|EVP_MD_meth_set_input_blocksize|EVP_MD_meth_set_result_size|EVP_MD_meth_set_update|EVP_PKEY_CTX_set_rsa_mgf1_md|EVP_PKEY_CTX_set_rsa_padding|EVP_PKEY_CTX_set_rsa_pss_saltlen|EVP_PKEY_CTX_set_signature|EVP_PKEY_assign|EVP_PKEY_assign_DSA|EVP_PKEY_assign_EC_KEY|EVP_PKEY_assign_RSA|EVP_PKEY_decrypt|EVP_PKEY_decrypt_init|EVP_PKEY_derive|EVP_PKEY_derive_init|EVP_PKEY_derive_set_peer|EVP_PKEY_encrypt|EVP_PKEY_encrypt_init|EVP_PKEY_get1_DH|EVP_PKEY_get_raw_private_key|EVP_PKEY_get_raw_public_key|EVP_PKEY_keygen|EVP_PKEY_keygen_init|EVP_PKEY_set1_DH|EVP_PKEY_sign|EVP_PKEY_sign_init|EVP_PKEY_verify|EVP_PKEY_verify_init|EVP_PKEY_verify_recover|EVP_PKEY_verify_recover_init|EVP_add_mac|RAND_bytes|RAND_priv_bytes)$";
+position p1 != openssl_check_1.p;
+
+identifier FUNCVOID =~ "^(AES_cfb128_encrypt|AES_cfb8_encrypt|AES_ige_encrypt|BN_GENCB_set|DSA_get0_key|DSA_get0_pqg|EC_GROUP_set_asn1_flag|EC_GROUP_set_point_conversion_form|ENGINE_get_static_state|ENGINE_unregister_DH|ENGINE_unregister_DSA|ENGINE_unregister_EC|ENGINE_unregister_RAND|ENGINE_unregister_RSA|ENGINE_unregister_ciphers|ENGINE_unregister_digests|ENGINE_unregister_pkey_asn1_meths|ENGINE_unregister_pkey_meths|OpenSSL_add_all_ciphers|OpenSSL_add_all_digests|RAND_seed|RC4|RC4_set_key|RSA_get0_crt_params|RSA_get0_factors|RSA_get0_key)$";
+position pvoid != openssl_void.p;
+
+identifier FUNCFREE =~ "^(BN_CTX_free|BN_GENCB_free|BN_clear_free|BN_free|CMAC_CTX_free|CRYPTO_free|DH_free|DSA_free|EC_GROUP_free|EC_KEY_free|EC_POINT_free|EVP_CIPHER_CTX_free|EVP_MD_CTX_free|EVP_PKEY_CTX_free|EVP_PKEY_free|HMAC_CTX_free|RSA_free|RSA_meth_free)$";
+position pfree != openssl_free.p;
+@@
+
+(
+* FUNCNEG(...)@pneg
+|
+* FUNCPOS(...)@ppos
+|
+* FUNCNULL(...)@pnull
+|
+* FUNC0(...)@p0
+|
+* FUNC1(...)@p1
+|
+* FUNCNOT(...)@pnot
+|
+* FUNCVOID(...)@pvoid
+|
+* FUNCFREE(...)@pfree
+)
diff --git a/lib/crypto/c_src/cipher.c b/lib/crypto/c_src/cipher.c
index 6580cb183f..c055a62654 100644
--- a/lib/crypto/c_src/cipher.c
+++ b/lib/crypto/c_src/cipher.c
@@ -28,90 +28,295 @@
static struct cipher_type_t cipher_types[] =
{
- {{"rc2_cbc"},
#ifndef OPENSSL_NO_RC2
- {&EVP_rc2_cbc}
+ {{"rc2_cbc"}, {&EVP_rc2_cbc}, 0, NO_FIPS_CIPHER},
#else
- {NULL}
+ {{"rc2_cbc"}, {NULL}, 0, NO_FIPS_CIPHER},
#endif
- },
- {{"des_cbc"}, {COND_NO_DES_PTR(&EVP_des_cbc)}},
- {{"des_cfb"}, {COND_NO_DES_PTR(&EVP_des_cfb8)}},
- {{"des_ecb"}, {COND_NO_DES_PTR(&EVP_des_ecb)}},
- {{"des_ede3_cbc"}, {COND_NO_DES_PTR(&EVP_des_ede3_cbc)}},
- {{"des_ede3_cbf"}, /* Misspelled, retained */
-#ifdef HAVE_DES_ede3_cfb_encrypt
- {COND_NO_DES_PTR(&EVP_des_ede3_cfb8)}
+#ifndef OPENSSL_NO_RC4
+ {{"rc4"}, {&EVP_rc4}, 0, NO_FIPS_CIPHER},
#else
- {NULL}
+ {{"rc4"}, {NULL}, 0, NO_FIPS_CIPHER},
#endif
- },
- {{"des_ede3_cfb"},
+ {{"des_cbc"}, {COND_NO_DES_PTR(&EVP_des_cbc)}, 0, NO_FIPS_CIPHER},
+ {{"des_cfb"}, {COND_NO_DES_PTR(&EVP_des_cfb8)}, 0, NO_FIPS_CIPHER},
+ {{"des_ecb"}, {COND_NO_DES_PTR(&EVP_des_ecb)}, 0, NO_FIPS_CIPHER | ECB_BUG_0_9_8L},
+
+ {{"des_ede3_cbc"}, {COND_NO_DES_PTR(&EVP_des_ede3_cbc)}, 0, 0},
+
#ifdef HAVE_DES_ede3_cfb_encrypt
- {COND_NO_DES_PTR(&EVP_des_ede3_cfb8)}
+ {{"des_ede3_cfb"}, {COND_NO_DES_PTR(&EVP_des_ede3_cfb8)}, 0, 0},
+#else
+ {{"des_ede3_cfb"}, {NULL}, 0, 0},
+#endif
+
+ {{"blowfish_cbc"}, {&EVP_bf_cbc}, 0, NO_FIPS_CIPHER},
+ {{"blowfish_cfb64"}, {&EVP_bf_cfb64}, 0, NO_FIPS_CIPHER},
+ {{"blowfish_ofb64"}, {&EVP_bf_ofb}, 0, NO_FIPS_CIPHER},
+ {{"blowfish_ecb"}, {&EVP_bf_ecb}, 0, NO_FIPS_CIPHER | ECB_BUG_0_9_8L},
+
+ {{"aes_cbc"}, {&EVP_aes_128_cbc}, 16, 0},
+ {{"aes_cbc"}, {&EVP_aes_192_cbc}, 24, 0},
+ {{"aes_cbc"}, {&EVP_aes_256_cbc}, 32, 0},
+
+ {{"aes_128_cbc"}, {&EVP_aes_128_cbc}, 16, 0},
+ {{"aes_192_cbc"}, {&EVP_aes_192_cbc}, 24, 0},
+ {{"aes_256_cbc"}, {&EVP_aes_256_cbc}, 32, 0},
+
+ {{"aes_cfb8"}, {&EVP_aes_128_cfb8}, 16, NO_FIPS_CIPHER | AES_CFBx},
+ {{"aes_cfb8"}, {&EVP_aes_192_cfb8}, 24, NO_FIPS_CIPHER | AES_CFBx},
+ {{"aes_cfb8"}, {&EVP_aes_256_cfb8}, 32, NO_FIPS_CIPHER | AES_CFBx},
+
+ {{"aes_128_cfb8"}, {&EVP_aes_128_cfb8}, 16, NO_FIPS_CIPHER | AES_CFBx},
+ {{"aes_192_cfb8"}, {&EVP_aes_192_cfb8}, 24, NO_FIPS_CIPHER | AES_CFBx},
+ {{"aes_256_cfb8"}, {&EVP_aes_256_cfb8}, 32, NO_FIPS_CIPHER | AES_CFBx},
+
+ {{"aes_cfb128"}, {&EVP_aes_128_cfb128}, 16, NO_FIPS_CIPHER | AES_CFBx},
+ {{"aes_cfb128"}, {&EVP_aes_192_cfb128}, 24, NO_FIPS_CIPHER | AES_CFBx},
+ {{"aes_cfb128"}, {&EVP_aes_256_cfb128}, 32, NO_FIPS_CIPHER | AES_CFBx},
+
+ {{"aes_128_cfb128"}, {&EVP_aes_128_cfb128}, 16, NO_FIPS_CIPHER | AES_CFBx},
+ {{"aes_192_cfb128"}, {&EVP_aes_192_cfb128}, 24, NO_FIPS_CIPHER | AES_CFBx},
+ {{"aes_256_cfb128"}, {&EVP_aes_256_cfb128}, 32, NO_FIPS_CIPHER | AES_CFBx},
+
+ {{"aes_ecb"}, {&EVP_aes_128_ecb}, 16, ECB_BUG_0_9_8L},
+ {{"aes_ecb"}, {&EVP_aes_192_ecb}, 24, ECB_BUG_0_9_8L},
+ {{"aes_ecb"}, {&EVP_aes_256_ecb}, 32, ECB_BUG_0_9_8L},
+
+ {{"aes_128_ecb"}, {&EVP_aes_128_ecb}, 16, ECB_BUG_0_9_8L},
+ {{"aes_192_ecb"}, {&EVP_aes_192_ecb}, 24, ECB_BUG_0_9_8L},
+ {{"aes_256_ecb"}, {&EVP_aes_256_ecb}, 32, ECB_BUG_0_9_8L},
+
+#if defined(HAVE_EVP_AES_CTR)
+ {{"aes_128_ctr"}, {&EVP_aes_128_ctr}, 16, 0},
+ {{"aes_192_ctr"}, {&EVP_aes_192_ctr}, 24, 0},
+ {{"aes_256_ctr"}, {&EVP_aes_256_ctr}, 32, 0},
+ {{"aes_ctr"}, {&EVP_aes_128_ctr}, 16, 0},
+ {{"aes_ctr"}, {&EVP_aes_192_ctr}, 24, 0},
+ {{"aes_ctr"}, {&EVP_aes_256_ctr}, 32, 0},
+#else
+ {{"aes_128_ctr"}, {NULL}, 16, AES_CTR_COMPAT},
+ {{"aes_192_ctr"}, {NULL}, 24, AES_CTR_COMPAT},
+ {{"aes_256_ctr"}, {NULL}, 32, AES_CTR_COMPAT},
+ {{"aes_ctr"}, {NULL}, 0, AES_CTR_COMPAT},
+#endif
+
+#if defined(HAVE_CHACHA20)
+ {{"chacha20"}, {&EVP_chacha20}, 32, NO_FIPS_CIPHER},
+#else
+ {{"chacha20"}, {NULL}, 0, NO_FIPS_CIPHER},
+#endif
+
+ /*==== AEAD ciphers ====*/
+#if defined(HAVE_CHACHA20_POLY1305)
+ {{"chacha20_poly1305"}, {&EVP_chacha20_poly1305}, 0, NO_FIPS_CIPHER | AEAD_CIPHER, {{EVP_CTRL_AEAD_SET_IVLEN,EVP_CTRL_AEAD_GET_TAG,EVP_CTRL_AEAD_SET_TAG}}},
+#else
+ {{"chacha20_poly1305"}, {NULL}, 0, NO_FIPS_CIPHER | AEAD_CIPHER, {{0,0,0}}},
+#endif
+
+#if defined(HAVE_GCM)
+ {{"aes_gcm"}, {&EVP_aes_128_gcm}, 16, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}},
+ {{"aes_gcm"}, {&EVP_aes_192_gcm}, 24, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}},
+ {{"aes_gcm"}, {&EVP_aes_256_gcm}, 32, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}},
+ {{"aes_128_gcm"}, {&EVP_aes_128_gcm}, 16, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}},
+ {{"aes_192_gcm"}, {&EVP_aes_192_gcm}, 24, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}},
+ {{"aes_256_gcm"}, {&EVP_aes_256_gcm}, 32, AEAD_CIPHER, {{EVP_CTRL_GCM_SET_IVLEN,EVP_CTRL_GCM_GET_TAG,EVP_CTRL_GCM_SET_TAG}}},
#else
- {NULL}
+ {{"aes_gcm"}, {NULL}, 0, AEAD_CIPHER, {{0,0,0}}},
+ {{"aes_128_gcm"}, {NULL}, 16, AEAD_CIPHER, {{0,0,0}}},
+ {{"aes_192_gcm"}, {NULL}, 24, AEAD_CIPHER, {{0,0,0}}},
+ {{"aes_256_gcm"}, {NULL}, 32, AEAD_CIPHER, {{0,0,0}}},
+#endif
+
+#if defined(HAVE_CCM)
+ {{"aes_ccm"}, {&EVP_aes_128_ccm}, 16, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}},
+ {{"aes_ccm"}, {&EVP_aes_192_ccm}, 24, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}},
+ {{"aes_ccm"}, {&EVP_aes_256_ccm}, 32, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}},
+ {{"aes_128_ccm"}, {&EVP_aes_128_ccm}, 16, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}},
+ {{"aes_192_ccm"}, {&EVP_aes_192_ccm}, 24, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}},
+ {{"aes_256_ccm"}, {&EVP_aes_256_ccm}, 32, AEAD_CIPHER, {{EVP_CTRL_CCM_SET_IVLEN,EVP_CTRL_CCM_GET_TAG,EVP_CTRL_CCM_SET_TAG}}},
+#else
+ {{"aes_ccm"}, {NULL}, 0, AEAD_CIPHER, {{0,0,0}}},
+ {{"aes_128_ccm"}, {NULL}, 16, AEAD_CIPHER, {{0,0,0}}},
+ {{"aes_192_ccm"}, {NULL}, 24, AEAD_CIPHER, {{0,0,0}}},
+ {{"aes_256_ccm"}, {NULL}, 32, AEAD_CIPHER, {{0,0,0}}},
+#endif
+
+ /*==== Specialy handled ciphers, only for inclusion in algorithm's list ====*/
+#ifdef HAVE_AES_IGE
+ {{"aes_ige256"}, {NULL}, 0, NO_FIPS_CIPHER | NON_EVP_CIPHER},
#endif
- },
- {{"blowfish_cbc"}, {&EVP_bf_cbc}},
- {{"blowfish_cfb64"}, {&EVP_bf_cfb64}},
- {{"blowfish_ofb64"}, {&EVP_bf_ofb}},
- {{"blowfish_ecb"}, {&EVP_bf_ecb}},
- {{"aes_cbc"}, {&EVP_aes_128_cbc}, 16},
- {{"aes_cbc"}, {&EVP_aes_192_cbc}, 24},
- {{"aes_cbc"}, {&EVP_aes_256_cbc}, 32},
- {{"aes_cbc128"}, {&EVP_aes_128_cbc}},
- {{"aes_cbc256"}, {&EVP_aes_256_cbc}},
- {{"aes_cfb8"}, {&EVP_aes_128_cfb8}},
- {{"aes_cfb128"}, {&EVP_aes_128_cfb128}},
- {{"aes_ecb"}, {&EVP_aes_128_ecb}, 16},
- {{"aes_ecb"}, {&EVP_aes_192_ecb}, 24},
- {{"aes_ecb"}, {&EVP_aes_256_ecb}, 32},
- {{NULL}}
+
+ /*==== End of list ==== */
+
+ {{NULL},{NULL},0,0}
};
-#ifdef HAVE_EVP_AES_CTR
ErlNifResourceType* evp_cipher_ctx_rtype;
+static size_t num_cipher_types = 0;
+
static void evp_cipher_ctx_dtor(ErlNifEnv* env, struct evp_cipher_ctx* ctx) {
- EVP_CIPHER_CTX_free(ctx->ctx);
+ if (ctx == NULL)
+ return;
+
+ if (ctx->ctx)
+ EVP_CIPHER_CTX_free(ctx->ctx);
}
-#endif
int init_cipher_ctx(ErlNifEnv *env) {
-#ifdef HAVE_EVP_AES_CTR
evp_cipher_ctx_rtype = enif_open_resource_type(env, NULL, "EVP_CIPHER_CTX",
(ErlNifResourceDtor*) evp_cipher_ctx_dtor,
ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER,
NULL);
- if (evp_cipher_ctx_rtype == NULL) {
- PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_CIPHER_CTX'");
- return 0;
- }
-#endif
+ if (evp_cipher_ctx_rtype == NULL)
+ goto err;
return 1;
+
+ err:
+ PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_CIPHER_CTX'");
+ return 0;
}
void init_cipher_types(ErlNifEnv* env)
{
struct cipher_type_t* p = cipher_types;
+ num_cipher_types = 0;
for (p = cipher_types; p->type.str; p++) {
+ num_cipher_types++;
p->type.atom = enif_make_atom(env, p->type.str);
if (p->cipher.funcp)
p->cipher.p = p->cipher.funcp();
}
p->type.atom = atom_false; /* end marker */
+
+ qsort(cipher_types, num_cipher_types, sizeof(cipher_types[0]), cmp_cipher_types);
}
-struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len)
+const struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len)
{
- struct cipher_type_t* p = NULL;
- for (p = cipher_types; p->type.atom != atom_false; p++) {
- if (type == p->type.atom && (!p->key_len || key_len == p->key_len)) {
- return p;
- }
+ struct cipher_type_t key;
+
+ key.type.atom = type;
+ key.key_len = key_len;
+
+ return bsearch(&key, cipher_types, num_cipher_types, sizeof(cipher_types[0]), cmp_cipher_types);
+}
+
+
+int cmp_cipher_types(const void *keyp, const void *elemp) {
+ const struct cipher_type_t *key = keyp;
+ const struct cipher_type_t *elem = elemp;
+
+ if (key->type.atom < elem->type.atom) return -1;
+ else if (key->type.atom > elem->type.atom) return 1;
+ else /* key->type.atom == elem->type.atom */
+ if (!elem->key_len || key->key_len == elem->key_len) return 0;
+ else if (key->key_len < elem->key_len) return -1;
+ else return 1;
+}
+
+
+ERL_NIF_TERM cipher_info_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type) */
+ const struct cipher_type_t *cipherp;
+ const EVP_CIPHER *cipher;
+ ERL_NIF_TERM ret, ret_mode;
+ unsigned type;
+ unsigned long mode;
+
+ if ((cipherp = get_cipher_type_no_key(argv[0])) == NULL)
+ return enif_make_badarg(env);
+
+ if (FORBIDDEN_IN_FIPS(cipherp))
+ return enif_raise_exception(env, atom_notsup);
+ if ((cipher = cipherp->cipher.p) == NULL)
+ return enif_raise_exception(env, atom_notsup);
+
+ ret = enif_make_new_map(env);
+
+ type = EVP_CIPHER_type(cipher);
+ enif_make_map_put(env, ret, atom_type,
+ type == NID_undef ? atom_undefined : enif_make_int(env, type),
+ &ret);
+
+ enif_make_map_put(env, ret, atom_key_length,
+ enif_make_int(env, EVP_CIPHER_key_length(cipher)), &ret);
+ enif_make_map_put(env, ret, atom_iv_length,
+ enif_make_int(env, EVP_CIPHER_iv_length(cipher)), &ret);
+ enif_make_map_put(env, ret, atom_block_size,
+ enif_make_int(env, EVP_CIPHER_block_size(cipher)), &ret);
+
+ mode = EVP_CIPHER_mode(cipher);
+ switch (mode) {
+ case EVP_CIPH_ECB_MODE:
+ ret_mode = atom_ecb_mode;
+ break;
+
+ case EVP_CIPH_CBC_MODE:
+ ret_mode = atom_cbc_mode;
+ break;
+
+ case EVP_CIPH_CFB_MODE:
+ ret_mode = atom_cfb_mode;
+ break;
+
+ case EVP_CIPH_OFB_MODE:
+ ret_mode = atom_ofb_mode;
+ break;
+
+ case EVP_CIPH_STREAM_CIPHER:
+ ret_mode = atom_stream_cipher;
+ break;
+
+ default:
+ ret_mode = atom_undefined;
+ break;
}
- return NULL;
+
+ enif_make_map_put(env, ret, atom_mode, ret_mode, &ret);
+
+ return ret;
+}
+
+const struct cipher_type_t* get_cipher_type_no_key(ERL_NIF_TERM type)
+{
+ struct cipher_type_t key;
+
+ key.type.atom = type;
+
+ return bsearch(&key, cipher_types, num_cipher_types, sizeof(cipher_types[0]), cmp_cipher_types_no_key);
+}
+
+int cmp_cipher_types_no_key(const void *keyp, const void *elemp) {
+ const struct cipher_type_t *key = keyp;
+ const struct cipher_type_t *elem = elemp;
+
+ if (key->type.atom < elem->type.atom) return -1;
+ else if (key->type.atom > elem->type.atom) return 1;
+ else /* key->type.atom == elem->type.atom */ return 0;
+}
+
+
+ERL_NIF_TERM cipher_types_as_list(ErlNifEnv* env)
+{
+ struct cipher_type_t* p;
+ ERL_NIF_TERM prev, hd;
+
+ hd = enif_make_list(env, 0);
+ prev = atom_undefined;
+
+ for (p = cipher_types; (p->type.atom & (p->type.atom != atom_false)); p++) {
+ if ((prev != p->type.atom) &&
+ ((p->cipher.p != NULL) ||
+ (p->flags & (NON_EVP_CIPHER|AES_CTR_COMPAT)) ) && /* Special handling. Bad indeed... */
+ ! FORBIDDEN_IN_FIPS(p)
+ )
+ hd = enif_make_list_cell(env, p->type.atom, hd);
+ prev = p->type.atom;
+ }
+
+ return hd;
}
diff --git a/lib/crypto/c_src/cipher.h b/lib/crypto/c_src/cipher.h
index 3fb27f0ba3..b0d9d324e1 100644
--- a/lib/crypto/c_src/cipher.h
+++ b/lib/crypto/c_src/cipher.h
@@ -32,19 +32,46 @@ struct cipher_type_t {
const EVP_CIPHER* (*funcp)(void); /* before init, NULL if notsup */
const EVP_CIPHER* p; /* after init, NULL if notsup */
}cipher;
- const size_t key_len; /* != 0 to also match on key_len */
+ size_t key_len; /* != 0 to also match on key_len */
+ unsigned flags;
+ union {
+ struct aead_ctrl {int ctx_ctrl_set_ivlen, ctx_ctrl_get_tag, ctx_ctrl_set_tag;} aead;
+ } extra;
};
-#ifdef HAVE_EVP_AES_CTR
+/* masks in the flags field if cipher_type_t */
+#define NO_FIPS_CIPHER 1
+#define AES_CFBx 2
+#define ECB_BUG_0_9_8L 4
+#define AEAD_CIPHER 8
+#define NON_EVP_CIPHER 16
+#define AES_CTR_COMPAT 32
+
+
+#ifdef FIPS_SUPPORT
+/* May have FIPS support, must check dynamically if it is enabled */
+# define FORBIDDEN_IN_FIPS(P) (((P)->flags & NO_FIPS_CIPHER) && FIPS_mode())
+#else
+/* No FIPS support since the symbol FIPS_SUPPORT is undefined */
+# define FORBIDDEN_IN_FIPS(P) 0
+#endif
+
extern ErlNifResourceType* evp_cipher_ctx_rtype;
struct evp_cipher_ctx {
EVP_CIPHER_CTX* ctx;
};
-#endif
+
+ERL_NIF_TERM cipher_info_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
int init_cipher_ctx(ErlNifEnv *env);
void init_cipher_types(ErlNifEnv* env);
-struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len);
+const struct cipher_type_t* get_cipher_type_no_key(ERL_NIF_TERM type);
+const struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len);
+
+int cmp_cipher_types(const void *keyp, const void *elemp);
+int cmp_cipher_types_no_key(const void *keyp, const void *elemp);
+
+ERL_NIF_TERM cipher_types_as_list(ErlNifEnv* env);
#endif /* E_CIPHER_H__ */
diff --git a/lib/crypto/c_src/cmac.c b/lib/crypto/c_src/cmac.c
index 526de11a01..49e67ccf29 100644
--- a/lib/crypto/c_src/cmac.c
+++ b/lib/crypto/c_src/cmac.c
@@ -24,42 +24,60 @@
ERL_NIF_TERM cmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type, Key, Data) */
#if defined(HAVE_CMAC)
- struct cipher_type_t *cipherp = NULL;
+ const struct cipher_type_t *cipherp;
const EVP_CIPHER *cipher;
- CMAC_CTX *ctx;
+ CMAC_CTX *ctx = NULL;
ErlNifBinary key;
ErlNifBinary data;
ERL_NIF_TERM ret;
size_t ret_size;
+ unsigned char *outp;
+ int cipher_len;
- if (!enif_inspect_iolist_as_binary(env, argv[1], &key)
- || !(cipherp = get_cipher_type(argv[0], key.size))
- || !enif_inspect_iolist_as_binary(env, argv[2], &data)) {
- return enif_make_badarg(env);
- }
- cipher = cipherp->cipher.p;
- if (!cipher) {
+ ASSERT(argc == 3);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key))
+ goto bad_arg;
+ if ((cipherp = get_cipher_type(argv[0], key.size)) == NULL)
+ goto bad_arg;
+ if (cipherp->flags & (NON_EVP_CIPHER | AEAD_CIPHER))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[2], &data))
+ goto bad_arg;
+
+ if (FORBIDDEN_IN_FIPS(cipherp))
+ return enif_raise_exception(env, atom_notsup);
+ if ((cipher = cipherp->cipher.p) == NULL)
return enif_raise_exception(env, atom_notsup);
- }
- ctx = CMAC_CTX_new();
- if (!CMAC_Init(ctx, key.data, key.size, cipher, NULL)) {
- CMAC_CTX_free(ctx);
- return atom_notsup;
- }
+ if ((ctx = CMAC_CTX_new()) == NULL)
+ goto err;
+ if (!CMAC_Init(ctx, key.data, key.size, cipher, NULL))
+ goto err;
+ if (!CMAC_Update(ctx, data.data, data.size))
+ goto err;
+ if ((cipher_len = EVP_CIPHER_block_size(cipher)) < 0)
+ goto err;
+ if ((outp = enif_make_new_binary(env, (size_t)cipher_len, &ret)) == NULL)
+ goto err;
+ if (!CMAC_Final(ctx, outp, &ret_size))
+ goto err;
- if (!CMAC_Update(ctx, data.data, data.size) ||
- !CMAC_Final(ctx,
- enif_make_new_binary(env, EVP_CIPHER_block_size(cipher), &ret),
- &ret_size)) {
- CMAC_CTX_free(ctx);
- return atom_notsup;
- }
ASSERT(ret_size == (unsigned)EVP_CIPHER_block_size(cipher));
-
- CMAC_CTX_free(ctx);
CONSUME_REDS(env, data);
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = atom_notsup;
+
+ done:
+ if (ctx)
+ CMAC_CTX_free(ctx);
return ret;
+
#else
/* The CMAC functionality was introduced in OpenSSL 1.0.1
* Although OTP requires at least version 0.9.8, the versions 0.9.8 and 1.0.0 are
diff --git a/lib/crypto/c_src/common.h b/lib/crypto/c_src/common.h
index 1259ba1f36..2bc8bdd73c 100644
--- a/lib/crypto/c_src/common.h
+++ b/lib/crypto/c_src/common.h
@@ -28,6 +28,8 @@
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
+#include <limits.h>
+#include <stdint.h>
#include <erl_nif.h>
#include "openssl_config.h"
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index fde3d99fa8..261590d9a5 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -28,6 +28,7 @@
#include "aead.h"
#include "aes.h"
#include "algorithms.h"
+#include "api_ng.h"
#include "block.h"
#include "bn.h"
#include "chacha20.h"
@@ -62,77 +63,81 @@ static int library_refc = 0; /* number of users of this dynamic library */
static int library_initialized = 0;
static ErlNifFunc nif_funcs[] = {
- {"info_lib", 0, info_lib},
- {"info_fips", 0, info_fips},
- {"enable_fips_mode", 1, enable_fips_mode},
- {"algorithms", 0, algorithms},
- {"hash_nif", 2, hash_nif},
- {"hash_init_nif", 1, hash_init_nif},
- {"hash_update_nif", 2, hash_update_nif},
- {"hash_final_nif", 1, hash_final_nif},
- {"hmac_nif", 3, hmac_nif},
- {"hmac_nif", 4, hmac_nif},
- {"hmac_init_nif", 2, hmac_init_nif},
- {"hmac_update_nif", 2, hmac_update_nif},
- {"hmac_final_nif", 1, hmac_final_nif},
- {"hmac_final_nif", 2, hmac_final_nif},
- {"cmac_nif", 3, cmac_nif},
- {"block_crypt_nif", 5, block_crypt_nif},
- {"block_crypt_nif", 4, block_crypt_nif},
- {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif},
- {"aes_ctr_stream_init", 2, aes_ctr_stream_init},
- {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt},
- {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt},
- {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif},
- {"strong_rand_range_nif", 1, strong_rand_range_nif},
- {"rand_uniform_nif", 2, rand_uniform_nif},
- {"mod_exp_nif", 4, mod_exp_nif},
- {"do_exor", 2, do_exor},
- {"rc4_set_key", 1, rc4_set_key},
- {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state},
- {"pkey_sign_nif", 5, pkey_sign_nif},
- {"pkey_verify_nif", 6, pkey_verify_nif},
- {"pkey_crypt_nif", 6, pkey_crypt_nif},
- {"rsa_generate_key_nif", 2, rsa_generate_key_nif},
- {"dh_generate_key_nif", 4, dh_generate_key_nif},
- {"dh_compute_key_nif", 3, dh_compute_key_nif},
- {"evp_compute_key_nif", 3, evp_compute_key_nif},
- {"evp_generate_key_nif", 1, evp_generate_key_nif},
- {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif},
- {"srp_value_B_nif", 5, srp_value_B_nif},
- {"srp_user_secret_nif", 7, srp_user_secret_nif},
- {"srp_host_secret_nif", 5, srp_host_secret_nif},
-
- {"ec_key_generate", 2, ec_key_generate},
- {"ecdh_compute_key_nif", 3, ecdh_compute_key_nif},
-
- {"rand_seed_nif", 1, rand_seed_nif},
-
- {"aead_encrypt", 6, aead_encrypt},
- {"aead_decrypt", 6, aead_decrypt},
-
- {"chacha20_stream_init", 2, chacha20_stream_init},
- {"chacha20_stream_encrypt", 2, chacha20_stream_crypt},
- {"chacha20_stream_decrypt", 2, chacha20_stream_crypt},
-
- {"poly1305_nif", 2, poly1305_nif},
-
- {"engine_by_id_nif", 1, engine_by_id_nif},
- {"engine_init_nif", 1, engine_init_nif},
- {"engine_finish_nif", 1, engine_finish_nif},
- {"engine_free_nif", 1, engine_free_nif},
- {"engine_load_dynamic_nif", 0, engine_load_dynamic_nif},
- {"engine_ctrl_cmd_strings_nif", 3, engine_ctrl_cmd_strings_nif},
- {"engine_register_nif", 2, engine_register_nif},
- {"engine_unregister_nif", 2, engine_unregister_nif},
- {"engine_add_nif", 1, engine_add_nif},
- {"engine_remove_nif", 1, engine_remove_nif},
- {"engine_get_first_nif", 0, engine_get_first_nif},
- {"engine_get_next_nif", 1, engine_get_next_nif},
- {"engine_get_id_nif", 1, engine_get_id_nif},
- {"engine_get_name_nif", 1, engine_get_name_nif},
- {"engine_get_all_methods_nif", 0, engine_get_all_methods_nif}
-
+ {"info_lib", 0, info_lib, 0},
+ {"info_fips", 0, info_fips, 0},
+ {"enable_fips_mode", 1, enable_fips_mode, 0},
+ {"algorithms", 0, algorithms, 0},
+ {"hash_info", 1, hash_info_nif, 0},
+ {"hash_nif", 2, hash_nif, 0},
+ {"hash_init_nif", 1, hash_init_nif, 0},
+ {"hash_update_nif", 2, hash_update_nif, 0},
+ {"hash_final_nif", 1, hash_final_nif, 0},
+ {"hmac_nif", 3, hmac_nif, 0},
+ {"hmac_nif", 4, hmac_nif, 0},
+ {"hmac_init_nif", 2, hmac_init_nif, 0},
+ {"hmac_update_nif", 2, hmac_update_nif, 0},
+ {"hmac_final_nif", 1, hmac_final_nif, 0},
+ {"hmac_final_nif", 2, hmac_final_nif, 0},
+ {"cmac_nif", 3, cmac_nif, 0},
+ {"cipher_info_nif", 1, cipher_info_nif, 0},
+ {"block_crypt_nif", 5, block_crypt_nif, 0},
+ {"block_crypt_nif", 4, block_crypt_nif, 0},
+ {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif, 0},
+ {"aes_ctr_stream_init", 2, aes_ctr_stream_init, 0},
+ {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt, 0},
+ {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt, 0},
+ {"ng_crypto_init_nif", 4, ng_crypto_init_nif, 0},
+ {"ng_crypto_update_nif", 2, ng_crypto_update_nif, 0},
+ {"ng_crypto_update_nif", 3, ng_crypto_update_nif, 0},
+ {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif, 0},
+ {"strong_rand_range_nif", 1, strong_rand_range_nif, 0},
+ {"rand_uniform_nif", 2, rand_uniform_nif, 0},
+ {"mod_exp_nif", 4, mod_exp_nif, 0},
+ {"do_exor", 2, do_exor, 0},
+ {"rc4_set_key", 1, rc4_set_key, 0},
+ {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state, 0},
+ {"pkey_sign_nif", 5, pkey_sign_nif, 0},
+ {"pkey_verify_nif", 6, pkey_verify_nif, 0},
+ {"pkey_crypt_nif", 6, pkey_crypt_nif, 0},
+ {"rsa_generate_key_nif", 2, rsa_generate_key_nif, 0},
+ {"dh_generate_key_nif", 4, dh_generate_key_nif, 0},
+ {"dh_compute_key_nif", 3, dh_compute_key_nif, 0},
+ {"evp_compute_key_nif", 3, evp_compute_key_nif, 0},
+ {"evp_generate_key_nif", 1, evp_generate_key_nif, 0},
+ {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif, 0},
+ {"srp_value_B_nif", 5, srp_value_B_nif, 0},
+ {"srp_user_secret_nif", 7, srp_user_secret_nif, 0},
+ {"srp_host_secret_nif", 5, srp_host_secret_nif, 0},
+
+ {"ec_key_generate", 2, ec_key_generate, 0},
+ {"ecdh_compute_key_nif", 3, ecdh_compute_key_nif, 0},
+
+ {"rand_seed_nif", 1, rand_seed_nif, 0},
+
+ {"aead_encrypt", 6, aead_encrypt, 0},
+ {"aead_decrypt", 6, aead_decrypt, 0},
+
+ {"chacha20_stream_init", 2, chacha20_stream_init, 0},
+ {"chacha20_stream_encrypt", 2, chacha20_stream_crypt, 0},
+ {"chacha20_stream_decrypt", 2, chacha20_stream_crypt, 0},
+
+ {"poly1305_nif", 2, poly1305_nif, 0},
+
+ {"engine_by_id_nif", 1, engine_by_id_nif, 0},
+ {"engine_init_nif", 1, engine_init_nif, 0},
+ {"engine_finish_nif", 1, engine_finish_nif, 0},
+ {"engine_free_nif", 1, engine_free_nif, 0},
+ {"engine_load_dynamic_nif", 0, engine_load_dynamic_nif, 0},
+ {"engine_ctrl_cmd_strings_nif", 3, engine_ctrl_cmd_strings_nif, 0},
+ {"engine_register_nif", 2, engine_register_nif, 0},
+ {"engine_unregister_nif", 2, engine_unregister_nif, 0},
+ {"engine_add_nif", 1, engine_add_nif, 0},
+ {"engine_remove_nif", 1, engine_remove_nif, 0},
+ {"engine_get_first_nif", 0, engine_get_first_nif, 0},
+ {"engine_get_next_nif", 1, engine_get_next_nif, 0},
+ {"engine_get_id_nif", 1, engine_get_id_nif, 0},
+ {"engine_get_name_nif", 1, engine_get_name_nif, 0},
+ {"engine_get_all_methods_nif", 0, engine_get_all_methods_nif, 0}
};
ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload)
@@ -166,20 +171,24 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
int vernum;
ErlNifBinary lib_bin;
char lib_buf[1000];
+#ifdef HAVE_DYNAMIC_CRYPTO_LIB
+ void *handle;
+#endif
if (!verify_lib_version())
return __LINE__;
/* load_info: {302, <<"/full/path/of/this/library">>,true|false} */
- if (!enif_get_tuple(env, load_info, &tpl_arity, &tpl_array)
- || tpl_arity != 3
- || !enif_get_int(env, tpl_array[0], &vernum)
- || vernum != 302
- || !enif_inspect_binary(env, tpl_array[1], &lib_bin)) {
-
- PRINTF_ERR1("CRYPTO: Invalid load_info '%T'", load_info);
- return __LINE__;
- }
+ if (!enif_get_tuple(env, load_info, &tpl_arity, &tpl_array))
+ return __LINE__;
+ if (tpl_arity != 3)
+ return __LINE__;
+ if (!enif_get_int(env, tpl_array[0], &vernum))
+ return __LINE__;
+ if (vernum != 302)
+ return __LINE__;
+ if (!enif_inspect_binary(env, tpl_array[1], &lib_bin))
+ return __LINE__;
if (!init_hmac_ctx(env)) {
return __LINE__;
@@ -206,19 +215,13 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
}
#ifdef HAVE_DYNAMIC_CRYPTO_LIB
- {
- void* handle;
- if (!change_basename(&lib_bin, lib_buf, sizeof(lib_buf), crypto_callback_name)) {
- return __LINE__;
- }
- if (!(handle = enif_dlopen(lib_buf, &error_handler, NULL))) {
- return __LINE__;
- }
- if (!(funcp = (get_crypto_callbacks_t*) enif_dlsym(handle, "get_crypto_callbacks",
- &error_handler, NULL))) {
- return __LINE__;
- }
- }
+ if (!change_basename(&lib_bin, lib_buf, sizeof(lib_buf), crypto_callback_name))
+ return __LINE__;
+ if ((handle = enif_dlopen(lib_buf, &error_handler, NULL)) == NULL)
+ return __LINE__;
+ if ((funcp = (get_crypto_callbacks_t*) enif_dlsym(handle, "get_crypto_callbacks",
+ &error_handler, NULL)) == NULL)
+ return __LINE__;
#else /* !HAVE_DYNAMIC_CRYPTO_LIB */
funcp = &get_crypto_callbacks;
#endif
@@ -238,7 +241,10 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
return __LINE__;
}
- CRYPTO_set_mem_functions(ccb->crypto_alloc, ccb->crypto_realloc, ccb->crypto_free);
+#ifdef HAS_CRYPTO_MEM_FUNCTIONS
+ if (!CRYPTO_set_mem_functions(ccb->crypto_alloc, ccb->crypto_realloc, ccb->crypto_free))
+ return __LINE__;
+#endif
#ifdef OPENSSL_THREADS
if (nlocks > 0) {
diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c
index 0cc7dd609d..0141ccd840 100644
--- a/lib/crypto/c_src/crypto_callback.c
+++ b/lib/crypto/c_src/crypto_callback.c
@@ -21,6 +21,7 @@
#include <stdio.h>
#include <string.h>
#include <openssl/opensslconf.h>
+#include <stdint.h>
#include <erl_nif.h>
#include "crypto_callback.h"
@@ -64,22 +65,36 @@ static void nomem(size_t size, const char* op)
static void* crypto_alloc(size_t size CCB_FILE_LINE_ARGS)
{
- void *ret = enif_alloc(size);
+ void *ret;
- if (!ret && size)
- nomem(size, "allocate");
+ if ((ret = enif_alloc(size)) == NULL)
+ goto err;
return ret;
+
+ err:
+ if (size)
+ nomem(size, "allocate");
+ return NULL;
}
static void* crypto_realloc(void* ptr, size_t size CCB_FILE_LINE_ARGS)
{
- void* ret = enif_realloc(ptr, size);
+ void* ret;
- if (!ret && size)
- nomem(size, "reallocate");
+ if ((ret = enif_realloc(ptr, size)) == NULL)
+ goto err;
return ret;
+
+ err:
+ if (size)
+ nomem(size, "reallocate");
+ return NULL;
}
+
static void crypto_free(void* ptr CCB_FILE_LINE_ARGS)
{
+ if (ptr == NULL)
+ return;
+
enif_free(ptr);
}
@@ -160,19 +175,26 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks)
#ifdef OPENSSL_THREADS
if (nlocks > 0) {
int i;
- lock_vec = enif_alloc(nlocks*sizeof(*lock_vec));
- if (lock_vec==NULL) return NULL;
- memset(lock_vec, 0, nlocks*sizeof(*lock_vec));
-
+
+ if ((size_t)nlocks > SIZE_MAX / sizeof(*lock_vec))
+ goto err;
+ if ((lock_vec = enif_alloc((size_t)nlocks * sizeof(*lock_vec))) == NULL)
+ goto err;
+
+ memset(lock_vec, 0, (size_t)nlocks * sizeof(*lock_vec));
+
for (i=nlocks-1; i>=0; --i) {
- lock_vec[i] = enif_rwlock_create("crypto_stat");
- if (lock_vec[i]==NULL) return NULL;
+ if ((lock_vec[i] = enif_rwlock_create("crypto_stat")) == NULL)
+ goto err;
}
}
#endif
is_initialized = 1;
}
return &the_struct;
+
+ err:
+ return NULL;
}
#ifdef HAVE_DYNAMIC_CRYPTO_LIB
diff --git a/lib/crypto/c_src/dh.c b/lib/crypto/c_src/dh.c
index 0c18ad7a3f..38eb534d99 100644
--- a/lib/crypto/c_src/dh.c
+++ b/lib/crypto/c_src/dh.c
@@ -24,181 +24,271 @@
ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */
DH *dh_params = NULL;
- int mpint; /* 0 or 4 */
-
- {
- ERL_NIF_TERM head, tail;
- BIGNUM
- *dh_p = NULL,
- *dh_g = NULL,
- *priv_key_in = NULL;
- unsigned long
- len = 0;
-
- if (!(get_bn_from_bin(env, argv[0], &priv_key_in)
- || argv[0] == atom_undefined)
- || !enif_get_list_cell(env, argv[1], &head, &tail)
- || !get_bn_from_bin(env, head, &dh_p)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dh_g)
- || !enif_is_empty_list(env, tail)
- || !enif_get_int(env, argv[2], &mpint) || (mpint & ~4)
- || !enif_get_ulong(env, argv[3], &len)
-
- /* Load dh_params with values to use by the generator.
- Mem mgmnt transfered from dh_p etc to dh_params */
- || !(dh_params = DH_new())
- || (priv_key_in && !DH_set0_key(dh_params, NULL, priv_key_in))
- || !DH_set0_pqg(dh_params, dh_p, NULL, dh_g)
- ) {
- if (priv_key_in) BN_free(priv_key_in);
- if (dh_p) BN_free(dh_p);
- if (dh_g) BN_free(dh_g);
- if (dh_params) DH_free(dh_params);
- return enif_make_badarg(env);
- }
-
- if (len) {
- if (len < BN_num_bits(dh_p))
- DH_set_length(dh_params, len);
- else {
- if (priv_key_in) BN_free(priv_key_in);
- if (dh_p) BN_free(dh_p);
- if (dh_g) BN_free(dh_g);
- if (dh_params) DH_free(dh_params);
- return enif_make_badarg(env);
- }
- }
+ unsigned int mpint; /* 0 or 4 */
+ ERL_NIF_TERM head, tail;
+ BIGNUM *dh_p = NULL;
+ BIGNUM *dh_p_shared;
+ BIGNUM *dh_g = NULL;
+ BIGNUM *priv_key_in = NULL;
+ unsigned long len = 0;
+ unsigned char *pub_ptr, *prv_ptr;
+ int pub_len, prv_len;
+ ERL_NIF_TERM ret_pub, ret_prv, ret;
+ const BIGNUM *pub_key_gen, *priv_key_gen;
+#ifdef HAS_EVP_PKEY_CTX
+ EVP_PKEY_CTX *ctx = NULL;
+ EVP_PKEY *dhkey = NULL, *params = NULL;
+#endif
+
+ ASSERT(argc == 4);
+
+ if (argv[0] != atom_undefined) {
+ if (!get_bn_from_bin(env, argv[0], &priv_key_in))
+ goto bad_arg;
}
+ if (!enif_get_list_cell(env, argv[1], &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &dh_p))
+ goto bad_arg;
-#ifdef HAS_EVP_PKEY_CTX
- {
- EVP_PKEY_CTX *ctx;
- EVP_PKEY *dhkey, *params;
- int success;
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &dh_g))
+ goto bad_arg;
- params = EVP_PKEY_new();
- success = EVP_PKEY_set1_DH(params, dh_params); /* set the key referenced by params to dh_params... */
- DH_free(dh_params); /* ...dh_params (and params) must be freed */
- if (!success) return atom_error;
+ if (!enif_is_empty_list(env, tail))
+ goto bad_arg;
- ctx = EVP_PKEY_CTX_new(params, NULL);
- EVP_PKEY_free(params);
- if (!ctx) {
- return atom_error;
- }
-
- if (!EVP_PKEY_keygen_init(ctx)) {
- /* EVP_PKEY_CTX_free(ctx); */
- return atom_error;
- }
-
- dhkey = EVP_PKEY_new();
- if (!EVP_PKEY_keygen(ctx, &dhkey)) { /* "performs a key generation operation, the ... */
- /*... generated key is written to ppkey." (=last arg) */
- /* EVP_PKEY_CTX_free(ctx); */
- /* EVP_PKEY_free(dhkey); */
- return atom_error;
- }
-
- dh_params = EVP_PKEY_get1_DH(dhkey); /* return the referenced key. dh_params and dhkey must be freed */
- EVP_PKEY_free(dhkey);
- if (!dh_params) {
- /* EVP_PKEY_CTX_free(ctx); */
- return atom_error;
- }
- EVP_PKEY_CTX_free(ctx);
+ if (!enif_get_uint(env, argv[2], &mpint))
+ goto bad_arg;
+ if (mpint != 0 && mpint != 4)
+ goto bad_arg;
+
+ if (!enif_get_ulong(env, argv[3], &len))
+ goto bad_arg;
+ if (len > LONG_MAX)
+ goto bad_arg;
+
+ /* Load dh_params with values to use by the generator.
+ Mem mgmnt transfered from dh_p etc to dh_params */
+ if ((dh_params = DH_new()) == NULL)
+ goto bad_arg;
+ if (priv_key_in) {
+ if (!DH_set0_key(dh_params, NULL, priv_key_in))
+ goto bad_arg;
+ /* On success, dh_params owns priv_key_in */
+ priv_key_in = NULL;
+ }
+ if (!DH_set0_pqg(dh_params, dh_p, NULL, dh_g))
+ goto bad_arg;
+ dh_p_shared = dh_p; /* Don't free this because dh_params owns it */
+ /* On success, dh_params owns dh_p and dh_g */
+ dh_p = NULL;
+ dh_g = NULL;
+
+ if (len) {
+ int bn_len;
+
+ if ((bn_len = BN_num_bits(dh_p_shared)) < 0)
+ goto bad_arg;
+ dh_p_shared = NULL; /* dh_params owns the reference */
+ if (len >= (size_t)bn_len)
+ goto bad_arg;
+
+ if (!DH_set_length(dh_params, (long)len))
+ goto bad_arg;
}
+
+#ifdef HAS_EVP_PKEY_CTX
+ if ((params = EVP_PKEY_new()) == NULL)
+ goto err;
+
+ /* set the key referenced by params to dh_params... */
+ if (EVP_PKEY_set1_DH(params, dh_params) != 1)
+ goto err;
+
+ if ((ctx = EVP_PKEY_CTX_new(params, NULL)) == NULL)
+ goto err;
+
+ if (EVP_PKEY_keygen_init(ctx) != 1)
+ goto err;
+
+ if ((dhkey = EVP_PKEY_new()) == NULL)
+ goto err;
+
+ /* key gen op, key written to ppkey (=last arg) */
+ if (EVP_PKEY_keygen(ctx, &dhkey) != 1)
+ goto err;
+
+ DH_free(dh_params);
+ if ((dh_params = EVP_PKEY_get1_DH(dhkey)) == NULL)
+ goto err;
+
#else
- if (!DH_generate_key(dh_params)) return atom_error;
+ if (!DH_generate_key(dh_params))
+ goto err;
#endif
- {
- unsigned char *pub_ptr, *prv_ptr;
- int pub_len, prv_len;
- ERL_NIF_TERM ret_pub, ret_prv;
- const BIGNUM *pub_key_gen, *priv_key_gen;
-
- DH_get0_key(dh_params,
- &pub_key_gen, &priv_key_gen); /* Get pub_key_gen and priv_key_gen.
- "The values point to the internal representation of
- the public key and private key values. This memory
- should not be freed directly." says man */
- pub_len = BN_num_bytes(pub_key_gen);
- prv_len = BN_num_bytes(priv_key_gen);
- pub_ptr = enif_make_new_binary(env, pub_len+mpint, &ret_pub);
- prv_ptr = enif_make_new_binary(env, prv_len+mpint, &ret_prv);
- if (mpint) {
- put_int32(pub_ptr, pub_len); pub_ptr += 4;
- put_int32(prv_ptr, prv_len); prv_ptr += 4;
- }
- BN_bn2bin(pub_key_gen, pub_ptr);
- BN_bn2bin(priv_key_gen, prv_ptr);
- ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr, pub_len);
- ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr, prv_len);
- DH_free(dh_params);
+ DH_get0_key(dh_params, &pub_key_gen, &priv_key_gen);
+
+ if ((pub_len = BN_num_bytes(pub_key_gen)) < 0)
+ goto err;
+ if ((prv_len = BN_num_bytes(priv_key_gen)) < 0)
+ goto err;
+
+ if ((pub_ptr = enif_make_new_binary(env, (size_t)pub_len+mpint, &ret_pub)) == NULL)
+ goto err;
+ if ((prv_ptr = enif_make_new_binary(env, (size_t)prv_len+mpint, &ret_prv)) == NULL)
+ goto err;
+
+ if (mpint) {
+ put_uint32(pub_ptr, (unsigned int)pub_len);
+ pub_ptr += 4;
- return enif_make_tuple2(env, ret_pub, ret_prv);
+ put_uint32(prv_ptr, (unsigned int)prv_len);
+ prv_ptr += 4;
}
+
+ if (BN_bn2bin(pub_key_gen, pub_ptr) < 0)
+ goto err;
+ if (BN_bn2bin(priv_key_gen, prv_ptr) < 0)
+ goto err;
+
+ ERL_VALGRIND_MAKE_MEM_DEFINED(pub_ptr, pub_len);
+ ERL_VALGRIND_MAKE_MEM_DEFINED(prv_ptr, prv_len);
+
+ ret = enif_make_tuple2(env, ret_pub, ret_prv);
+ goto done;
+
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ err:
+ ret = atom_error;
+
+ done:
+ if (priv_key_in)
+ BN_free(priv_key_in);
+ if (dh_p)
+ BN_free(dh_p);
+ if (dh_g)
+ BN_free(dh_g);
+ if (dh_params)
+ DH_free(dh_params);
+
+#ifdef HAS_EVP_PKEY_CTX
+ if (ctx)
+ EVP_PKEY_CTX_free(ctx);
+ if (dhkey)
+ EVP_PKEY_free(dhkey);
+ if (params)
+ EVP_PKEY_free(params);
+#endif
+
+ return ret;
}
ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (OthersPublicKey, MyPrivateKey, DHParams=[P,G]) */
- BIGNUM *other_pub_key = NULL,
- *dh_p = NULL,
- *dh_g = NULL;
- DH *dh_priv = DH_new();
+ BIGNUM *other_pub_key = NULL;
+ BIGNUM *dh_p = NULL;
+ BIGNUM *dh_g = NULL;
+ BIGNUM *dummy_pub_key = NULL;
+ BIGNUM *priv_key = NULL;
+ DH *dh_priv = NULL;
+ ERL_NIF_TERM head, tail, ret;
+ ErlNifBinary ret_bin;
+ int size;
+ int ret_bin_alloc = 0;
+ int dh_size;
/* Check the arguments and get
my private key (dh_priv),
the peer's public key (other_pub_key),
the parameters p & q
*/
+ ASSERT(argc == 3);
+
+ if (!get_bn_from_bin(env, argv[0], &other_pub_key))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[1], &priv_key))
+ goto bad_arg;
+
+ if (!enif_get_list_cell(env, argv[2], &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &dh_p))
+ goto bad_arg;
+
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &dh_g))
+ goto bad_arg;
+
+ if (!enif_is_empty_list(env, tail))
+ goto bad_arg;
+
+ /* Note: DH_set0_key() does not allow setting only the
+ * private key, although DH_compute_key() does not use the
+ * public key. Work around this limitation by setting
+ * the public key to a copy of the private key.
+ */
+ if ((dummy_pub_key = BN_dup(priv_key)) == NULL)
+ goto err;
+ if ((dh_priv = DH_new()) == NULL)
+ goto err;
+
+ if (!DH_set0_key(dh_priv, dummy_pub_key, priv_key))
+ goto err;
+ /* dh_priv owns dummy_pub_key and priv_key now */
+ dummy_pub_key = NULL;
+ priv_key = NULL;
- {
- BIGNUM *dummy_pub_key = NULL,
- *priv_key = NULL;
- ERL_NIF_TERM head, tail;
-
- if (!get_bn_from_bin(env, argv[0], &other_pub_key)
- || !get_bn_from_bin(env, argv[1], &priv_key)
- || !enif_get_list_cell(env, argv[2], &head, &tail)
- || !get_bn_from_bin(env, head, &dh_p)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dh_g)
- || !enif_is_empty_list(env, tail)
-
- /* Note: DH_set0_key() does not allow setting only the
- * private key, although DH_compute_key() does not use the
- * public key. Work around this limitation by setting
- * the public key to a copy of the private key.
- */
- || !(dummy_pub_key = BN_dup(priv_key))
- || !DH_set0_key(dh_priv, dummy_pub_key, priv_key)
- || !DH_set0_pqg(dh_priv, dh_p, NULL, dh_g)
- ) {
- if (dh_p) BN_free(dh_p);
- if (dh_g) BN_free(dh_g);
- if (other_pub_key) BN_free(other_pub_key);
- if (dummy_pub_key) BN_free(dummy_pub_key);
- if (priv_key) BN_free(priv_key);
- return enif_make_badarg(env);
- }
+ if (!DH_set0_pqg(dh_priv, dh_p, NULL, dh_g))
+ goto err;
+ /* dh_priv owns dh_p and dh_g now */
+ dh_p = NULL;
+ dh_g = NULL;
+
+ if ((dh_size = DH_size(dh_priv)) < 0)
+ goto err;
+ if (!enif_alloc_binary((size_t)dh_size, &ret_bin))
+ goto err;
+ ret_bin_alloc = 1;
+
+ if ((size = DH_compute_key(ret_bin.data, other_pub_key, dh_priv)) < 0)
+ goto err;
+ if (size == 0)
+ goto err;
+
+ if ((size_t)size != ret_bin.size) {
+ if (!enif_realloc_binary(&ret_bin, (size_t)size))
+ goto err;
}
- {
- ErlNifBinary ret_bin;
- int size;
- enif_alloc_binary(DH_size(dh_priv), &ret_bin);
- size = DH_compute_key(ret_bin.data, other_pub_key, dh_priv);
+ ret = enif_make_binary(env, &ret_bin);
+ ret_bin_alloc = 0;
+ goto done;
+
+ bad_arg:
+ err:
+ if (ret_bin_alloc)
+ enif_release_binary(&ret_bin);
+ ret = enif_make_badarg(env);
+
+ done:
+ if (other_pub_key)
BN_free(other_pub_key);
+ if (priv_key)
+ BN_free(priv_key);
+ if (dh_p)
+ BN_free(dh_p);
+ if (dh_g)
+ BN_free(dh_g);
+ if (dummy_pub_key)
+ BN_free(dummy_pub_key);
+ if (dh_priv)
DH_free(dh_priv);
- if (size<=0) {
- enif_release_binary(&ret_bin);
- return atom_error;
- }
- if (size != ret_bin.size) enif_realloc_binary(&ret_bin, size);
- return enif_make_binary(env, &ret_bin);
- }
+ return ret;
}
diff --git a/lib/crypto/c_src/digest.c b/lib/crypto/c_src/digest.c
index 9e6199030d..fec286c000 100644
--- a/lib/crypto/c_src/digest.c
+++ b/lib/crypto/c_src/digest.c
@@ -82,8 +82,22 @@ static struct digest_type_t digest_types[] =
{NULL}
#endif
},
+ {{"blake2b"},
+#ifdef HAVE_BLAKE2
+ {&EVP_blake2b512}
+#else
+ {NULL}
+#endif
+ },
+ {{"blake2s"},
+#ifdef HAVE_BLAKE2
+ {&EVP_blake2s256}
+#else
+ {NULL}
+#endif
+ },
- {{NULL}}
+ {{NULL}, {NULL}}
};
void init_digest_types(ErlNifEnv* env)
diff --git a/lib/crypto/c_src/dss.c b/lib/crypto/c_src/dss.c
index 9d39241382..9bf8eb3ce0 100644
--- a/lib/crypto/c_src/dss.c
+++ b/lib/crypto/c_src/dss.c
@@ -26,36 +26,67 @@ int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa)
/* key=[P,Q,G,KEY] */
ERL_NIF_TERM head, tail;
BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL;
- BIGNUM *dummy_pub_key, *priv_key = NULL;
-
- if (!enif_get_list_cell(env, key, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_p)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_q)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_g)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &priv_key)
- || !enif_is_empty_list(env,tail)) {
- if (dsa_p) BN_free(dsa_p);
- if (dsa_q) BN_free(dsa_q);
- if (dsa_g) BN_free(dsa_g);
- if (priv_key) BN_free(priv_key);
- return 0;
- }
+ BIGNUM *dummy_pub_key = NULL, *priv_key = NULL;
+
+ if (!enif_get_list_cell(env, key, &head, &tail))
+ goto err;
+ if (!get_bn_from_bin(env, head, &dsa_p))
+ goto err;
+
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto err;
+ if (!get_bn_from_bin(env, head, &dsa_q))
+ goto err;
+
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto err;
+ if (!get_bn_from_bin(env, head, &dsa_g))
+ goto err;
+
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto err;
+ if (!get_bn_from_bin(env, head, &priv_key))
+ goto err;
+
+ if (!enif_is_empty_list(env, tail))
+ goto err;
/* Note: DSA_set0_key() does not allow setting only the
* private key, although DSA_sign() does not use the
* public key. Work around this limitation by setting
* the public key to a copy of the private key.
*/
- dummy_pub_key = BN_dup(priv_key);
+ if ((dummy_pub_key = BN_dup(priv_key)) == NULL)
+ goto err;
+
+ if (!DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g))
+ goto err;
+ /* dsa takes ownership on success */
+ dsa_p = NULL;
+ dsa_q = NULL;
+ dsa_g = NULL;
+
+ if (!DSA_set0_key(dsa, dummy_pub_key, priv_key))
+ goto err;
+ /* dsa takes ownership on success */
+ dummy_pub_key = NULL;
+ priv_key = NULL;
- DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g);
- DSA_set0_key(dsa, dummy_pub_key, priv_key);
return 1;
-}
+ err:
+ if (dsa_p)
+ BN_free(dsa_p);
+ if (dsa_q)
+ BN_free(dsa_q);
+ if (dsa_g)
+ BN_free(dsa_g);
+ if (priv_key)
+ BN_free(priv_key);
+ if (dummy_pub_key)
+ BN_free(dummy_pub_key);
+ return 0;
+}
int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa)
{
@@ -63,23 +94,51 @@ int get_dss_public_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa)
ERL_NIF_TERM head, tail;
BIGNUM *dsa_p = NULL, *dsa_q = NULL, *dsa_g = NULL, *dsa_y = NULL;
- if (!enif_get_list_cell(env, key, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_p)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_q)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_g)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dsa_y)
- || !enif_is_empty_list(env,tail)) {
- if (dsa_p) BN_free(dsa_p);
- if (dsa_q) BN_free(dsa_q);
- if (dsa_g) BN_free(dsa_g);
- if (dsa_y) BN_free(dsa_y);
- return 0;
- }
-
- DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g);
- DSA_set0_key(dsa, dsa_y, NULL);
+ if (!enif_get_list_cell(env, key, &head, &tail))
+ goto err;
+ if (!get_bn_from_bin(env, head, &dsa_p))
+ goto err;
+
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto err;
+ if (!get_bn_from_bin(env, head, &dsa_q))
+ goto err;
+
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto err;
+ if (!get_bn_from_bin(env, head, &dsa_g))
+ goto err;
+
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto err;
+ if (!get_bn_from_bin(env, head, &dsa_y))
+ goto err;
+
+ if (!enif_is_empty_list(env,tail))
+ goto err;
+
+ if (!DSA_set0_pqg(dsa, dsa_p, dsa_q, dsa_g))
+ goto err;
+ /* dsa takes ownership on success */
+ dsa_p = NULL;
+ dsa_q = NULL;
+ dsa_g = NULL;
+
+ if (!DSA_set0_key(dsa, dsa_y, NULL))
+ goto err;
+ /* dsa takes ownership on success */
+ dsa_y = NULL;
+
return 1;
+
+ err:
+ if (dsa_p)
+ BN_free(dsa_p);
+ if (dsa_q)
+ BN_free(dsa_q);
+ if (dsa_g)
+ BN_free(dsa_g);
+ if (dsa_y)
+ BN_free(dsa_y);
+ return 0;
}
diff --git a/lib/crypto/c_src/ec.c b/lib/crypto/c_src/ec.c
index 6d831ec9d2..51a3547694 100644
--- a/lib/crypto/c_src/ec.c
+++ b/lib/crypto/c_src/ec.c
@@ -50,157 +50,183 @@ static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg)
BIGNUM *cofactor = NULL;
EC_GROUP *group = NULL;
EC_POINT *point = NULL;
+ int f_arity = -1;
+ const ERL_NIF_TERM *field;
+ int p_arity = -1;
+ const ERL_NIF_TERM *prime;
+ long field_bits;
/* {Field, Prime, Point, Order, CoFactor} = Curve */
- if (enif_get_tuple(env,curve_arg,&c_arity,&curve)
- && c_arity == 5
- && get_bn_from_bin(env, curve[3], &bn_order)
- && (curve[4] != atom_none && get_bn_from_bin(env, curve[4], &cofactor))) {
-
- int f_arity = -1;
- const ERL_NIF_TERM* field;
- int p_arity = -1;
- const ERL_NIF_TERM* prime;
-
- long field_bits;
-
- /* {A, B, Seed} = Prime */
- if (!enif_get_tuple(env,curve[1],&p_arity,&prime)
- || !get_bn_from_bin(env, prime[0], &a)
- || !get_bn_from_bin(env, prime[1], &b))
- goto out_err;
-
- if (!enif_get_tuple(env,curve[0],&f_arity,&field))
- goto out_err;
-
- if (f_arity == 2 && field[0] == atom_prime_field) {
- /* {prime_field, Prime} */
-
- if (!get_bn_from_bin(env, field[1], &p))
- goto out_err;
-
- if (BN_is_negative(p) || BN_is_zero(p))
- goto out_err;
-
- field_bits = BN_num_bits(p);
- if (field_bits > OPENSSL_ECC_MAX_FIELD_BITS)
- goto out_err;
-
- /* create the EC_GROUP structure */
- group = EC_GROUP_new_curve_GFp(p, a, b, NULL);
+ if (!enif_get_tuple(env, curve_arg, &c_arity, &curve))
+ goto err;
+ if (c_arity != 5)
+ goto err;
+ if (!get_bn_from_bin(env, curve[3], &bn_order))
+ goto err;
+ if (curve[4] != atom_none) {
+ if (!get_bn_from_bin(env, curve[4], &cofactor))
+ goto err;
+ }
- } else if (f_arity == 3 && field[0] == atom_characteristic_two_field) {
+ /* {A, B, Seed} = Prime */
+ if (!enif_get_tuple(env, curve[1], &p_arity, &prime))
+ goto err;
+ if (!get_bn_from_bin(env, prime[0], &a))
+ goto err;
+ if (!get_bn_from_bin(env, prime[1], &b))
+ goto err;
+
+ if (!enif_get_tuple(env, curve[0], &f_arity, &field))
+ goto err;
+
+ if (f_arity == 2 && field[0] == atom_prime_field) {
+ /* {prime_field, Prime} */
+ if (!get_bn_from_bin(env, field[1], &p))
+ goto err;
+ if (BN_is_negative(p))
+ goto err;
+ if (BN_is_zero(p))
+ goto err;
+
+ field_bits = BN_num_bits(p);
+ if (field_bits > OPENSSL_ECC_MAX_FIELD_BITS)
+ goto err;
+
+ /* create the EC_GROUP structure */
+ if ((group = EC_GROUP_new_curve_GFp(p, a, b, NULL)) == NULL)
+ goto err;
+
+ } else if (f_arity == 3 && field[0] == atom_characteristic_two_field) {
#if defined(OPENSSL_NO_EC2M)
- enif_raise_exception(env, atom_notsup);
- goto out_err;
+ enif_raise_exception(env, atom_notsup);
+ goto err;
#else
- /* {characteristic_two_field, M, Basis} */
-
- int b_arity = -1;
- const ERL_NIF_TERM* basis;
- unsigned int k1, k2, k3;
-
- if ((p = BN_new()) == NULL)
- goto out_err;
-
- if (!enif_get_long(env, field[1], &field_bits)
- || field_bits > OPENSSL_ECC_MAX_FIELD_BITS)
- goto out_err;
-
- if (enif_get_tuple(env,field[2],&b_arity,&basis)) {
- if (b_arity == 2
- && basis[0] == atom_tpbasis
- && enif_get_uint(env, basis[1], &k1)) {
- /* {tpbasis, k} = Basis */
-
- if (!(field_bits > k1 && k1 > 0))
- goto out_err;
-
- /* create the polynomial */
- if (!BN_set_bit(p, (int)field_bits)
- || !BN_set_bit(p, (int)k1)
- || !BN_set_bit(p, 0))
- goto out_err;
-
- } else if (b_arity == 4
- && basis[0] == atom_ppbasis
- && enif_get_uint(env, basis[1], &k1)
- && enif_get_uint(env, basis[2], &k2)
- && enif_get_uint(env, basis[3], &k3)) {
- /* {ppbasis, k1, k2, k3} = Basis */
-
- if (!(field_bits > k3 && k3 > k2 && k2 > k1 && k1 > 0))
- goto out_err;
-
- /* create the polynomial */
- if (!BN_set_bit(p, (int)field_bits)
- || !BN_set_bit(p, (int)k1)
- || !BN_set_bit(p, (int)k2)
- || !BN_set_bit(p, (int)k3)
- || !BN_set_bit(p, 0))
- goto out_err;
-
- } else
- goto out_err;
- } else if (field[2] == atom_onbasis) {
- /* onbasis = Basis */
- /* no parameters */
- goto out_err;
-
- } else
- goto out_err;
-
- group = EC_GROUP_new_curve_GF2m(p, a, b, NULL);
+ /* {characteristic_two_field, M, Basis} */
+ int b_arity = -1;
+ const ERL_NIF_TERM* basis;
+
+ if ((p = BN_new()) == NULL)
+ goto err;
+ if (!enif_get_long(env, field[1], &field_bits))
+ goto err;
+ if (field_bits > OPENSSL_ECC_MAX_FIELD_BITS || field_bits > INT_MAX)
+ goto err;
+
+ if (enif_get_tuple(env, field[2], &b_arity, &basis)) {
+ if (b_arity == 2) {
+ unsigned int k1;
+
+ if (basis[0] != atom_tpbasis)
+ goto err;
+ if (!enif_get_uint(env, basis[1], &k1))
+ goto err;
+
+ /* {tpbasis, k} = Basis */
+ if (field_bits <= k1 || k1 == 0 || k1 > INT_MAX)
+ goto err;
+
+ /* create the polynomial */
+ if (!BN_set_bit(p, (int)field_bits))
+ goto err;
+ if (!BN_set_bit(p, (int)k1))
+ goto err;
+ if (!BN_set_bit(p, 0))
+ goto err;
+
+ } else if (b_arity == 4) {
+ unsigned int k1, k2, k3;
+
+ if (basis[0] != atom_ppbasis)
+ goto err;
+ if (!enif_get_uint(env, basis[1], &k1))
+ goto err;
+ if (!enif_get_uint(env, basis[2], &k2))
+ goto err;
+ if (!enif_get_uint(env, basis[3], &k3))
+ goto err;
+
+ /* {ppbasis, k1, k2, k3} = Basis */
+ if (field_bits <= k3 || k3 <= k2 || k2 <= k1 || k1 == 0 || k3 > INT_MAX || k2 > INT_MAX || k1 > INT_MAX)
+ goto err;
+
+ /* create the polynomial */
+ if (!BN_set_bit(p, (int)field_bits))
+ goto err;
+ if (!BN_set_bit(p, (int)k1))
+ goto err;
+ if (!BN_set_bit(p, (int)k2))
+ goto err;
+ if (!BN_set_bit(p, (int)k3))
+ goto err;
+ if (!BN_set_bit(p, 0))
+ goto err;
+
+ } else
+ goto err;
+ } else if (field[2] == atom_onbasis) {
+ /* onbasis = Basis */
+ /* no parameters */
+ goto err;
+
+ } else
+ goto err;
+
+ if ((group = EC_GROUP_new_curve_GF2m(p, a, b, NULL)) == NULL)
+ goto err;
#endif
- } else
- goto out_err;
-
- if (!group)
- goto out_err;
+ } else
+ goto err;
- if (enif_inspect_binary(env, prime[2], &seed)) {
- EC_GROUP_set_seed(group, seed.data, seed.size);
- }
+ if (enif_inspect_binary(env, prime[2], &seed)) {
+ if (!EC_GROUP_set_seed(group, seed.data, seed.size))
+ goto err;
+ }
- if (!term2point(env, curve[2], group, &point))
- goto out_err;
+ if (!term2point(env, curve[2], group, &point))
+ goto err;
- if (BN_is_negative(bn_order)
- || BN_is_zero(bn_order)
- || BN_num_bits(bn_order) > (int)field_bits + 1)
- goto out_err;
+ if (BN_is_negative(bn_order))
+ goto err;
+ if (BN_is_zero(bn_order))
+ goto err;
+ if (BN_num_bits(bn_order) > (int)field_bits + 1)
+ goto err;
- if (!EC_GROUP_set_generator(group, point, bn_order, cofactor))
- goto out_err;
+ if (!EC_GROUP_set_generator(group, point, bn_order, cofactor))
+ goto err;
- EC_GROUP_set_asn1_flag(group, 0x0);
+ EC_GROUP_set_asn1_flag(group, 0x0);
- key = EC_KEY_new();
- if (!key)
- goto out_err;
- EC_KEY_set_group(key, group);
- }
- else {
- goto out_err;
- }
+ if ((key = EC_KEY_new()) == NULL)
+ goto err;
+ if (!EC_KEY_set_group(key, group))
+ goto err;
- goto out;
+ goto done;
-out_err:
- if (key) EC_KEY_free(key);
+ err:
+ if (key)
+ EC_KEY_free(key);
key = NULL;
-out:
+ done:
/* some OpenSSL structures are mem-dup'ed into the key,
so we have to free our copies here */
- if (p) BN_free(p);
- if (a) BN_free(a);
- if (b) BN_free(b);
- if (bn_order) BN_free(bn_order);
- if (cofactor) BN_free(cofactor);
- if (group) EC_GROUP_free(group);
- if (point) EC_POINT_free(point);
+ if (bn_order)
+ BN_free(bn_order);
+ if (cofactor)
+ BN_free(cofactor);
+ if (a)
+ BN_free(a);
+ if (b)
+ BN_free(b);
+ if (p)
+ BN_free(p);
+ if (group)
+ EC_GROUP_free(group);
+ if (point)
+ EC_POINT_free(point);
return key;
}
@@ -210,49 +236,61 @@ static ERL_NIF_TERM point2term(ErlNifEnv* env,
const EC_POINT *point,
point_conversion_form_t form)
{
- unsigned dlen;
+ ERL_NIF_TERM ret;
+ size_t dlen;
ErlNifBinary bin;
+ int bin_alloc = 0;
- dlen = EC_POINT_point2oct(group, point, form, NULL, 0, NULL);
- if (dlen == 0)
+ if ((dlen = EC_POINT_point2oct(group, point, form, NULL, 0, NULL)) == 0)
return atom_undefined;
if (!enif_alloc_binary(dlen, &bin))
- return enif_make_badarg(env);
+ goto err;
+ bin_alloc = 1;
+
+ if (!EC_POINT_point2oct(group, point, form, bin.data, bin.size, NULL))
+ goto err;
- if (!EC_POINT_point2oct(group, point, form, bin.data, bin.size, NULL)) {
- enif_release_binary(&bin);
- return enif_make_badarg(env);
- }
ERL_VALGRIND_MAKE_MEM_DEFINED(bin.data, bin.size);
- return enif_make_binary(env, &bin);
+
+ ret = enif_make_binary(env, &bin);
+ bin_alloc = 0;
+ goto done;
+
+ err:
+ if (bin_alloc)
+ enif_release_binary(&bin);
+ ret = enif_make_badarg(env);
+
+ done:
+ return ret;
}
int term2point(ErlNifEnv* env, ERL_NIF_TERM term, EC_GROUP *group, EC_POINT **pptr)
{
- int ret = 0;
ErlNifBinary bin;
- EC_POINT *point;
+ EC_POINT *point = NULL;
- if (!enif_inspect_binary(env,term,&bin)) {
- return 0;
- }
+ if (!enif_inspect_binary(env, term, &bin))
+ goto err;
- if ((*pptr = point = EC_POINT_new(group)) == NULL) {
- return 0;
- }
+ if ((point = EC_POINT_new(group)) == NULL)
+ goto err;
/* set the point conversion form */
EC_GROUP_set_point_conversion_form(group, (point_conversion_form_t)(bin.data[0] & ~0x01));
/* extract the ec point */
- if (!EC_POINT_oct2point(group, point, bin.data, bin.size, NULL)) {
- EC_POINT_free(point);
- *pptr = NULL;
- } else
- ret = 1;
+ if (!EC_POINT_oct2point(group, point, bin.data, bin.size, NULL))
+ goto err;
- return ret;
+ *pptr = point;
+ return 1;
+
+ err:
+ if (point)
+ EC_POINT_free(point);
+ return 0;
}
int get_ec_key(ErlNifEnv* env,
@@ -264,58 +302,64 @@ int get_ec_key(ErlNifEnv* env,
EC_POINT *pub_key = NULL;
EC_GROUP *group = NULL;
- if (!(priv == atom_undefined || get_bn_from_bin(env, priv, &priv_key))
- || !(pub == atom_undefined || enif_is_binary(env, pub))) {
- goto out_err;
+ if (priv != atom_undefined) {
+ if (!get_bn_from_bin(env, priv, &priv_key))
+ goto err;
}
-
- key = ec_key_new(env, curve);
-
- if (!key) {
- goto out_err;
+ if (pub != atom_undefined) {
+ if (!enif_is_binary(env, pub))
+ goto err;
}
- if (!group)
- group = EC_GROUP_dup(EC_KEY_get0_group(key));
+ if ((key = ec_key_new(env, curve)) == NULL)
+ goto err;
+
+ if ((group = EC_GROUP_dup(EC_KEY_get0_group(key))) == NULL)
+ goto err;
if (term2point(env, pub, group, &pub_key)) {
- if (!EC_KEY_set_public_key(key, pub_key)) {
- goto out_err;
- }
- }
- if (priv != atom_undefined
- && !BN_is_zero(priv_key)) {
- if (!EC_KEY_set_private_key(key, priv_key))
- goto out_err;
-
- /* calculate public key (if necessary) */
- if (EC_KEY_get0_public_key(key) == NULL)
- {
- /* the public key was not included in the SEC1 private
- * key => calculate the public key */
- pub_key = EC_POINT_new(group);
- if (pub_key == NULL
- || !EC_POINT_copy(pub_key, EC_GROUP_get0_generator(group))
- || !EC_POINT_mul(group, pub_key, priv_key, NULL, NULL, NULL)
- || !EC_KEY_set_public_key(key, pub_key))
- goto out_err;
- }
+ if (!EC_KEY_set_public_key(key, pub_key))
+ goto err;
}
- goto out;
+ if (priv != atom_undefined && !BN_is_zero(priv_key)) {
+ if (!EC_KEY_set_private_key(key, priv_key))
+ goto err;
+
+ /* calculate public key (if necessary) */
+ if (EC_KEY_get0_public_key(key) == NULL) {
+ /* the public key was not included in the SEC1 private
+ * key => calculate the public key */
+ if ((pub_key = EC_POINT_new(group)) == NULL)
+ goto err;
+ if (!EC_POINT_copy(pub_key, EC_GROUP_get0_generator(group)))
+ goto err;
+ if (!EC_POINT_mul(group, pub_key, priv_key, NULL, NULL, NULL))
+ goto err;
+ if (!EC_KEY_set_public_key(key, pub_key))
+ goto err;
+ }
+ }
+ goto done;
-out_err:
- if (key) EC_KEY_free(key);
+ err:
+ if (key)
+ EC_KEY_free(key);
key = NULL;
-out:
+ done:
/* some OpenSSL structures are mem-dup'ed into the key,
so we have to free our copies here */
- if (priv_key) BN_clear_free(priv_key);
- if (pub_key) EC_POINT_free(pub_key);
- if (group) EC_GROUP_free(group);
- if (!key)
- return 0;
+ if (priv_key)
+ BN_clear_free(priv_key);
+ if (group)
+ EC_GROUP_free(group);
+ if (pub_key)
+ EC_POINT_free(pub_key);
+
+ if (key == NULL)
+ return 0;
+
*res = key;
return 1;
}
@@ -329,31 +373,41 @@ ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
const EC_GROUP *group;
const EC_POINT *public_key;
ERL_NIF_TERM priv_key;
- ERL_NIF_TERM pub_key = atom_undefined;
+ ERL_NIF_TERM pub_key;
+ ERL_NIF_TERM ret;
if (!get_ec_key(env, argv[0], argv[1], atom_undefined, &key))
- goto badarg;
+ goto bad_arg;
if (argv[1] == atom_undefined) {
if (!EC_KEY_generate_key(key))
- goto badarg;
+ goto err;
}
group = EC_KEY_get0_group(key);
public_key = EC_KEY_get0_public_key(key);
- if (group && public_key) {
- pub_key = point2term(env, group, public_key,
- EC_KEY_get_conv_form(key));
+ if (group == NULL || public_key == NULL) {
+ pub_key = atom_undefined;
+
+ } else {
+ pub_key = point2term(env, group, public_key,
+ EC_KEY_get_conv_form(key));
}
+
priv_key = bn2term(env, EC_KEY_get0_private_key(key));
- EC_KEY_free(key);
- return enif_make_tuple2(env, pub_key, priv_key);
+ ret = enif_make_tuple2(env, pub_key, priv_key);
+ goto done;
+
+ err:
+ bad_arg:
+ ret = make_badarg_maybe(env);
-badarg:
+ done:
if (key)
- EC_KEY_free(key);
- return make_badarg_maybe(env);
+ EC_KEY_free(key);
+ return ret;
+
#else
return atom_notsup;
#endif
diff --git a/lib/crypto/c_src/ecdh.c b/lib/crypto/c_src/ecdh.c
index d458f3c48e..9e3f460519 100644
--- a/lib/crypto/c_src/ecdh.c
+++ b/lib/crypto/c_src/ecdh.c
@@ -32,48 +32,62 @@ ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
ERL_NIF_TERM ret;
unsigned char *p;
EC_KEY* key = NULL;
- int field_size = 0;
- int i;
- EC_GROUP *group;
+ int degree;
+ size_t field_size;
+ EC_GROUP *group = NULL;
const BIGNUM *priv_key;
EC_POINT *my_ecpoint = NULL;
EC_KEY *other_ecdh = NULL;
- if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key))
- return make_badarg_maybe(env);
+ ASSERT(argc == 3);
- group = EC_GROUP_dup(EC_KEY_get0_group(key));
+ if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key))
+ goto bad_arg;
+ if ((group = EC_GROUP_dup(EC_KEY_get0_group(key))) == NULL)
+ goto bad_arg;
priv_key = EC_KEY_get0_private_key(key);
if (!term2point(env, argv[0], group, &my_ecpoint)) {
- goto out_err;
+ goto err;
}
- if ((other_ecdh = EC_KEY_new()) == NULL
- || !EC_KEY_set_group(other_ecdh, group)
- || !EC_KEY_set_private_key(other_ecdh, priv_key))
- goto out_err;
+ if ((other_ecdh = EC_KEY_new()) == NULL)
+ goto err;
+ if (!EC_KEY_set_group(other_ecdh, group))
+ goto err;
+ if (!EC_KEY_set_private_key(other_ecdh, priv_key))
+ goto err;
- field_size = EC_GROUP_get_degree(group);
- if (field_size <= 0)
- goto out_err;
+ if ((degree = EC_GROUP_get_degree(group)) <= 0)
+ goto err;
- p = enif_make_new_binary(env, (field_size+7)/8, &ret);
- i = ECDH_compute_key(p, (field_size+7)/8, my_ecpoint, other_ecdh, NULL);
+ field_size = (size_t)degree;
+ if ((p = enif_make_new_binary(env, (field_size+7)/8, &ret)) == NULL)
+ goto err;
+ if (ECDH_compute_key(p, (field_size+7)/8, my_ecpoint, other_ecdh, NULL) < 1)
+ goto err;
- if (i < 0)
- goto out_err;
-out:
- if (group) EC_GROUP_free(group);
- if (my_ecpoint) EC_POINT_free(my_ecpoint);
- if (other_ecdh) EC_KEY_free(other_ecdh);
- if (key) EC_KEY_free(key);
+ goto done;
- return ret;
+ bad_arg:
+ ret = make_badarg_maybe(env);
+ goto done;
-out_err:
+ err:
ret = enif_make_badarg(env);
- goto out;
+
+ done:
+ if (group)
+ EC_GROUP_free(group);
+ if (my_ecpoint)
+ EC_POINT_free(my_ecpoint);
+ if (other_ecdh)
+ EC_KEY_free(other_ecdh);
+ if (key)
+ EC_KEY_free(key);
+
+ return ret;
+
#else
return atom_notsup;
#endif
diff --git a/lib/crypto/c_src/eddsa.c b/lib/crypto/c_src/eddsa.c
index 0fdada9677..0c89f9f6db 100644
--- a/lib/crypto/c_src/eddsa.c
+++ b/lib/crypto/c_src/eddsa.c
@@ -24,28 +24,40 @@
int get_eddsa_key(ErlNifEnv* env, int public, ERL_NIF_TERM key, EVP_PKEY **pkey)
{
/* key=[K] */
+ EVP_PKEY *result;
ERL_NIF_TERM head, tail, tail2, algo;
ErlNifBinary bin;
int type;
- if (!enif_get_list_cell(env, key, &head, &tail)
- || !enif_inspect_binary(env, head, &bin)
- || !enif_get_list_cell(env, tail, &algo, &tail2)
- || !enif_is_empty_list(env, tail2)) {
- return 0;
+ if (!enif_get_list_cell(env, key, &head, &tail))
+ goto err;
+ if (!enif_inspect_binary(env, head, &bin))
+ goto err;
+ if (!enif_get_list_cell(env, tail, &algo, &tail2))
+ goto err;
+ if (!enif_is_empty_list(env, tail2))
+ goto err;
+
+ if (algo == atom_ed25519) {
+ type = EVP_PKEY_ED25519;
+ } else if (algo == atom_ed448) {
+ type = EVP_PKEY_ED448;
+ } else {
+ goto err;
}
- if (algo == atom_ed25519) type = EVP_PKEY_ED25519;
- else if (algo == atom_ed448) type = EVP_PKEY_ED448;
- else
- return 0;
if (public)
- *pkey = EVP_PKEY_new_raw_public_key(type, NULL, bin.data, bin.size);
+ result = EVP_PKEY_new_raw_public_key(type, NULL, bin.data, bin.size);
else
- *pkey = EVP_PKEY_new_raw_private_key(type, NULL, bin.data, bin.size);
+ result = EVP_PKEY_new_raw_private_key(type, NULL, bin.data, bin.size);
+
+ if (result == NULL)
+ goto err;
- if (!pkey)
- return 0;
+ *pkey = result;
return 1;
+
+ err:
+ return 0;
}
#endif
diff --git a/lib/crypto/c_src/engine.c b/lib/crypto/c_src/engine.c
index dc8e1828ce..7ffbb9e70d 100644
--- a/lib/crypto/c_src/engine.c
+++ b/lib/crypto/c_src/engine.c
@@ -26,12 +26,18 @@ struct engine_ctx {
char *id;
};
+#define ERROR_Term(Env, ReasonTerm) enif_make_tuple2((Env), atom_error, (ReasonTerm))
+#define ERROR_Atom(Env, ReasonString) ERROR_Term((Env), enif_make_atom((Env),(ReasonString)))
+
static ErlNifResourceType* engine_ctx_rtype;
static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i);
static int zero_terminate(ErlNifBinary bin, char **buf);
static void engine_ctx_dtor(ErlNifEnv* env, struct engine_ctx* ctx) {
+ if (ctx == NULL)
+ return;
+
PRINTF_ERR0("engine_ctx_dtor");
if(ctx->id) {
PRINTF_ERR1(" non empty ctx->id=%s", ctx->id);
@@ -46,37 +52,51 @@ int get_engine_and_key_id(ErlNifEnv *env, ERL_NIF_TERM key, char ** id, ENGINE *
struct engine_ctx *ctx;
ErlNifBinary key_id_bin;
- if (!enif_get_map_value(env, key, atom_engine, &engine_res) ||
- !enif_get_resource(env, engine_res, engine_ctx_rtype, (void**)&ctx) ||
- !enif_get_map_value(env, key, atom_key_id, &key_id_term) ||
- !enif_inspect_binary(env, key_id_term, &key_id_bin)) {
- return 0;
- }
- else {
- *e = ctx->engine;
- return zero_terminate(key_id_bin, id);
- }
+ if (!enif_get_map_value(env, key, atom_engine, &engine_res))
+ goto err;
+ if (!enif_get_resource(env, engine_res, engine_ctx_rtype, (void**)&ctx))
+ goto err;
+ if (!enif_get_map_value(env, key, atom_key_id, &key_id_term))
+ goto err;
+ if (!enif_inspect_binary(env, key_id_term, &key_id_bin))
+ goto err;
+
+ *e = ctx->engine;
+ return zero_terminate(key_id_bin, id);
+
+ err:
+ return 0;
}
char *get_key_password(ErlNifEnv *env, ERL_NIF_TERM key) {
ERL_NIF_TERM tmp_term;
ErlNifBinary pwd_bin;
char *pwd = NULL;
- if (enif_get_map_value(env, key, atom_password, &tmp_term) &&
- enif_inspect_binary(env, tmp_term, &pwd_bin) &&
- zero_terminate(pwd_bin, &pwd)
- ) return pwd;
+ if (!enif_get_map_value(env, key, atom_password, &tmp_term))
+ goto err;
+ if (!enif_inspect_binary(env, tmp_term, &pwd_bin))
+ goto err;
+ if (!zero_terminate(pwd_bin, &pwd))
+ goto err;
+
+ return pwd;
+
+ err:
return NULL;
}
static int zero_terminate(ErlNifBinary bin, char **buf) {
- *buf = enif_alloc(bin.size+1);
- if (!*buf)
- return 0;
+ if ((*buf = enif_alloc(bin.size + 1)) == NULL)
+ goto err;
+
memcpy(*buf, bin.data, bin.size);
- *(*buf+bin.size) = 0;
+ *(*buf + bin.size) = 0;
+
return 1;
+
+ err:
+ return 0;
}
#endif /* HAS_ENGINE_SUPPORT */
@@ -86,49 +106,65 @@ int init_engine_ctx(ErlNifEnv *env) {
(ErlNifResourceDtor*) engine_ctx_dtor,
ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER,
NULL);
- if (engine_ctx_rtype == NULL) {
- PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'");
- return 0;
- }
+ if (engine_ctx_rtype == NULL)
+ goto err;
#endif
return 1;
+
+ err:
+ PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'");
+ return 0;
}
ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (EngineId) */
#ifdef HAS_ENGINE_SUPPORT
- ERL_NIF_TERM ret;
+ ERL_NIF_TERM ret, result;
ErlNifBinary engine_id_bin;
- char *engine_id;
+ char *engine_id = NULL;
ENGINE *engine;
- struct engine_ctx *ctx;
+ struct engine_ctx *ctx = NULL;
// Get Engine Id
- if(!enif_inspect_binary(env, argv[0], &engine_id_bin)) {
- PRINTF_ERR0("engine_by_id_nif Leaved: badarg");
- return enif_make_badarg(env);
- } else {
- engine_id = enif_alloc(engine_id_bin.size+1);
- (void) memcpy(engine_id, engine_id_bin.data, engine_id_bin.size);
- engine_id[engine_id_bin.size] = '\0';
- }
+ ASSERT(argc == 1);
- engine = ENGINE_by_id(engine_id);
- if(!engine) {
- enif_free(engine_id);
+ if (!enif_inspect_binary(env, argv[0], &engine_id_bin))
+ goto bad_arg;
+
+ if ((engine_id = enif_alloc(engine_id_bin.size+1)) == NULL)
+ goto err;
+ (void) memcpy(engine_id, engine_id_bin.data, engine_id_bin.size);
+ engine_id[engine_id_bin.size] = '\0';
+
+ if ((engine = ENGINE_by_id(engine_id)) == NULL) {
PRINTF_ERR0("engine_by_id_nif Leaved: {error, bad_engine_id}");
- return enif_make_tuple2(env, atom_error, atom_bad_engine_id);
+ ret = ERROR_Atom(env, "bad_engine_id");
+ goto done;
}
- ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx));
+ if ((ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx))) == NULL)
+ goto err;
ctx->engine = engine;
ctx->id = engine_id;
+ /* ctx now owns engine_id */
+ engine_id = NULL;
+
+ result = enif_make_resource(env, ctx);
+ ret = enif_make_tuple2(env, atom_ok, result);
+ goto done;
- ret = enif_make_resource(env, ctx);
- enif_release_resource(ctx);
+ bad_arg:
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (engine_id)
+ enif_free(engine_id);
+ if (ctx)
+ enif_release_resource(ctx);
+ return ret;
- return enif_make_tuple2(env, atom_ok, ret);
#else
return atom_notsup;
#endif
@@ -137,21 +173,22 @@ ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Engine) */
#ifdef HAS_ENGINE_SUPPORT
- ERL_NIF_TERM ret = atom_ok;
struct engine_ctx *ctx;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_init_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
- if (!ENGINE_init(ctx->engine)) {
- //ERR_print_errors_fp(stderr);
- PRINTF_ERR0("engine_init_nif Leaved: {error, engine_init_failed}");
- return enif_make_tuple2(env, atom_error, atom_engine_init_failed);
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+
+ if (!ENGINE_init(ctx->engine))
+ return ERROR_Atom(env, "engine_init_failed");
+
+ return atom_ok;
+
+ bad_arg:
+ return enif_make_badarg(env);
- return ret;
#else
return atom_notsup;
#endif
@@ -163,13 +200,18 @@ ERL_NIF_TERM engine_free_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
struct engine_ctx *ctx;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_free_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
- ENGINE_free(ctx->engine);
+ if (!ENGINE_free(ctx->engine))
+ goto err;
return atom_ok;
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
#else
return atom_notsup;
#endif
@@ -181,13 +223,19 @@ ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
struct engine_ctx *ctx;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_finish_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 1);
- ENGINE_finish(ctx->engine);
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+
+ if (!ENGINE_finish(ctx->engine))
+ goto err;
return atom_ok;
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
+
#else
return atom_notsup;
#endif
@@ -196,6 +244,8 @@ ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
ERL_NIF_TERM engine_load_dynamic_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* () */
#ifdef HAS_ENGINE_SUPPORT
+ ASSERT(argc == 0);
+
ENGINE_load_dynamic();
return atom_ok;
#else
@@ -204,40 +254,40 @@ ERL_NIF_TERM engine_load_dynamic_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER
}
ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Engine, Commands) */
+{/* (Engine, Commands, Optional) */
#ifdef HAS_ENGINE_SUPPORT
- ERL_NIF_TERM ret = atom_ok;
+ ERL_NIF_TERM ret;
unsigned int cmds_len = 0;
char **cmds = NULL;
struct engine_ctx *ctx;
- int i, optional = 0;
+ unsigned int i;
+ int optional = 0;
+ int cmds_loaded = 0;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 3);
- PRINTF_ERR1("Engine Id: %s\r\n", ENGINE_get_id(ctx->engine));
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+ PRINTF_ERR1("Engine Id: %s\r\n", ENGINE_get_id(ctx->engine));
// Get Command List
- if(!enif_get_list_length(env, argv[1], &cmds_len)) {
- PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Bad Command List");
- return enif_make_badarg(env);
- } else {
- cmds_len *= 2; // Key-Value list from erlang
- cmds = enif_alloc((cmds_len+1)*sizeof(char*));
- if(get_engine_load_cmd_list(env, argv[1], cmds, 0)) {
- PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Couldn't read Command List");
- ret = enif_make_badarg(env);
- goto error;
- }
- }
-
- if(!enif_get_int(env, argv[2], &optional)) {
- PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Parameter optional not an integer");
- return enif_make_badarg(env);
- }
+ if (!enif_get_list_length(env, argv[1], &cmds_len))
+ goto bad_arg;
+
+ if (cmds_len > (UINT_MAX / 2) - 1)
+ goto err;
+ cmds_len *= 2; // Key-Value list from erlang
+
+ if ((size_t)cmds_len + 1 > SIZE_MAX / sizeof(char*))
+ goto err;
+ if ((cmds = enif_alloc((cmds_len + 1) * sizeof(char*))) == NULL)
+ goto err;
+ if (get_engine_load_cmd_list(env, argv[1], cmds, 0))
+ goto err;
+ cmds_loaded = 1;
+ if (!enif_get_int(env, argv[2], &optional))
+ goto err;
for(i = 0; i < cmds_len; i+=2) {
PRINTF_ERR2("Cmd: %s:%s\r\n",
@@ -247,18 +297,31 @@ ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const ERL_NIF
PRINTF_ERR2("Command failed: %s:%s\r\n",
cmds[i] ? cmds[i] : "(NULL)",
cmds[i+1] ? cmds[i+1] : "(NULL)");
- //ENGINE_free(ctx->engine);
- ret = enif_make_tuple2(env, atom_error, atom_ctrl_cmd_failed);
- PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: {error, ctrl_cmd_failed}");
- goto error;
+ goto cmd_failed;
}
}
+ ret = atom_ok;
+ goto done;
+
+ bad_arg:
+ err:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ cmd_failed:
+ ret = ERROR_Atom(env, "ctrl_cmd_failed");
+
+ done:
+ if (cmds_loaded) {
+ for (i = 0; cmds != NULL && cmds[i] != NULL; i++)
+ enif_free(cmds[i]);
+ }
+
+ if (cmds != NULL)
+ enif_free(cmds);
- error:
- for(i = 0; cmds != NULL && cmds[i] != NULL; i++)
- enif_free(cmds[i]);
- enif_free(cmds);
return ret;
+
#else
return atom_notsup;
#endif
@@ -270,16 +333,22 @@ ERL_NIF_TERM engine_add_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
struct engine_ctx *ctx;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_add_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+
+ if (!ENGINE_add(ctx->engine))
+ goto failed;
- if (!ENGINE_add(ctx->engine)) {
- PRINTF_ERR0("engine_add_nif Leaved: {error, add_engine_failed}");
- return enif_make_tuple2(env, atom_error, atom_add_engine_failed);
- }
return atom_ok;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ failed:
+ return ERROR_Atom(env, "add_engine_failed");
+
#else
return atom_notsup;
#endif
@@ -291,16 +360,21 @@ ERL_NIF_TERM engine_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
struct engine_ctx *ctx;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_remove_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+
+ if (!ENGINE_remove(ctx->engine))
+ goto failed;
- if (!ENGINE_remove(ctx->engine)) {
- PRINTF_ERR0("engine_remove_nif Leaved: {error, remove_engine_failed}");
- return enif_make_tuple2(env, atom_error, atom_remove_engine_failed);
- }
return atom_ok;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ failed:
+ return ERROR_Atom(env, "remove_engine_failed");
#else
return atom_notsup;
#endif
@@ -313,95 +387,99 @@ ERL_NIF_TERM engine_register_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
unsigned int method;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_register_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
- // Get Method
- if (!enif_get_uint(env, argv[1], &method)) {
- PRINTF_ERR0("engine_register_nif Leaved: Parameter Method not an uint");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 2);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+ if (!enif_get_uint(env, argv[1], &method))
+ goto bad_arg;
switch(method)
{
#ifdef ENGINE_METHOD_RSA
case ENGINE_METHOD_RSA:
if (!ENGINE_register_RSA(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_DSA
case ENGINE_METHOD_DSA:
if (!ENGINE_register_DSA(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_DH
case ENGINE_METHOD_DH:
if (!ENGINE_register_DH(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_RAND
case ENGINE_METHOD_RAND:
if (!ENGINE_register_RAND(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_ECDH
case ENGINE_METHOD_ECDH:
if (!ENGINE_register_ECDH(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_ECDSA
case ENGINE_METHOD_ECDSA:
if (!ENGINE_register_ECDSA(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_STORE
case ENGINE_METHOD_STORE:
if (!ENGINE_register_STORE(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_CIPHERS
case ENGINE_METHOD_CIPHERS:
if (!ENGINE_register_ciphers(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_DIGESTS
case ENGINE_METHOD_DIGESTS:
if (!ENGINE_register_digests(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_PKEY_METHS
case ENGINE_METHOD_PKEY_METHS:
if (!ENGINE_register_pkey_meths(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_PKEY_ASN1_METHS
case ENGINE_METHOD_PKEY_ASN1_METHS:
if (!ENGINE_register_pkey_asn1_meths(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
#ifdef ENGINE_METHOD_EC
case ENGINE_METHOD_EC:
if (!ENGINE_register_EC(ctx->engine))
- return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ goto failed;
break;
#endif
default:
- return enif_make_tuple2(env, atom_error, atom_engine_method_not_supported);
- break;
+ return ERROR_Atom(env, "engine_method_not_supported");
}
+
return atom_ok;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ failed:
+ return ERROR_Atom(env, "register_engine_failed");
+
#else
return atom_notsup;
#endif
@@ -414,15 +492,12 @@ ERL_NIF_TERM engine_unregister_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
unsigned int method;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_unregister_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
- // Get Method
- if (!enif_get_uint(env, argv[1], &method)) {
- PRINTF_ERR0("engine_unregister_nif Leaved: Parameter Method not an uint");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 2);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+ if (!enif_get_uint(env, argv[1], &method))
+ goto bad_arg;
switch(method)
{
@@ -489,35 +564,51 @@ ERL_NIF_TERM engine_unregister_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
default:
break;
}
+
return atom_ok;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
#else
return atom_notsup;
#endif
}
ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Engine) */
+{/* () */
#ifdef HAS_ENGINE_SUPPORT
- ERL_NIF_TERM ret;
+ ERL_NIF_TERM ret, result;
ENGINE *engine;
ErlNifBinary engine_bin;
- struct engine_ctx *ctx;
+ struct engine_ctx *ctx = NULL;
+
+ ASSERT(argc == 0);
- engine = ENGINE_get_first();
- if(!engine) {
- enif_alloc_binary(0, &engine_bin);
+ if ((engine = ENGINE_get_first()) == NULL) {
+ if (!enif_alloc_binary(0, &engine_bin))
+ goto err;
engine_bin.size = 0;
return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_bin));
}
- ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx));
+ if ((ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx))) == NULL)
+ goto err;
ctx->engine = engine;
ctx->id = NULL;
- ret = enif_make_resource(env, ctx);
- enif_release_resource(ctx);
+ result = enif_make_resource(env, ctx);
+ ret = enif_make_tuple2(env, atom_ok, result);
+ goto done;
+
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (ctx)
+ enif_release_resource(ctx);
+ return ret;
- return enif_make_tuple2(env, atom_ok, ret);
#else
return atom_notsup;
#endif
@@ -526,31 +617,42 @@ ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
ERL_NIF_TERM engine_get_next_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Engine) */
#ifdef HAS_ENGINE_SUPPORT
- ERL_NIF_TERM ret;
+ ERL_NIF_TERM ret, result;
ENGINE *engine;
ErlNifBinary engine_bin;
- struct engine_ctx *ctx, *next_ctx;
+ struct engine_ctx *ctx, *next_ctx = NULL;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_get_next_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
- engine = ENGINE_get_next(ctx->engine);
- if (!engine) {
- enif_alloc_binary(0, &engine_bin);
+ ASSERT(argc == 1);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+
+ if ((engine = ENGINE_get_next(ctx->engine)) == NULL) {
+ if (!enif_alloc_binary(0, &engine_bin))
+ goto err;
engine_bin.size = 0;
return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_bin));
}
- next_ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx));
+ if ((next_ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx))) == NULL)
+ goto err;
next_ctx->engine = engine;
next_ctx->id = NULL;
- ret = enif_make_resource(env, next_ctx);
- enif_release_resource(next_ctx);
+ result = enif_make_resource(env, next_ctx);
+ ret = enif_make_tuple2(env, atom_ok, result);
+ goto done;
+
+ bad_arg:
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (next_ctx)
+ enif_release_resource(next_ctx);
+ return ret;
- return enif_make_tuple2(env, atom_ok, ret);
#else
return atom_notsup;
#endif
@@ -561,28 +663,34 @@ ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv
#ifdef HAS_ENGINE_SUPPORT
ErlNifBinary engine_id_bin;
const char *engine_id;
- int size;
- struct engine_ctx *ctx;
+ size_t size;
+ struct engine_ctx *ctx = NULL;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_get_id_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
- engine_id = ENGINE_get_id(ctx->engine);
- if (!engine_id) {
- enif_alloc_binary(0, &engine_id_bin);
+ if ((engine_id = ENGINE_get_id(ctx->engine)) == NULL) {
+ if (!enif_alloc_binary(0, &engine_id_bin))
+ goto err;
engine_id_bin.size = 0;
return enif_make_binary(env, &engine_id_bin);
}
size = strlen(engine_id);
- enif_alloc_binary(size, &engine_id_bin);
+ if (!enif_alloc_binary(size, &engine_id_bin))
+ goto err;
engine_id_bin.size = size;
memcpy(engine_id_bin.data, engine_id, size);
return enif_make_binary(env, &engine_id_bin);
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
+
#else
return atom_notsup;
#endif
@@ -593,28 +701,34 @@ ERL_NIF_TERM engine_get_name_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
#ifdef HAS_ENGINE_SUPPORT
ErlNifBinary engine_name_bin;
const char *engine_name;
- int size;
+ size_t size;
struct engine_ctx *ctx;
// Get Engine
- if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
- PRINTF_ERR0("engine_get_id_nif Leaved: Parameter not an engine resource object");
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
- engine_name = ENGINE_get_name(ctx->engine);
- if (!engine_name) {
- enif_alloc_binary(0, &engine_name_bin);
+ if ((engine_name = ENGINE_get_name(ctx->engine)) == NULL) {
+ if (!enif_alloc_binary(0, &engine_name_bin))
+ goto err;
engine_name_bin.size = 0;
return enif_make_binary(env, &engine_name_bin);
}
size = strlen(engine_name);
- enif_alloc_binary(size, &engine_name_bin);
+ if (!enif_alloc_binary(size, &engine_name_bin))
+ goto err;
engine_name_bin.size = size;
memcpy(engine_name_bin.data, engine_name, size);
return enif_make_binary(env, &engine_name_bin);
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
+
#else
return atom_notsup;
#endif
@@ -627,46 +741,52 @@ static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, cha
const ERL_NIF_TERM *tmp_tuple;
ErlNifBinary tmpbin;
int arity;
- char* tmpstr;
-
- if(!enif_is_empty_list(env, term)) {
- if(!enif_get_list_cell(env, term, &head, &tail)) {
- cmds[i] = NULL;
- return -1;
- } else {
- if(!enif_get_tuple(env, head, &arity, &tmp_tuple) || arity != 2) {
- cmds[i] = NULL;
- return -1;
- } else {
- if(!enif_inspect_binary(env, tmp_tuple[0], &tmpbin)) {
- cmds[i] = NULL;
- return -1;
- } else {
- tmpstr = enif_alloc(tmpbin.size+1);
- (void) memcpy(tmpstr, tmpbin.data, tmpbin.size);
- tmpstr[tmpbin.size] = '\0';
- cmds[i++] = tmpstr;
- }
- if(!enif_inspect_binary(env, tmp_tuple[1], &tmpbin)) {
- cmds[i] = NULL;
- return -1;
- } else {
- if(tmpbin.size == 0)
- cmds[i++] = NULL;
- else {
- tmpstr = enif_alloc(tmpbin.size+1);
- (void) memcpy(tmpstr, tmpbin.data, tmpbin.size);
- tmpstr[tmpbin.size] = '\0';
- cmds[i++] = tmpstr;
- }
- }
- return get_engine_load_cmd_list(env, tail, cmds, i);
- }
- }
- } else {
+ char *tuple1 = NULL, *tuple2 = NULL;
+
+ if (enif_is_empty_list(env, term)) {
cmds[i] = NULL;
return 0;
}
+
+ if (!enif_get_list_cell(env, term, &head, &tail))
+ goto err;
+ if (!enif_get_tuple(env, head, &arity, &tmp_tuple))
+ goto err;
+ if (arity != 2)
+ goto err;
+ if (!enif_inspect_binary(env, tmp_tuple[0], &tmpbin))
+ goto err;
+
+ if ((tuple1 = enif_alloc(tmpbin.size + 1)) == NULL)
+ goto err;
+
+ (void) memcpy(tuple1, tmpbin.data, tmpbin.size);
+ tuple1[tmpbin.size] = '\0';
+ cmds[i] = tuple1;
+ i++;
+
+ if (!enif_inspect_binary(env, tmp_tuple[1], &tmpbin))
+ goto err;
+
+ if (tmpbin.size == 0) {
+ cmds[i] = NULL;
+ } else {
+ if ((tuple2 = enif_alloc(tmpbin.size + 1)) == NULL)
+ goto err;
+ (void) memcpy(tuple2, tmpbin.data, tmpbin.size);
+ tuple2[tmpbin.size] = '\0';
+ cmds[i] = tuple2;
+ }
+ i++;
+ return get_engine_load_cmd_list(env, tail, cmds, i);
+
+ err:
+ if (tuple1 != NULL) {
+ i--;
+ enif_free(tuple1);
+ }
+ cmds[i] = NULL;
+ return -1;
}
#endif /* HAS_ENGINE_SUPPORT */
@@ -674,7 +794,9 @@ ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_
{/* () */
#ifdef HAS_ENGINE_SUPPORT
ERL_NIF_TERM method_array[12];
- int i = 0;
+ unsigned int i = 0;
+
+ ASSERT(argc == 0);
#ifdef ENGINE_METHOD_RSA
method_array[i++] = atom_engine_method_rsa;
diff --git a/lib/crypto/c_src/evp.c b/lib/crypto/c_src/evp.c
index 3c55ab630b..3bf66bfffe 100644
--- a/lib/crypto/c_src/evp.c
+++ b/lib/crypto/c_src/evp.c
@@ -24,54 +24,75 @@ ERL_NIF_TERM evp_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
/* (Curve, PeerBin, MyBin) */
{
#ifdef HAVE_ED_CURVE_DH
+ ERL_NIF_TERM ret;
int type;
EVP_PKEY_CTX *ctx = NULL;
ErlNifBinary peer_bin, my_bin, key_bin;
EVP_PKEY *peer_key = NULL, *my_key = NULL;
size_t max_size;
+ int key_bin_alloc = 0;
- if (argv[0] == atom_x25519) type = EVP_PKEY_X25519;
- else if (argv[0] == atom_x448) type = EVP_PKEY_X448;
- else return enif_make_badarg(env);
+ ASSERT(argc == 3);
- if (!enif_inspect_binary(env, argv[1], &peer_bin) ||
- !enif_inspect_binary(env, argv[2], &my_bin))
- goto return_badarg;
+ if (argv[0] == atom_x25519)
+ type = EVP_PKEY_X25519;
+ else if (argv[0] == atom_x448)
+ type = EVP_PKEY_X448;
+ else
+ goto bad_arg;
- if (!(my_key = EVP_PKEY_new_raw_private_key(type, NULL, my_bin.data, my_bin.size)) ||
- !(ctx = EVP_PKEY_CTX_new(my_key, NULL)))
- goto return_badarg;
+ if (!enif_inspect_binary(env, argv[1], &peer_bin))
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[2], &my_bin))
+ goto bad_arg;
- if (!EVP_PKEY_derive_init(ctx))
- goto return_badarg;
+ if ((my_key = EVP_PKEY_new_raw_private_key(type, NULL, my_bin.data, my_bin.size)) == NULL)
+ goto err;
+ if ((ctx = EVP_PKEY_CTX_new(my_key, NULL)) == NULL)
+ goto err;
- if (!(peer_key = EVP_PKEY_new_raw_public_key(type, NULL, peer_bin.data, peer_bin.size)) ||
- !EVP_PKEY_derive_set_peer(ctx, peer_key))
- goto return_badarg;
+ if (EVP_PKEY_derive_init(ctx) != 1)
+ goto err;
- if (!EVP_PKEY_derive(ctx, NULL, &max_size))
- goto return_badarg;
+ if ((peer_key = EVP_PKEY_new_raw_public_key(type, NULL, peer_bin.data, peer_bin.size)) == NULL)
+ goto err;
+ if (EVP_PKEY_derive_set_peer(ctx, peer_key) != 1)
+ goto err;
- if (!enif_alloc_binary(max_size, &key_bin) ||
- !EVP_PKEY_derive(ctx, key_bin.data, &key_bin.size))
- goto return_badarg;
+ if (EVP_PKEY_derive(ctx, NULL, &max_size) != 1)
+ goto err;
+
+ if (!enif_alloc_binary(max_size, &key_bin))
+ goto err;
+ key_bin_alloc = 1;
+ if (EVP_PKEY_derive(ctx, key_bin.data, &key_bin.size) != 1)
+ goto err;
if (key_bin.size < max_size) {
- size_t actual_size = key_bin.size;
- if (!enif_realloc_binary(&key_bin, actual_size))
- goto return_badarg;
+ if (!enif_realloc_binary(&key_bin, (size_t)key_bin.size))
+ goto err;
}
- EVP_PKEY_free(my_key);
- EVP_PKEY_free(peer_key);
- EVP_PKEY_CTX_free(ctx);
- return enif_make_binary(env, &key_bin);
+ ret = enif_make_binary(env, &key_bin);
+ key_bin_alloc = 0;
+ goto done;
+
+ bad_arg:
+ err:
+ if (key_bin_alloc)
+ enif_release_binary(&key_bin);
+ ret = enif_make_badarg(env);
+
+ done:
+ if (my_key)
+ EVP_PKEY_free(my_key);
+ if (peer_key)
+ EVP_PKEY_free(peer_key);
+ if (ctx)
+ EVP_PKEY_CTX_free(ctx);
+
+ return ret;
-return_badarg:
- if (my_key) EVP_PKEY_free(my_key);
- if (peer_key) EVP_PKEY_free(peer_key);
- if (ctx) EVP_PKEY_CTX_free(ctx);
- return enif_make_badarg(env);
#else
return atom_notsup;
#endif
@@ -84,38 +105,57 @@ ERL_NIF_TERM evp_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
int type;
EVP_PKEY_CTX *ctx = NULL;
EVP_PKEY *pkey = NULL;
- ERL_NIF_TERM ret_pub, ret_prv;
+ ERL_NIF_TERM ret_pub, ret_prv, ret;
size_t key_len;
-
- if (argv[0] == atom_x25519) type = EVP_PKEY_X25519;
- else if (argv[0] == atom_x448) type = EVP_PKEY_X448;
- else return enif_make_badarg(env);
-
- if (!(ctx = EVP_PKEY_CTX_new_id(type, NULL))) return enif_make_badarg(env);
-
- if (!EVP_PKEY_keygen_init(ctx)) goto return_error;
- if (!EVP_PKEY_keygen(ctx, &pkey)) goto return_error;
-
- if (!EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len)) goto return_error;
- if (!EVP_PKEY_get_raw_public_key(pkey,
- enif_make_new_binary(env, key_len, &ret_pub),
- &key_len))
- goto return_error;
-
- if (!EVP_PKEY_get_raw_private_key(pkey, NULL, &key_len)) goto return_error;
- if (!EVP_PKEY_get_raw_private_key(pkey,
- enif_make_new_binary(env, key_len, &ret_prv),
- &key_len))
- goto return_error;
-
- EVP_PKEY_free(pkey);
- EVP_PKEY_CTX_free(ctx);
- return enif_make_tuple2(env, ret_pub, ret_prv);
-
-return_error:
- if (pkey) EVP_PKEY_free(pkey);
- if (ctx) EVP_PKEY_CTX_free(ctx);
- return atom_error;
+ unsigned char *out_pub = NULL, *out_priv = NULL;
+
+ ASSERT(argc == 1);
+
+ if (argv[0] == atom_x25519)
+ type = EVP_PKEY_X25519;
+ else if (argv[0] == atom_x448)
+ type = EVP_PKEY_X448;
+ else
+ goto bad_arg;
+
+ if ((ctx = EVP_PKEY_CTX_new_id(type, NULL)) == NULL)
+ goto bad_arg;
+
+ if (EVP_PKEY_keygen_init(ctx) != 1)
+ goto err;
+ if (EVP_PKEY_keygen(ctx, &pkey) != 1)
+ goto err;
+
+ if (EVP_PKEY_get_raw_public_key(pkey, NULL, &key_len) != 1)
+ goto err;
+ if ((out_pub = enif_make_new_binary(env, key_len, &ret_pub)) == NULL)
+ goto err;
+ if (EVP_PKEY_get_raw_public_key(pkey, out_pub, &key_len) != 1)
+ goto err;
+
+ if (EVP_PKEY_get_raw_private_key(pkey, NULL, &key_len) != 1)
+ goto err;
+ if ((out_priv = enif_make_new_binary(env, key_len, &ret_prv)) == NULL)
+ goto err;
+ if (EVP_PKEY_get_raw_private_key(pkey, out_priv, &key_len) != 1)
+ goto err;
+
+ ret = enif_make_tuple2(env, ret_pub, ret_prv);
+ goto done;
+
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ err:
+ ret = atom_error;
+
+ done:
+ if (pkey)
+ EVP_PKEY_free(pkey);
+ if (ctx)
+ EVP_PKEY_CTX_free(ctx);
+ return ret;
#else
return atom_notsup;
diff --git a/lib/crypto/c_src/evp_compat.h b/lib/crypto/c_src/evp_compat.h
index 98c861c45e..dc94a61d8e 100644
--- a/lib/crypto/c_src/evp_compat.h
+++ b/lib/crypto/c_src/evp_compat.h
@@ -37,19 +37,27 @@ static INLINE void HMAC_CTX_free(HMAC_CTX *ctx);
static INLINE HMAC_CTX *HMAC_CTX_new()
{
- HMAC_CTX *ctx = CRYPTO_malloc(sizeof(HMAC_CTX), __FILE__, __LINE__);
+ HMAC_CTX *ctx;
+
+ if ((ctx = CRYPTO_malloc(sizeof(HMAC_CTX), __FILE__, __LINE__)) == NULL)
+ return NULL;
+
HMAC_CTX_init(ctx);
return ctx;
}
static INLINE void HMAC_CTX_free(HMAC_CTX *ctx)
{
+ if (ctx == NULL)
+ return;
+
HMAC_CTX_cleanup(ctx);
CRYPTO_free(ctx);
}
+/* Renamed in 1.1.0 */
#define EVP_MD_CTX_new() EVP_MD_CTX_create()
-#define EVP_MD_CTX_free(ctx) EVP_MD_CTX_destroy(ctx)
+#define EVP_MD_CTX_free(ctx) EVP_MD_CTX_destroy((ctx))
static INLINE void *BN_GENCB_get_arg(BN_GENCB *cb);
@@ -141,8 +149,11 @@ DSA_get0_pqg(const DSA *dsa, const BIGNUM **p, const BIGNUM **q, const BIGNUM **
static INLINE void
DSA_get0_key(const DSA *dsa, const BIGNUM **pub_key, const BIGNUM **priv_key)
{
- if (pub_key) *pub_key = dsa->pub_key;
- if (priv_key) *priv_key = dsa->priv_key;
+ if (pub_key)
+ *pub_key = dsa->pub_key;
+
+ if (priv_key)
+ *priv_key = dsa->priv_key;
}
@@ -189,8 +200,11 @@ DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g)
static INLINE void
DH_get0_key(const DH *dh, const BIGNUM **pub_key, const BIGNUM **priv_key)
{
- if (pub_key) *pub_key = dh->pub_key;
- if (priv_key) *priv_key = dh->priv_key;
+ if (pub_key)
+ *pub_key = dh->pub_key;
+
+ if (priv_key)
+ *priv_key = dh->priv_key;
}
#endif /* E_EVP_COMPAT_H__ */
diff --git a/lib/crypto/c_src/hash.c b/lib/crypto/c_src/hash.c
index 52748dc933..0a9f64acef 100644
--- a/lib/crypto/c_src/hash.c
+++ b/lib/crypto/c_src/hash.c
@@ -34,7 +34,11 @@ struct evp_md_ctx {
static ErlNifResourceType* evp_md_ctx_rtype;
static void evp_md_ctx_dtor(ErlNifEnv* env, struct evp_md_ctx *ctx) {
- EVP_MD_CTX_free(ctx->ctx);
+ if (ctx == NULL)
+ return;
+
+ if (ctx->ctx)
+ EVP_MD_CTX_free(ctx->ctx);
}
#endif
@@ -44,13 +48,43 @@ int init_hash_ctx(ErlNifEnv* env) {
(ErlNifResourceDtor*) evp_md_ctx_dtor,
ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER,
NULL);
- if (evp_md_ctx_rtype == NULL) {
- PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_MD_CTX'");
- return 0;
- }
+ if (evp_md_ctx_rtype == NULL)
+ goto err;
#endif
return 1;
+
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
+ err:
+ PRINTF_ERR0("CRYPTO: Could not open resource type 'EVP_MD_CTX'");
+ return 0;
+#endif
+}
+
+ERL_NIF_TERM hash_info_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type) */
+ struct digest_type_t *digp = NULL;
+ const EVP_MD *md;
+ ERL_NIF_TERM ret;
+
+ ASSERT(argc == 1);
+
+ if ((digp = get_digest_type(argv[0])) == NULL)
+ return enif_make_badarg(env);
+
+ if ((md = digp->md.p) == NULL)
+ return atom_notsup;
+
+ ret = enif_make_new_map(env);
+
+ enif_make_map_put(env, ret, atom_type,
+ enif_make_int(env, EVP_MD_type(md)), &ret);
+ enif_make_map_put(env, ret, atom_size,
+ enif_make_int(env, EVP_MD_size(md)), &ret);
+ enif_make_map_put(env, ret, atom_block_size,
+ enif_make_int(env, EVP_MD_block_size(md)), &ret);
+
+ return ret;
}
ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -60,28 +94,36 @@ ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
ErlNifBinary data;
ERL_NIF_TERM ret;
unsigned ret_size;
+ unsigned char *outp;
- digp = get_digest_type(argv[0]);
- if (!digp ||
- !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
+ ASSERT(argc == 2);
+
+ if ((digp = get_digest_type(argv[0])) == NULL)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &data))
+ goto bad_arg;
+
+ if ((md = digp->md.p) == NULL)
+ goto err;
ret_size = (unsigned)EVP_MD_size(md);
ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE);
- if (!EVP_Digest(data.data, data.size,
- enif_make_new_binary(env, ret_size, &ret), &ret_size,
- md, NULL)) {
- return atom_notsup;
- }
+
+ if ((outp = enif_make_new_binary(env, ret_size, &ret)) == NULL)
+ goto err;
+ if (EVP_Digest(data.data, data.size, outp, &ret_size, md, NULL) != 1)
+ goto err;
+
ASSERT(ret_size == (unsigned)EVP_MD_size(md));
CONSUME_REDS(env, data);
return ret;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ return atom_notsup;
}
#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
@@ -89,50 +131,73 @@ ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type) */
struct digest_type_t *digp = NULL;
- struct evp_md_ctx *ctx;
+ struct evp_md_ctx *ctx = NULL;
ERL_NIF_TERM ret;
- digp = get_digest_type(argv[0]);
- if (!digp) {
- return enif_make_badarg(env);
- }
- if (!digp->md.p) {
- return atom_notsup;
- }
+ ASSERT(argc == 1);
+
+ if ((digp = get_digest_type(argv[0])) == NULL)
+ goto bad_arg;
+ if (digp->md.p == NULL)
+ goto err;
+
+ if ((ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx))) == NULL)
+ goto err;
+ if ((ctx->ctx = EVP_MD_CTX_new()) == NULL)
+ goto err;
+ if (EVP_DigestInit(ctx->ctx, digp->md.p) != 1)
+ goto err;
- ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx));
- ctx->ctx = EVP_MD_CTX_new();
- if (!EVP_DigestInit(ctx->ctx, digp->md.p)) {
- enif_release_resource(ctx);
- return atom_notsup;
- }
ret = enif_make_resource(env, ctx);
- enif_release_resource(ctx);
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = atom_notsup;
+
+ done:
+ if (ctx)
+ enif_release_resource(ctx);
return ret;
}
ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context, Data) */
- struct evp_md_ctx *ctx, *new_ctx;
+ struct evp_md_ctx *ctx, *new_ctx = NULL;
ErlNifBinary data;
ERL_NIF_TERM ret;
- if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx) ||
- !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 2);
- new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx));
- new_ctx->ctx = EVP_MD_CTX_new();
- if (!EVP_MD_CTX_copy(new_ctx->ctx, ctx->ctx) ||
- !EVP_DigestUpdate(new_ctx->ctx, data.data, data.size)) {
- enif_release_resource(new_ctx);
- return atom_notsup;
- }
+ if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &data))
+ goto bad_arg;
+
+ if ((new_ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(struct evp_md_ctx))) == NULL)
+ goto err;
+ if ((new_ctx->ctx = EVP_MD_CTX_new()) == NULL)
+ goto err;
+ if (EVP_MD_CTX_copy(new_ctx->ctx, ctx->ctx) != 1)
+ goto err;
+ if (EVP_DigestUpdate(new_ctx->ctx, data.data, data.size) != 1)
+ goto err;
ret = enif_make_resource(env, new_ctx);
- enif_release_resource(new_ctx);
CONSUME_REDS(env, data);
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = atom_notsup;
+
+ done:
+ if (new_ctx)
+ enif_release_resource(new_ctx);
return ret;
}
@@ -142,25 +207,37 @@ ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
EVP_MD_CTX *new_ctx;
ERL_NIF_TERM ret;
unsigned ret_size;
+ unsigned char *outp;
- if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx)) {
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_resource(env, argv[0], evp_md_ctx_rtype, (void**)&ctx))
+ goto bad_arg;
ret_size = (unsigned)EVP_MD_CTX_size(ctx->ctx);
ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE);
- new_ctx = EVP_MD_CTX_new();
- if (!EVP_MD_CTX_copy(new_ctx, ctx->ctx) ||
- !EVP_DigestFinal(new_ctx,
- enif_make_new_binary(env, ret_size, &ret),
- &ret_size)) {
- EVP_MD_CTX_free(new_ctx);
- return atom_notsup;
- }
- EVP_MD_CTX_free(new_ctx);
+ if ((new_ctx = EVP_MD_CTX_new()) == NULL)
+ goto err;
+ if (EVP_MD_CTX_copy(new_ctx, ctx->ctx) != 1)
+ goto err;
+ if ((outp = enif_make_new_binary(env, ret_size, &ret)) == NULL)
+ goto err;
+ if (EVP_DigestFinal(new_ctx, outp, &ret_size) != 1)
+ goto err;
+
ASSERT(ret_size == (unsigned)EVP_MD_CTX_size(ctx->ctx));
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+ err:
+ ret = atom_notsup;
+
+ done:
+ if (new_ctx)
+ EVP_MD_CTX_free(new_ctx);
return ret;
}
@@ -173,14 +250,14 @@ ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
ERL_NIF_TERM ctx;
size_t ctx_size = 0;
init_fun ctx_init = 0;
+ unsigned char *outp;
- digp = get_digest_type(argv[0]);
- if (!digp) {
- return enif_make_badarg(env);
- }
- if (!digp->md.p) {
- return atom_notsup;
- }
+ ASSERT(argc == 1);
+
+ if ((digp = get_digest_type(argv[0])) == NULL)
+ goto bad_arg;
+ if (digp->md.p == NULL)
+ goto err;
switch (EVP_MD_type(digp->md.p))
{
@@ -225,13 +302,24 @@ ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
break;
#endif
default:
- return atom_notsup;
+ goto err;
}
ASSERT(ctx_size);
ASSERT(ctx_init);
- ctx_init(enif_make_new_binary(env, ctx_size, &ctx));
+ if ((outp = enif_make_new_binary(env, ctx_size, &ctx)) == NULL)
+ goto err;
+
+ if (ctx_init(outp) != 1)
+ goto err;
+
return enif_make_tuple2(env, argv[0], ctx);
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ return atom_notsup;
}
ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -246,16 +334,21 @@ ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
size_t ctx_size = 0;
update_fun ctx_update = 0;
- if (!enif_get_tuple(env, argv[0], &arity, &tuple) ||
- arity != 2 ||
- !(digp = get_digest_type(tuple[0])) ||
- !enif_inspect_binary(env, tuple[1], &ctx) ||
- !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
- return enif_make_badarg(env);
- }
- if (!digp->md.p) {
- return atom_notsup;
- }
+ ASSERT(argc == 2);
+
+ if (!enif_get_tuple(env, argv[0], &arity, &tuple))
+ goto bad_arg;
+ if (arity != 2)
+ goto bad_arg;
+ if ((digp = get_digest_type(tuple[0])) == NULL)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, tuple[1], &ctx))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &data))
+ goto bad_arg;
+
+ if (digp->md.p == NULL)
+ goto err;
switch (EVP_MD_type(digp->md.p))
{
@@ -300,21 +393,29 @@ ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
break;
#endif
default:
- return atom_notsup;
+ goto err;
}
ASSERT(ctx_size);
ASSERT(ctx_update);
- if (ctx.size != ctx_size) {
- return enif_make_badarg(env);
- }
+ if (ctx.size != ctx_size)
+ goto bad_arg;
- ctx_buff = enif_make_new_binary(env, ctx_size, &new_ctx);
+ if ((ctx_buff = enif_make_new_binary(env, ctx_size, &new_ctx)) == NULL)
+ goto err;
memcpy(ctx_buff, ctx.data, ctx_size);
- ctx_update(ctx_buff, data.data, data.size);
+
+ if (ctx_update(ctx_buff, data.data, data.size) != 1)
+ goto err;
CONSUME_REDS(env, data);
return enif_make_tuple2(env, tuple[0], new_ctx);
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ return atom_notsup;
}
ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -326,20 +427,24 @@ ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
int arity;
struct digest_type_t *digp = NULL;
const EVP_MD *md;
- void *new_ctx;
+ void *new_ctx = NULL;
size_t ctx_size = 0;
final_fun ctx_final = 0;
+ unsigned char *outp;
- if (!enif_get_tuple(env, argv[0], &arity, &tuple) ||
- arity != 2 ||
- !(digp = get_digest_type(tuple[0])) ||
- !enif_inspect_binary(env, tuple[1], &ctx)) {
- return enif_make_badarg(env);
- }
- md = digp->md.p;
- if (!md) {
- return atom_notsup;
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_tuple(env, argv[0], &arity, &tuple))
+ goto bad_arg;
+ if (arity != 2)
+ goto bad_arg;
+ if ((digp = get_digest_type(tuple[0])) == NULL)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, tuple[1], &ctx))
+ goto bad_arg;
+
+ if ((md = digp->md.p) == NULL)
+ goto err;
switch (EVP_MD_type(md))
{
@@ -384,21 +489,36 @@ ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
break;
#endif
default:
- return atom_notsup;
+ goto err;
}
ASSERT(ctx_size);
ASSERT(ctx_final);
- if (ctx.size != ctx_size) {
- return enif_make_badarg(env);
- }
+ if (ctx.size != ctx_size)
+ goto bad_arg;
+
+ if ((new_ctx = enif_alloc(ctx_size)) == NULL)
+ goto err;
- new_ctx = enif_alloc(ctx_size);
memcpy(new_ctx, ctx.data, ctx_size);
- ctx_final(enif_make_new_binary(env, (size_t)EVP_MD_size(md), &ret),
- new_ctx);
- enif_free(new_ctx);
+ if ((outp = enif_make_new_binary(env, (size_t)EVP_MD_size(md), &ret)) == NULL)
+ goto err;
+
+ if (ctx_final(outp, new_ctx) != 1)
+ goto err;
+
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = atom_notsup;
+
+ done:
+ if (new_ctx)
+ enif_free(new_ctx);
return ret;
}
diff --git a/lib/crypto/c_src/hash.h b/lib/crypto/c_src/hash.h
index 8bae07f39a..92a25cedb7 100644
--- a/lib/crypto/c_src/hash.h
+++ b/lib/crypto/c_src/hash.h
@@ -25,6 +25,7 @@
int init_hash_ctx(ErlNifEnv *env);
+ERL_NIF_TERM hash_info_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
diff --git a/lib/crypto/c_src/hmac.c b/lib/crypto/c_src/hmac.c
index 143cde90e1..c41e50eb35 100644
--- a/lib/crypto/c_src/hmac.c
+++ b/lib/crypto/c_src/hmac.c
@@ -37,11 +37,14 @@ int init_hmac_ctx(ErlNifEnv *env) {
(ErlNifResourceDtor*) hmac_context_dtor,
ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER,
NULL);
- if (hmac_context_rtype == NULL) {
- PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'");
- return 0;
- }
+ if (hmac_context_rtype == NULL)
+ goto err;
+
return 1;
+
+ err:
+ PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'");
+ return 0;
}
ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -51,44 +54,67 @@ ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
unsigned char buff[EVP_MAX_MD_SIZE];
unsigned size = 0, req_size = 0;
ERL_NIF_TERM ret;
+ unsigned char *outp;
- digp = get_digest_type(argv[0]);
- if (!digp ||
- !enif_inspect_iolist_as_binary(env, argv[1], &key) ||
- !enif_inspect_iolist_as_binary(env, argv[2], &data) ||
- (argc == 4 && !enif_get_uint(env, argv[3], &req_size))) {
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 3 || argc == 4);
- if (!digp->md.p ||
- !HMAC(digp->md.p,
- key.data, key.size,
- data.data, data.size,
- buff, &size)) {
- return atom_notsup;
+ if ((digp = get_digest_type(argv[0])) == NULL)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key))
+ goto bad_arg;
+ if (key.size > INT_MAX)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[2], &data))
+ goto bad_arg;
+ if (argc == 4) {
+ if (!enif_get_uint(env, argv[3], &req_size))
+ goto bad_arg;
}
+
+ if (digp->md.p == NULL)
+ goto err;
+ if (HMAC(digp->md.p,
+ key.data, (int)key.size,
+ data.data, data.size,
+ buff, &size) == NULL)
+ goto err;
+
ASSERT(0 < size && size <= EVP_MAX_MD_SIZE);
CONSUME_REDS(env, data);
if (argc == 4) {
- if (req_size <= size) {
- size = req_size;
- }
- else {
- return enif_make_badarg(env);
- }
+ if (req_size > size)
+ goto bad_arg;
+
+ size = req_size;
}
- memcpy(enif_make_new_binary(env, size, &ret), buff, size);
+
+ if ((outp = enif_make_new_binary(env, size, &ret)) == NULL)
+ goto err;
+
+ memcpy(outp, buff, size);
return ret;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ return atom_notsup;
}
static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj)
{
+ if (obj == NULL)
+ return;
+
if (obj->alive) {
- HMAC_CTX_free(obj->ctx);
+ if (obj->ctx)
+ HMAC_CTX_free(obj->ctx);
obj->alive = 0;
}
- enif_mutex_destroy(obj->mtx);
+
+ if (obj->mtx != NULL)
+ enif_mutex_destroy(obj->mtx);
}
ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -96,56 +122,95 @@ ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
struct digest_type_t *digp = NULL;
ErlNifBinary key;
ERL_NIF_TERM ret;
- struct hmac_context *obj;
+ struct hmac_context *obj = NULL;
- digp = get_digest_type(argv[0]);
- if (!digp ||
- !enif_inspect_iolist_as_binary(env, argv[1], &key)) {
- return enif_make_badarg(env);
- }
- if (!digp->md.p) {
- return atom_notsup;
- }
+ ASSERT(argc == 2);
+
+ if ((digp = get_digest_type(argv[0])) == NULL)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key))
+ goto bad_arg;
+ if (key.size > INT_MAX)
+ goto bad_arg;
+
+ if (digp->md.p == NULL)
+ goto err;
- obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context));
- obj->mtx = enif_mutex_create("crypto.hmac");
+ if ((obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context))) == NULL)
+ goto err;
+ obj->ctx = NULL;
+ obj->mtx = NULL;
+ obj->alive = 0;
+
+ if ((obj->ctx = HMAC_CTX_new()) == NULL)
+ goto err;
obj->alive = 1;
- obj->ctx = HMAC_CTX_new();
+ if ((obj->mtx = enif_mutex_create("crypto.hmac")) == NULL)
+ goto err;
+
#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
// Check the return value of HMAC_Init: it may fail in FIPS mode
// for disabled algorithms
- if (!HMAC_Init_ex(obj->ctx, key.data, key.size, digp->md.p, NULL)) {
- enif_release_resource(obj);
- return atom_notsup;
- }
+ if (!HMAC_Init_ex(obj->ctx, key.data, (int)key.size, digp->md.p, NULL))
+ goto err;
#else
- HMAC_Init_ex(obj->ctx, key.data, key.size, digp->md.p, NULL);
+ // In ancient versions of OpenSSL, this was a void function.
+ HMAC_Init_ex(obj->ctx, key.data, (int)key.size, digp->md.p, NULL);
#endif
ret = enif_make_resource(env, obj);
- enif_release_resource(obj);
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = atom_notsup;
+
+ done:
+ if (obj)
+ enif_release_resource(obj);
return ret;
}
ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Context, Data) */
+ ERL_NIF_TERM ret;
ErlNifBinary data;
- struct hmac_context* obj;
+ struct hmac_context *obj = NULL;
+
+ ASSERT(argc == 2);
+
+ if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &data))
+ goto bad_arg;
- if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj)
- || !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
- return enif_make_badarg(env);
- }
enif_mutex_lock(obj->mtx);
- if (!obj->alive) {
- enif_mutex_unlock(obj->mtx);
- return enif_make_badarg(env);
- }
+ if (!obj->alive)
+ goto err;
+
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
+ if (!HMAC_Update(obj->ctx, data.data, data.size))
+ goto err;
+#else
+ // In ancient versions of OpenSSL, this was a void function.
HMAC_Update(obj->ctx, data.data, data.size);
- enif_mutex_unlock(obj->mtx);
+#endif
CONSUME_REDS(env,data);
- return argv[0];
+ ret = argv[0];
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ enif_mutex_unlock(obj->mtx);
+ return ret;
}
ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -157,29 +222,49 @@ ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
unsigned int req_len = 0;
unsigned int mac_len;
- if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj)
- || (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) {
- return enif_make_badarg(env);
+ ASSERT(argc == 1 || argc == 2);
+
+ if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj))
+ goto bad_arg;
+ if (argc == 2) {
+ if (!enif_get_uint(env, argv[1], &req_len))
+ goto bad_arg;
}
enif_mutex_lock(obj->mtx);
- if (!obj->alive) {
- enif_mutex_unlock(obj->mtx);
- return enif_make_badarg(env);
- }
+ if (!obj->alive)
+ goto err;
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
+ if (!HMAC_Final(obj->ctx, mac_buf, &mac_len))
+ goto err;
+#else
+ // In ancient versions of OpenSSL, this was a void function.
HMAC_Final(obj->ctx, mac_buf, &mac_len);
- HMAC_CTX_free(obj->ctx);
+#endif
+
+ if (obj->ctx)
+ HMAC_CTX_free(obj->ctx);
obj->alive = 0;
- enif_mutex_unlock(obj->mtx);
if (argc == 2 && req_len < mac_len) {
/* Only truncate to req_len bytes if asked. */
mac_len = req_len;
}
- mac_bin = enif_make_new_binary(env, mac_len, &ret);
+ if ((mac_bin = enif_make_new_binary(env, mac_len, &ret)) == NULL)
+ goto err;
+
memcpy(mac_bin, mac_buf, mac_len);
+ goto done;
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ enif_mutex_unlock(obj->mtx);
return ret;
}
diff --git a/lib/crypto/c_src/info.c b/lib/crypto/c_src/info.c
index 3f3194081d..42f477fead 100644
--- a/lib/crypto/c_src/info.c
+++ b/lib/crypto/c_src/info.c
@@ -30,21 +30,30 @@ char *crypto_callback_name = "crypto_callback.valgrind";
char *crypto_callback_name = "crypto_callback";
# endif
-int change_basename(ErlNifBinary* bin, char* buf, int bufsz, const char* newfile)
+int change_basename(ErlNifBinary* bin, char* buf, size_t bufsz, const char* newfile)
{
- int i;
+ size_t i;
+ size_t newlen;
for (i = bin->size; i > 0; i--) {
if (bin->data[i-1] == '/')
break;
}
- if (i + strlen(newfile) >= bufsz) {
- PRINTF_ERR0("CRYPTO: lib name too long");
- return 0;
- }
+
+ newlen = strlen(newfile);
+ if (i > SIZE_MAX - newlen)
+ goto err;
+
+ if (i + newlen >= bufsz)
+ goto err;
+
memcpy(buf, bin->data, i);
strcpy(buf+i, newfile);
+
return 1;
+
+ err:
+ return 0;
}
void error_handler(void* null, const char* errstr)
@@ -53,16 +62,25 @@ void error_handler(void* null, const char* errstr)
}
#endif /* HAVE_DYNAMIC_CRYPTO_LIB */
-ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{
+ERL_NIF_TERM info_lib(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
+{/* () */
/* [{<<"OpenSSL">>,9470143,<<"OpenSSL 0.9.8k 25 Mar 2009">>}] */
- static const char libname[] = "OpenSSL";
- unsigned name_sz = strlen(libname);
- const char* ver = SSLeay_version(SSLEAY_VERSION);
- unsigned ver_sz = strlen(ver);
ERL_NIF_TERM name_term, ver_term;
- int ver_num = OPENSSL_VERSION_NUMBER;
+ static const char libname[] = "OpenSSL";
+ size_t name_sz;
+ const char* ver;
+ size_t ver_sz;
+ int ver_num;
+ unsigned char *out_name, *out_ver;
+
+ ASSERT(argc == 0);
+
+ name_sz = strlen(libname);
+ ver = SSLeay_version(SSLEAY_VERSION);
+ ver_sz = strlen(ver);
+ ver_num = OPENSSL_VERSION_NUMBER;
+
/* R16:
* Ignore library version number from SSLeay() and instead show header
* version. Otherwise user might try to call a function that is implemented
@@ -72,10 +90,18 @@ ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
* Version string is still from library though.
*/
- memcpy(enif_make_new_binary(env, name_sz, &name_term), libname, name_sz);
- memcpy(enif_make_new_binary(env, ver_sz, &ver_term), ver, ver_sz);
+ if ((out_name = enif_make_new_binary(env, name_sz, &name_term)) == NULL)
+ goto err;
+ if ((out_ver = enif_make_new_binary(env, ver_sz, &ver_term)) == NULL)
+ goto err;
+
+ memcpy(out_name, libname, name_sz);
+ memcpy(out_ver, ver, ver_sz);
return enif_make_list1(env, enif_make_tuple3(env, name_term,
enif_make_int(env, ver_num),
ver_term));
+
+ err:
+ return enif_make_badarg(env);
}
diff --git a/lib/crypto/c_src/info.h b/lib/crypto/c_src/info.h
index 4f8822ddd7..67690625c9 100644
--- a/lib/crypto/c_src/info.h
+++ b/lib/crypto/c_src/info.h
@@ -26,7 +26,7 @@
#ifdef HAVE_DYNAMIC_CRYPTO_LIB
extern char *crypto_callback_name;
-int change_basename(ErlNifBinary* bin, char* buf, int bufsz, const char* newfile);
+int change_basename(ErlNifBinary* bin, char* buf, size_t bufsz, const char* newfile);
void error_handler(void* null, const char* errstr);
#endif
diff --git a/lib/crypto/c_src/math.c b/lib/crypto/c_src/math.c
index 7d7d146ca9..85494bbc93 100644
--- a/lib/crypto/c_src/math.c
+++ b/lib/crypto/c_src/math.c
@@ -24,20 +24,30 @@ ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Data1, Data2) */
ErlNifBinary d1, d2;
unsigned char* ret_ptr;
- int i;
+ size_t i;
ERL_NIF_TERM ret;
- if (!enif_inspect_iolist_as_binary(env,argv[0], &d1)
- || !enif_inspect_iolist_as_binary(env,argv[1], &d2)
- || d1.size != d2.size) {
- return enif_make_badarg(env);
- }
- ret_ptr = enif_make_new_binary(env, d1.size, &ret);
+ ASSERT(argc == 2);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &d1))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &d2))
+ goto bad_arg;
+ if (d1.size != d2.size)
+ goto bad_arg;
+
+ if ((ret_ptr = enif_make_new_binary(env, d1.size, &ret)) == NULL)
+ goto err;
for (i=0; i<d1.size; i++) {
ret_ptr[i] = d1.data[i] ^ d2.data[i];
}
+
CONSUME_REDS(env,d1);
return ret;
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
}
diff --git a/lib/crypto/c_src/openssl_config.h b/lib/crypto/c_src/openssl_config.h
index 2e5f5b22c1..1c138e3bd1 100644
--- a/lib/crypto/c_src/openssl_config.h
+++ b/lib/crypto/c_src/openssl_config.h
@@ -89,6 +89,11 @@
# undef FIPS_SUPPORT
# endif
+/* LibreSSL has never supported the custom mem functions */
+#ifndef HAS_LIBRESSL
+# define HAS_CRYPTO_MEM_FUNCTIONS
+#endif
+
# if LIBRESSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(2,7,0)
/* LibreSSL wants the 1.0.1 API */
# define NEED_EVP_COMPATIBILITY_FUNCTIONS
@@ -153,6 +158,13 @@
# define HAVE_SHA3_512
# endif
+// BLAKE2:
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,1) \
+ && !defined(HAS_LIBRESSL) \
+ && !defined(OPENSSL_NO_BLAKE2)
+# define HAVE_BLAKE2
+#endif
+
#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'o') \
&& !defined(OPENSSL_NO_EC) \
&& !defined(OPENSSL_NO_ECDH) \
@@ -191,12 +203,17 @@
#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,1,0)
# ifndef HAS_LIBRESSL
-# define HAVE_CHACHA20
# define HAVE_CHACHA20_POLY1305
# define HAVE_RSA_OAEP_MD
# endif
#endif
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(1,1,0,'d')
+# ifndef HAS_LIBRESSL
+# define HAVE_CHACHA20
+# endif
+#endif
+
// OPENSSL_VERSION_NUMBER >= 1.1.1-pre8
#if OPENSSL_VERSION_NUMBER >= (PACKED_OPENSSL_VERSION_PLAIN(1,1,1)-7)
# ifndef HAS_LIBRESSL
@@ -291,11 +308,11 @@
(((unsigned char*) (s))[2] << 8) | \
(((unsigned char*) (s))[3]))
-#define put_int32(s,i) \
-{ (s)[0] = (char)(((i) >> 24) & 0xff);\
- (s)[1] = (char)(((i) >> 16) & 0xff);\
- (s)[2] = (char)(((i) >> 8) & 0xff);\
- (s)[3] = (char)((i) & 0xff);\
+#define put_uint32(s,i) \
+{ (s)[0] = (unsigned char)(((i) >> 24) & 0xff);\
+ (s)[1] = (unsigned char)(((i) >> 16) & 0xff);\
+ (s)[2] = (unsigned char)(((i) >> 8) & 0xff);\
+ (s)[3] = (unsigned char)((i) & 0xff);\
}
/* This shall correspond to the similar macro in crypto.erl */
@@ -303,11 +320,16 @@
#define MAX_BYTES_TO_NIF 20000
#define CONSUME_REDS(NifEnv, Ibin) \
-do { \
- int _cost = ((Ibin).size * 100) / MAX_BYTES_TO_NIF;\
+do { \
+ size_t _cost = (Ibin).size; \
+ if (_cost > SIZE_MAX / 100) \
+ _cost = 100; \
+ else \
+ _cost = (_cost * 100) / MAX_BYTES_TO_NIF; \
+ \
if (_cost) { \
(void) enif_consume_timeslice((NifEnv), \
- (_cost > 100) ? 100 : _cost); \
+ (_cost > 100) ? 100 : (int)_cost); \
} \
} while (0)
@@ -317,15 +339,15 @@ do { \
# define HAVE_OPAQUE_BN_GENCB
#endif
-/*
-#define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n")
-#define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1)
-#define PRINTF_ERR2(FMT, A1, A2) enif_fprintf(stderr, FMT "\n", A1, A2)
-*/
-
-#define PRINTF_ERR0(FMT)
-#define PRINTF_ERR1(FMT,A1)
-#define PRINTF_ERR2(FMT,A1,A2)
+#if 0
+# define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n")
+# define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1)
+# define PRINTF_ERR2(FMT, A1, A2) enif_fprintf(stderr, FMT "\n", A1, A2)
+#else
+# define PRINTF_ERR0(FMT)
+# define PRINTF_ERR1(FMT,A1)
+# define PRINTF_ERR2(FMT,A1,A2)
+#endif
#ifdef FIPS_SUPPORT
/* In FIPS mode non-FIPS algorithms are disabled and return badarg. */
diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c
index 2c8cce094e..fd26b7cb5d 100644
--- a/lib/crypto/c_src/otp_test_engine.c
+++ b/lib/crypto/c_src/otp_test_engine.c
@@ -21,8 +21,11 @@
#ifdef _WIN32
#define OPENSSL_OPT_WINDLL
#endif
+
#include <stdio.h>
#include <string.h>
+#include <limits.h>
+#include <stdint.h>
#include <openssl/md5.h>
#include <openssl/rsa.h>
@@ -87,13 +90,12 @@ static int test_init(ENGINE *e) {
printf("OTP Test Engine Initializatzion!\r\n");
#if defined(FAKE_RSA_IMPL)
- if ( !RSA_meth_set_finish(test_rsa_method, test_rsa_free)
- || !RSA_meth_set_sign(test_rsa_method, test_rsa_sign)
- || !RSA_meth_set_verify(test_rsa_method, test_rsa_verify)
- ) {
- fprintf(stderr, "Setup RSA_METHOD failed\r\n");
- return 0;
- }
+ if (!RSA_meth_set_finish(test_rsa_method, test_rsa_free))
+ goto err;
+ if (!RSA_meth_set_sign(test_rsa_method, test_rsa_sign))
+ goto err;
+ if (!RSA_meth_set_verify(test_rsa_method, test_rsa_verify))
+ goto err;
#endif /* if defined(FAKE_RSA_IMPL) */
/* Load all digest and cipher algorithms. Needed for password protected private keys */
@@ -101,6 +103,12 @@ static int test_init(ENGINE *e) {
OpenSSL_add_all_digests();
return 111;
+
+#if defined(FAKE_RSA_IMPL)
+err:
+ fprintf(stderr, "Setup RSA_METHOD failed\r\n");
+ return 0;
+#endif
}
static void add_test_data(unsigned char *md, unsigned int len)
@@ -152,15 +160,15 @@ static int test_engine_md5_update(EVP_MD_CTX *ctx,const void *data, size_t count
static int test_engine_md5_final(EVP_MD_CTX *ctx,unsigned char *md) {
#ifdef OLD
- int ret;
-
fprintf(stderr, "MD5 final size of EVP_MD: %lu\r\n", sizeof(EVP_MD));
- ret = MD5_Final(md, data(ctx));
+ if (!MD5_Final(md, data(ctx)))
+ goto err;
- if (ret > 0) {
- add_test_data(md, MD5_DIGEST_LENGTH);
- }
- return ret;
+ add_test_data(md, MD5_DIGEST_LENGTH);
+ return 1;
+
+ err:
+ return 0;
#else
fprintf(stderr, "MD5 final\r\n");
add_test_data(md, MD5_DIGEST_LENGTH);
@@ -190,7 +198,6 @@ static int test_digest_ids[] = {NID_md5};
static int test_engine_digest_selector(ENGINE *e, const EVP_MD **digest,
const int **nids, int nid) {
- int ok = 1;
if (!digest) {
*nids = test_digest_ids;
fprintf(stderr, "Digest is empty! Nid:%d\r\n", nid);
@@ -201,64 +208,82 @@ static int test_engine_digest_selector(ENGINE *e, const EVP_MD **digest,
#ifdef OLD
*digest = &test_engine_md5_method;
#else
- EVP_MD *md = EVP_MD_meth_new(NID_md5, NID_undef);
- if (!md ||
- !EVP_MD_meth_set_result_size(md, MD5_DIGEST_LENGTH) ||
- !EVP_MD_meth_set_flags(md, 0) ||
- !EVP_MD_meth_set_init(md, test_engine_md5_init) ||
- !EVP_MD_meth_set_update(md, test_engine_md5_update) ||
- !EVP_MD_meth_set_final(md, test_engine_md5_final) ||
- !EVP_MD_meth_set_copy(md, NULL) ||
- !EVP_MD_meth_set_cleanup(md, NULL) ||
- !EVP_MD_meth_set_input_blocksize(md, MD5_CBLOCK) ||
- !EVP_MD_meth_set_app_datasize(md, sizeof(EVP_MD *) + sizeof(MD5_CTX)) ||
- !EVP_MD_meth_set_ctrl(md, NULL))
- {
- ok = 0;
- *digest = NULL;
- } else
- {
- *digest = md;
- }
+ EVP_MD *md;
+
+ if ((md = EVP_MD_meth_new(NID_md5, NID_undef)) == NULL)
+ goto err;
+ if (EVP_MD_meth_set_result_size(md, MD5_DIGEST_LENGTH) != 1)
+ goto err;
+ if (EVP_MD_meth_set_flags(md, 0) != 1)
+ goto err;
+ if (EVP_MD_meth_set_init(md, test_engine_md5_init) != 1)
+ goto err;
+ if (EVP_MD_meth_set_update(md, test_engine_md5_update) != 1)
+ goto err;
+ if (EVP_MD_meth_set_final(md, test_engine_md5_final) != 1)
+ goto err;
+ if (EVP_MD_meth_set_copy(md, NULL) != 1)
+ goto err;
+ if (EVP_MD_meth_set_cleanup(md, NULL) != 1)
+ goto err;
+ if (EVP_MD_meth_set_input_blocksize(md, MD5_CBLOCK) != 1)
+ goto err;
+ if (EVP_MD_meth_set_app_datasize(md, sizeof(EVP_MD *) + sizeof(MD5_CTX)) != 1)
+ goto err;
+ if (EVP_MD_meth_set_ctrl(md, NULL) != 1)
+ goto err;
+
+ *digest = md;
#endif
}
else {
- ok = 0;
- *digest = NULL;
+ goto err;
}
- return ok;
+ return 1;
+
+ err:
+ *digest = NULL;
+ return 0;
}
static int bind_helper(ENGINE * e, const char *id)
{
#if defined(FAKE_RSA_IMPL)
- test_rsa_method = RSA_meth_new("OTP test RSA method", 0);
- if (test_rsa_method == NULL) {
+ if ((test_rsa_method = RSA_meth_new("OTP test RSA method", 0)) == NULL) {
fprintf(stderr, "RSA_meth_new failed\r\n");
- return 0;
+ goto err;
}
#endif /* if defined(FAKE_RSA_IMPL) */
- if (!ENGINE_set_id(e, test_engine_id)
- || !ENGINE_set_name(e, test_engine_name)
- || !ENGINE_set_init_function(e, test_init)
- || !ENGINE_set_digests(e, &test_engine_digest_selector)
- /* For testing of key storage in an Engine: */
- || !ENGINE_set_load_privkey_function(e, &test_privkey_load)
- || !ENGINE_set_load_pubkey_function(e, &test_pubkey_load)
- )
- return 0;
+ if (!ENGINE_set_id(e, test_engine_id))
+ goto err;
+ if (!ENGINE_set_name(e, test_engine_name))
+ goto err;
+ if (!ENGINE_set_init_function(e, test_init))
+ goto err;
+ if (!ENGINE_set_digests(e, &test_engine_digest_selector))
+ goto err;
+ /* For testing of key storage in an Engine: */
+ if (!ENGINE_set_load_privkey_function(e, &test_privkey_load))
+ goto err;
+ if (!ENGINE_set_load_pubkey_function(e, &test_pubkey_load))
+ goto err;
#if defined(FAKE_RSA_IMPL)
- if ( !ENGINE_set_RSA(e, test_rsa_method) ) {
- RSA_meth_free(test_rsa_method);
- test_rsa_method = NULL;
- return 0;
- }
+ if (!ENGINE_set_RSA(e, test_rsa_method))
+ goto err;
#endif /* if defined(FAKE_RSA_IMPL) */
return 1;
+
+ err:
+#if defined(FAKE_RSA_IMPL)
+ if (test_rsa_method)
+ RSA_meth_free(test_rsa_method);
+ test_rsa_method = NULL;
+#endif
+ return 0;
}
IMPLEMENT_DYNAMIC_CHECK_FN();
@@ -304,7 +329,7 @@ EVP_PKEY* test_key_load(ENGINE *eng, const char *id, UI_METHOD *ui_method, void
fprintf(stderr, "Contents of file \"%s\":\r\n",id);
f = fopen(id, "r");
{ /* Print the contents of the key file */
- char c;
+ int c;
while (!feof(f)) {
switch (c=fgetc(f)) {
case '\n':
@@ -324,23 +349,28 @@ EVP_PKEY* test_key_load(ENGINE *eng, const char *id, UI_METHOD *ui_method, void
int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password)
{
- int i;
+ size_t i;
+
+ if (size < 0)
+ return 0;
fprintf(stderr, "In pem_passwd_cb_fun\r\n");
if (!password)
return 0;
i = strlen(password);
- if (i < size) {
- /* whole pwd (incl terminating 0) fits */
- fprintf(stderr, "Got FULL pwd %d(%d) chars\r\n", i, size);
- memcpy(buf, (char*)password, i+1);
- return i+1;
- } else {
- fprintf(stderr, "Got TO LONG pwd %d(%d) chars\r\n", i, size);
- /* meaningless with a truncated password */
- return 0;
- }
+ if (i >= (size_t)size || i > INT_MAX - 1)
+ goto err;
+
+ /* whole pwd (incl terminating 0) fits */
+ fprintf(stderr, "Got FULL pwd %zu(%d) chars\r\n", i, size);
+ memcpy(buf, (char*)password, i+1);
+ return (int)i+1;
+
+ err:
+ fprintf(stderr, "Got TO LONG pwd %zu(%d) chars\r\n", i, size);
+ /* meaningless with a truncated password */
+ return 0;
}
#endif
@@ -349,7 +379,7 @@ int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password)
/* RSA sign. This returns a fixed string so the test case can test that it was called
instead of the cryptolib default RSA sign */
-unsigned char fake_flag[] = {255,3,124,180,35,10,180,151,101,247,62,59,80,122,220,
+static unsigned char fake_flag[] = {255,3,124,180,35,10,180,151,101,247,62,59,80,122,220,
142,24,180,191,34,51,150,112,27,43,142,195,60,245,213,80,179};
int test_rsa_sign(int dtype,
@@ -360,11 +390,10 @@ int test_rsa_sign(int dtype,
/* The key */
const RSA *rsa)
{
- int slen;
fprintf(stderr, "test_rsa_sign (dtype=%i) called m_len=%u *siglen=%u\r\n", dtype, m_len, *siglen);
if (!sigret) {
fprintf(stderr, "sigret = NULL\r\n");
- return -1;
+ goto err;
}
/* {int i;
@@ -376,14 +405,20 @@ int test_rsa_sign(int dtype,
if ((sizeof(fake_flag) == m_len)
&& bcmp(m,fake_flag,m_len) == 0) {
+ int slen;
+
printf("To be faked\r\n");
/* To be faked */
- slen = RSA_size(rsa);
- add_test_data(sigret, slen); /* The signature is 0,1,2...255,0,1... */
- *siglen = slen; /* Must set this. Why? */
+ if ((slen = RSA_size(rsa)) < 0)
+ goto err;
+ add_test_data(sigret, (unsigned int)slen); /* The signature is 0,1,2...255,0,1... */
+ *siglen = (unsigned int)slen; /* Must set this. Why? */
return 1; /* 1 = success */
}
return 0;
+
+ err:
+ return -1;
}
int test_rsa_verify(int dtype,
@@ -398,8 +433,13 @@ int test_rsa_verify(int dtype,
if ((sizeof(fake_flag) == m_len)
&& bcmp(m,fake_flag,m_len) == 0) {
+ int size;
+
+ if ((size = RSA_size(rsa)) < 0)
+ return 0;
+
printf("To be faked\r\n");
- return (siglen == RSA_size(rsa))
+ return (siglen == (unsigned int)size)
&& chk_test_data(sigret, siglen);
}
return 0;
diff --git a/lib/crypto/c_src/pkey.c b/lib/crypto/c_src/pkey.c
index bd56b2d977..393358d173 100644
--- a/lib/crypto/c_src/pkey.c
+++ b/lib/crypto/c_src/pkey.c
@@ -68,13 +68,19 @@ static int get_pkey_digest_type(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_
struct digest_type_t *digp = NULL;
*md = NULL;
- if (type == atom_none && algorithm == atom_rsa) return PKEY_OK;
+ if (type == atom_none && algorithm == atom_rsa)
+ return PKEY_OK;
+ if (algorithm == atom_eddsa) {
#ifdef HAVE_EDDSA
- if (algorithm == atom_eddsa) return PKEY_OK;
+ if (!FIPS_mode()) return PKEY_OK;
+#else
+ return PKEY_NOTSUP;
#endif
- digp = get_digest_type(type);
- if (!digp) return PKEY_BADARG;
- if (!digp->md.p) return PKEY_NOTSUP;
+ }
+ if ((digp = get_digest_type(type)) == NULL)
+ return PKEY_BADARG;
+ if (digp->md.p == NULL)
+ return PKEY_NOTSUP;
*md = digp->md.p;
return PKEY_OK;
@@ -85,67 +91,83 @@ static int get_pkey_sign_digest(ErlNifEnv *env, ERL_NIF_TERM algorithm,
unsigned char *md_value, const EVP_MD **mdp,
unsigned char **tbsp, size_t *tbslenp)
{
- int i;
+ int i, ret;
const ERL_NIF_TERM *tpl_terms;
int tpl_arity;
ErlNifBinary tbs_bin;
- EVP_MD_CTX *mdctx;
- const EVP_MD *md = *mdp;
- unsigned char *tbs = *tbsp;
- size_t tbslen = *tbslenp;
+ EVP_MD_CTX *mdctx = NULL;
+ const EVP_MD *md;
+ unsigned char *tbs;
+ size_t tbslen;
unsigned int tbsleni;
- if ((i = get_pkey_digest_type(env, algorithm, type, &md)) != PKEY_OK) {
- return i;
- }
+ md = *mdp;
+ tbs = *tbsp;
+ tbslen = *tbslenp;
+
+ if ((i = get_pkey_digest_type(env, algorithm, type, &md)) != PKEY_OK)
+ return i;
+
if (enif_get_tuple(env, data, &tpl_arity, &tpl_terms)) {
- if (tpl_arity != 2 || tpl_terms[0] != atom_digest
- || !enif_inspect_binary(env, tpl_terms[1], &tbs_bin)
- || (md != NULL && tbs_bin.size != EVP_MD_size(md))) {
- return PKEY_BADARG;
- }
+ if (tpl_arity != 2)
+ goto bad_arg;
+ if (tpl_terms[0] != atom_digest)
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, tpl_terms[1], &tbs_bin))
+ goto bad_arg;
+ if (tbs_bin.size > INT_MAX)
+ goto bad_arg;
+ if (md != NULL) {
+ if ((int)tbs_bin.size != EVP_MD_size(md))
+ goto bad_arg;
+ }
+
/* We have a digest (= hashed text) in tbs_bin */
tbs = tbs_bin.data;
tbslen = tbs_bin.size;
} else if (md == NULL) {
- if (!enif_inspect_binary(env, data, &tbs_bin)) {
- return PKEY_BADARG;
- }
+ if (!enif_inspect_iolist_as_binary(env, data, &tbs_bin))
+ goto bad_arg;
+
/* md == NULL, that is no hashing because DigestType argument was atom_none */
tbs = tbs_bin.data;
tbslen = tbs_bin.size;
} else {
- if (!enif_inspect_binary(env, data, &tbs_bin)) {
- return PKEY_BADARG;
- }
+ if (!enif_inspect_iolist_as_binary(env, data, &tbs_bin))
+ goto bad_arg;
+
/* We have the cleartext in tbs_bin and the hash algo info in md */
tbs = md_value;
- mdctx = EVP_MD_CTX_create();
- if (!mdctx) {
- return PKEY_BADARG;
- }
+
+ if ((mdctx = EVP_MD_CTX_create()) == NULL)
+ goto err;
+
/* Looks well, now hash the plain text into a digest according to md */
- if (EVP_DigestInit_ex(mdctx, md, NULL) <= 0) {
- EVP_MD_CTX_destroy(mdctx);
- return PKEY_BADARG;
- }
- if (EVP_DigestUpdate(mdctx, tbs_bin.data, tbs_bin.size) <= 0) {
- EVP_MD_CTX_destroy(mdctx);
- return PKEY_BADARG;
- }
- if (EVP_DigestFinal_ex(mdctx, tbs, &tbsleni) <= 0) {
- EVP_MD_CTX_destroy(mdctx);
- return PKEY_BADARG;
- }
- tbslen = (size_t)(tbsleni);
- EVP_MD_CTX_destroy(mdctx);
+ if (EVP_DigestInit_ex(mdctx, md, NULL) != 1)
+ goto err;
+ if (EVP_DigestUpdate(mdctx, tbs_bin.data, tbs_bin.size) != 1)
+ goto err;
+ if (EVP_DigestFinal_ex(mdctx, tbs, &tbsleni) != 1)
+ goto err;
+
+ tbslen = (size_t)tbsleni;
}
*mdp = md;
*tbsp = tbs;
*tbslenp = tbslen;
- return PKEY_OK;
+ ret = PKEY_OK;
+ goto done;
+
+ bad_arg:
+ err:
+ ret = PKEY_BADARG;
+
+ done:
+ if (mdctx)
+ EVP_MD_CTX_destroy(mdctx);
+ return ret;
}
static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM options,
@@ -155,11 +177,9 @@ static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF
const ERL_NIF_TERM *tpl_terms;
int tpl_arity;
const EVP_MD *opt_md;
- int i;
- if (!enif_is_list(env, options)) {
- return PKEY_BADARG;
- }
+ if (!enif_is_list(env, options))
+ goto bad_arg;
/* defaults */
if (algorithm == atom_rsa) {
@@ -168,533 +188,711 @@ static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF
opt->rsa_pss_saltlen = -2;
}
- if (enif_is_empty_list(env, options)) {
+ if (enif_is_empty_list(env, options))
return PKEY_OK;
- }
- if (algorithm == atom_rsa) {
- tail = options;
- while (enif_get_list_cell(env, tail, &head, &tail)) {
- if (enif_get_tuple(env, head, &tpl_arity, &tpl_terms) && tpl_arity == 2) {
- if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) {
- i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
- if (i != PKEY_OK) {
- return i;
- }
- opt->rsa_mgf1_md = opt_md;
- } else if (tpl_terms[0] == atom_rsa_padding) {
- if (tpl_terms[1] == atom_rsa_pkcs1_padding) {
- opt->rsa_padding = RSA_PKCS1_PADDING;
- } else if (tpl_terms[1] == atom_rsa_pkcs1_pss_padding) {
+ if (algorithm != atom_rsa)
+ goto bad_arg;
+
+ tail = options;
+ while (enif_get_list_cell(env, tail, &head, &tail)) {
+ if (!enif_get_tuple(env, head, &tpl_arity, &tpl_terms))
+ goto bad_arg;
+ if (tpl_arity != 2)
+ goto bad_arg;
+
+ if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) {
+ int result;
+
+ result = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
+ if (result != PKEY_OK)
+ return result;
+
+ opt->rsa_mgf1_md = opt_md;
+
+ } else if (tpl_terms[0] == atom_rsa_padding) {
+ if (tpl_terms[1] == atom_rsa_pkcs1_padding) {
+ opt->rsa_padding = RSA_PKCS1_PADDING;
+
+ } else if (tpl_terms[1] == atom_rsa_pkcs1_pss_padding) {
#ifdef HAVE_RSA_PKCS1_PSS_PADDING
- opt->rsa_padding = RSA_PKCS1_PSS_PADDING;
- if (opt->rsa_mgf1_md == NULL) {
- opt->rsa_mgf1_md = md;
- }
+ opt->rsa_padding = RSA_PKCS1_PSS_PADDING;
+ if (opt->rsa_mgf1_md == NULL)
+ opt->rsa_mgf1_md = md;
#else
- return PKEY_NOTSUP;
+ return PKEY_NOTSUP;
#endif
- } else if (tpl_terms[1] == atom_rsa_x931_padding) {
- opt->rsa_padding = RSA_X931_PADDING;
- } else if (tpl_terms[1] == atom_rsa_no_padding) {
- opt->rsa_padding = RSA_NO_PADDING;
- } else {
- return PKEY_BADARG;
- }
- } else if (tpl_terms[0] == atom_rsa_pss_saltlen) {
- if (!enif_get_int(env, tpl_terms[1], &(opt->rsa_pss_saltlen))
- || opt->rsa_pss_saltlen < -2) {
- return PKEY_BADARG;
- }
- } else {
- return PKEY_BADARG;
- }
- } else {
- return PKEY_BADARG;
- }
- }
- } else {
- return PKEY_BADARG;
+
+ } else if (tpl_terms[1] == atom_rsa_x931_padding) {
+ opt->rsa_padding = RSA_X931_PADDING;
+
+ } else if (tpl_terms[1] == atom_rsa_no_padding) {
+ opt->rsa_padding = RSA_NO_PADDING;
+
+ } else {
+ goto bad_arg;
+ }
+
+ } else if (tpl_terms[0] == atom_rsa_pss_saltlen) {
+ if (!enif_get_int(env, tpl_terms[1], &(opt->rsa_pss_saltlen)))
+ goto bad_arg;
+ if (opt->rsa_pss_saltlen < -2)
+ goto bad_arg;
+
+ } else {
+ goto bad_arg;
+ }
}
return PKEY_OK;
+
+ bad_arg:
+ return PKEY_BADARG;
}
static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, EVP_PKEY **pkey)
{
+ EVP_PKEY *result = NULL;
+ RSA *rsa = NULL;
+ DSA *dsa = NULL;
+#if defined(HAVE_EC)
+ EC_KEY *ec = NULL;
+#endif
+ char *id = NULL;
+ char *password = NULL;
+
if (enif_is_map(env, key)) {
#ifdef HAS_ENGINE_SUPPORT
/* Use key stored in engine */
ENGINE *e;
- char *id = NULL;
- char *password;
if (!get_engine_and_key_id(env, key, &id, &e))
- return PKEY_BADARG;
+ goto err;
+
password = get_key_password(env, key);
- *pkey = ENGINE_load_private_key(e, id, NULL, password);
- if (password) enif_free(password);
- enif_free(id);
- if (!*pkey)
- return PKEY_BADARG;
+ result = ENGINE_load_private_key(e, id, NULL, password);
+
#else
return PKEY_BADARG;
#endif
- }
- else if (algorithm == atom_rsa) {
- RSA *rsa = RSA_new();
-
- if (!get_rsa_private_key(env, key, rsa)) {
- RSA_free(rsa);
- return PKEY_BADARG;
- }
-
- *pkey = EVP_PKEY_new();
- if (!EVP_PKEY_assign_RSA(*pkey, rsa)) {
- EVP_PKEY_free(*pkey);
- RSA_free(rsa);
- return PKEY_BADARG;
- }
+ } else if (algorithm == atom_rsa) {
+ if ((rsa = RSA_new()) == NULL)
+ goto err;
+
+ if (!get_rsa_private_key(env, key, rsa))
+ goto err;
+ if ((result = EVP_PKEY_new()) == NULL)
+ goto err;
+ if (EVP_PKEY_assign_RSA(result, rsa) != 1)
+ goto err;
+ /* On success, result owns rsa */
+ rsa = NULL;
+
} else if (algorithm == atom_ecdsa) {
#if defined(HAVE_EC)
- EC_KEY *ec = NULL;
const ERL_NIF_TERM *tpl_terms;
int tpl_arity;
- if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2
- && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1])
- && get_ec_key(env, tpl_terms[0], tpl_terms[1], atom_undefined, &ec)) {
-
- *pkey = EVP_PKEY_new();
- if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) {
- EVP_PKEY_free(*pkey);
- EC_KEY_free(ec);
- return PKEY_BADARG;
- }
- } else {
- return PKEY_BADARG;
- }
+ if (!enif_get_tuple(env, key, &tpl_arity, &tpl_terms))
+ goto err;
+ if (tpl_arity != 2)
+ goto err;
+ if (!enif_is_tuple(env, tpl_terms[0]))
+ goto err;
+ if (!enif_is_binary(env, tpl_terms[1]))
+ goto err;
+ if (!get_ec_key(env, tpl_terms[0], tpl_terms[1], atom_undefined, &ec))
+ goto err;
+
+ if ((result = EVP_PKEY_new()) == NULL)
+ goto err;
+ if (EVP_PKEY_assign_EC_KEY(result, ec) != 1)
+ goto err;
+ /* On success, result owns ec */
+ ec = NULL;
+
#else
return PKEY_NOTSUP;
#endif
} else if (algorithm == atom_eddsa) {
-#if defined(HAVE_EDDSA)
- if (!get_eddsa_key(env, 0, key, pkey)) {
- return PKEY_BADARG;
- }
+#ifdef HAVE_EDDSA
+ if (!FIPS_mode())
+ {
+ if (!get_eddsa_key(env, 0, key, &result))
+ goto err;
+ else
+ goto done; // Not nice....
+ }
#else
- return PKEY_NOTSUP;
+ return PKEY_NOTSUP;
#endif
} else if (algorithm == atom_dss) {
- DSA *dsa = DSA_new();
+ if ((dsa = DSA_new()) == NULL)
+ goto err;
+ if (!get_dss_private_key(env, key, dsa))
+ goto err;
+
+ if ((result = EVP_PKEY_new()) == NULL)
+ goto err;
+ if (EVP_PKEY_assign_DSA(result, dsa) != 1)
+ goto err;
+ /* On success, result owns dsa */
+ dsa = NULL;
- if (!get_dss_private_key(env, key, dsa)) {
- DSA_free(dsa);
- return PKEY_BADARG;
- }
-
- *pkey = EVP_PKEY_new();
- if (!EVP_PKEY_assign_DSA(*pkey, dsa)) {
- EVP_PKEY_free(*pkey);
- DSA_free(dsa);
- return PKEY_BADARG;
- }
} else {
return PKEY_BADARG;
}
- return PKEY_OK;
+ goto done;
+
+ err:
+ if (result)
+ EVP_PKEY_free(result);
+ result = NULL;
+
+ done:
+ if (password)
+ enif_free(password);
+ if (id)
+ enif_free(id);
+ if (rsa)
+ RSA_free(rsa);
+ if (dsa)
+ DSA_free(dsa);
+#ifdef HAVE_EC
+ if (ec)
+ EC_KEY_free(ec);
+#endif
+
+ if (result == NULL) {
+ return PKEY_BADARG;
+ } else {
+ *pkey = result;
+ return PKEY_OK;
+ }
}
static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key,
EVP_PKEY **pkey)
{
+ EVP_PKEY *result = NULL;
+ RSA *rsa = NULL;
+ DSA *dsa = NULL;
+#if defined(HAVE_EC)
+ EC_KEY *ec = NULL;
+#endif
+ char *id = NULL;
+ char *password = NULL;
+
if (enif_is_map(env, key)) {
#ifdef HAS_ENGINE_SUPPORT
/* Use key stored in engine */
ENGINE *e;
- char *id = NULL;
- char *password;
if (!get_engine_and_key_id(env, key, &id, &e))
- return PKEY_BADARG;
+ goto err;
+
password = get_key_password(env, key);
- *pkey = ENGINE_load_public_key(e, id, NULL, password);
- if (password) enif_free(password);
- enif_free(id);
- if (!pkey)
- return PKEY_BADARG;
+ result = ENGINE_load_public_key(e, id, NULL, password);
+
#else
return PKEY_BADARG;
#endif
} else if (algorithm == atom_rsa) {
- RSA *rsa = RSA_new();
-
- if (!get_rsa_public_key(env, key, rsa)) {
- RSA_free(rsa);
- return PKEY_BADARG;
- }
-
- *pkey = EVP_PKEY_new();
- if (!EVP_PKEY_assign_RSA(*pkey, rsa)) {
- EVP_PKEY_free(*pkey);
- RSA_free(rsa);
- return PKEY_BADARG;
- }
+ if ((rsa = RSA_new()) == NULL)
+ goto err;
+
+ if (!get_rsa_public_key(env, key, rsa))
+ goto err;
+
+ if ((result = EVP_PKEY_new()) == NULL)
+ goto err;
+ if (EVP_PKEY_assign_RSA(result, rsa) != 1)
+ goto err;
+ /* On success, result owns rsa */
+ rsa = NULL;
+
} else if (algorithm == atom_ecdsa) {
#if defined(HAVE_EC)
- EC_KEY *ec = NULL;
const ERL_NIF_TERM *tpl_terms;
int tpl_arity;
- if (enif_get_tuple(env, key, &tpl_arity, &tpl_terms) && tpl_arity == 2
- && enif_is_tuple(env, tpl_terms[0]) && enif_is_binary(env, tpl_terms[1])
- && get_ec_key(env, tpl_terms[0], atom_undefined, tpl_terms[1], &ec)) {
-
- *pkey = EVP_PKEY_new();
- if (!EVP_PKEY_assign_EC_KEY(*pkey, ec)) {
- EVP_PKEY_free(*pkey);
- EC_KEY_free(ec);
- return PKEY_BADARG;
- }
- } else {
- return PKEY_BADARG;
- }
+ if (!enif_get_tuple(env, key, &tpl_arity, &tpl_terms))
+ goto err;
+ if (tpl_arity != 2)
+ goto err;
+ if (!enif_is_tuple(env, tpl_terms[0]))
+ goto err;
+ if (!enif_is_binary(env, tpl_terms[1]))
+ goto err;
+ if (!get_ec_key(env, tpl_terms[0], atom_undefined, tpl_terms[1], &ec))
+ goto err;
+
+ if ((result = EVP_PKEY_new()) == NULL)
+ goto err;
+
+ if (EVP_PKEY_assign_EC_KEY(result, ec) != 1)
+ goto err;
+ /* On success, result owns ec */
+ ec = NULL;
+
#else
return PKEY_NOTSUP;
#endif
} else if (algorithm == atom_eddsa) {
-#if defined(HAVE_EDDSA)
- if (!get_eddsa_key(env, 1, key, pkey)) {
- return PKEY_BADARG;
+#ifdef HAVE_EDDSA
+ if (!FIPS_mode()) {
+ if (!get_eddsa_key(env, 1, key, &result))
+ goto err;
}
#else
- return PKEY_NOTSUP;
+ return PKEY_NOTSUP;
#endif
} else if (algorithm == atom_dss) {
- DSA *dsa = DSA_new();
-
- if (!get_dss_public_key(env, key, dsa)) {
- DSA_free(dsa);
- return PKEY_BADARG;
- }
-
- *pkey = EVP_PKEY_new();
- if (!EVP_PKEY_assign_DSA(*pkey, dsa)) {
- EVP_PKEY_free(*pkey);
- DSA_free(dsa);
- return PKEY_BADARG;
- }
+ if ((dsa = DSA_new()) == NULL)
+ goto err;
+
+ if (!get_dss_public_key(env, key, dsa))
+ goto err;
+
+ if ((result = EVP_PKEY_new()) == NULL)
+ goto err;
+ if (EVP_PKEY_assign_DSA(result, dsa) != 1)
+ goto err;
+ /* On success, result owns dsa */
+ dsa = NULL;
+
} else {
return PKEY_BADARG;
}
- return PKEY_OK;
+ goto done;
+
+ err:
+ if (result)
+ EVP_PKEY_free(result);
+ result = NULL;
+
+ done:
+ if (password)
+ enif_free(password);
+ if (id)
+ enif_free(id);
+ if (rsa)
+ RSA_free(rsa);
+ if (dsa)
+ DSA_free(dsa);
+#ifdef HAVE_EC
+ if (ec)
+ EC_KEY_free(ec);
+#endif
+
+ if (result == NULL) {
+ return PKEY_BADARG;
+ } else {
+ *pkey = result;
+ return PKEY_OK;
+ }
}
ERL_NIF_TERM pkey_sign_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
{/* (Algorithm, Type, Data|{digest,Digest}, Key|#{}, Options) */
int i;
+ int sig_bin_alloc = 0;
+ ERL_NIF_TERM ret;
const EVP_MD *md = NULL;
unsigned char md_value[EVP_MAX_MD_SIZE];
- EVP_PKEY *pkey;
+ EVP_PKEY *pkey = NULL;
+#ifdef HAVE_EDDSA
+ EVP_MD_CTX *mdctx = NULL;
+#endif
#ifdef HAS_EVP_PKEY_CTX
- EVP_PKEY_CTX *ctx;
+ EVP_PKEY_CTX *ctx = NULL;
size_t siglen;
#else
- unsigned len, siglen;
+ int len;
+ unsigned int siglen;
#endif
PKeySignOptions sig_opt;
ErlNifBinary sig_bin; /* signature */
unsigned char *tbs; /* data to be signed */
size_t tbslen;
+ RSA *rsa = NULL;
+ DSA *dsa = NULL;
+#if defined(HAVE_EC)
+ EC_KEY *ec = NULL;
+#endif
/*char buf[1024];
enif_get_atom(env,argv[0],buf,1024,ERL_NIF_LATIN1); printf("algo=%s ",buf);
enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf);
-printf("\r\n");
*/
#ifndef HAS_ENGINE_SUPPORT
- if (enif_is_map(env, argv[3])) {
+ if (enif_is_map(env, argv[3]))
return atom_notsup;
- }
#endif
i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen);
- if (i != PKEY_OK) {
- if (i == PKEY_NOTSUP)
- return atom_notsup;
- else
- return enif_make_badarg(env);
+ switch (i) {
+ case PKEY_OK:
+ break;
+ case PKEY_NOTSUP:
+ goto notsup;
+ default:
+ goto bad_arg;
}
i = get_pkey_sign_options(env, argv[0], argv[4], md, &sig_opt);
- if (i != PKEY_OK) {
- if (i == PKEY_NOTSUP)
- return atom_notsup;
- else
- return enif_make_badarg(env);
+ switch (i) {
+ case PKEY_OK:
+ break;
+ case PKEY_NOTSUP:
+ goto notsup;
+ default:
+ goto bad_arg;
}
- if (get_pkey_private_key(env, argv[0], argv[3], &pkey) != PKEY_OK) {
- return enif_make_badarg(env);
- }
+ if (get_pkey_private_key(env, argv[0], argv[3], &pkey) != PKEY_OK)
+ goto bad_arg;
#ifdef HAS_EVP_PKEY_CTX
- ctx = EVP_PKEY_CTX_new(pkey, NULL);
- if (!ctx) goto badarg;
+ if ((ctx = EVP_PKEY_CTX_new(pkey, NULL)) == NULL)
+ goto err;
if (argv[0] != atom_eddsa) {
- if (EVP_PKEY_sign_init(ctx) <= 0) goto badarg;
- if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg;
+ if (EVP_PKEY_sign_init(ctx) != 1)
+ goto err;
+ if (md != NULL) {
+ if (EVP_PKEY_CTX_set_signature_md(ctx, md) != 1)
+ goto err;
+ }
}
if (argv[0] == atom_rsa) {
- if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg;
+ if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) != 1)
+ goto err;
# ifdef HAVE_RSA_PKCS1_PSS_PADDING
if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) {
if (sig_opt.rsa_mgf1_md != NULL) {
# ifdef HAVE_RSA_MGF1_MD
- if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) <= 0) goto badarg;
+ if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) != 1)
+ goto err;
# else
- EVP_PKEY_CTX_free(ctx);
- EVP_PKEY_free(pkey);
- return atom_notsup;
+ goto notsup;
# endif
}
- if (sig_opt.rsa_pss_saltlen > -2
- && EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) <= 0)
- goto badarg;
- }
+ if (sig_opt.rsa_pss_saltlen > -2) {
+ if (EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) != 1)
+ goto err;
+ }
+ }
#endif
}
if (argv[0] == atom_eddsa) {
#ifdef HAVE_EDDSA
- EVP_MD_CTX* mdctx = EVP_MD_CTX_new();
- if (!EVP_DigestSignInit(mdctx, NULL, NULL, NULL, pkey)) {
- if (mdctx) EVP_MD_CTX_free(mdctx);
- goto badarg;
- }
-
- if (!EVP_DigestSign(mdctx, NULL, &siglen, tbs, tbslen)) {
- EVP_MD_CTX_free(mdctx);
- goto badarg;
- }
- enif_alloc_binary(siglen, &sig_bin);
-
- if (!EVP_DigestSign(mdctx, sig_bin.data, &siglen, tbs, tbslen)) {
- EVP_MD_CTX_free(mdctx);
- goto badarg;
+ if (!FIPS_mode()) {
+ if ((mdctx = EVP_MD_CTX_new()) == NULL)
+ goto err;
+
+ if (EVP_DigestSignInit(mdctx, NULL, NULL, NULL, pkey) != 1)
+ goto err;
+ if (EVP_DigestSign(mdctx, NULL, &siglen, tbs, tbslen) != 1)
+ goto err;
+ if (!enif_alloc_binary(siglen, &sig_bin))
+ goto err;
+ sig_bin_alloc = 1;
+
+ if (EVP_DigestSign(mdctx, sig_bin.data, &siglen, tbs, tbslen) != 1)
+ goto bad_key;
}
- EVP_MD_CTX_free(mdctx);
-#else
- goto badarg;
+ else
#endif
- }
- else
- {
- if (EVP_PKEY_sign(ctx, NULL, &siglen, tbs, tbslen) <= 0) goto badarg;
- enif_alloc_binary(siglen, &sig_bin);
+ goto notsup;
+ } else {
+ if (EVP_PKEY_sign(ctx, NULL, &siglen, tbs, tbslen) != 1)
+ goto err;
+ if (!enif_alloc_binary(siglen, &sig_bin))
+ goto err;
+ sig_bin_alloc = 1;
if (md != NULL) {
ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md));
}
- i = EVP_PKEY_sign(ctx, sig_bin.data, &siglen, tbs, tbslen);
+ if (EVP_PKEY_sign(ctx, sig_bin.data, &siglen, tbs, tbslen) != 1)
+ goto bad_key;
}
-
- EVP_PKEY_CTX_free(ctx);
#else
/*printf("Old interface\r\n");
*/
if (argv[0] == atom_rsa) {
- RSA *rsa = EVP_PKEY_get1_RSA(pkey);
- enif_alloc_binary(RSA_size(rsa), &sig_bin);
- len = EVP_MD_size(md);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
- i = RSA_sign(md->type, tbs, len, sig_bin.data, &siglen, rsa);
- RSA_free(rsa);
+ if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL)
+ goto err;
+ if ((len = RSA_size(rsa)) < 0)
+ goto err;
+ if (!enif_alloc_binary((size_t)len, &sig_bin))
+ goto err;
+ sig_bin_alloc = 1;
+
+ if ((len = EVP_MD_size(md)) < 0)
+ goto err;
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+
+ if (RSA_sign(md->type, tbs, (unsigned int)len, sig_bin.data, &siglen, rsa) != 1)
+ goto bad_key;
} else if (argv[0] == atom_dss) {
- DSA *dsa = EVP_PKEY_get1_DSA(pkey);
- enif_alloc_binary(DSA_size(dsa), &sig_bin);
- len = EVP_MD_size(md);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
- i = DSA_sign(md->type, tbs, len, sig_bin.data, &siglen, dsa);
- DSA_free(dsa);
+ if ((dsa = EVP_PKEY_get1_DSA(pkey)) == NULL)
+ goto err;
+ if ((len = DSA_size(dsa)) < 0)
+ goto err;
+ if (!enif_alloc_binary((size_t)len, &sig_bin))
+ goto err;
+ sig_bin_alloc = 1;
+
+ if ((len = EVP_MD_size(md)) < 0)
+ goto err;
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+
+ if (DSA_sign(md->type, tbs, len, sig_bin.data, &siglen, dsa) != 1)
+ goto bad_key;
} else if (argv[0] == atom_ecdsa) {
#if defined(HAVE_EC)
- EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
- enif_alloc_binary(ECDSA_size(ec), &sig_bin);
- len = EVP_MD_size(md);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
- i = ECDSA_sign(md->type, tbs, len, sig_bin.data, &siglen, ec);
- EC_KEY_free(ec);
+ if ((ec = EVP_PKEY_get1_EC_KEY(pkey)) == NULL)
+ goto err;
+ if ((len = ECDSA_size(ec)) < 0)
+ goto err;
+ if (!enif_alloc_binary((size_t)len, &sig_bin))
+ goto err;
+ sig_bin_alloc = 1;
+
+ len = EVP_MD_size(md);
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, len);
+
+ if (ECDSA_sign(md->type, tbs, len, sig_bin.data, &siglen, ec) != 1)
+ goto bad_key;
#else
- EVP_PKEY_free(pkey);
- return atom_notsup;
+ goto notsup;
#endif
} else {
- goto badarg;
+ goto bad_arg;
}
#endif
- EVP_PKEY_free(pkey);
- if (i == 1) {
- ERL_VALGRIND_MAKE_MEM_DEFINED(sig_bin.data, siglen);
- if (siglen != sig_bin.size) {
- enif_realloc_binary(&sig_bin, siglen);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(sig_bin.data, siglen);
- }
- return enif_make_binary(env, &sig_bin);
- } else {
- enif_release_binary(&sig_bin);
- return atom_error;
+ ERL_VALGRIND_MAKE_MEM_DEFINED(sig_bin.data, siglen);
+ if (siglen != sig_bin.size) {
+ if (!enif_realloc_binary(&sig_bin, siglen))
+ goto err;
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(sig_bin.data, siglen);
}
-
- badarg:
+ ret = enif_make_binary(env, &sig_bin);
+ sig_bin_alloc = 0;
+ goto done;
+
+ bad_key:
+ ret = atom_error;
+ goto done;
+
+ notsup:
+ ret = atom_notsup;
+ goto done;
+
+ bad_arg:
+ err:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ done:
+ if (sig_bin_alloc)
+ enif_release_binary(&sig_bin);
+ if (rsa)
+ RSA_free(rsa);
+ if (dsa)
+ DSA_free(dsa);
+#ifdef HAVE_EC
+ if (ec)
+ EC_KEY_free(ec);
+#endif
#ifdef HAS_EVP_PKEY_CTX
- EVP_PKEY_CTX_free(ctx);
+ if (ctx)
+ EVP_PKEY_CTX_free(ctx);
#endif
- EVP_PKEY_free(pkey);
- return enif_make_badarg(env);
+ if (pkey)
+ EVP_PKEY_free(pkey);
+
+ return ret;
}
ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
{/* (Algorithm, Type, Data|{digest,Digest}, Signature, Key, Options) */
int i;
+ int result;
const EVP_MD *md = NULL;
unsigned char md_value[EVP_MAX_MD_SIZE];
- EVP_PKEY *pkey;
+ EVP_PKEY *pkey = NULL;
#ifdef HAS_EVP_PKEY_CTX
- EVP_PKEY_CTX *ctx;
+ EVP_PKEY_CTX *ctx = NULL;
#else
#endif
PKeySignOptions sig_opt;
ErlNifBinary sig_bin; /* signature */
unsigned char *tbs; /* data to be signed */
size_t tbslen;
+ ERL_NIF_TERM ret;
+ RSA *rsa = NULL;
+ DSA *dsa = NULL;
+#ifdef HAVE_EC
+ EC_KEY *ec = NULL;
+#endif
+#ifdef HAVE_EDDSA
+ EVP_MD_CTX *mdctx = NULL;
+#endif
#ifndef HAS_ENGINE_SUPPORT
- if (enif_is_map(env, argv[4])) {
+ if (enif_is_map(env, argv[4]))
return atom_notsup;
- }
#endif
- if (!enif_inspect_binary(env, argv[3], &sig_bin)) {
+ if (!enif_inspect_binary(env, argv[3], &sig_bin))
return enif_make_badarg(env);
- }
i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen);
- if (i != PKEY_OK) {
- if (i == PKEY_NOTSUP)
- return atom_notsup;
- else
- return enif_make_badarg(env);
+ switch (i) {
+ case PKEY_OK:
+ break;
+ case PKEY_NOTSUP:
+ goto notsup;
+ default:
+ goto bad_arg;
}
i = get_pkey_sign_options(env, argv[0], argv[5], md, &sig_opt);
- if (i != PKEY_OK) {
- if (i == PKEY_NOTSUP)
- return atom_notsup;
- else
- return enif_make_badarg(env);
+ switch (i) {
+ case PKEY_OK:
+ break;
+ case PKEY_NOTSUP:
+ goto notsup;
+ default:
+ goto bad_arg;
}
if (get_pkey_public_key(env, argv[0], argv[4], &pkey) != PKEY_OK) {
- return enif_make_badarg(env);
+ goto bad_arg;
}
#ifdef HAS_EVP_PKEY_CTX
/* printf("EVP interface\r\n");
*/
- ctx = EVP_PKEY_CTX_new(pkey, NULL);
- if (!ctx) goto badarg;
+ if ((ctx = EVP_PKEY_CTX_new(pkey, NULL)) == NULL)
+ goto err;
if (argv[0] != atom_eddsa) {
- if (EVP_PKEY_verify_init(ctx) <= 0) goto badarg;
- if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg;
+ if (EVP_PKEY_verify_init(ctx) != 1)
+ goto err;
+ if (md != NULL) {
+ if (EVP_PKEY_CTX_set_signature_md(ctx, md) != 1)
+ goto err;
+ }
}
if (argv[0] == atom_rsa) {
- if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg;
- if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) {
+ if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) != 1)
+ goto err;
+ if (sig_opt.rsa_padding == RSA_PKCS1_PSS_PADDING) {
if (sig_opt.rsa_mgf1_md != NULL) {
# ifdef HAVE_RSA_MGF1_MD
- if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) <= 0) goto badarg;
+ if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, sig_opt.rsa_mgf1_md) != 1)
+ goto err;
# else
- EVP_PKEY_CTX_free(ctx);
- EVP_PKEY_free(pkey);
- return atom_notsup;
+ goto notsup;
# endif
}
- if (sig_opt.rsa_pss_saltlen > -2
- && EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) <= 0)
- goto badarg;
- }
+ if (sig_opt.rsa_pss_saltlen > -2) {
+ if (EVP_PKEY_CTX_set_rsa_pss_saltlen(ctx, sig_opt.rsa_pss_saltlen) != 1)
+ goto err;
+ }
+ }
}
- if (argv[0] == atom_eddsa) {
+ if (argv[0] == atom_eddsa) {
#ifdef HAVE_EDDSA
- EVP_MD_CTX* mdctx = EVP_MD_CTX_create();
-
- if (!EVP_DigestVerifyInit(mdctx, NULL, NULL, NULL, pkey)) {
- if (mdctx) EVP_MD_CTX_destroy(mdctx);
- goto badarg;
- }
+ if (!FIPS_mode()) {
+ if ((mdctx = EVP_MD_CTX_new()) == NULL)
+ goto err;
- i = EVP_DigestVerify(mdctx, sig_bin.data, sig_bin.size, tbs, tbslen);
- EVP_MD_CTX_destroy(mdctx);
-#else
- goto badarg;
-#endif
+ if (EVP_DigestVerifyInit(mdctx, NULL, NULL, NULL, pkey) != 1)
+ goto err;
+
+ result = EVP_DigestVerify(mdctx, sig_bin.data, sig_bin.size, tbs, tbslen);
}
- else
- {
- if (md != NULL) {
- ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md));
- }
- i = EVP_PKEY_verify(ctx, sig_bin.data, sig_bin.size, tbs, tbslen);
+ else
+#endif
+ goto notsup;
+ } else {
+ if (md != NULL) {
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md));
}
-
- EVP_PKEY_CTX_free(ctx);
+ result = EVP_PKEY_verify(ctx, sig_bin.data, sig_bin.size, tbs, tbslen);
+ }
#else
/*printf("Old interface\r\n");
*/
+ if (tbslen > INT_MAX)
+ goto bad_arg;
+ if (sig_bin.size > INT_MAX)
+ goto bad_arg;
if (argv[0] == atom_rsa) {
- RSA *rsa = EVP_PKEY_get1_RSA(pkey);
- i = RSA_verify(md->type, tbs, tbslen, sig_bin.data, sig_bin.size, rsa);
- RSA_free(rsa);
+ if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL)
+ goto err;
+ result = RSA_verify(md->type, tbs, (unsigned int)tbslen, sig_bin.data, (unsigned int)sig_bin.size, rsa);
} else if (argv[0] == atom_dss) {
- DSA *dsa = EVP_PKEY_get1_DSA(pkey);
- i = DSA_verify(0, tbs, tbslen, sig_bin.data, sig_bin.size, dsa);
- DSA_free(dsa);
+ if ((dsa = EVP_PKEY_get1_DSA(pkey)) == NULL)
+ goto err;
+ result = DSA_verify(0, tbs, (int)tbslen, sig_bin.data, (int)sig_bin.size, dsa);
} else if (argv[0] == atom_ecdsa) {
#if defined(HAVE_EC)
- EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
- i = ECDSA_verify(EVP_MD_type(md), tbs, tbslen, sig_bin.data, sig_bin.size, ec);
- EC_KEY_free(ec);
+ if ((ec = EVP_PKEY_get1_EC_KEY(pkey)) == NULL)
+ goto err;
+ result = ECDSA_verify(EVP_MD_type(md), tbs, (int)tbslen, sig_bin.data, (int)sig_bin.size, ec);
#else
- EVP_PKEY_free(pkey);
- return atom_notsup;
+ goto notsup;
#endif
} else {
- goto badarg;
+ goto bad_arg;
}
#endif
- EVP_PKEY_free(pkey);
- if (i == 1) {
- return atom_true;
- } else {
- return atom_false;
- }
+ ret = (result == 1 ? atom_true : atom_false);
+ goto done;
- badarg:
+ bad_arg:
+ err:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ notsup:
+ ret = atom_notsup;
+
+ done:
#ifdef HAS_EVP_PKEY_CTX
- EVP_PKEY_CTX_free(ctx);
+ if (ctx)
+ EVP_PKEY_CTX_free(ctx);
+#endif
+#ifdef HAVE_EDDSA
+ if (mdctx)
+ EVP_MD_CTX_free(mdctx);
#endif
- EVP_PKEY_free(pkey);
- return enif_make_badarg(env);
+ if (pkey)
+ EVP_PKEY_free(pkey);
+ if (rsa)
+ RSA_free(rsa);
+ if (dsa)
+ DSA_free(dsa);
+#ifdef HAVE_EC
+ if (ec)
+ EC_KEY_free(ec);
+#endif
+
+ return ret;
}
static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM options,
@@ -704,11 +902,9 @@ static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NI
const ERL_NIF_TERM *tpl_terms;
int tpl_arity;
const EVP_MD *opt_md;
- int i;
- if (!enif_is_list(env, options)) {
- return PKEY_BADARG;
- }
+ if (!enif_is_list(env, options))
+ goto bad_arg;
/* defaults */
if (algorithm == atom_rsa) {
@@ -720,98 +916,124 @@ static int get_pkey_crypt_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NI
opt->signature_md = NULL;
}
- if (enif_is_empty_list(env, options)) {
- return PKEY_OK;
- }
+ if (enif_is_empty_list(env, options))
+ return PKEY_OK;
+
+ if (algorithm != atom_rsa)
+ goto bad_arg;
+
+ tail = options;
+ while (enif_get_list_cell(env, tail, &head, &tail)) {
+ if (!enif_get_tuple(env, head, &tpl_arity, &tpl_terms))
+ goto bad_arg;
+ if (tpl_arity != 2)
+ goto bad_arg;
+
+ if (tpl_terms[0] == atom_rsa_padding
+ || tpl_terms[0] == atom_rsa_pad /* Compatibility */
+ ) {
+ if (tpl_terms[1] == atom_rsa_pkcs1_padding) {
+ opt->rsa_padding = RSA_PKCS1_PADDING;
- if (algorithm == atom_rsa) {
- tail = options;
- while (enif_get_list_cell(env, tail, &head, &tail)) {
- if (enif_get_tuple(env, head, &tpl_arity, &tpl_terms) && tpl_arity == 2) {
- if (tpl_terms[0] == atom_rsa_padding
- || tpl_terms[0] == atom_rsa_pad /* Compatibility */
- ) {
- if (tpl_terms[1] == atom_rsa_pkcs1_padding) {
- opt->rsa_padding = RSA_PKCS1_PADDING;
#ifdef HAVE_RSA_OAEP_PADDING
- } else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) {
- opt->rsa_padding = RSA_PKCS1_OAEP_PADDING;
+ } else if (tpl_terms[1] == atom_rsa_pkcs1_oaep_padding) {
+ opt->rsa_padding = RSA_PKCS1_OAEP_PADDING;
#endif
+
#ifdef HAVE_RSA_SSLV23_PADDING
- } else if (tpl_terms[1] == atom_rsa_sslv23_padding) {
- opt->rsa_padding = RSA_SSLV23_PADDING;
+ } else if (tpl_terms[1] == atom_rsa_sslv23_padding) {
+ opt->rsa_padding = RSA_SSLV23_PADDING;
#endif
- } else if (tpl_terms[1] == atom_rsa_x931_padding) {
- opt->rsa_padding = RSA_X931_PADDING;
- } else if (tpl_terms[1] == atom_rsa_no_padding) {
- opt->rsa_padding = RSA_NO_PADDING;
- } else {
- return PKEY_BADARG;
- }
- } else if (tpl_terms[0] == atom_signature_md && enif_is_atom(env, tpl_terms[1])) {
- i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
- if (i != PKEY_OK) {
- return i;
- }
- opt->signature_md = opt_md;
- } else if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) {
+
+ } else if (tpl_terms[1] == atom_rsa_x931_padding) {
+ opt->rsa_padding = RSA_X931_PADDING;
+
+ } else if (tpl_terms[1] == atom_rsa_no_padding) {
+ opt->rsa_padding = RSA_NO_PADDING;
+
+ } else {
+ goto bad_arg;
+ }
+
+ } else if (tpl_terms[0] == atom_signature_md && enif_is_atom(env, tpl_terms[1])) {
+ int i;
+ i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
+ if (i != PKEY_OK) {
+ return i;
+ }
+ opt->signature_md = opt_md;
+
+ } else if (tpl_terms[0] == atom_rsa_mgf1_md && enif_is_atom(env, tpl_terms[1])) {
+ int i;
#ifndef HAVE_RSA_MGF1_MD
- if (tpl_terms[1] != atom_sha)
- return PKEY_NOTSUP;
+ if (tpl_terms[1] != atom_sha)
+ return PKEY_NOTSUP;
#endif
- i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
- if (i != PKEY_OK) {
- return i;
- }
- opt->rsa_mgf1_md = opt_md;
- } else if (tpl_terms[0] == atom_rsa_oaep_label
- && enif_inspect_binary(env, tpl_terms[1], &(opt->rsa_oaep_label))) {
+ i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
+ if (i != PKEY_OK) {
+ return i;
+ }
+ opt->rsa_mgf1_md = opt_md;
+
+ } else if (tpl_terms[0] == atom_rsa_oaep_label
+ && enif_inspect_binary(env, tpl_terms[1], &(opt->rsa_oaep_label))) {
#ifdef HAVE_RSA_OAEP_MD
- continue;
+ continue;
#else
- return PKEY_NOTSUP;
+ return PKEY_NOTSUP;
#endif
- } else if (tpl_terms[0] == atom_rsa_oaep_md && enif_is_atom(env, tpl_terms[1])) {
+
+ } else if (tpl_terms[0] == atom_rsa_oaep_md && enif_is_atom(env, tpl_terms[1])) {
+ int i;
#ifndef HAVE_RSA_OAEP_MD
- if (tpl_terms[1] != atom_sha)
- return PKEY_NOTSUP;
+ if (tpl_terms[1] != atom_sha)
+ return PKEY_NOTSUP;
#endif
- i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
- if (i != PKEY_OK) {
- return i;
- }
- opt->rsa_oaep_md = opt_md;
- } else {
- return PKEY_BADARG;
- }
- } else {
- return PKEY_BADARG;
- }
- }
- } else {
- return PKEY_BADARG;
+ i = get_pkey_digest_type(env, algorithm, tpl_terms[1], &opt_md);
+ if (i != PKEY_OK) {
+ return i;
+ }
+ opt->rsa_oaep_md = opt_md;
+
+ } else {
+ goto bad_arg;
+ }
}
return PKEY_OK;
+
+ bad_arg:
+ return PKEY_BADARG;
}
static size_t size_of_RSA(EVP_PKEY *pkey) {
- size_t tmplen;
- RSA *rsa = EVP_PKEY_get1_RSA(pkey);
- if (rsa == NULL) return 0;
- tmplen = RSA_size(rsa);
- RSA_free(rsa);
- return tmplen;
+ int ret = 0;
+ RSA *rsa = NULL;
+
+ if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL)
+ goto err;
+ ret = RSA_size(rsa);
+
+ err:
+ if (rsa)
+ RSA_free(rsa);
+
+ return (ret < 0) ? 0 : (size_t)ret;
}
ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
{/* (Algorithm, Data, PublKey=[E,N]|[E,N,D]|[E,N,D,P1,P2,E1,E2,C], Options, IsPrivate, IsEncrypt) */
+ ERL_NIF_TERM ret;
int i;
- EVP_PKEY *pkey;
+ int result = 0;
+ int tmp_bin_alloc = 0;
+ int out_bin_alloc = 0;
+ EVP_PKEY *pkey = NULL;
#ifdef HAS_EVP_PKEY_CTX
- EVP_PKEY_CTX *ctx;
+ EVP_PKEY_CTX *ctx = NULL;
#else
- RSA *rsa;
+ int len;
+ RSA *rsa = NULL;
#endif
PKeyCryptOptions crypt_opt;
ErlNifBinary in_bin, out_bin, tmp_bin;
@@ -819,164 +1041,174 @@ ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
#ifdef HAVE_RSA_SSLV23_PADDING
size_t tmplen;
#endif
- int is_private = (argv[4] == atom_true),
- is_encrypt = (argv[5] == atom_true);
+ int is_private, is_encrypt;
int algo_init = 0;
+ unsigned char *label_copy = NULL;
+
+ ASSERT(argc == 6);
+
+ is_private = (argv[4] == atom_true);
+ is_encrypt = (argv[5] == atom_true);
/* char algo[1024]; */
#ifndef HAS_ENGINE_SUPPORT
- if (enif_is_map(env, argv[2])) {
+ if (enif_is_map(env, argv[2]))
return atom_notsup;
- }
#endif
- if (!enif_inspect_binary(env, argv[1], &in_bin)) {
- return enif_make_badarg(env);
- }
+ if (!enif_inspect_binary(env, argv[1], &in_bin))
+ goto bad_arg;
i = get_pkey_crypt_options(env, argv[0], argv[3], &crypt_opt);
- if (i != PKEY_OK) {
- if (i == PKEY_NOTSUP)
- return atom_notsup;
- else
- return enif_make_badarg(env);
+ switch (i) {
+ case PKEY_OK:
+ break;
+ case PKEY_NOTSUP:
+ goto notsup;
+ default:
+ goto bad_arg;
}
if (is_private) {
- if (get_pkey_private_key(env, argv[0], argv[2], &pkey) != PKEY_OK) {
- return enif_make_badarg(env);
- }
+ if (get_pkey_private_key(env, argv[0], argv[2], &pkey) != PKEY_OK)
+ goto bad_arg;
} else {
- if (get_pkey_public_key(env, argv[0], argv[2], &pkey) != PKEY_OK) {
- return enif_make_badarg(env);
- }
+ if (get_pkey_public_key(env, argv[0], argv[2], &pkey) != PKEY_OK)
+ goto bad_arg;
}
- out_bin.data = NULL;
- out_bin.size = 0;
- tmp_bin.data = NULL;
- tmp_bin.size = 0;
-
#ifdef HAS_EVP_PKEY_CTX
- ctx = EVP_PKEY_CTX_new(pkey, NULL);
- if (!ctx) goto badarg;
+ if ((ctx = EVP_PKEY_CTX_new(pkey, NULL)) == NULL)
+ goto err;
/* enif_get_atom(env,argv[0],algo,1024,ERL_NIF_LATIN1); */
if (is_private) {
if (is_encrypt) {
/* private encrypt */
- if ((algo_init=EVP_PKEY_sign_init(ctx)) <= 0) {
- /* fprintf(stderr,"BADARG %s private encrypt algo_init=%d %s:%d\r\n", algo, algo_init, __FILE__, __LINE__); */
- goto badarg;
- }
+ if ((algo_init = EVP_PKEY_sign_init(ctx)) != 1)
+ goto bad_arg;
} else {
/* private decrypt */
- if ((algo_init=EVP_PKEY_decrypt_init(ctx)) <= 0) {
- /* fprintf(stderr,"BADARG %s private decrypt algo_init=%d %s:%d\r\n", algo, algo_init, __FILE__, __LINE__); */
- goto badarg;
- }
+ if ((algo_init = EVP_PKEY_decrypt_init(ctx)) != 1)
+ goto bad_arg;
}
} else {
if (is_encrypt) {
/* public encrypt */
- if ((algo_init=EVP_PKEY_encrypt_init(ctx)) <= 0) {
- /* fprintf(stderr,"BADARG %s public encrypt algo_init=%d %s:%d\r\n", algo,algo_init,__FILE__, __LINE__); */
- goto badarg;
- }
+ if ((algo_init = EVP_PKEY_encrypt_init(ctx)) != 1)
+ goto bad_arg;
} else {
/* public decrypt */
- if ((algo_init=EVP_PKEY_verify_recover_init(ctx)) <= 0) {
- /* fprintf(stderr,"BADARG %s public decrypt algo_init=%d %s:%d\r\n", algo,algo_init,__FILE__, __LINE__); */
- goto badarg;
- }
+ if ((algo_init = EVP_PKEY_verify_recover_init(ctx)) != 1)
+ goto bad_arg;
}
}
if (argv[0] == atom_rsa) {
- if (crypt_opt.signature_md != NULL
- && EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) <= 0)
- goto badarg;
+ if (crypt_opt.signature_md != NULL) {
+ if (EVP_PKEY_CTX_set_signature_md(ctx, crypt_opt.signature_md) != 1)
+ goto bad_arg;
+ }
+
#ifdef HAVE_RSA_SSLV23_PADDING
- if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) {
- if (is_encrypt) {
+ if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) {
+ if (is_encrypt) {
tmplen = size_of_RSA(pkey);
- if (tmplen == 0) goto badarg;
- if (!enif_alloc_binary(tmplen, &tmp_bin)) goto badarg;
- if (RSA_padding_add_SSLv23(tmp_bin.data, tmplen, in_bin.data, in_bin.size) <= 0)
- goto badarg;
- in_bin = tmp_bin;
- }
- if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) <= 0) goto badarg;
- } else
+ if (tmplen < 1 || tmplen > INT_MAX)
+ goto err;
+ if (!enif_alloc_binary(tmplen, &tmp_bin))
+ goto err;
+ tmp_bin_alloc = 1;
+ if (in_bin.size > INT_MAX)
+ goto err;
+ if (!RSA_padding_add_SSLv23(tmp_bin.data, (int)tmplen, in_bin.data, (int)in_bin.size))
+ goto err;
+ in_bin = tmp_bin;
+ }
+ if (EVP_PKEY_CTX_set_rsa_padding(ctx, RSA_NO_PADDING) != 1)
+ goto err;
+ } else
#endif
- {
- if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) <= 0) goto badarg;
+ {
+ if (EVP_PKEY_CTX_set_rsa_padding(ctx, crypt_opt.rsa_padding) != 1)
+ goto err;
}
+
#ifdef HAVE_RSA_OAEP_MD
- if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) {
- if (crypt_opt.rsa_oaep_md != NULL
- && EVP_PKEY_CTX_set_rsa_oaep_md(ctx, crypt_opt.rsa_oaep_md) <= 0)
- goto badarg;
- if (crypt_opt.rsa_mgf1_md != NULL
- && EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, crypt_opt.rsa_mgf1_md) <= 0) goto badarg;
- if (crypt_opt.rsa_oaep_label.data != NULL && crypt_opt.rsa_oaep_label.size > 0) {
- unsigned char *label_copy = NULL;
- label_copy = OPENSSL_malloc(crypt_opt.rsa_oaep_label.size);
- if (label_copy == NULL) goto badarg;
- memcpy((void *)(label_copy), (const void *)(crypt_opt.rsa_oaep_label.data),
- crypt_opt.rsa_oaep_label.size);
- if (EVP_PKEY_CTX_set0_rsa_oaep_label(ctx, label_copy,
- crypt_opt.rsa_oaep_label.size) <= 0) {
- OPENSSL_free(label_copy);
- label_copy = NULL;
- goto badarg;
- }
- }
- }
+ if (crypt_opt.rsa_padding == RSA_PKCS1_OAEP_PADDING) {
+ if (crypt_opt.rsa_oaep_md != NULL) {
+ if (EVP_PKEY_CTX_set_rsa_oaep_md(ctx, crypt_opt.rsa_oaep_md) != 1)
+ goto err;
+ }
+
+ if (crypt_opt.rsa_mgf1_md != NULL) {
+ if (EVP_PKEY_CTX_set_rsa_mgf1_md(ctx, crypt_opt.rsa_mgf1_md) != 1)
+ goto err;
+ }
+
+ if (crypt_opt.rsa_oaep_label.data != NULL && crypt_opt.rsa_oaep_label.size > 0) {
+ if (crypt_opt.rsa_oaep_label.size > INT_MAX)
+ goto err;
+ if ((label_copy = OPENSSL_malloc(crypt_opt.rsa_oaep_label.size)) == NULL)
+ goto err;
+
+ memcpy((void *)(label_copy), (const void *)(crypt_opt.rsa_oaep_label.data),
+ crypt_opt.rsa_oaep_label.size);
+
+ if (EVP_PKEY_CTX_set0_rsa_oaep_label(ctx, label_copy,
+ (int)crypt_opt.rsa_oaep_label.size) != 1)
+ goto err;
+ /* On success, label_copy is owned by ctx */
+ label_copy = NULL;
+ }
+ }
#endif
}
if (is_private) {
- if (is_encrypt) {
- /* private_encrypt */
- i = EVP_PKEY_sign(ctx, NULL, &outlen, in_bin.data, in_bin.size);
- } else {
- /* private_decrypt */
- i = EVP_PKEY_decrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size);
- }
+ if (is_encrypt) {
+ /* private_encrypt */
+ result = EVP_PKEY_sign(ctx, NULL, &outlen, in_bin.data, in_bin.size);
+ } else {
+ /* private_decrypt */
+ result = EVP_PKEY_decrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size);
+ }
} else {
- if (is_encrypt) {
- /* public_encrypt */
- i = EVP_PKEY_encrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size);
- } else {
- /* public_decrypt */
- i = EVP_PKEY_verify_recover(ctx, NULL, &outlen, in_bin.data, in_bin.size);
- }
+ if (is_encrypt) {
+ /* public_encrypt */
+ result = EVP_PKEY_encrypt(ctx, NULL, &outlen, in_bin.data, in_bin.size);
+ } else {
+ /* public_decrypt */
+ result = EVP_PKEY_verify_recover(ctx, NULL, &outlen, in_bin.data, in_bin.size);
+ }
}
/* fprintf(stderr,"i = %d %s:%d\r\n", i, __FILE__, __LINE__); */
- if (i != 1) goto badarg;
+ if (result != 1)
+ goto err;
- enif_alloc_binary(outlen, &out_bin);
+ if (!enif_alloc_binary(outlen, &out_bin))
+ goto err;
+ out_bin_alloc = 1;
if (is_private) {
- if (is_encrypt) {
- /* private_encrypt */
- i = EVP_PKEY_sign(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size);
- } else {
- /* private_decrypt */
- i = EVP_PKEY_decrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size);
- }
+ if (is_encrypt) {
+ /* private_encrypt */
+ result = EVP_PKEY_sign(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size);
+ } else {
+ /* private_decrypt */
+ result = EVP_PKEY_decrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size);
+ }
} else {
- if (is_encrypt) {
- /* public_encrypt */
- i = EVP_PKEY_encrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size);
- } else {
- /* public_decrypt */
- i = EVP_PKEY_verify_recover(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size);
- }
+ if (is_encrypt) {
+ /* public_encrypt */
+ result = EVP_PKEY_encrypt(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size);
+ } else {
+ /* public_decrypt */
+ result = EVP_PKEY_verify_recover(ctx, out_bin.data, &outlen, in_bin.data, in_bin.size);
+ }
}
#else
@@ -984,149 +1216,187 @@ ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
if (argv[0] != atom_rsa) {
algo_init = -2; /* exitcode: notsup */
- goto badarg;
+ goto bad_arg;
}
- rsa = EVP_PKEY_get1_RSA(pkey);
- enif_alloc_binary(RSA_size(rsa), &out_bin);
+ if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL)
+ goto err;
+ if ((len = RSA_size(rsa)) < 0)
+ goto err;
+ if (!enif_alloc_binary((size_t)len, &out_bin))
+ goto err;
+ out_bin_alloc = 1;
+
+ if (in_bin.size > INT_MAX)
+ goto err;
if (is_private) {
if (is_encrypt) {
/* non-evp rsa private encrypt */
ERL_VALGRIND_ASSERT_MEM_DEFINED(in_bin.data,in_bin.size);
- i = RSA_private_encrypt(in_bin.size, in_bin.data,
+ result = RSA_private_encrypt((int)in_bin.size, in_bin.data,
out_bin.data, rsa, crypt_opt.rsa_padding);
- if (i > 0) {
- ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i);
+ if (result > 0) {
+ ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, result);
}
} else {
/* non-evp rsa private decrypt */
- i = RSA_private_decrypt(in_bin.size, in_bin.data,
+ result = RSA_private_decrypt((int)in_bin.size, in_bin.data,
out_bin.data, rsa, crypt_opt.rsa_padding);
- if (i > 0) {
- ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i);
- enif_realloc_binary(&out_bin, i);
+ if (result > 0) {
+ ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, result);
+ if (!enif_realloc_binary(&out_bin, (size_t)result))
+ goto err;
}
}
} else {
if (is_encrypt) {
/* non-evp rsa public encrypt */
ERL_VALGRIND_ASSERT_MEM_DEFINED(in_bin.data,in_bin.size);
- i = RSA_public_encrypt(in_bin.size, in_bin.data,
+ result = RSA_public_encrypt((int)in_bin.size, in_bin.data,
out_bin.data, rsa, crypt_opt.rsa_padding);
- if (i > 0) {
- ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i);
- }
+ if (result > 0) {
+ ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, result);
+ }
} else {
/* non-evp rsa public decrypt */
- i = RSA_public_decrypt(in_bin.size, in_bin.data,
+ result = RSA_public_decrypt((int)in_bin.size, in_bin.data,
out_bin.data, rsa, crypt_opt.rsa_padding);
- if (i > 0) {
- ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, i);
- enif_realloc_binary(&out_bin, i);
+ if (result > 0) {
+ ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, result);
+ if (!enif_realloc_binary(&out_bin, (size_t)result))
+ goto err;
}
}
}
- outlen = i;
- RSA_free(rsa);
+ outlen = (size_t)result;
#endif
- if ((i > 0) && argv[0] == atom_rsa && !is_encrypt) {
+ if ((result > 0) && argv[0] == atom_rsa && !is_encrypt) {
#ifdef HAVE_RSA_SSLV23_PADDING
- if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) {
- unsigned char *p;
+ if (crypt_opt.rsa_padding == RSA_SSLV23_PADDING) {
+ unsigned char *p;
+
tmplen = size_of_RSA(pkey);
- if (tmplen == 0) goto badarg;
- if (!enif_alloc_binary(tmplen, &tmp_bin))
- goto badarg;
- p = out_bin.data;
- p++;
- i = RSA_padding_check_SSLv23(tmp_bin.data, tmplen, p, out_bin.size - 1, tmplen);
- if (i >= 0) {
- outlen = i;
- in_bin = out_bin;
- out_bin = tmp_bin;
- tmp_bin = in_bin;
- i = 1;
- }
- }
+ if (tmplen < 1 || tmplen > INT_MAX)
+ goto err;
+ if (!enif_alloc_binary(tmplen, &tmp_bin))
+ goto err;
+ tmp_bin_alloc = 1;
+ if (out_bin.size > INT_MAX)
+ goto err;
+
+ p = out_bin.data;
+ p++;
+
+ result = RSA_padding_check_SSLv23(tmp_bin.data, (int)tmplen, p, (int)out_bin.size - 1, (int)tmplen);
+ if (result >= 0) {
+ outlen = (size_t)result;
+ in_bin = out_bin;
+ out_bin = tmp_bin;
+ tmp_bin = in_bin;
+ result = 1;
+ }
+ }
#endif
}
- if (tmp_bin.data != NULL) {
- enif_release_binary(&tmp_bin);
- }
-
-#ifdef HAS_EVP_PKEY_CTX
- EVP_PKEY_CTX_free(ctx);
-#else
-#endif
- EVP_PKEY_free(pkey);
- if (i > 0) {
- ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, outlen);
- if (outlen != out_bin.size) {
- enif_realloc_binary(&out_bin, outlen);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(out_bin.data, outlen);
- }
- return enif_make_binary(env, &out_bin);
+ if (result > 0) {
+ ERL_VALGRIND_MAKE_MEM_DEFINED(out_bin.data, outlen);
+ if (outlen != out_bin.size) {
+ if (!enif_realloc_binary(&out_bin, outlen))
+ goto err;
+ ERL_VALGRIND_ASSERT_MEM_DEFINED(out_bin.data, outlen);
+ }
+ ret = enif_make_binary(env, &out_bin);
+ out_bin_alloc = 0;
} else {
- enif_release_binary(&out_bin);
- return atom_error;
+ ret = atom_error;
}
+ goto done;
+
+ notsup:
+ ret = atom_notsup;
+ goto done;
+
+ bad_arg:
+ err:
+ if (algo_init == -2)
+ ret = atom_notsup;
+ else
+ ret = enif_make_badarg(env);
+
+ done:
+ if (out_bin_alloc)
+ enif_release_binary(&out_bin);
+ if (tmp_bin_alloc)
+ enif_release_binary(&tmp_bin);
- badarg:
- if (out_bin.data != NULL) {
- enif_release_binary(&out_bin);
- }
- if (tmp_bin.data != NULL) {
- enif_release_binary(&tmp_bin);
- }
#ifdef HAS_EVP_PKEY_CTX
- EVP_PKEY_CTX_free(ctx);
+ if (ctx)
+ EVP_PKEY_CTX_free(ctx);
#else
+ if (rsa)
+ RSA_free(rsa);
#endif
- EVP_PKEY_free(pkey);
- if (algo_init == -2)
- return atom_notsup;
- else
- return enif_make_badarg(env);
+ if (pkey)
+ EVP_PKEY_free(pkey);
+
+ if (label_copy)
+ OPENSSL_free(label_copy);
+
+ return ret;
}
ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{ /* (Algorithm, PrivKey | KeyMap) */
- EVP_PKEY *pkey;
- ERL_NIF_TERM alg = argv[0];
+ ERL_NIF_TERM ret;
+ EVP_PKEY *pkey = NULL;
+ RSA *rsa = NULL;
+ DSA *dsa = NULL;
ERL_NIF_TERM result[8];
- if (get_pkey_private_key(env, alg, argv[1], &pkey) != PKEY_OK) {
- return enif_make_badarg(env);
- }
- if (alg == atom_rsa) {
+ ASSERT(argc == 2);
+
+ if (get_pkey_private_key(env, argv[0], argv[1], &pkey) != PKEY_OK)
+ goto bad_arg;
+
+ if (argv[0] == atom_rsa) {
const BIGNUM *n = NULL, *e = NULL, *d = NULL;
- RSA *rsa = EVP_PKEY_get1_RSA(pkey);
- if (rsa) {
- RSA_get0_key(rsa, &n, &e, &d);
- result[0] = bin_from_bn(env, e); // Exponent E
- result[1] = bin_from_bn(env, n); // Modulus N = p*q
- RSA_free(rsa);
- EVP_PKEY_free(pkey);
- return enif_make_list_from_array(env, result, 2);
- }
+
+ if ((rsa = EVP_PKEY_get1_RSA(pkey)) == NULL)
+ goto err;
+
+ RSA_get0_key(rsa, &n, &e, &d);
+
+ // Exponent E
+ if ((result[0] = bin_from_bn(env, e)) == atom_error)
+ goto err;
+ // Modulus N = p*q
+ if ((result[1] = bin_from_bn(env, n)) == atom_error)
+ goto err;
+
+ ret = enif_make_list_from_array(env, result, 2);
} else if (argv[0] == atom_dss) {
const BIGNUM *p = NULL, *q = NULL, *g = NULL, *pub_key = NULL;
- DSA *dsa = EVP_PKEY_get1_DSA(pkey);
- if (dsa) {
- DSA_get0_pqg(dsa, &p, &q, &g);
- DSA_get0_key(dsa, &pub_key, NULL);
- result[0] = bin_from_bn(env, p);
- result[1] = bin_from_bn(env, q);
- result[2] = bin_from_bn(env, g);
- result[3] = bin_from_bn(env, pub_key);
- DSA_free(dsa);
- EVP_PKEY_free(pkey);
- return enif_make_list_from_array(env, result, 4);
- }
+
+ if ((dsa = EVP_PKEY_get1_DSA(pkey)) == NULL)
+ goto err;
+
+ DSA_get0_pqg(dsa, &p, &q, &g);
+ DSA_get0_key(dsa, &pub_key, NULL);
+
+ if ((result[0] = bin_from_bn(env, p)) == atom_error)
+ goto err;
+ if ((result[1] = bin_from_bn(env, q)) == atom_error)
+ goto err;
+ if ((result[2] = bin_from_bn(env, g)) == atom_error)
+ goto err;
+ if ((result[3] = bin_from_bn(env, pub_key)) == atom_error)
+ goto err;
+
+ ret = enif_make_list_from_array(env, result, 4);
} else if (argv[0] == atom_ecdsa) {
#if defined(HAVE_EC)
@@ -1163,8 +1433,24 @@ ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
return enif_make_list_from_array(env, ..., ...);
*/
#endif
+ goto bad_arg;
+ } else {
+ goto bad_arg;
}
- if (pkey) EVP_PKEY_free(pkey);
- return enif_make_badarg(env);
+ goto done;
+
+ bad_arg:
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (rsa)
+ RSA_free(rsa);
+ if (dsa)
+ DSA_free(dsa);
+ if (pkey)
+ EVP_PKEY_free(pkey);
+
+ return ret;
}
diff --git a/lib/crypto/c_src/poly1305.c b/lib/crypto/c_src/poly1305.c
index 3e2bcfa60e..76579c0a29 100644
--- a/lib/crypto/c_src/poly1305.c
+++ b/lib/crypto/c_src/poly1305.c
@@ -25,54 +25,66 @@ ERL_NIF_TERM poly1305_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Key, Text) */
#ifdef HAVE_POLY1305
ErlNifBinary key_bin, text, ret_bin;
- ERL_NIF_TERM ret = atom_error;
+ ERL_NIF_TERM ret;
EVP_PKEY *key = NULL;
EVP_MD_CTX *mctx = NULL;
EVP_PKEY_CTX *pctx = NULL;
const EVP_MD *md = NULL;
size_t size;
- int type;
+ int ret_bin_alloc = 0;
- type = EVP_PKEY_POLY1305;
+ ASSERT(argc == 2);
- if (!enif_inspect_binary(env, argv[0], &key_bin) ||
- !(key_bin.size == 32) ) {
- return enif_make_badarg(env);
- }
-
- if (!enif_inspect_binary(env, argv[1], &text) ) {
- return enif_make_badarg(env);
- }
-
- key = EVP_PKEY_new_raw_private_key(type, /*engine*/ NULL, key_bin.data, key_bin.size);
+ if (!enif_inspect_binary(env, argv[0], &key_bin))
+ goto bad_arg;
+ if (key_bin.size != 32)
+ goto bad_arg;
+ if (!enif_inspect_binary(env, argv[1], &text))
+ goto bad_arg;
- if (!key ||
- !(mctx = EVP_MD_CTX_new()) ||
- !EVP_DigestSignInit(mctx, &pctx, md, /*engine*/ NULL, key) ||
- !EVP_DigestSignUpdate(mctx, text.data, text.size)) {
+ if ((key = EVP_PKEY_new_raw_private_key(EVP_PKEY_POLY1305, /*engine*/ NULL, key_bin.data, key_bin.size)) == NULL)
goto err;
- }
- if (!EVP_DigestSignFinal(mctx, NULL, &size) ||
- !enif_alloc_binary(size, &ret_bin) ||
- !EVP_DigestSignFinal(mctx, ret_bin.data, &size)) {
+ if ((mctx = EVP_MD_CTX_new()) == NULL)
+ goto err;
+ if (EVP_DigestSignInit(mctx, &pctx, md, /*engine*/ NULL, key) != 1)
+ goto err;
+ if (EVP_DigestSignUpdate(mctx, text.data, text.size) != 1)
goto err;
- }
- if ((size != ret_bin.size) &&
- !enif_realloc_binary(&ret_bin, size)) {
+ if (EVP_DigestSignFinal(mctx, NULL, &size) != 1)
+ goto err;
+ if (!enif_alloc_binary(size, &ret_bin))
goto err;
+ ret_bin_alloc = 1;
+ if (EVP_DigestSignFinal(mctx, ret_bin.data, &size) != 1)
+ goto err;
+
+ if (size != ret_bin.size) {
+ if (!enif_realloc_binary(&ret_bin, size))
+ goto err;
}
ret = enif_make_binary(env, &ret_bin);
+ ret_bin_alloc = 0;
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
err:
- EVP_MD_CTX_free(mctx);
- EVP_PKEY_free(key);
+ if (ret_bin_alloc)
+ enif_release_binary(&ret_bin);
+ ret = atom_error;
+
+ done:
+ if (mctx)
+ EVP_MD_CTX_free(mctx);
+ if (key)
+ EVP_PKEY_free(key);
return ret;
#else
- return atom_notsup;
+ return enif_raise_exception(env, atom_notsup);
#endif
}
-
diff --git a/lib/crypto/c_src/rand.c b/lib/crypto/c_src/rand.c
index e71e202f36..3812ae0991 100644
--- a/lib/crypto/c_src/rand.c
+++ b/lib/crypto/c_src/rand.c
@@ -27,73 +27,123 @@ ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
unsigned char* data;
ERL_NIF_TERM ret;
- if (!enif_get_uint(env, argv[0], &bytes)) {
- return enif_make_badarg(env);
- }
- data = enif_make_new_binary(env, bytes, &ret);
- if ( RAND_bytes(data, bytes) != 1) {
- return atom_false;
- }
+ ASSERT(argc == 1);
+
+ if (!enif_get_uint(env, argv[0], &bytes))
+ goto bad_arg;
+ if (bytes > INT_MAX)
+ goto bad_arg;
+
+ if ((data = enif_make_new_binary(env, bytes, &ret)) == NULL)
+ goto err;
+ if (RAND_bytes(data, (int)bytes) != 1)
+ goto err;
+
ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes);
return ret;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ return atom_false;
}
ERL_NIF_TERM strong_rand_range_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Range) */
- BIGNUM *bn_range, *bn_rand;
+ BIGNUM *bn_range = NULL, *bn_rand = NULL;
ERL_NIF_TERM ret;
- if(!get_bn_from_bin(env, argv[0], &bn_range)) {
- return enif_make_badarg(env);
- }
-
- bn_rand = BN_new();
- if (BN_rand_range(bn_rand, bn_range) != 1) {
- ret = atom_false;
- }
- else {
- ret = bin_from_bn(env, bn_rand);
- }
- BN_free(bn_rand);
- BN_free(bn_range);
+ ASSERT(argc == 1);
+
+ if (!get_bn_from_bin(env, argv[0], &bn_range))
+ goto bad_arg;
+
+ if ((bn_rand = BN_new()) == NULL)
+ goto err;
+ if (!BN_rand_range(bn_rand, bn_range))
+ goto err;
+
+ if ((ret = bin_from_bn(env, bn_rand)) == atom_error)
+ goto err;
+ goto done;
+
+ bad_arg:
+ return enif_make_badarg(env);
+
+ err:
+ ret = atom_false;
+
+ done:
+ if (bn_rand)
+ BN_free(bn_rand);
+ if (bn_range)
+ BN_free(bn_range);
return ret;
}
ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Lo,Hi) */
- BIGNUM *bn_from = NULL, *bn_to, *bn_rand;
+ BIGNUM *bn_from = NULL, *bn_to = NULL, *bn_rand = NULL;
unsigned char* data;
- unsigned dlen;
+ int dlen;
ERL_NIF_TERM ret;
- if (!get_bn_from_mpint(env, argv[0], &bn_from)
- || !get_bn_from_mpint(env, argv[1], &bn_rand)) {
- if (bn_from) BN_free(bn_from);
- return enif_make_badarg(env);
- }
-
- bn_to = BN_new();
- BN_sub(bn_to, bn_rand, bn_from);
- BN_pseudo_rand_range(bn_rand, bn_to);
- BN_add(bn_rand, bn_rand, bn_from);
- dlen = BN_num_bytes(bn_rand);
- data = enif_make_new_binary(env, dlen+4, &ret);
- put_int32(data, dlen);
+ ASSERT(argc == 2);
+
+ if (!get_bn_from_mpint(env, argv[0], &bn_from))
+ goto bad_arg;
+ if (!get_bn_from_mpint(env, argv[1], &bn_rand))
+ goto bad_arg;
+
+ if ((bn_to = BN_new()) == NULL)
+ goto err;
+
+ if (!BN_sub(bn_to, bn_rand, bn_from))
+ goto err;
+ if (!BN_pseudo_rand_range(bn_rand, bn_to))
+ goto err;
+ if (!BN_add(bn_rand, bn_rand, bn_from))
+ goto err;
+
+ if ((dlen = BN_num_bytes(bn_rand)) < 0)
+ goto err;
+ if ((data = enif_make_new_binary(env, (size_t)dlen+4, &ret)) == NULL)
+ goto err;
+
+ put_uint32(data, (unsigned int)dlen);
BN_bn2bin(bn_rand, data+4);
ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen);
- BN_free(bn_rand);
- BN_free(bn_from);
- BN_free(bn_to);
+ goto done;
+
+ bad_arg:
+ err:
+ ret = enif_make_badarg(env);
+
+ done:
+ if (bn_rand)
+ BN_free(bn_rand);
+ if (bn_from)
+ BN_free(bn_from);
+ if (bn_to)
+ BN_free(bn_to);
return ret;
}
ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{
+{/* (Seed) */
ErlNifBinary seed_bin;
+ ASSERT(argc == 1);
+
if (!enif_inspect_binary(env, argv[0], &seed_bin))
- return enif_make_badarg(env);
- RAND_seed(seed_bin.data,seed_bin.size);
+ goto bad_arg;
+ if (seed_bin.size > INT_MAX)
+ goto bad_arg;
+
+ RAND_seed(seed_bin.data, (int)seed_bin.size);
return atom_ok;
-}
+ bad_arg:
+ return enif_make_badarg(env);
+}
diff --git a/lib/crypto/c_src/rc4.c b/lib/crypto/c_src/rc4.c
index 483c87b04b..e423661097 100644
--- a/lib/crypto/c_src/rc4.c
+++ b/lib/crypto/c_src/rc4.c
@@ -25,15 +25,27 @@ ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
#ifndef OPENSSL_NO_RC4
ErlNifBinary key;
ERL_NIF_TERM ret;
+ RC4_KEY *rc4_key;
CHECK_NO_FIPS_MODE();
- if (!enif_inspect_iolist_as_binary(env,argv[0], &key)) {
- return enif_make_badarg(env);
- }
- RC4_set_key((RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret),
- key.size, key.data);
+ ASSERT(argc == 1);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &key))
+ goto bad_arg;
+ if (key.size > INT_MAX)
+ goto bad_arg;
+
+ if ((rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret)) == NULL)
+ goto err;
+
+ RC4_set_key(rc4_key, (int)key.size, key.data);
return ret;
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
+
#else
return enif_raise_exception(env, atom_notsup);
#endif
@@ -45,20 +57,34 @@ ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM
ErlNifBinary state, data;
RC4_KEY* rc4_key;
ERL_NIF_TERM new_state, new_data;
+ unsigned char *outp;
CHECK_NO_FIPS_MODE();
- if (!enif_inspect_iolist_as_binary(env,argv[0], &state)
- || state.size != sizeof(RC4_KEY)
- || !enif_inspect_iolist_as_binary(env,argv[1], &data)) {
- return enif_make_badarg(env);
- }
- rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &new_state);
+ ASSERT(argc == 2);
+
+ if (!enif_inspect_iolist_as_binary(env, argv[0], &state))
+ goto bad_arg;
+ if (state.size != sizeof(RC4_KEY))
+ goto bad_arg;
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &data))
+ goto bad_arg;
+
+ if ((rc4_key = (RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &new_state)) == NULL)
+ goto err;
+ if ((outp = enif_make_new_binary(env, data.size, &new_data)) == NULL)
+ goto err;
+
memcpy(rc4_key, state.data, sizeof(RC4_KEY));
- RC4(rc4_key, data.size, data.data,
- enif_make_new_binary(env, data.size, &new_data));
- CONSUME_REDS(env,data);
- return enif_make_tuple2(env,new_state,new_data);
+ RC4(rc4_key, data.size, data.data, outp);
+
+ CONSUME_REDS(env, data);
+ return enif_make_tuple2(env, new_state, new_data);
+
+ bad_arg:
+ err:
+ return enif_make_badarg(env);
+
#else
return enif_raise_exception(env, atom_notsup);
#endif
diff --git a/lib/crypto/c_src/rsa.c b/lib/crypto/c_src/rsa.c
index 92867671fb..e9f29aa496 100644
--- a/lib/crypto/c_src/rsa.c
+++ b/lib/crypto/c_src/rsa.c
@@ -29,89 +29,167 @@ int get_rsa_private_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa)
{
/* key=[E,N,D]|[E,N,D,P1,P2,E1,E2,C] */
ERL_NIF_TERM head, tail;
- BIGNUM *e, *n, *d;
- BIGNUM *p, *q;
- BIGNUM *dmp1, *dmq1, *iqmp;
-
- if (!enif_get_list_cell(env, key, &head, &tail)
- || !get_bn_from_bin(env, head, &e)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &n)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &d)) {
- return 0;
- }
- (void) RSA_set0_key(rsa, n, e, d);
- if (enif_is_empty_list(env, tail)) {
- return 1;
- }
- if (!enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &p)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &q)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dmp1)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &dmq1)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &iqmp)
- || !enif_is_empty_list(env, tail)) {
- return 0;
- }
- (void) RSA_set0_factors(rsa, p, q);
- (void) RSA_set0_crt_params(rsa, dmp1, dmq1, iqmp);
+ BIGNUM *e = NULL, *n = NULL, *d = NULL;
+ BIGNUM *p = NULL, *q = NULL;
+ BIGNUM *dmp1 = NULL, *dmq1 = NULL, *iqmp = NULL;
+
+ if (!enif_get_list_cell(env, key, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &e))
+ goto bad_arg;
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &n))
+ goto bad_arg;
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &d))
+ goto bad_arg;
+
+ if (!RSA_set0_key(rsa, n, e, d))
+ goto err;
+ /* rsa now owns n, e, and d */
+ n = NULL;
+ e = NULL;
+ d = NULL;
+
+ if (enif_is_empty_list(env, tail))
+ return 1;
+
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &p))
+ goto bad_arg;
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &q))
+ goto bad_arg;
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &dmp1))
+ goto bad_arg;
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &dmq1))
+ goto bad_arg;
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &iqmp))
+ goto bad_arg;
+ if (!enif_is_empty_list(env, tail))
+ goto bad_arg;
+
+ if (!RSA_set0_factors(rsa, p, q))
+ goto err;
+ /* rsa now owns p and q */
+ p = NULL;
+ q = NULL;
+
+ if (!RSA_set0_crt_params(rsa, dmp1, dmq1, iqmp))
+ goto err;
+ /* rsa now owns dmp1, dmq1, and iqmp */
+ dmp1 = NULL;
+ dmq1 = NULL;
+ iqmp = NULL;
+
return 1;
+
+ bad_arg:
+ err:
+ if (e)
+ BN_free(e);
+ if (n)
+ BN_free(n);
+ if (d)
+ BN_free(d);
+ if (p)
+ BN_free(p);
+ if (q)
+ BN_free(q);
+ if (dmp1)
+ BN_free(dmp1);
+ if (dmq1)
+ BN_free(dmq1);
+ if (iqmp)
+ BN_free(iqmp);
+
+ return 0;
}
int get_rsa_public_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa)
{
/* key=[E,N] */
ERL_NIF_TERM head, tail;
- BIGNUM *e, *n;
+ BIGNUM *e = NULL, *n = NULL;
- if (!enif_get_list_cell(env, key, &head, &tail)
- || !get_bn_from_bin(env, head, &e)
- || !enif_get_list_cell(env, tail, &head, &tail)
- || !get_bn_from_bin(env, head, &n)
- || !enif_is_empty_list(env, tail)) {
- return 0;
- }
+ if (!enif_get_list_cell(env, key, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &e))
+ goto bad_arg;
+ if (!enif_get_list_cell(env, tail, &head, &tail))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, head, &n))
+ goto bad_arg;
+ if (!enif_is_empty_list(env, tail))
+ goto bad_arg;
+
+ if (!RSA_set0_key(rsa, n, e, NULL))
+ goto err;
+ /* rsa now owns n and e */
+ n = NULL;
+ e = NULL;
- (void) RSA_set0_key(rsa, n, e, NULL);
return 1;
+
+ bad_arg:
+ err:
+ if (e)
+ BN_free(e);
+ if (n)
+ BN_free(n);
+
+ return 0;
}
/* Creates a term which can be parsed by get_rsa_private_key(). This is a list of plain integer binaries (not mpints). */
static ERL_NIF_TERM put_rsa_private_key(ErlNifEnv* env, const RSA *rsa)
{
ERL_NIF_TERM result[8];
- const BIGNUM *n, *e, *d, *p, *q, *dmp1, *dmq1, *iqmp;
+ const BIGNUM *n = NULL, *e = NULL, *d = NULL, *p = NULL, *q = NULL, *dmp1 = NULL, *dmq1 = NULL, *iqmp = NULL;
/* Return at least [E,N,D] */
- n = NULL; e = NULL; d = NULL;
RSA_get0_key(rsa, &n, &e, &d);
- result[0] = bin_from_bn(env, e); // Exponent E
- result[1] = bin_from_bn(env, n); // Modulus N = p*q
- result[2] = bin_from_bn(env, d); // Exponent D
+ if ((result[0] = bin_from_bn(env, e)) == atom_error) // Exponent E
+ goto err;
+ if ((result[1] = bin_from_bn(env, n)) == atom_error) // Modulus N = p*q
+ goto err;
+ if ((result[2] = bin_from_bn(env, d)) == atom_error) // Exponent D
+ goto err;
/* Check whether the optional additional parameters are available */
- p = NULL; q = NULL;
RSA_get0_factors(rsa, &p, &q);
- dmp1 = NULL; dmq1 = NULL; iqmp = NULL;
RSA_get0_crt_params(rsa, &dmp1, &dmq1, &iqmp);
if (p && q && dmp1 && dmq1 && iqmp) {
- result[3] = bin_from_bn(env, p); // Factor p
- result[4] = bin_from_bn(env, q); // Factor q
- result[5] = bin_from_bn(env, dmp1); // D mod (p-1)
- result[6] = bin_from_bn(env, dmq1); // D mod (q-1)
- result[7] = bin_from_bn(env, iqmp); // (1/q) mod p
+ if ((result[3] = bin_from_bn(env, p)) == atom_error) // Factor p
+ goto err;
+ if ((result[4] = bin_from_bn(env, q)) == atom_error) // Factor q
+ goto err;
+ if ((result[5] = bin_from_bn(env, dmp1)) == atom_error) // D mod (p-1)
+ goto err;
+ if ((result[6] = bin_from_bn(env, dmq1)) == atom_error) // D mod (q-1)
+ goto err;
+ if ((result[7] = bin_from_bn(env, iqmp)) == atom_error) // (1/q) mod p
+ goto err;
return enif_make_list_from_array(env, result, 8);
} else {
return enif_make_list_from_array(env, result, 3);
}
+
+ err:
+ return enif_make_badarg(env);
}
static int check_erlang_interrupt(int maj, int min, BN_GENCB *ctxt)
@@ -127,62 +205,71 @@ static int check_erlang_interrupt(int maj, int min, BN_GENCB *ctxt)
static ERL_NIF_TERM rsa_generate_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (ModulusSize, PublicExponent) */
+ ERL_NIF_TERM ret;
int modulus_bits;
- BIGNUM *pub_exp, *three;
- RSA *rsa;
- int success;
- ERL_NIF_TERM result;
- BN_GENCB *intr_cb;
+ BIGNUM *pub_exp = NULL, *three = NULL;
+ RSA *rsa = NULL;
+ BN_GENCB *intr_cb = NULL;
#ifndef HAVE_OPAQUE_BN_GENCB
BN_GENCB intr_cb_buf;
#endif
- if (!enif_get_int(env, argv[0], &modulus_bits) || modulus_bits < 256) {
- return enif_make_badarg(env);
- }
+ ASSERT(argc == 2);
- if (!get_bn_from_bin(env, argv[1], &pub_exp)) {
- return enif_make_badarg(env);
- }
+ if (!enif_get_int(env, argv[0], &modulus_bits))
+ goto bad_arg;
+ if (modulus_bits < 256)
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[1], &pub_exp))
+ goto bad_arg;
/* Make sure the public exponent is large enough (at least 3).
* Without this, RSA_generate_key_ex() can run forever. */
- three = BN_new();
- BN_set_word(three, 3);
- success = BN_cmp(pub_exp, three);
- BN_free(three);
- if (success < 0) {
- BN_free(pub_exp);
- return enif_make_badarg(env);
- }
+ if ((three = BN_new()) == NULL)
+ goto err;
+ if (!BN_set_word(three, 3))
+ goto err;
+ if (BN_cmp(pub_exp, three) < 0)
+ goto err;
/* For large keys, prime generation can take many seconds. Set up
* the callback which we use to test whether the process has been
* interrupted. */
#ifdef HAVE_OPAQUE_BN_GENCB
- intr_cb = BN_GENCB_new();
+ if ((intr_cb = BN_GENCB_new()) == NULL)
+ goto err;
#else
intr_cb = &intr_cb_buf;
#endif
BN_GENCB_set(intr_cb, check_erlang_interrupt, env);
- rsa = RSA_new();
- success = RSA_generate_key_ex(rsa, modulus_bits, pub_exp, intr_cb);
- BN_free(pub_exp);
+ if ((rsa = RSA_new()) == NULL)
+ goto err;
-#ifdef HAVE_OPAQUE_BN_GENCB
- BN_GENCB_free(intr_cb);
-#endif
+ if (!RSA_generate_key_ex(rsa, modulus_bits, pub_exp, intr_cb))
+ goto err;
- if (!success) {
- RSA_free(rsa);
- return atom_error;
- }
+ ret = put_rsa_private_key(env, rsa);
+ goto done;
- result = put_rsa_private_key(env, rsa);
- RSA_free(rsa);
+ bad_arg:
+ return enif_make_badarg(env);
- return result;
+ err:
+ ret = atom_error;
+
+ done:
+ if (pub_exp)
+ BN_free(pub_exp);
+ if (three)
+ BN_free(three);
+#ifdef HAVE_OPAQUE_BN_GENCB
+ if (intr_cb)
+ BN_GENCB_free(intr_cb);
+#endif
+ if (rsa)
+ RSA_free(rsa);
+ return ret;
}
ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
diff --git a/lib/crypto/c_src/srp.c b/lib/crypto/c_src/srp.c
index 1552bc8cc1..2979048006 100644
--- a/lib/crypto/c_src/srp.c
+++ b/lib/crypto/c_src/srp.c
@@ -24,57 +24,86 @@
ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Multiplier, Verifier, Generator, Exponent, Prime) */
BIGNUM *bn_verifier = NULL;
- BIGNUM *bn_exponent = NULL, *bn_generator = NULL, *bn_prime = NULL, *bn_multiplier = NULL, *bn_result;
- BN_CTX *bn_ctx;
+ BIGNUM *bn_exponent = NULL, *bn_generator = NULL, *bn_prime = NULL, *bn_multiplier = NULL, *bn_result = NULL;
+ BN_CTX *bn_ctx = NULL;
unsigned char* ptr;
- unsigned dlen;
+ int dlen;
ERL_NIF_TERM ret;
CHECK_NO_FIPS_MODE();
- if (!get_bn_from_bin(env, argv[0], &bn_multiplier)
- || !get_bn_from_bin(env, argv[1], &bn_verifier)
- || !get_bn_from_bin(env, argv[2], &bn_generator)
- || !get_bn_from_bin(env, argv[3], &bn_exponent)
- || !get_bn_from_bin(env, argv[4], &bn_prime)) {
- if (bn_multiplier) BN_free(bn_multiplier);
- if (bn_verifier) BN_free(bn_verifier);
- if (bn_generator) BN_free(bn_generator);
- if (bn_exponent) BN_free(bn_exponent);
- if (bn_prime) BN_free(bn_prime);
- return enif_make_badarg(env);
- }
-
- bn_result = BN_new();
- bn_ctx = BN_CTX_new();
+ ASSERT(argc == 5);
+
+ if (!get_bn_from_bin(env, argv[0], &bn_multiplier))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[1], &bn_verifier))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[2], &bn_generator))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[3], &bn_exponent))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[4], &bn_prime))
+ goto bad_arg;
+
+ if ((bn_result = BN_new()) == NULL)
+ goto err;
+ if ((bn_ctx = BN_CTX_new()) == NULL)
+ goto err;
/* B = k*v + g^b % N */
/* k * v */
- BN_mod_mul(bn_multiplier, bn_multiplier, bn_verifier, bn_prime, bn_ctx);
+ if (!BN_mod_mul(bn_multiplier, bn_multiplier, bn_verifier, bn_prime, bn_ctx))
+ goto err;
/* g^b % N */
- BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx);
+ if (!BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx))
+ goto err;
/* k*v + g^b % N */
- BN_mod_add(bn_result, bn_result, bn_multiplier, bn_prime, bn_ctx);
+ if (!BN_mod_add(bn_result, bn_result, bn_multiplier, bn_prime, bn_ctx))
+ goto err;
/* check that B % N != 0, reuse bn_multiplier */
- BN_nnmod(bn_multiplier, bn_result, bn_prime, bn_ctx);
- if (BN_is_zero(bn_multiplier)) {
- ret = atom_error;
- } else {
- dlen = BN_num_bytes(bn_result);
- ptr = enif_make_new_binary(env, dlen, &ret);
- BN_bn2bin(bn_result, ptr);
- }
- BN_free(bn_result);
- BN_CTX_free(bn_ctx);
- BN_free(bn_prime);
- BN_free(bn_generator);
- BN_free(bn_multiplier);
- BN_free(bn_exponent);
- BN_free(bn_verifier);
+ if (!BN_nnmod(bn_multiplier, bn_result, bn_prime, bn_ctx))
+ goto err;
+
+ if (BN_is_zero(bn_multiplier))
+ goto err;
+
+ if ((dlen = BN_num_bytes(bn_result)) < 0)
+ goto err;
+ if ((ptr = enif_make_new_binary(env, (size_t)dlen, &ret)) == NULL)
+ goto err;
+
+ if (BN_bn2bin(bn_result, ptr) < 0)
+ goto err;
+
+ goto done;
+
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ err:
+ ret = atom_error;
+
+ done:
+ if (bn_multiplier)
+ BN_free(bn_multiplier);
+ if (bn_verifier)
+ BN_free(bn_verifier);
+ if (bn_generator)
+ BN_free(bn_generator);
+ if (bn_exponent)
+ BN_free(bn_exponent);
+ if (bn_prime)
+ BN_free(bn_prime);
+ if (bn_result)
+ BN_free(bn_result);
+ if (bn_ctx)
+ BN_CTX_free(bn_ctx);
+
return ret;
}
@@ -84,80 +113,107 @@ ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
<premaster secret> = (B - (k * g^x)) ^ (a + (u * x)) % N
*/
BIGNUM *bn_exponent = NULL, *bn_a = NULL;
- BIGNUM *bn_u = NULL, *bn_multiplier = NULL, *bn_exp2,
- *bn_base, *bn_prime = NULL, *bn_generator = NULL,
- *bn_B = NULL, *bn_result;
- BN_CTX *bn_ctx;
- unsigned char* ptr;
- unsigned dlen;
+ BIGNUM *bn_u = NULL, *bn_multiplier = NULL, *bn_exp2 = NULL;
+ BIGNUM *bn_base = NULL, *bn_prime = NULL, *bn_generator = NULL;
+ BIGNUM *bn_B = NULL, *bn_result = NULL;
+ BN_CTX *bn_ctx = NULL;
+ unsigned char *ptr;
+ int dlen;
ERL_NIF_TERM ret;
CHECK_NO_FIPS_MODE();
- if (!get_bn_from_bin(env, argv[0], &bn_a)
- || !get_bn_from_bin(env, argv[1], &bn_u)
- || !get_bn_from_bin(env, argv[2], &bn_B)
- || !get_bn_from_bin(env, argv[3], &bn_multiplier)
- || !get_bn_from_bin(env, argv[4], &bn_generator)
- || !get_bn_from_bin(env, argv[5], &bn_exponent)
- || !get_bn_from_bin(env, argv[6], &bn_prime))
- {
- if (bn_exponent) BN_free(bn_exponent);
- if (bn_a) BN_free(bn_a);
- if (bn_u) BN_free(bn_u);
- if (bn_B) BN_free(bn_B);
- if (bn_multiplier) BN_free(bn_multiplier);
- if (bn_generator) BN_free(bn_generator);
- if (bn_prime) BN_free(bn_prime);
- return enif_make_badarg(env);
- }
-
- bn_ctx = BN_CTX_new();
- bn_result = BN_new();
+ ASSERT(argc == 7);
+
+ if (!get_bn_from_bin(env, argv[0], &bn_a))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[1], &bn_u))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[2], &bn_B))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[3], &bn_multiplier))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[4], &bn_generator))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[5], &bn_exponent))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[6], &bn_prime))
+ goto bad_arg;
+
+ if ((bn_ctx = BN_CTX_new()) == NULL)
+ goto err;
+ if ((bn_result = BN_new()) == NULL)
+ goto err;
/* check that B % N != 0 */
- BN_nnmod(bn_result, bn_B, bn_prime, bn_ctx);
- if (BN_is_zero(bn_result)) {
- BN_free(bn_exponent);
- BN_free(bn_a);
- BN_free(bn_generator);
- BN_free(bn_prime);
- BN_free(bn_u);
- BN_free(bn_B);
- BN_CTX_free(bn_ctx);
-
- return atom_error;
- }
+ if (!BN_nnmod(bn_result, bn_B, bn_prime, bn_ctx))
+ goto err;
+ if (BN_is_zero(bn_result))
+ goto err;
/* (B - (k * g^x)) */
- bn_base = BN_new();
- BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx);
- BN_mod_mul(bn_result, bn_multiplier, bn_result, bn_prime, bn_ctx);
- BN_mod_sub(bn_base, bn_B, bn_result, bn_prime, bn_ctx);
+ if ((bn_base = BN_new()) == NULL)
+ goto err;
+ if (!BN_mod_exp(bn_result, bn_generator, bn_exponent, bn_prime, bn_ctx))
+ goto err;
+ if (!BN_mod_mul(bn_result, bn_multiplier, bn_result, bn_prime, bn_ctx))
+ goto err;
+ if (!BN_mod_sub(bn_base, bn_B, bn_result, bn_prime, bn_ctx))
+ goto err;
/* a + (u * x) */
- bn_exp2 = BN_new();
- BN_mul(bn_result, bn_u, bn_exponent, bn_ctx);
- BN_add(bn_exp2, bn_a, bn_result);
+ if ((bn_exp2 = BN_new()) == NULL)
+ goto err;
+ if (!BN_mul(bn_result, bn_u, bn_exponent, bn_ctx))
+ goto err;
+ if (!BN_add(bn_exp2, bn_a, bn_result))
+ goto err;
/* (B - (k * g^x)) ^ (a + (u * x)) % N */
- BN_mod_exp(bn_result, bn_base, bn_exp2, bn_prime, bn_ctx);
-
- dlen = BN_num_bytes(bn_result);
- ptr = enif_make_new_binary(env, dlen, &ret);
- BN_bn2bin(bn_result, ptr);
- BN_free(bn_result);
- BN_CTX_free(bn_ctx);
-
- BN_free(bn_multiplier);
- BN_free(bn_exp2);
- BN_free(bn_u);
- BN_free(bn_exponent);
- BN_free(bn_a);
- BN_free(bn_B);
- BN_free(bn_base);
- BN_free(bn_generator);
- BN_free(bn_prime);
+ if (!BN_mod_exp(bn_result, bn_base, bn_exp2, bn_prime, bn_ctx))
+ goto err;
+
+ if ((dlen = BN_num_bytes(bn_result)) < 0)
+ goto err;
+ if ((ptr = enif_make_new_binary(env, (size_t)dlen, &ret)) == NULL)
+ goto err;
+
+ if (BN_bn2bin(bn_result, ptr) < 0)
+ goto err;
+
+ goto done;
+
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ err:
+ ret = atom_error;
+
+ done:
+ if (bn_a)
+ BN_free(bn_a);
+ if (bn_u)
+ BN_free(bn_u);
+ if (bn_B)
+ BN_free(bn_B);
+ if (bn_multiplier)
+ BN_free(bn_multiplier);
+ if (bn_generator)
+ BN_free(bn_generator);
+ if (bn_exponent)
+ BN_free(bn_exponent);
+ if (bn_prime)
+ BN_free(bn_prime);
+ if (bn_ctx)
+ BN_CTX_free(bn_ctx);
+ if (bn_result)
+ BN_free(bn_result);
+ if (bn_base)
+ BN_free(bn_base);
+ if (bn_exp2)
+ BN_free(bn_exp2);
+
return ret;
}
@@ -167,63 +223,85 @@ ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
<premaster secret> = (A * v^u) ^ b % N
*/
BIGNUM *bn_b = NULL, *bn_verifier = NULL;
- BIGNUM *bn_prime = NULL, *bn_A = NULL, *bn_u = NULL, *bn_base, *bn_result;
- BN_CTX *bn_ctx;
- unsigned char* ptr;
- unsigned dlen;
+ BIGNUM *bn_prime = NULL, *bn_A = NULL, *bn_u = NULL, *bn_base = NULL, *bn_result = NULL;
+ BN_CTX *bn_ctx = NULL;
+ unsigned char *ptr;
+ int dlen;
ERL_NIF_TERM ret;
CHECK_NO_FIPS_MODE();
- if (!get_bn_from_bin(env, argv[0], &bn_verifier)
- || !get_bn_from_bin(env, argv[1], &bn_b)
- || !get_bn_from_bin(env, argv[2], &bn_u)
- || !get_bn_from_bin(env, argv[3], &bn_A)
- || !get_bn_from_bin(env, argv[4], &bn_prime))
- {
- if (bn_verifier) BN_free(bn_verifier);
- if (bn_b) BN_free(bn_b);
- if (bn_u) BN_free(bn_u);
- if (bn_A) BN_free(bn_A);
- if (bn_prime) BN_free(bn_prime);
- return enif_make_badarg(env);
- }
-
- bn_ctx = BN_CTX_new();
- bn_result = BN_new();
+ ASSERT(argc == 5);
- /* check that A % N != 0 */
- BN_nnmod(bn_result, bn_A, bn_prime, bn_ctx);
- if (BN_is_zero(bn_result)) {
- BN_free(bn_b);
- BN_free(bn_verifier);
- BN_free(bn_prime);
- BN_free(bn_A);
- BN_CTX_free(bn_ctx);
+ if (!get_bn_from_bin(env, argv[0], &bn_verifier))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[1], &bn_b))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[2], &bn_u))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[3], &bn_A))
+ goto bad_arg;
+ if (!get_bn_from_bin(env, argv[4], &bn_prime))
+ goto bad_arg;
- return atom_error;
- }
+ if ((bn_ctx = BN_CTX_new()) == NULL)
+ goto err;
+ if ((bn_result = BN_new()) == NULL)
+ goto err;
+
+ /* check that A % N != 0 */
+ if (!BN_nnmod(bn_result, bn_A, bn_prime, bn_ctx))
+ goto err;
+ if (BN_is_zero(bn_result))
+ goto err;
/* (A * v^u) */
- bn_base = BN_new();
- BN_mod_exp(bn_base, bn_verifier, bn_u, bn_prime, bn_ctx);
- BN_mod_mul(bn_base, bn_A, bn_base, bn_prime, bn_ctx);
+ if ((bn_base = BN_new()) == NULL)
+ goto err;
+ if (!BN_mod_exp(bn_base, bn_verifier, bn_u, bn_prime, bn_ctx))
+ goto err;
+ if (!BN_mod_mul(bn_base, bn_A, bn_base, bn_prime, bn_ctx))
+ goto err;
/* (A * v^u) ^ b % N */
- BN_mod_exp(bn_result, bn_base, bn_b, bn_prime, bn_ctx);
-
- dlen = BN_num_bytes(bn_result);
- ptr = enif_make_new_binary(env, dlen, &ret);
- BN_bn2bin(bn_result, ptr);
- BN_free(bn_result);
- BN_CTX_free(bn_ctx);
-
- BN_free(bn_u);
- BN_free(bn_base);
- BN_free(bn_verifier);
- BN_free(bn_prime);
- BN_free(bn_A);
- BN_free(bn_b);
+ if (!BN_mod_exp(bn_result, bn_base, bn_b, bn_prime, bn_ctx))
+ goto err;
+
+ if ((dlen = BN_num_bytes(bn_result)) < 0)
+ goto err;
+ if ((ptr = enif_make_new_binary(env, (size_t)dlen, &ret)) == NULL)
+ goto err;
+
+ if (BN_bn2bin(bn_result, ptr) < 0)
+ goto err;
+
+ goto done;
+
+ bad_arg:
+ ret = enif_make_badarg(env);
+ goto done;
+
+ err:
+ ret = atom_error;
+
+ done:
+ if (bn_verifier)
+ BN_free(bn_verifier);
+ if (bn_b)
+ BN_free(bn_b);
+ if (bn_u)
+ BN_free(bn_u);
+ if (bn_A)
+ BN_free(bn_A);
+ if (bn_prime)
+ BN_free(bn_prime);
+ if (bn_ctx)
+ BN_CTX_free(bn_ctx);
+ if (bn_result)
+ BN_free(bn_result);
+ if (bn_base)
+ BN_free(bn_base);
+
return ret;
}
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 3306fe3d16..83e10c4c78 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -44,6 +44,10 @@
SHA-3 Standard: Permutation-Based Hash and Extendable-Output Functions [FIPS PUB 202]
</url>
</item>
+ <tag>BLAKE2</tag>
+ <item>
+ <url href="https://blake2.net/">BLAKE2 — fast secure hashing</url>
+ </item>
<tag>MD5</tag>
<item>
<url href="http://www.ietf.org/rfc/rfc1321.txt">The MD5 Message Digest Algorithm [RFC 1321]</url>
@@ -189,10 +193,12 @@
<datatype_title>Ciphers</datatype_title>
<datatype>
<name name="stream_cipher"/>
+ <name name="stream_cipher_iv"/>
+ <name name="stream_cipher_no_iv"/>
<desc>
<p>Stream ciphers for
- <seealso marker="#stream_encrypt-2">stream_encrypt/2</seealso> and
- <seealso marker="#stream_decrypt-2">stream_decrypt/2</seealso> .
+ <seealso marker="#stream_init-3">stream_init/3</seealso> and
+ <seealso marker="#stream_init-2">stream_init/2</seealso> .
</p>
</desc>
</datatype>
@@ -210,6 +216,18 @@
</datatype>
<datatype>
+ <name name="alias_cfb"/>
+ <name name="alias_cbc"/>
+ <desc>
+ <p>Names that are replaced by more common names. They may deprecated in futer releases.</p>
+ <p><c>des3_cbc</c> and <c>des_ede3</c> should be replaced by <c>des_ede3_cbc</c></p>
+ <p><c>des_ede3_cbf</c>, <c>des3_cbf</c> and <c>des3_cfb</c> should be replaced by <c>des_ede3_cfb</c>.</p>
+ <p><c>aes_cbc128</c> should be replaced by <c>aes_128_cbc</c>.</p>
+ <p><c>aes_cbc256</c> should be replaced by <c>aes_256_cbc</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
<name name="block_cipher_without_iv"/>
<name name="ecb_cipher"/>
<desc>
@@ -235,6 +253,7 @@
<name name="sha1"/>
<name name="sha2"/>
<name name="sha3"/>
+ <name name="blake2"/>
<desc>
</desc>
</datatype>
diff --git a/lib/crypto/doc/src/engine_keys.xml b/lib/crypto/doc/src/engine_keys.xml
index b28606fb4e..f78bb81bba 100644
--- a/lib/crypto/doc/src/engine_keys.xml
+++ b/lib/crypto/doc/src/engine_keys.xml
@@ -51,7 +51,7 @@
<p>
OTP/Crypto requires that the user provides two or three items of information about the key. The application used
by the user is usually on a higher level, for example in
- <seealso marker="ssl:ssl#key_option_def">SSL</seealso>. If using
+ <seealso marker="ssl:ssl#type-key">SSL</seealso>. If using
the crypto application directly, it is required that:
</p>
<list>
diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml
index 0a3f68ade2..c0b302734e 100644
--- a/lib/crypto/doc/src/notes.xml
+++ b/lib/crypto/doc/src/notes.xml
@@ -31,6 +31,38 @@
</header>
<p>This document describes the changes made to the Crypto application.</p>
+<section><title>Crypto 4.4.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixes a bug that caused <c>crypto:sign</c> and
+ <c>crypto:verify</c> to return the error message
+ <c>badarg</c> instead of <c>notsup</c> in one case. That
+ case was when signing or verifying with eddsa keys (that
+ is, ed15519 or ed448), but only when FIPS was supported
+ and enabled.</p>
+ <p>
+ Own Id: OTP-15634</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Added a crypto benchmark test suite.</p>
+ <p>
+ Own Id: OTP-15447</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Crypto 4.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 6836e30a1b..97a4a7a3f0 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -24,6 +24,7 @@
-export([start/0, stop/0, info_lib/0, info_fips/0, supports/0, enable_fips_mode/1,
version/0, bytes_to_integer/1]).
+-export([cipher_info/1, hash_info/1]).
-export([hash/2, hash_init/1, hash_update/2, hash_final/1]).
-export([sign/4, sign/5, verify/5, verify/6]).
-export([generate_key/2, generate_key/3, compute_key/4]).
@@ -47,6 +48,19 @@
-export([privkey_to_pubkey/2]).
-export([ec_curve/1, ec_curves/0]).
-export([rand_seed/1]).
+
+%% Experiment
+-export([crypto_init/4,
+ crypto_update/2, crypto_update/3,
+ %% Emulates old api:
+ crypto_stream_init/2, crypto_stream_init/3,
+ crypto_stream_encrypt/2,
+ crypto_stream_decrypt/2,
+ crypto_block_encrypt/3, crypto_block_encrypt/4,
+ crypto_block_decrypt/3, crypto_block_decrypt/4
+ ]).
+
+
%% Engine
-export([
engine_get_all_methods/0,
@@ -89,7 +103,8 @@
-export_type([
stream_state/0,
hmac_state/0,
- hash_state/0
+ hash_state/0,
+ crypto_state/0
]).
%% Private. For tests.
@@ -261,17 +276,36 @@
%%%
-type block_cipher_with_iv() :: cbc_cipher()
| cfb_cipher()
- | aes_cbc128
- | aes_cbc256
| aes_ige256
| blowfish_ofb64
- | des3_cbf % cfb misspelled
- | des_ede3
| rc2_cbc .
--type cbc_cipher() :: des_cbc | des3_cbc | aes_cbc | blowfish_cbc .
--type aead_cipher() :: aes_gcm | aes_ccm | chacha20_poly1305 .
--type cfb_cipher() :: aes_cfb128 | aes_cfb8 | blowfish_cfb64 | des3_cfb | des_cfb .
+-type cbc_cipher() :: des_cbc | des_ede3_cbc
+ | blowfish_cbc
+ | aes_cbc | aes_128_cbc | aes_192_cbc | aes_256_cbc
+ | alias_cbc() .
+-type alias_cbc() :: des3_cbc | des_ede3
+ | aes_cbc128 | aes_cbc256 .
+
+-type aead_cipher() :: aes_gcm
+ | aes_128_gcm
+ | aes_192_gcm
+ | aes_256_gcm
+ | aes_ccm
+ | aes_128_ccm
+ | aes_192_ccm
+ | aes_256_ccm
+ | chacha20_poly1305 .
+
+-type cfb_cipher() :: aes_cfb8
+ | aes_cfb128
+ | blowfish_cfb64
+ | des_cfb
+ | des_ede3_cfb
+ | alias_cfb() .
+-type alias_cfb() :: des_ede3_cbf | des3_cbf
+ | des3_cfb .
+
-type block_cipher_without_iv() :: ecb_cipher() .
-type ecb_cipher() :: des_ecb | blowfish_ecb | aes_ecb .
@@ -287,6 +321,7 @@
-type sha1() :: sha .
-type sha2() :: sha224 | sha256 | sha384 | sha512 .
-type sha3() :: sha3_224 | sha3_256 | sha3_384 | sha3_512 .
+-type blake2() :: blake2b | blake2s .
-type compatibility_only_hash() :: md5 | md4 .
@@ -329,11 +364,11 @@ stop() ->
| {macs, Macs}
| {curves, Curves}
| {rsa_opts, RSAopts},
- Hashs :: [sha1() | sha2() | sha3() | ripemd160 | compatibility_only_hash()],
+ Hashs :: [sha1() | sha2() | sha3() | blake2() | ripemd160 | compatibility_only_hash()],
Ciphers :: [stream_cipher()
| block_cipher_with_iv() | block_cipher_without_iv()
| aead_cipher()
- ],
+ ],
PKs :: [rsa | dss | ecdsa | dh | ecdh | ec_gf2m],
Macs :: [hmac | cmac | poly1305],
Curves :: [ec_named_curve() | edwards_curve_dh() | edwards_curve_ed()],
@@ -341,7 +376,7 @@ stop() ->
supports()->
{Hashs, PubKeys, Ciphers, Macs, Curves, RsaOpts} = algorithms(),
[{hashs, Hashs},
- {ciphers, Ciphers},
+ {ciphers, prepend_cipher_aliases(Ciphers)},
{public_keys, PubKeys},
{macs, Macs},
{curves, Curves},
@@ -367,7 +402,12 @@ enable_fips_mode(_) -> ?nif_stub.
%%%
%%%================================================================
--define(HASH_HASH_ALGORITHM, sha1() | sha2() | sha3() | ripemd160 | compatibility_only_hash() ).
+-define(HASH_HASH_ALGORITHM, sha1() | sha2() | sha3() | blake2() | ripemd160 | compatibility_only_hash() ).
+
+-spec hash_info(Type) -> map() when Type :: ?HASH_HASH_ALGORITHM.
+
+hash_info(Type) ->
+ notsup_to_error(hash_info_nif(Type)).
-spec hash(Type, Data) -> Digest when Type :: ?HASH_HASH_ALGORITHM,
Data :: iodata(),
@@ -472,7 +512,7 @@ hmac_final_n(Context, HashLen) ->
Data :: iodata(),
Mac :: binary().
cmac(Type, Key, Data) ->
- notsup_to_error(cmac_nif(Type, Key, Data)).
+ notsup_to_error(cmac_nif(alias(Type), Key, Data)).
-spec cmac(Type, Key, Data, MacLength) ->
Mac when Type :: ?CMAC_CIPHER_ALGORITHM,
@@ -480,8 +520,9 @@ cmac(Type, Key, Data) ->
Data :: iodata(),
MacLength :: integer(),
Mac :: binary().
+
cmac(Type, Key, Data, MacLength) ->
- erlang:binary_part(cmac(Type, Key, Data), 0, MacLength).
+ erlang:binary_part(cmac(alias(Type), Key, Data), 0, MacLength).
%%%---- POLY1305
@@ -496,93 +537,88 @@ poly1305(Key, Data) ->
%%%
%%%================================================================
+-spec cipher_info(Type) -> map() when Type :: block_cipher_with_iv()
+ | aead_cipher()
+ | block_cipher_without_iv().
+cipher_info(Type) ->
+ cipher_info_nif(Type).
+
%%%---- Block ciphers
+%%%----------------------------------------------------------------
-spec block_encrypt(Type::block_cipher_with_iv(), Key::key()|des3_key(), Ivec::binary(), PlainText::iodata()) -> binary();
(Type::aead_cipher(), Key::iodata(), Ivec::binary(), {AAD::binary(), PlainText::iodata()}) ->
{binary(), binary()};
(aes_gcm | aes_ccm, Key::iodata(), Ivec::binary(), {AAD::binary(), PlainText::iodata(), TagLength::1..16}) ->
{binary(), binary()}.
-block_encrypt(Type, Key, Ivec, PlainText) when Type =:= des_cbc;
- Type =:= des_cfb;
- Type =:= blowfish_cbc;
- Type =:= blowfish_cfb64;
- Type =:= blowfish_ofb64;
- Type =:= aes_cbc128;
- Type =:= aes_cfb8;
- Type =:= aes_cfb128;
- Type =:= aes_cbc256;
- Type =:= aes_cbc;
- Type =:= rc2_cbc ->
- block_crypt_nif(Type, Key, Ivec, PlainText, true);
-block_encrypt(Type, Key0, Ivec, PlainText) when Type =:= des3_cbc;
- Type =:= des_ede3 ->
- Key = check_des3_key(Key0),
- block_crypt_nif(des_ede3_cbc, Key, Ivec, PlainText, true);
-block_encrypt(des3_cbf, Key0, Ivec, PlainText) -> % cfb misspelled
- Key = check_des3_key(Key0),
- block_crypt_nif(des_ede3_cbf, Key, Ivec, PlainText, true);
-block_encrypt(des3_cfb, Key0, Ivec, PlainText) ->
+
+block_encrypt(Type, Key, Ivec, Data) ->
+ do_block_encrypt(alias(Type), Key, Ivec, Data).
+
+do_block_encrypt(Type, Key0, Ivec, Data) when Type =:= des_ede3_cbc;
+ Type =:= des_ede3_cfb ->
Key = check_des3_key(Key0),
- block_crypt_nif(des_ede3_cfb, Key, Ivec, PlainText, true);
-block_encrypt(aes_ige256, Key, Ivec, PlainText) ->
+ block_crypt_nif(Type, Key, Ivec, Data, true);
+
+do_block_encrypt(Type, Key, Ivec, PlainText) when Type =:= aes_ige256 ->
notsup_to_error(aes_ige_crypt_nif(Key, Ivec, PlainText, true));
-block_encrypt(Type, Key, Ivec, {AAD, PlainText}) when Type =:= aes_gcm;
- Type =:= aes_ccm ->
- aead_encrypt(Type, Key, Ivec, AAD, PlainText);
-block_encrypt(Type, Key, Ivec, {AAD, PlainText, TagLength}) when Type =:= aes_gcm;
- Type =:= aes_ccm ->
- aead_encrypt(Type, Key, Ivec, AAD, PlainText, TagLength);
-block_encrypt(chacha20_poly1305=Type, Key, Ivec, {AAD, PlainText}) ->
- aead_encrypt(Type, Key, Ivec, AAD, PlainText, 16).
+do_block_encrypt(Type, Key, Ivec, {AAD, PlainText}) when Type =:= chacha20_poly1305 ->
+ aead_encrypt(Type, Key, Ivec, AAD, PlainText, 16);
+
+do_block_encrypt(Type, Key, Ivec, Data) when Type =:= aes_gcm;
+ Type =:= aes_ccm ->
+ case Data of
+ {AAD, PlainText} ->
+ aead_encrypt(Type, Key, Ivec, AAD, PlainText);
+ {AAD, PlainText, TagLength} ->
+ aead_encrypt(Type, Key, Ivec, AAD, PlainText, TagLength)
+ end;
+
+do_block_encrypt(Type, Key, Ivec, PlainText) ->
+ block_crypt_nif(Type, Key, Ivec, PlainText, true).
+
+
+
+-spec block_encrypt(Type::block_cipher_without_iv(), Key::key(), PlainText::iodata()) -> binary().
+
+block_encrypt(Type, Key, PlainText) ->
+ block_crypt_nif(alias(Type), Key, PlainText, true).
+%%%----------------------------------------------------------------
+%%%----------------------------------------------------------------
-spec block_decrypt(Type::block_cipher_with_iv(), Key::key()|des3_key(), Ivec::binary(), Data::iodata()) -> binary();
(Type::aead_cipher(), Key::iodata(), Ivec::binary(),
{AAD::binary(), Data::iodata(), Tag::binary()}) -> binary() | error.
-block_decrypt(Type, Key, Ivec, Data) when Type =:= des_cbc;
- Type =:= des_cfb;
- Type =:= blowfish_cbc;
- Type =:= blowfish_cfb64;
- Type =:= blowfish_ofb64;
- Type =:= aes_cbc;
- Type =:= aes_cbc128;
- Type =:= aes_cfb8;
- Type =:= aes_cfb128;
- Type =:= aes_cbc256;
- Type =:= rc2_cbc ->
- block_crypt_nif(Type, Key, Ivec, Data, false);
-block_decrypt(Type, Key0, Ivec, Data) when Type =:= des3_cbc;
- Type =:= des_ede3 ->
- Key = check_des3_key(Key0),
- block_crypt_nif(des_ede3_cbc, Key, Ivec, Data, false);
-block_decrypt(des3_cbf, Key0, Ivec, Data) -> % cfb misspelled
- Key = check_des3_key(Key0),
- block_crypt_nif(des_ede3_cbf, Key, Ivec, Data, false);
-block_decrypt(des3_cfb, Key0, Ivec, Data) ->
+
+block_decrypt(Type, Key, Ivec, Data) ->
+ do_block_decrypt(alias(Type), Key, Ivec, Data).
+
+do_block_decrypt(Type, Key0, Ivec, Data) when Type =:= des_ede3_cbc;
+ Type =:= des_ede3_cfb ->
Key = check_des3_key(Key0),
- block_crypt_nif(des_ede3_cfb, Key, Ivec, Data, false);
-block_decrypt(aes_ige256, Key, Ivec, Data) ->
+ block_crypt_nif(Type, Key, Ivec, Data, false);
+
+do_block_decrypt(aes_ige256, Key, Ivec, Data) ->
notsup_to_error(aes_ige_crypt_nif(Key, Ivec, Data, false));
-block_decrypt(Type, Key, Ivec, {AAD, Data, Tag}) when Type =:= aes_gcm;
+
+do_block_decrypt(Type, Key, Ivec, {AAD, Data, Tag}) when Type =:= aes_gcm;
Type =:= aes_ccm;
Type =:= chacha20_poly1305 ->
- aead_decrypt(Type, Key, Ivec, AAD, Data, Tag).
-
+ aead_decrypt(Type, Key, Ivec, AAD, Data, Tag);
--spec block_encrypt(Type::block_cipher_without_iv(), Key::key(), PlainText::iodata()) -> binary().
+do_block_decrypt(Type, Key, Ivec, Data) ->
+ block_crypt_nif(Type, Key, Ivec, Data, false).
-block_encrypt(Type, Key, PlainText) ->
- block_crypt_nif(Type, Key, PlainText, true).
-spec block_decrypt(Type::block_cipher_without_iv(), Key::key(), Data::iodata()) -> binary().
block_decrypt(Type, Key, Data) ->
- block_crypt_nif(Type, Key, Data, false).
-
+ block_crypt_nif(alias(Type), Key, Data, false).
+%%%----------------------------------------------------------------
-spec next_iv(Type:: cbc_cipher(), Data) -> NextIVec when % Type :: cbc_cipher(), %des_cbc | des3_cbc | aes_cbc | aes_ige,
Data :: iodata(),
NextIVec :: binary().
@@ -613,18 +649,30 @@ next_iv(Type, Data, _Ivec) ->
-opaque stream_state() :: {stream_cipher(), reference()}.
--type stream_cipher() :: rc4 | aes_ctr | chacha20 .
+-type stream_cipher() :: stream_cipher_iv() | stream_cipher_no_iv() .
+-type stream_cipher_no_iv() :: rc4 .
+-type stream_cipher_iv() :: aes_ctr
+ | aes_128_ctr
+ | aes_192_ctr
+ | aes_256_ctr
+ | chacha20 .
--spec stream_init(Type, Key, IVec) -> State when Type :: aes_ctr | chacha20,
+-spec stream_init(Type, Key, IVec) -> State when Type :: stream_cipher_iv(),
Key :: iodata(),
IVec :: binary(),
State :: stream_state() .
stream_init(aes_ctr, Key, Ivec) ->
{aes_ctr, aes_ctr_stream_init(Key, Ivec)};
+stream_init(aes_128_ctr, Key, Ivec) ->
+ {aes_ctr, aes_ctr_stream_init(Key, Ivec)};
+stream_init(aes_192_ctr, Key, Ivec) ->
+ {aes_ctr, aes_ctr_stream_init(Key, Ivec)};
+stream_init(aes_256_ctr, Key, Ivec) ->
+ {aes_ctr, aes_ctr_stream_init(Key, Ivec)};
stream_init(chacha20, Key, Ivec) ->
{chacha20, chacha20_stream_init(Key,Ivec)}.
--spec stream_init(Type, Key) -> State when Type :: rc4,
+-spec stream_init(Type, Key) -> State when Type :: stream_cipher_no_iv(),
Key :: iodata(),
State :: stream_state() .
stream_init(rc4, Key) ->
@@ -914,7 +962,8 @@ rand_seed_nif(_Seed) -> ?nif_stub.
-type pk_sign_verify_opts() :: [ rsa_sign_verify_opt() ] .
-type rsa_sign_verify_opt() :: {rsa_padding, rsa_sign_verify_padding()}
- | {rsa_pss_saltlen, integer()} .
+ | {rsa_pss_saltlen, integer()}
+ | {rsa_mgf1_md, sha2()}.
-type rsa_sign_verify_padding() :: rsa_pkcs1_padding | rsa_pkcs1_pss_padding
| rsa_x931_padding | rsa_no_padding
@@ -930,7 +979,7 @@ rand_seed_nif(_Seed) -> ?nif_stub.
DigestType :: rsa_digest_type()
| dss_digest_type()
| ecdsa_digest_type(),
- Msg :: binary() | {digest,binary()},
+ Msg :: iodata() | {digest,iodata()},
Key :: rsa_private()
| dss_private()
| [ecdsa_private() | ecdsa_params()]
@@ -949,7 +998,7 @@ sign(Algorithm, Type, Data, Key) ->
| dss_digest_type()
| ecdsa_digest_type()
| none,
- Msg :: binary() | {digest,binary()},
+ Msg :: iodata() | {digest,iodata()},
Key :: rsa_private()
| dss_private()
| [ecdsa_private() | ecdsa_params()]
@@ -978,7 +1027,7 @@ pkey_sign_nif(_Algorithm, _Type, _Digest, _Key, _Options) -> ?nif_stub.
| dss_digest_type()
| ecdsa_digest_type()
| none,
- Msg :: binary() | {digest,binary()},
+ Msg :: iodata() | {digest,iodata()},
Signature :: binary(),
Key :: rsa_public()
| dss_public()
@@ -996,7 +1045,7 @@ verify(Algorithm, Type, Data, Signature, Key) ->
DigestType :: rsa_digest_type()
| dss_digest_type()
| ecdsa_digest_type(),
- Msg :: binary() | {digest,binary()},
+ Msg :: iodata() | {digest,iodata()},
Signature :: binary(),
Key :: rsa_public()
| dss_public()
@@ -1689,6 +1738,7 @@ hash_update(State0, Data, _, MaxBytes) ->
State = notsup_to_error(hash_update_nif(State0, Increment)),
hash_update(State, Rest, erlang:byte_size(Rest), MaxBytes).
+hash_info_nif(_Hash) -> ?nif_stub.
hash_nif(_Hash, _Data) -> ?nif_stub.
hash_init_nif(_Hash) -> ?nif_stub.
hash_update_nif(_State, _Data) -> ?nif_stub.
@@ -1733,6 +1783,8 @@ poly1305_nif(_Key, _Data) -> ?nif_stub.
%% CIPHERS --------------------------------------------------------------------
+cipher_info_nif(_Type) -> ?nif_stub.
+
block_crypt_nif(_Type, _Key, _Ivec, _Text, _IsEncrypt) -> ?nif_stub.
block_crypt_nif(_Type, _Key, _Text, _IsEncrypt) -> ?nif_stub.
@@ -2178,3 +2230,178 @@ check_otp_test_engine(LibDir) ->
{error, notexist}
end
end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% Experimental NG
+%%%
+
+%%% -> {ok,State::ref()} | {error,Reason}
+
+-opaque crypto_state() :: reference() | {any(),any(),any(),any()}.
+
+
+%%%----------------------------------------------------------------
+%%%
+%%% Create and initialize a new state for encryption or decryption
+%%%
+
+-spec crypto_init(Cipher, Key, IV, EncryptFlag) -> {ok,State} | {error,term()} | undefined
+ when Cipher :: stream_cipher()
+ | block_cipher_with_iv()
+ | block_cipher_without_iv() ,
+ Key :: iodata(),
+ IV :: binary(),
+ EncryptFlag :: boolean() | undefined,
+ State :: crypto_state() .
+
+crypto_init(Cipher, Key, IV, EncryptFlag) when is_atom(Cipher),
+ is_binary(Key),
+ is_binary(IV),
+ is_atom(EncryptFlag) ->
+ case ng_crypto_init_nif(alias(Cipher), Key, IV, EncryptFlag) of
+ {error,Error} ->
+ {error,Error};
+ undefined -> % For compatibility function crypto_stream_init/3
+ undefined;
+ Ref when is_reference(Ref) ->
+ {ok,Ref};
+ State when is_tuple(State),
+ size(State)==4 ->
+ {ok,State} % compatibility with old cryptolibs < 1.0.1
+ end.
+
+
+%%%----------------------------------------------------------------
+%%%
+%%% Encrypt/decrypt a sequence of bytes. The sum of the sizes
+%%% of all blocks must be an integer multiple of the crypto's
+%%% blocksize.
+%%%
+
+-spec crypto_update(State, Data) -> {ok,Result} | {error,term()}
+ when State :: crypto_state(),
+ Data :: iodata(),
+ Result :: binary() | {crypto_state(),binary()}.
+crypto_update(State, Data) ->
+ mk_ret(ng_crypto_update_nif(State, Data)).
+
+%%%----------------------------------------------------------------
+%%%
+%%% Encrypt/decrypt a sequence of bytes but change the IV first.
+%%% Not applicable for all modes.
+%%%
+
+-spec crypto_update(State, Data, IV) -> {ok,Result} | {error,term()}
+ when State :: crypto_state(),
+ Data :: iodata(),
+ IV :: binary(),
+ Result :: binary() | {crypto_state(),binary()}.
+crypto_update(State, Data, IV) ->
+ mk_ret(ng_crypto_update_nif(State, Data, IV)).
+
+%%%----------------------------------------------------------------
+%%% Helpers
+mk_ret(R) -> mk_ret(R, []).
+
+mk_ret({error,Error}, _) ->
+ {error,Error};
+mk_ret(Bin, Acc) when is_binary(Bin) ->
+ {ok, iolist_to_binary(lists:reverse([Bin|Acc]))};
+mk_ret({State1,Bin}, Acc) when is_tuple(State1),
+ size(State1) == 4,
+ is_binary(Bin) ->
+ %% compatibility with old cryptolibs < 1.0.1
+ {ok, {State1, iolist_to_binary(lists:reverse([Bin|Acc]))}}.
+
+%%%----------------------------------------------------------------
+%%% NIFs
+ng_crypto_init_nif(_Cipher, _Key, _IVec, _EncryptFlg) -> ?nif_stub.
+ng_crypto_update_nif(_State, _Data) -> ?nif_stub.
+ng_crypto_update_nif(_State, _Data, _IV) -> ?nif_stub.
+
+%%%================================================================
+%%% Compatibility functions to be called by "old" api functions.
+
+%%%--------------------------------
+%%%---- block encrypt/decrypt
+crypto_block_encrypt(Cipher, Key, Data) -> crypto_block_encrypt(Cipher, Key, <<>>, Data).
+crypto_block_decrypt(Cipher, Key, Data) -> crypto_block_decrypt(Cipher, Key, <<>>, Data).
+
+crypto_block_encrypt(Cipher, Key, Ivec, Data) -> crypto_block(Cipher, Key, Ivec, Data, true).
+crypto_block_decrypt(Cipher, Key, Ivec, Data) -> crypto_block(Cipher, Key, Ivec, Data, false).
+
+%% AEAD: use old funcs
+
+%%%---- helper
+crypto_block(Cipher, Key, IV, Data, EncryptFlag) ->
+ case crypto_init(Cipher, iolist_to_binary(Key), iolist_to_binary(IV), EncryptFlag) of
+ {ok, Ref} ->
+ case crypto_update(Ref, Data) of
+ {ok, {_,Bin}} when is_binary(Bin) -> Bin;
+ {ok, Bin} when is_binary(Bin) -> Bin;
+ {error,_} -> error(badarg)
+ end;
+
+ {error,_} -> error(badarg)
+ end.
+
+%%%--------------------------------
+%%%---- stream init, encrypt/decrypt
+
+crypto_stream_init(Cipher, Key) ->
+ crypto_stream_init(Cipher, Key, <<>>).
+
+crypto_stream_init(Cipher, Key0, IV0) ->
+ Key = iolist_to_binary(Key0),
+ IV = iolist_to_binary(IV0),
+ %% First check the argumensts:
+ case crypto_init(Cipher, Key, IV, undefined) of
+ undefined ->
+ {Cipher, {Key, IV}};
+ {error,_} ->
+ {error,badarg}
+ end.
+
+crypto_stream_encrypt(State, PlainText) ->
+ crypto_stream_emulate(State, PlainText, true).
+
+crypto_stream_decrypt(State, CryptoText) ->
+ crypto_stream_emulate(State, CryptoText, false).
+
+
+%%%---- helper
+crypto_stream_emulate({Cipher,{Key,IV}}, Data, EncryptFlag) ->
+ case crypto_init(Cipher, Key, IV, EncryptFlag) of
+ {ok,State} ->
+ crypto_stream_emulate({Cipher,State}, Data, EncryptFlag);
+ {error,_} ->
+ error(badarg)
+ end;
+crypto_stream_emulate({Cipher,State}, Data, _) ->
+ case crypto_update(State, Data) of
+ {ok, {State1,Bin}} when is_binary(Bin) -> {{Cipher,State1},Bin};
+ {ok,Bin} when is_binary(Bin) -> {{Cipher,State},Bin};
+ {error,_} -> error(badarg)
+ end.
+
+
+%%%================================================================
+
+prepend_cipher_aliases(L) ->
+ [des3_cbc, des_ede3, des_ede3_cbf, des3_cbf, des3_cfb, aes_cbc128, aes_cbc256 | L].
+
+
+%%%---- des_ede3_cbc
+alias(des3_cbc) -> des_ede3_cbc;
+alias(des_ede3) -> des_ede3_cbc;
+%%%---- des_ede3_cfb
+alias(des_ede3_cbf) -> des_ede3_cfb;
+alias(des3_cbf) -> des_ede3_cfb;
+alias(des3_cfb) -> des_ede3_cfb;
+%%%---- aes_*_cbc
+alias(aes_cbc128) -> aes_128_cbc;
+alias(aes_cbc256) -> aes_256_cbc;
+
+alias(Alg) -> Alg.
diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile
index 8b320e01a9..988d95a8bc 100644
--- a/lib/crypto/test/Makefile
+++ b/lib/crypto/test/Makefile
@@ -7,7 +7,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
MODULES = \
crypto_bench_SUITE \
- blowfish_SUITE \
crypto_SUITE \
engine_SUITE
diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl
deleted file mode 100644
index a931ebb47e..0000000000
--- a/lib/crypto/test/blowfish_SUITE.erl
+++ /dev/null
@@ -1,300 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2009-2018. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%
--module(blowfish_SUITE).
-
-%% Note: This directive should only be used in test suites.
--compile(export_all).
-
--include_lib("common_test/include/ct.hrl").
-
--define(TIMEOUT, 120000). % 2 min
-
--define(KEY, to_bin("0123456789ABCDEFF0E1D2C3B4A59687")).
--define(IVEC, to_bin("FEDCBA9876543210")).
-%% "7654321 Now is the time for " (includes trailing '\0')
--define(DATA, to_bin("37363534333231204E6F77206973207468652074696D6520666F722000")).
--define(DATA_PADDED, to_bin("37363534333231204E6F77206973207468652074696D6520666F722000000000")).
-
-%% 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 ->
- catch ct:comment("~s",[element(3,hd(crypto:info_lib()))]),
- catch ct:log("crypto:info_lib() -> ~p~n"
- "crypto:supports() -> ~p~n"
- "crypto:version() -> ~p~n"
- ,[crypto:info_lib(), crypto:supports(), crypto:version()]),
- Config;
- _Else ->
- {skip,"Could not start crypto!"}
- 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().
-
-%%--------------------------------------------------------------------
-%% 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, Config0) ->
- Config = lists:keydelete(watchdog, 1, Config0),
- Dog = test_server:timetrap(?TIMEOUT),
- [{watchdog, Dog} | 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) ->
- Dog = ?config(watchdog, Config),
- case Dog of
- undefined ->
- ok;
- _ ->
- test_server:timetrap_cancel(Dog)
- end.
-
-%%--------------------------------------------------------------------
-%% 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
-%%--------------------------------------------------------------------
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
-[{group, fips},
- {group, non_fips}].
-
-groups() ->
- [{fips, [], [no_ecb, no_cbc, no_cfb64, no_ofb64]},
- {non_fips, [], [ecb, cbc, cfb64, ofb64]}].
-
-init_per_group(fips, Config) ->
- case crypto:info_fips() of
- enabled ->
- Config;
- not_enabled ->
- case crypto:enable_fips_mode(true) of
- true ->
- enabled = crypto:info_fips(),
- Config;
- false ->
- {skip, "Failed to enable FIPS mode"}
- end;
- not_supported ->
- {skip, "FIPS mode not supported"}
- end;
-init_per_group(non_fips, Config) ->
- case crypto:info_fips() of
- enabled ->
- true = crypto:enable_fips_mode(false),
- not_enabled = crypto:info_fips(),
- Config;
- _NotEnabled ->
- Config
- end;
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% Test cases start here.
-%%--------------------------------------------------------------------
-
-ecb_test(KeyBytes, ClearBytes, CipherBytes) ->
- {Key, Clear, Cipher} =
- {to_bin(KeyBytes), to_bin(ClearBytes), to_bin(CipherBytes)},
- ?line m(crypto:block_encrypt(blowfish_ecb, Key, Clear), Cipher),
- true.
-
-ecb(doc) ->
- "Test that ECB mode is OK";
-ecb(suite) ->
- [];
-ecb(Config) when is_list(Config) ->
- true = ecb_test("0000000000000000", "0000000000000000", "4EF997456198DD78"),
- true = ecb_test("FFFFFFFFFFFFFFFF", "FFFFFFFFFFFFFFFF", "51866FD5B85ECB8A"),
- true = ecb_test("3000000000000000", "1000000000000001", "7D856F9A613063F2"),
- true = ecb_test("1111111111111111", "1111111111111111", "2466DD878B963C9D"),
- true = ecb_test("0123456789ABCDEF", "1111111111111111", "61F9C3802281B096"),
- true = ecb_test("1111111111111111", "0123456789ABCDEF", "7D0CC630AFDA1EC7"),
- true = ecb_test("0000000000000000", "0000000000000000", "4EF997456198DD78"),
- true = ecb_test("FEDCBA9876543210", "0123456789ABCDEF", "0ACEAB0FC6A0A28D"),
- true = ecb_test("7CA110454A1A6E57", "01A1D6D039776742", "59C68245EB05282B"),
- true = ecb_test("0131D9619DC1376E", "5CD54CA83DEF57DA", "B1B8CC0B250F09A0"),
- true = ecb_test("07A1133E4A0B2686", "0248D43806F67172", "1730E5778BEA1DA4"),
- true = ecb_test("3849674C2602319E", "51454B582DDF440A", "A25E7856CF2651EB"),
- true = ecb_test("04B915BA43FEB5B6", "42FD443059577FA2", "353882B109CE8F1A"),
- true = ecb_test("0113B970FD34F2CE", "059B5E0851CF143A", "48F4D0884C379918"),
- true = ecb_test("0170F175468FB5E6", "0756D8E0774761D2", "432193B78951FC98"),
- true = ecb_test("43297FAD38E373FE", "762514B829BF486A", "13F04154D69D1AE5"),
- true = ecb_test("07A7137045DA2A16", "3BDD119049372802", "2EEDDA93FFD39C79"),
- true = ecb_test("04689104C2FD3B2F", "26955F6835AF609A", "D887E0393C2DA6E3"),
- true = ecb_test("37D06BB516CB7546", "164D5E404F275232", "5F99D04F5B163969"),
- true = ecb_test("1F08260D1AC2465E", "6B056E18759F5CCA", "4A057A3B24D3977B"),
- true = ecb_test("584023641ABA6176", "004BD6EF09176062", "452031C1E4FADA8E"),
- true = ecb_test("025816164629B007", "480D39006EE762F2", "7555AE39F59B87BD"),
- true = ecb_test("49793EBC79B3258F", "437540C8698F3CFA", "53C55F9CB49FC019"),
- true = ecb_test("4FB05E1515AB73A7", "072D43A077075292", "7A8E7BFA937E89A3"),
- true = ecb_test("49E95D6D4CA229BF", "02FE55778117F12A", "CF9C5D7A4986ADB5"),
- true = ecb_test("018310DC409B26D6", "1D9D5C5018F728C2", "D1ABB290658BC778"),
- true = ecb_test("1C587F1C13924FEF", "305532286D6F295A", "55CB3774D13EF201"),
- true = ecb_test("0101010101010101", "0123456789ABCDEF", "FA34EC4847B268B2"),
- true = ecb_test("1F1F1F1F0E0E0E0E", "0123456789ABCDEF", "A790795108EA3CAE"),
- true = ecb_test("E0FEE0FEF1FEF1FE", "0123456789ABCDEF", "C39E072D9FAC631D"),
- true = ecb_test("0000000000000000", "FFFFFFFFFFFFFFFF", "014933E0CDAFF6E4"),
- true = ecb_test("FFFFFFFFFFFFFFFF", "0000000000000000", "F21E9A77B71C49BC"),
- true = ecb_test("0123456789ABCDEF", "0000000000000000", "245946885754369A"),
- true = ecb_test("FEDCBA9876543210", "FFFFFFFFFFFFFFFF", "6B5C5A9C5D9E0A5A"),
- ok.
-
-cbc(doc) ->
- "Test that CBC mode is OK";
-cbc(suite) ->
- [];
-cbc(Config) when is_list(Config) ->
- true = crypto:block_encrypt(blowfish_cbc, ?KEY, ?IVEC, ?DATA_PADDED) =:=
- to_bin("6B77B4D63006DEE605B156E27403979358DEB9E7154616D959F1652BD5FF92CC"),
- ok.
-
-cfb64(doc) ->
- "Test that CFB64 mode is OK";
-cfb64(suite) ->
- [];
-cfb64(Config) when is_list(Config) ->
- true = crypto:block_encrypt(blowfish_cfb64, ?KEY, ?IVEC, ?DATA) =:=
- to_bin("E73214A2822139CAF26ECF6D2EB9E76E3DA3DE04D1517200519D57A6C3"),
- ok.
-
-ofb64(doc) ->
- "Test that OFB64 mode is OK";
-ofb64(suite) ->
- [];
-ofb64(Config) when is_list(Config) ->
- true = crypto:block_encrypt(blowfish_ofb64, ?KEY, ?IVEC, ?DATA) =:=
- to_bin("E73214A2822139CA62B343CC5B65587310DD908D0C241B2263C2CF80DA"),
- ok.
-
-no_ecb(doc) ->
- "Test that ECB mode is disabled";
-no_ecb(suite) ->
- [];
-no_ecb(Config) when is_list(Config) ->
- notsup(fun crypto:block_encrypt/3,
- [blowfish_ecb,
- to_bin("0000000000000000"),
- to_bin("FFFFFFFFFFFFFFFF")]).
-
-no_cbc(doc) ->
- "Test that CBC mode is disabled";
-no_cbc(suite) ->
- [];
-no_cbc(Config) when is_list(Config) ->
- notsup(fun crypto:block_encrypt/4,
- [blowfish_cbc, ?KEY, ?IVEC, ?DATA_PADDED]).
-
-no_cfb64(doc) ->
- "Test that CFB64 mode is disabled";
-no_cfb64(suite) ->
- [];
-no_cfb64(Config) when is_list(Config) ->
- notsup(fun crypto:block_encrypt/4,
- [blowfish_cfb64, ?KEY, ?IVEC, ?DATA]),
- ok.
-
-no_ofb64(doc) ->
- "Test that OFB64 mode is disabled";
-no_ofb64(suite) ->
- [];
-no_ofb64(Config) when is_list(Config) ->
- notsup(fun crypto:block_encrypt/4,
- [blowfish_ofb64, ?KEY, ?IVEC, ?DATA]).
-
-%% Helper functions
-
-%% Assert function fails with notsup error
-notsup(Fun, Args) ->
- ok = try
- {error, {return, apply(Fun, Args)}}
- catch
- error:notsup ->
- ok;
- Class:Error ->
- {error, {Class, Error}}
- end.
-
-
-%% Convert a hexadecimal string to a binary.
--spec(to_bin(L::string()) -> binary()).
-to_bin(L) ->
- to_bin(L, []).
-
-%% @spec dehex(char()) -> integer()
-%% @doc Convert a hex digit to its integer value.
--spec(dehex(char()) -> integer()).
-dehex(C) when C >= $0, C =< $9 ->
- C - $0;
-dehex(C) when C >= $a, C =< $f ->
- C - $a + 10;
-dehex(C) when C >= $A, C =< $F ->
- C - $A + 10.
-
--spec(to_bin(L::string(), list()) -> binary()).
-to_bin([], Acc) ->
- iolist_to_binary(lists:reverse(Acc));
-to_bin([C1, C2 | Rest], Acc) ->
- to_bin(Rest, [(dehex(C1) bsl 4) bor dehex(C2) | Acc]).
-
-m(X,X) -> ok.
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 003e0c58b1..7257f4fb9f 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -40,7 +40,9 @@ all() ->
rand_uniform,
rand_threads,
rand_plugin,
- rand_plugin_s
+ rand_plugin_s,
+ cipher_info,
+ hash_info
].
groups() ->
@@ -56,6 +58,8 @@ groups() ->
{group, sha3_256},
{group, sha3_384},
{group, sha3_512},
+ {group, blake2b},
+ {group, blake2s},
{group, rsa},
{group, dss},
{group, ecdsa},
@@ -99,6 +103,8 @@ groups() ->
{group, rsa},
{group, dss},
{group, ecdsa},
+ {group, no_ed25519},
+ {group, no_ed448},
{group, dh},
{group, ecdh},
{group, no_srp},
@@ -113,8 +119,8 @@ groups() ->
{group, no_blowfish_cfb64},
{group, no_blowfish_ofb64},
{group, aes_cbc128},
- {group, aes_cfb8},
- {group, aes_cfb128},
+ {group, no_aes_cfb8},
+ {group, no_aes_cfb128},
{group, aes_cbc256},
{group, no_aes_ige256},
{group, no_rc2_cbc},
@@ -137,6 +143,8 @@ groups() ->
{sha3_256, [], [hash, hmac]},
{sha3_384, [], [hash, hmac]},
{sha3_512, [], [hash, hmac]},
+ {blake2b, [], [hash, hmac]},
+ {blake2s, [], [hash, hmac]},
{rsa, [], [sign_verify,
public_encrypt,
private_encrypt,
@@ -183,8 +191,16 @@ groups() ->
{chacha20, [], [stream]},
{poly1305, [], [poly1305]},
{aes_cbc, [], [block]},
+ {no_aes_cfb8,[], [no_support, no_block]},
+ {no_aes_cfb128,[], [no_support, no_block]},
{no_md4, [], [no_support, no_hash]},
{no_md5, [], [no_support, no_hash, no_hmac]},
+ {no_ed25519, [], [no_support, no_sign_verify
+ %% Does not work yet: ,public_encrypt, private_encrypt
+ ]},
+ {no_ed448, [], [no_support, no_sign_verify
+ %% Does not work yet: ,public_encrypt, private_encrypt
+ ]},
{no_ripemd160, [], [no_support, no_hash]},
{no_srp, [], [no_support, no_generate_compute]},
{no_des_cbc, [], [no_support, no_block]},
@@ -251,7 +267,7 @@ init_per_group(fips, Config) ->
enabled = crypto:info_fips(),
FIPSConfig;
false ->
- {skip, "Failed to enable FIPS mode"}
+ {fail, "Failed to enable FIPS mode"}
end;
not_supported ->
{skip, "FIPS mode not supported"}
@@ -401,17 +417,6 @@ block() ->
block(Config) when is_list(Config) ->
Fips = proplists:get_bool(fips, Config),
Type = ?config(type, Config),
- %% See comment about EVP_CIPHER_CTX_set_key_length in
- %% block_crypt_nif in crypto.c.
- case {Fips, Type} of
- {true, aes_cfb8} ->
- throw({skip, "Cannot test aes_cfb8 in FIPS mode because of key length issue"});
- {true, aes_cfb128} ->
- throw({skip, "Cannot test aes_cfb128 in FIPS mode because of key length issue"});
- _ ->
- ok
- end,
-
Blocks = lazy_eval(proplists:get_value(block, Config)),
lists:foreach(fun block_cipher/1, Blocks),
lists:foreach(fun block_cipher/1, block_iolistify(Blocks)),
@@ -500,6 +505,13 @@ sign_verify(Config) when is_list(Config) ->
SignVerify = proplists:get_value(sign_verify, Config),
lists:foreach(fun do_sign_verify/1, SignVerify).
+%%--------------------------------------------------------------------
+no_sign_verify() ->
+ [{doc, "Test disabled sign/verify digital signatures"}].
+no_sign_verify(Config) when is_list(Config) ->
+ [SignVerifyHd|_] = proplists:get_value(sign_verify, Config),
+ notsup(fun do_sign_verify/1, [SignVerifyHd]).
+
%%--------------------------------------------------------------------
public_encrypt() ->
[{doc, "Test public_encrypt/decrypt "}].
@@ -587,7 +599,7 @@ use_all_elliptic_curves(_Config) ->
{C,E}
end}
|| Curve <- Curves -- [ed25519, ed448, x25519, x448, ipsec3, ipsec4],
- Hash <- Hashs -- [md4, md5, ripemd160, sha3_224, sha3_256, sha3_384, sha3_512]
+ Hash <- Hashs -- [md4, md5, ripemd160, sha3_224, sha3_256, sha3_384, sha3_512, blake2b, blake2s]
],
Fails =
lists:filter(fun({_,true}) -> false;
@@ -656,6 +668,23 @@ rand_plugin_s(Config) when is_list(Config) ->
rand_plugin_aux(explicit_state).
%%--------------------------------------------------------------------
+cipher_info() ->
+ [{doc, "crypto cipher_info testing"}].
+cipher_info(Config) when is_list(Config) ->
+ #{type := _,key_length := _,iv_length := _,
+ block_size := _,mode := _} = crypto:cipher_info(aes_128_cbc),
+ {'EXIT',_} = (catch crypto:cipher_info(not_a_cipher)),
+ ok.
+
+%%--------------------------------------------------------------------
+hash_info() ->
+ [{doc, "crypto hash_info testing"}].
+hash_info(Config) when is_list(Config) ->
+ #{type := _,size := _,block_size := _} = crypto:hash_info(sha256),
+ {'EXIT',_} = (catch crypto:hash_info(not_a_hash)),
+ ok.
+
+%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
hash(_, [], []) ->
@@ -1438,6 +1467,12 @@ group_config(sha3_384 = Type, Config) ->
group_config(sha3_512 = Type, Config) ->
{Msgs,Digests} = sha3_test_vectors(Type),
[{hash, {Type, Msgs, Digests}}, {hmac, hmac_sha3(Type)} | Config];
+group_config(blake2b = Type, Config) ->
+ {Msgs, Digests} = blake2_test_vectors(Type),
+ [{hash, {Type, Msgs, Digests}}, {hmac, blake2_hmac(Type)} | Config];
+group_config(blake2s = Type, Config) ->
+ {Msgs, Digests} = blake2_test_vectors(Type),
+ [{hash, {Type, Msgs, Digests}}, {hmac, blake2_hmac(Type)} | Config];
group_config(rsa, Config) ->
Msg = rsa_plain(),
Public = rsa_public(),
@@ -1704,6 +1739,71 @@ rfc_1321_md5_digests() ->
hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f"),
hexstr2bin("57edf4a22be3c955ac49da2e2107b67a")].
+
+%% BLAKE2 re-use SHA3 test vectors.
+blake2_test_vectors(blake2b) ->
+ {sha3_msgs(),
+ [ <<186,128,165,63,152,28,77,13,106,39,151,182,159,18,246,233,76,33,47,20,104,90,196,183,75,18,187,111,219,255,162,209,125,135,197,57,42,171,121,45,194,82,213,222,69,51,204,149,24,211,138,168,219,241,146,90,185,35,134,237,212,0,153,35>>
+ , <<120,106,2,247,66,1,89,3,198,198,253,133,37,82,210,114,145,47,71,64,225,88,71,97,138,134,226,23,247,31,84,25,210,94,16,49,175,238,88,83,19,137,100,68,147,78,176,75,144,58,104,91,20,72,183,85,213,111,112,26,254,155,226,206>>
+ , <<114,133,255,62,139,215,104,214,155,230,43,59,241,135,101,163,37,145,127,169,116,74,194,245,130,162,8,80,188,43,17,65,237,27,62,69,40,89,90,204,144,119,43,223,45,55,220,138,71,19,11,68,243,58,2,232,115,14,90,216,225,102,232,136>>
+ , <<206,116,26,197,147,15,227,70,129,17,117,197,34,123,183,191,205,71,244,38,18,250,228,108,8,9,81,79,158,14,58,17,238,23,115,40,113,71,205,234,238,223,245,7,9,170,113,99,65,254,101,36,15,74,214,119,125,107,250,249,114,110,94,82>>
+ , <<152,251,62,251,114,6,253,25,235,246,155,111,49,44,247,182,78,59,148,219,225,161,113,7,145,57,117,167,147,241,119,225,208,119,96,157,127,186,54,60,187,160,13,5,247,170,78,79,168,113,93,100,40,16,76,10,117,100,59,15,243,253,62,175>>
+ ]};
+blake2_test_vectors(blake2s) ->
+ {sha3_msgs(),
+ [ <<80,140,94,140,50,124,20,226,225,167,43,163,78,235,69,47,55,69,139,32,158,214,58,41,77,153,155,76,134,103,89,130>>
+ , <<105,33,122,48,121,144,128,148,225,17,33,208,66,53,74,124,31,85,182,72,44,161,165,30,27,37,13,253,30,208,238,249>>
+ , <<111,77,245,17,106,111,51,46,218,177,217,225,14,232,125,246,85,123,234,182,37,157,118,99,243,188,213,114,44,19,241,137>>
+ , <<53,141,210,237,7,128,212,5,78,118,203,111,58,91,206,40,65,232,226,245,71,67,29,77,9,219,33,182,109,148,31,199>>
+ , <<190,192,192,230,205,229,182,122,203,115,184,31,121,166,122,64,121,174,28,96,218,201,210,102,26,241,142,159,139,80,223,165>>
+ ]}.
+
+blake2_hmac(Type) ->
+ {Ks, Ds, Hs} = lists:unzip3(
+ [ {hexstr2bin(K), hexstr2bin(D), H}
+ || {{K, D}, H} <- lists:zip(blake2_hmac_key_data(), blake2_hmac_hmac(Type)) ]),
+ {Type, Ks, Ds, Hs}.
+
+blake2_hmac_key_data() ->
+ [ {"0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b 0b0b0b0b",
+ "4869205468657265"}
+ , {"4a656665",
+ "7768617420646f2079612077616e7420 666f72206e6f7468696e673f"}
+ , {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaa",
+ "dddddddddddddddddddddddddddddddd dddddddddddddddddddddddddddddddd dddddddddddddddddddddddddddddddd dddd"}
+ , {"0102030405060708090a0b0c0d0e0f10 111213141516171819",
+ "cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd cdcd"}
+ , {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaa",
+ "54657374205573696e67204c61726765 72205468616e20426c6f636b2d53697a 65204b6579202d2048617368204b6579 204669727374"}
+ , {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaa",
+ "54657374205573696e67204c61726765 72205468616e20426c6f636b2d53697a 65204b6579202d2048617368204b6579 204669727374"}
+ , {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaa",
+ "54686973206973206120746573742075 73696e672061206c6172676572207468 616e20626c6f636b2d73697a65206b65 7920616e642061206c61726765722074 68616e20626c6f636b2d73697a652064 6174612e20546865206b6579206e6565 647320746f2062652068617368656420 6265666f7265206265696e6720757365 642062792074686520484d414320616c 676f726974686d2e"}
+ , {"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa aaaaaa",
+ "54686973206973206120746573742075 73696e672061206c6172676572207468 616e20626c6f636b2d73697a65206b65 7920616e642061206c61726765722074 68616e20626c6f636b2d73697a652064 6174612e20546865206b6579206e6565 647320746f2062652068617368656420 6265666f7265206265696e6720757365 642062792074686520484d414320616c 676f726974686d2e"}
+ ].
+
+blake2_hmac_hmac(blake2b) ->
+ [ <<53,138,106,24,73,36,137,79,195,75,238,86,128,238,223,87,216,74,55,187,56,131,47,40,142,59,39,220,99,169,140,200,201,30,118,218,71,107,80,139,198,178,212,8,162,72,133,116,82,144,110,74,32,180,140,107,75,85,210,223,15,225,221,36>>
+ , <<111,248,132,248,221,194,166,88,107,60,152,164,205,110,189,241,78,193,2,4,182,113,0,115,235,88,101,173,227,122,38,67,184,128,124,19,53,209,7,236,219,159,254,174,182,130,140,70,37,186,23,44,102,55,158,252,210,34,194,222,17,114,122,180>>
+ , <<244,59,198,44,122,153,53,60,59,44,96,232,239,36,251,189,66,233,84,120,102,220,156,91,228,237,198,244,167,212,188,10,198,32,194,198,0,52,208,64,240,219,175,134,249,233,205,120,145,160,149,89,94,237,85,226,169,150,33,95,12,21,192,24>>
+ , <<229,219,182,222,47,238,66,161,202,160,110,78,123,132,206,64,143,250,92,74,157,226,99,46,202,118,156,222,136,117,1,76,114,208,114,15,234,245,63,118,230,161,128,53,127,82,141,123,244,132,250,58,20,232,204,31,15,59,173,167,23,180,52,145>>
+ , <<165,75,41,67,178,162,2,39,212,28,164,108,9,69,175,9,188,31,174,251,47,73,137,76,35,174,188,85,127,183,156,72,137,220,167,68,8,220,134,80,134,102,122,237,238,74,49,133,197,58,73,200,11,129,76,76,88,19,234,12,139,56,168,248>>
+ , <<180,214,140,139,182,82,151,170,52,132,168,110,29,51,183,138,70,159,33,234,170,158,212,218,159,236,145,218,71,23,34,61,44,15,163,134,170,47,209,241,255,207,89,23,178,103,84,96,53,237,48,238,164,178,19,162,133,148,211,211,169,179,140,170>>
+ , <<171,52,121,128,166,75,94,130,93,209,14,125,50,253,67,160,26,142,109,234,38,122,185,173,125,145,53,36,82,102,24,146,83,17,175,188,176,196,149,25,203,235,221,112,149,64,168,215,37,251,145,26,194,174,233,178,163,170,67,215,150,18,51,147>>
+ , <<97,220,242,140,166,12,169,92,130,89,147,39,171,215,169,161,152,111,242,219,211,199,73,69,198,227,35,186,203,76,159,26,94,103,82,93,20,186,141,98,36,177,98,229,102,23,21,37,83,3,69,169,178,86,8,178,125,251,163,180,146,115,213,6>>
+ ];
+blake2_hmac_hmac(blake2s) ->
+ [ <<101,168,183,197,204,145,54,212,36,232,44,55,226,112,126,116,233,19,192,101,91,153,199,95,64,237,243,135,69,58,50,96>>
+ , <<144,182,40,30,47,48,56,201,5,106,240,180,167,231,99,202,230,254,93,158,180,56,106,14,201,82,55,137,12,16,79,240>>
+ , <<252,196,245,149,41,80,46,52,195,216,218,63,253,171,130,150,106,44,182,55,255,94,155,215,1,19,92,46,148,105,231,144>>
+ , <<70,68,52,220,190,206,9,93,69,106,29,98,214,236,86,248,152,230,37,163,158,92,82,189,249,77,175,17,27,173,131,170>>
+ , <<210,61,121,57,79,83,213,54,160,150,230,81,68,71,238,170,187,5,222,208,27,227,44,25,55,218,106,143,113,3,188,78>>
+ , <<92,76,83,46,110,69,89,83,133,78,21,16,149,38,110,224,127,213,88,129,190,223,139,57,8,217,95,13,190,54,159,234>>
+ , <<203,96,246,167,145,241,64,191,138,162,229,31,243,88,205,178,204,92,3,51,4,91,127,183,122,186,122,179,176,207,178,55>>
+ , <<190,53,233,217,99,171,215,108,1,184,171,181,22,36,240,209,16,96,16,92,213,22,16,58,114,241,117,214,211,189,30,202>>
+ ].
+
%%% https://www.di-mgt.com.au/sha_testvectors.html
sha3_msgs() ->
["abc",
diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl
index 2a89fa71a3..3416fbd78d 100644
--- a/lib/crypto/test/engine_SUITE.erl
+++ b/lib/crypto/test/engine_SUITE.erl
@@ -345,13 +345,13 @@ engine_list(Config) when is_list(Config) ->
{skip, "OTP Test engine not found"};
{ok, Engine} ->
try
- EngineList0 = crypto:engine_list(),
case crypto:engine_load(<<"dynamic">>,
[{<<"SO_PATH">>, Engine},
<<"LOAD">>],
[]) of
{ok, E} ->
EngineList0 = crypto:engine_list(),
+ false = lists:member(<<"MD5">>, EngineList0),
ok = crypto:engine_add(E),
[<<"MD5">>] = lists:subtract(crypto:engine_list(), EngineList0),
ok = crypto:engine_remove(E),
diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk
index 6a91244715..deba17fb66 100644
--- a/lib/crypto/vsn.mk
+++ b/lib/crypto/vsn.mk
@@ -1 +1 @@
-CRYPTO_VSN = 4.4
+CRYPTO_VSN = 4.4.1
diff --git a/lib/debugger/doc/src/Makefile b/lib/debugger/doc/src/Makefile
index 56d6085e9c..49b5a4be57 100644
--- a/lib/debugger/doc/src/Makefile
+++ b/lib/debugger/doc/src/Makefile
@@ -114,8 +114,7 @@ include $(ERL_TOP)/make/otp_release_targets.mk
release_docs_spec: docs
$(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf"
$(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf"
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
- ($(CP) -rf $(HTMLDIR) "$(RELSYSDIR)/doc")
+ $(INSTALL_DIR_DATA) $(HTMLDIR) "$(RELSYSDIR)/doc/html"
$(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
$(INSTALL_DIR) "$(RELEASE_PATH)/man/man3"
$(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3"
diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl
index 0542e45142..324a44bad8 100644
--- a/lib/debugger/test/int_eval_SUITE.erl
+++ b/lib/debugger/test/int_eval_SUITE.erl
@@ -285,7 +285,10 @@ do_eval(Config, Mod) ->
DataDir = proplists:get_value(data_dir, Config),
ok = file:set_cwd(DataDir),
- {ok,Mod} = compile:file(Mod, [report,debug_info]),
+ %% Turn off type-based optimizations across function calls, as it
+ %% would turn many body-recursive calls into tail-recursive calls,
+ %% which would change the stacktrace.
+ {ok,Mod} = compile:file(Mod, [no_module_opt,report,debug_info]),
{module,Mod} = code:load_file(Mod),
CompiledRes = Mod:Mod(),
ok = io:format("Compiled:\n~p", [CompiledRes]),
diff --git a/lib/dialyzer/doc/src/notes.xml b/lib/dialyzer/doc/src/notes.xml
index 3cf776e566..bc422c43a0 100644
--- a/lib/dialyzer/doc/src/notes.xml
+++ b/lib/dialyzer/doc/src/notes.xml
@@ -32,6 +32,36 @@
<p>This document describes the changes made to the Dialyzer
application.</p>
+<section><title>Dialyzer 3.3.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> Fix a bug that caused Dialyzer to crash when
+ analyzing a contract with a module name differing from
+ the analyzed module's name. The bug was introduced in
+ Erlang/OTP 18. </p>
+ <p>
+ Own Id: OTP-15562 Aux Id: ERL-845 </p>
+ </item>
+ <item>
+ <p> Fix a bug in the handling of the <c>Key</c> argument
+ of <c>lists:{keysearch, keyfind, keymember}</c>. </p>
+ <p>
+ Own Id: OTP-15570</p>
+ </item>
+ <item>
+ <p>Optimize (again) Dialyzer's handling of
+ left-associative use of <c>andalso</c> and <c>orelse</c>
+ in guards.</p>
+ <p>
+ Own Id: OTP-15577 Aux Id: ERL-851, PR-2141, PR-1944 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Dialyzer 3.3.1</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl
index 5587cf2bdf..c4e3c322e5 100644
--- a/lib/dialyzer/src/dialyzer_codeserver.erl
+++ b/lib/dialyzer/src/dialyzer_codeserver.erl
@@ -347,13 +347,11 @@ get_file_contract(Key, ContDict) ->
lookup_mfa_contract(MFA, #codeserver{contracts = ContDict}) ->
ets_dict_find(MFA, ContDict).
--spec lookup_meta_info(module() | mfa(), codeserver()) -> meta_info().
+-spec lookup_meta_info(module() | mfa(), codeserver()) ->
+ {'ok', meta_info()} | 'error'.
lookup_meta_info(MorMFA, #codeserver{fun_meta_info = FunMetaInfo}) ->
- case ets_dict_find(MorMFA, FunMetaInfo) of
- error -> [];
- {ok, PropList} -> PropList
- end.
+ ets_dict_find(MorMFA, FunMetaInfo).
-spec get_contracts(codeserver()) ->
dict:dict(mfa(), dialyzer_contracts:file_contract()).
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index af7f4385ad..9c36d745c3 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -25,7 +25,7 @@
%% get_contract_signature/1,
is_overloaded/1,
process_contract_remote_types/1,
- store_tmp_contract/5]).
+ store_tmp_contract/6]).
-export_type([file_contract/0, plt_contracts/0]).
@@ -146,18 +146,18 @@ process_contract_remote_types(CodeServer) ->
Mods = dialyzer_codeserver:all_temp_modules(CodeServer),
RecordTable = dialyzer_codeserver:get_records_table(CodeServer),
ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer),
- ContractFun =
- fun({{_M, _F, _A}=MFA, {File, TmpContract, Xtra}}, C0) ->
- #tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract,
- {NewCs, C2} = lists:mapfoldl(fun(CFun, C1) ->
- CFun(ExpTypes, RecordTable, C1)
- end, C0, CFuns),
- Args = general_domain(NewCs),
- Contract = #contract{contracts = NewCs, args = Args, forms = Forms},
- {{MFA, {File, Contract, Xtra}}, C2}
- end,
ModuleFun =
fun(ModuleName) ->
+ ContractFun =
+ fun({MFA, {File, TmpContract, Xtra}}, C0) ->
+ #tmp_contract{contract_funs = CFuns, forms = Forms} = TmpContract,
+ {NewCs, C2} = lists:mapfoldl(fun(CFun, C1) ->
+ CFun(ExpTypes, RecordTable, C1)
+ end, C0, CFuns),
+ Args = general_domain(NewCs),
+ Contract = #contract{contracts = NewCs, args = Args, forms = Forms},
+ {{MFA, {File, Contract, Xtra}}, C2}
+ end,
Cache = erl_types:cache__new(),
{ContractMap, CallbackMap} =
dialyzer_codeserver:get_temp_contracts(ModuleName, CodeServer),
@@ -474,26 +474,29 @@ insert_constraints([], Map) -> Map.
-type spec_data() :: {TypeSpec :: [_], Xtra:: [_]}.
--spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) ->
- contracts().
+-spec store_tmp_contract(module(), mfa(), file_line(), spec_data(),
+ contracts(), types()) -> contracts().
-store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecMap, RecordsDict) ->
+store_tmp_contract(Module, MFA, FileLine, {TypeSpec, Xtra}, SpecMap,
+ RecordsDict) ->
%% io:format("contract from form: ~tp\n", [TypeSpec]),
- TmpContract = contract_from_form(TypeSpec, MFA, RecordsDict, FileLine),
+ TmpContract = contract_from_form(TypeSpec, Module, MFA, RecordsDict, FileLine),
%% io:format("contract: ~tp\n", [TmpContract]),
maps:put(MFA, {FileLine, TmpContract, Xtra}, SpecMap).
-contract_from_form(Forms, MFA, RecDict, FileLine) ->
- {CFuns, Forms1} = contract_from_form(Forms, MFA, RecDict, FileLine, [], []),
+contract_from_form(Forms, Module, MFA, RecDict, FileLine) ->
+ {CFuns, Forms1} =
+ contract_from_form(Forms, Module, MFA, RecDict, FileLine, [], []),
#tmp_contract{contract_funs = CFuns, forms = Forms1}.
-contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], MFA, RecDict,
- FileLine, TypeAcc, FormAcc) ->
+contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, MFA,
+ RecDict, FileLine, TypeAcc, FormAcc) ->
TypeFun =
fun(ExpTypes, RecordTable, Cache) ->
{NewType, NewCache} =
try
- from_form_with_check(Form, ExpTypes, MFA, RecordTable, Cache)
+ from_form_with_check(Form, ExpTypes, Module, MFA, RecordTable,
+ Cache)
catch
throw:{error, Msg} ->
{File, Line} = FileLine,
@@ -506,68 +509,74 @@ contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], MFA, RecDict,
end,
NewTypeAcc = [TypeFun | TypeAcc],
NewFormAcc = [{Form, []} | FormAcc],
- contract_from_form(Left, MFA, RecDict, FileLine, NewTypeAcc, NewFormAcc);
+ contract_from_form(Left, Module, MFA, RecDict, FileLine, NewTypeAcc,
+ NewFormAcc);
contract_from_form([{type, _L1, bounded_fun,
[{type, _L2, 'fun', [_, _]} = Form, Constr]}| Left],
- MFA, RecDict, FileLine, TypeAcc, FormAcc) ->
+ Module, MFA, RecDict, FileLine, TypeAcc, FormAcc) ->
TypeFun =
fun(ExpTypes, RecordTable, Cache) ->
{Constr1, VarTable, Cache1} =
- process_constraints(Constr, MFA, RecDict, ExpTypes, RecordTable,
- Cache),
+ process_constraints(Constr, Module, MFA, RecDict, ExpTypes,
+ RecordTable, Cache),
{NewType, NewCache} =
- from_form_with_check(Form, ExpTypes, MFA, RecordTable,
+ from_form_with_check(Form, ExpTypes, Module, MFA, RecordTable,
VarTable, Cache1),
NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType),
{{NewTypeNoVars, Constr1}, NewCache}
end,
NewTypeAcc = [TypeFun | TypeAcc],
NewFormAcc = [{Form, Constr} | FormAcc],
- contract_from_form(Left, MFA, RecDict, FileLine, NewTypeAcc, NewFormAcc);
-contract_from_form([], _MFA, _RecDict, _FileLine, TypeAcc, FormAcc) ->
+ contract_from_form(Left, Module, MFA, RecDict, FileLine, NewTypeAcc,
+ NewFormAcc);
+contract_from_form([], _Mod, _MFA, _RecDict, _FileLine, TypeAcc, FormAcc) ->
{lists:reverse(TypeAcc), lists:reverse(FormAcc)}.
-process_constraints(Constrs, MFA, RecDict, ExpTypes, RecordTable, Cache) ->
- {Init0, NewCache} = initialize_constraints(Constrs, MFA, RecDict, ExpTypes,
- RecordTable, Cache),
+process_constraints(Constrs, Module, MFA, RecDict, ExpTypes, RecordTable,
+ Cache) ->
+ {Init0, NewCache} = initialize_constraints(Constrs, Module, MFA, RecDict,
+ ExpTypes, RecordTable, Cache),
Init = remove_cycles(Init0),
- constraints_fixpoint(Init, MFA, RecDict, ExpTypes, RecordTable, NewCache).
+ constraints_fixpoint(Init, Module, MFA, RecDict, ExpTypes, RecordTable,
+ NewCache).
-initialize_constraints(Constrs, MFA, RecDict, ExpTypes, RecordTable, Cache) ->
- initialize_constraints(Constrs, MFA, RecDict, ExpTypes, RecordTable,
+initialize_constraints(Constrs, Module, MFA, RecDict, ExpTypes, RecordTable,
+ Cache) ->
+ initialize_constraints(Constrs, Module, MFA, RecDict, ExpTypes, RecordTable,
Cache, []).
-initialize_constraints([], _MFA, _RecDict, _ExpTypes, _RecordTable,
+initialize_constraints([], _Module, _MFA, _RecDict, _ExpTypes, _RecordTable,
Cache, Acc) ->
{Acc, Cache};
-initialize_constraints([Constr|Rest], MFA, RecDict, ExpTypes, RecordTable,
- Cache, Acc) ->
+initialize_constraints([Constr|Rest], Module, MFA, RecDict, ExpTypes,
+ RecordTable, Cache, Acc) ->
case Constr of
{type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} ->
VarTable = erl_types:var_table__new(),
{T1, NewCache} =
- final_form(Type1, ExpTypes, MFA, RecordTable, VarTable, Cache),
+ final_form(Type1, ExpTypes, Module, MFA, RecordTable, VarTable, Cache),
Entry = {T1, Type2},
- initialize_constraints(Rest, MFA, RecDict, ExpTypes, RecordTable,
- NewCache, [Entry|Acc]);
+ initialize_constraints(Rest, Module, MFA, RecDict, ExpTypes,
+ RecordTable, NewCache, [Entry|Acc]);
{type, _, constraint, [{atom,_,Name}, List]} ->
N = length(List),
throw({error,
io_lib:format("Unsupported type guard ~tw/~w\n", [Name, N])})
end.
-constraints_fixpoint(Constrs, MFA, RecDict, ExpTypes, RecordTable, Cache) ->
+constraints_fixpoint(Constrs, Module, MFA, RecDict, ExpTypes, RecordTable,
+ Cache) ->
VarTable = erl_types:var_table__new(),
{VarTab, NewCache} =
- constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, RecordTable,
+ constraints_to_dict(Constrs, Module, MFA, RecDict, ExpTypes, RecordTable,
VarTable, Cache),
- constraints_fixpoint(VarTab, MFA, Constrs, RecDict, ExpTypes,
+ constraints_fixpoint(VarTab, Module, MFA, Constrs, RecDict, ExpTypes,
RecordTable, NewCache).
-constraints_fixpoint(OldVarTab, MFA, Constrs, RecDict, ExpTypes,
+constraints_fixpoint(OldVarTab, Module, MFA, Constrs, RecDict, ExpTypes,
RecordTable, Cache) ->
{NewVarTab, NewCache} =
- constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, RecordTable,
+ constraints_to_dict(Constrs, Module, MFA, RecDict, ExpTypes, RecordTable,
OldVarTab, Cache),
case NewVarTab of
OldVarTab ->
@@ -578,19 +587,23 @@ constraints_fixpoint(OldVarTab, MFA, Constrs, RecDict, ExpTypes,
FinalConstrs = maps:fold(Fun, [], NewVarTab),
{FinalConstrs, NewVarTab, NewCache};
_Other ->
- constraints_fixpoint(NewVarTab, MFA, Constrs, RecDict, ExpTypes,
+ constraints_fixpoint(NewVarTab, Module, MFA, Constrs, RecDict, ExpTypes,
RecordTable, NewCache)
end.
-final_form(Form, ExpTypes, MFA, RecordTable, VarTable, Cache) ->
- from_form_with_check(Form, ExpTypes, MFA, RecordTable, VarTable, Cache).
+final_form(Form, ExpTypes, Module, MFA, RecordTable, VarTable, Cache) ->
+ from_form_with_check(Form, ExpTypes, Module, MFA, RecordTable, VarTable,
+ Cache).
-from_form_with_check(Form, ExpTypes, MFA, RecordTable, Cache) ->
+from_form_with_check(Form, ExpTypes, Module, MFA, RecordTable, Cache) ->
VarTable = erl_types:var_table__new(),
- from_form_with_check(Form, ExpTypes, MFA, RecordTable, VarTable, Cache).
+ from_form_with_check(Form, ExpTypes, Module, MFA, RecordTable, VarTable,
+ Cache).
-from_form_with_check(Form, ExpTypes, MFA, RecordTable, VarTable, Cache) ->
- Site = {spec, MFA},
+from_form_with_check(Form, ExpTypes, Module, MFA, RecordTable, VarTable,
+ Cache) ->
+ {_, F, A} = MFA,
+ Site = {spec, {Module, F, A}},
C1 = erl_types:t_check_record_fields(Form, ExpTypes, Site, RecordTable,
VarTable, Cache),
%% The check costs some time, and with the assumption that contracts
@@ -598,22 +611,22 @@ from_form_with_check(Form, ExpTypes, MFA, RecordTable, VarTable, Cache) ->
%% erl_types:t_from_form_check_remote(Form, ExpTypes, MFA, RecordTable),
erl_types:t_from_form(Form, ExpTypes, Site, RecordTable, VarTable, C1).
-constraints_to_dict(Constrs, MFA, RecDict, ExpTypes, RecordTable,
+constraints_to_dict(Constrs, Module, MFA, RecDict, ExpTypes, RecordTable,
VarTab, Cache) ->
{Subtypes, NewCache} =
- constraints_to_subs(Constrs, MFA, RecDict, ExpTypes, RecordTable,
+ constraints_to_subs(Constrs, Module, MFA, RecDict, ExpTypes, RecordTable,
VarTab, Cache, []),
{insert_constraints(Subtypes), NewCache}.
-constraints_to_subs([], _MFA, _RecDict, _ExpTypes, _RecordTable,
+constraints_to_subs([], _Module, _MFA, _RecDict, _ExpTypes, _RecordTable,
_VarTab, Cache, Acc) ->
{Acc, Cache};
-constraints_to_subs([{T1, Form2}|Rest], MFA, RecDict, ExpTypes, RecordTable,
- VarTab, Cache, Acc) ->
+constraints_to_subs([{T1, Form2}|Rest], Module, MFA, RecDict, ExpTypes,
+ RecordTable, VarTab, Cache, Acc) ->
{T2, NewCache} =
- final_form(Form2, ExpTypes, MFA, RecordTable, VarTab, Cache),
+ final_form(Form2, ExpTypes, Module, MFA, RecordTable, VarTab, Cache),
NewAcc = [{subtype, T1, T2}|Acc],
- constraints_to_subs(Rest, MFA, RecDict, ExpTypes, RecordTable,
+ constraints_to_subs(Rest, Module, MFA, RecDict, ExpTypes, RecordTable,
VarTab, NewCache, NewAcc).
%% Replaces variables with '_' when necessary to break up cycles among
@@ -898,6 +911,7 @@ is_remote_types_related(Contract, CSig, Sig, MFA, RecDict) ->
t_from_forms_without_remote([{FType, []}], MFA, RecDict) ->
Site = {spec, MFA},
+ %% FIXME
Type1 = erl_types:t_from_form_without_remote(FType, Site, RecDict),
{ok, erl_types:subst_all_vars_to_any(Type1)};
t_from_forms_without_remote([{_FType, _Constrs}], _MFA, _RecDict) ->
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index ebe4040c34..3fe026b096 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -450,8 +450,9 @@ get_spec_info([{Contract, Ln, [{Id, TypeSpec}]}|Left],
error ->
SpecData = {TypeSpec, Xtra},
NewActiveMap =
- dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData,
- ActiveMap, RecordsMap),
+ dialyzer_contracts:store_tmp_contract(ModName, MFA, {File, Ln},
+ SpecData, ActiveMap,
+ RecordsMap),
{NewSpecMap, NewCallbackMap} =
case Contract of
spec -> {NewActiveMap, CallbackMap};
@@ -599,24 +600,32 @@ collect_attribute([], _Tag, _File) ->
-spec is_suppressed_fun(mfa(), codeserver()) -> boolean().
is_suppressed_fun(MFA, CodeServer) ->
- lookup_fun_property(MFA, nowarn_function, CodeServer).
+ lookup_fun_property(MFA, nowarn_function, CodeServer, false).
-spec is_suppressed_tag(mfa() | module(), dial_warn_tag(), codeserver()) ->
boolean().
is_suppressed_tag(MorMFA, Tag, Codeserver) ->
- not lookup_fun_property(MorMFA, Tag, Codeserver).
-
-lookup_fun_property({M, _F, _A}=MFA, Property, CodeServer) ->
- MFAPropList = dialyzer_codeserver:lookup_meta_info(MFA, CodeServer),
- case proplists:get_value(Property, MFAPropList, no) of
- mod -> false; % suppressed in function
- func -> true; % requested in function
- no -> lookup_fun_property(M, Property, CodeServer)
+ not lookup_fun_property(MorMFA, Tag, Codeserver, true).
+
+lookup_fun_property({M, _F, _A}=MFA, Property, CodeServer, NoInfoReturn) ->
+ case dialyzer_codeserver:lookup_meta_info(MFA, CodeServer) of
+ error ->
+ lookup_fun_property(M, Property, CodeServer, NoInfoReturn);
+ {ok, MFAPropList} ->
+ case proplists:get_value(Property, MFAPropList, no) of
+ mod -> false; % suppressed in function
+ func -> true; % requested in function
+ no -> lookup_fun_property(M, Property, CodeServer, NoInfoReturn)
+ end
end;
-lookup_fun_property(M, Property, CodeServer) when is_atom(M) ->
- MPropList = dialyzer_codeserver:lookup_meta_info(M, CodeServer),
- proplists:is_defined(Property, MPropList).
+lookup_fun_property(M, Property, CodeServer, NoInfoReturn) when is_atom(M) ->
+ case dialyzer_codeserver:lookup_meta_info(M, CodeServer) of
+ error ->
+ NoInfoReturn;
+ {ok, MPropList} ->
+ proplists:is_defined(Property, MPropList)
+ end.
%% ============================================================================
%%
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/para b/lib/dialyzer/test/opaque_SUITE_data/results/para
index 37b5b7b44e..eca445315c 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/para
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/para
@@ -29,5 +29,6 @@ para4.erl:74: Attempt to test for equality between a term of type para4_adt:int(
para4.erl:79: Attempt to test for equality between a term of type para4_adt:int(2 | 3 | 4) and a term of opaque type para4_adt:int(5 | 6 | 7)
para4.erl:84: Attempt to test for equality between a term of type para4_adt:un(3 | 4) and a term of opaque type para4_adt:un(1 | 2)
para4.erl:89: Attempt to test for equality between a term of type para4_adt:tup({_,_}) and a term of opaque type para4_adt:tup(tuple())
+para4.erl:94: Attempt to test for equality between a term of type para4_adt:t(#{1=>'a'}) and a term of opaque type para4_adt:t(#{2=>'b'})
para5.erl:13: Attempt to test for inequality between a term of type para5_adt:dd(atom()) and a term of opaque type para5_adt:d()
para5.erl:8: The test para5_adt:d() =:= para5_adt:d() can never evaluate to 'true'
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/para/para4.erl b/lib/dialyzer/test/opaque_SUITE_data/src/para/para4.erl
index b9794672a9..8cd049169d 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/src/para/para4.erl
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/para/para4.erl
@@ -88,6 +88,11 @@ adt_tt13() ->
I2 = adt_tup2(),
I1 =:= I2. % opaque attempt
+adt_tt14() ->
+ I1 = adt_map(),
+ I2 = adt_map2(),
+ I1 =:= I2.
+
y3() ->
{a, 3}.
@@ -132,3 +137,9 @@ adt_tup() ->
adt_tup2() ->
para4_adt:tup2().
+
+adt_map() ->
+ para4_adt:map().
+
+adt_map2() ->
+ para4_adt:map2().
diff --git a/lib/dialyzer/test/opaque_SUITE_data/src/para/para4_adt.erl b/lib/dialyzer/test/opaque_SUITE_data/src/para/para4_adt.erl
index 407dd198a7..06a6c22677 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/src/para/para4_adt.erl
+++ b/lib/dialyzer/test/opaque_SUITE_data/src/para/para4_adt.erl
@@ -8,6 +8,8 @@
-export([tup/0, tup2/0]).
+-export([map/0, map2/0]).
+
-export_type([t/1, y/1, int/1, tup/1, un/1]).
-type ai() :: atom() | integer().
@@ -106,3 +108,13 @@ tup() ->
tup2() ->
foo:tup2().
+
+-spec map() -> t(#{2 => b}).
+
+map() ->
+ foo:map().
+
+-spec map2() -> t(#{1 => a}).
+
+map2() ->
+ foo:map2().
diff --git a/lib/dialyzer/test/small_SUITE_data/results/spec_other_module b/lib/dialyzer/test/small_SUITE_data/results/spec_other_module
new file mode 100644
index 0000000000..ab2e35cf55
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/spec_other_module
@@ -0,0 +1,2 @@
+
+spec_other_module.erl:7: Contract for function that does not exist: lists:flatten/1
diff --git a/lib/dialyzer/test/small_SUITE_data/src/lists_key_bug.erl b/lib/dialyzer/test/small_SUITE_data/src/lists_key_bug.erl
new file mode 100644
index 0000000000..ad5cf3c503
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/lists_key_bug.erl
@@ -0,0 +1,75 @@
+-module(lists_key_bug).
+
+%% OTP-15570
+
+-export([is_1/1, is_2/1, i/1, t1/0, t2/0, im/0]).
+
+%% int_set([3])
+is_1(V) ->
+ K = ikey(V),
+ case lists:keyfind(K, 1, [{<<"foo">>, bar}]) of
+ false ->
+ a;
+ {_, _} ->
+ b
+ end.
+
+ikey(1) ->
+ 3;
+ikey(2) ->
+ <<"foo">>.
+
+%% int_set([3, 5])
+is_2(V) ->
+ K = iskey(V),
+ case lists:keyfind(K, 1, [{<<"foo">>, bar}]) of
+ false ->
+ a;
+ {_, _} ->
+ b
+ end.
+
+iskey(1) ->
+ 12;
+iskey(2) ->
+ 14;
+iskey(3) ->
+ <<"foo">>.
+
+%% integer()
+i(V) ->
+ K = intkey(V),
+ case lists:keyfind(K, 1, [{9.0, foo}]) of
+ false ->
+ a;
+ {_, _} ->
+ b
+ end.
+
+intkey(K) when is_integer(K) ->
+ K + 9999.
+
+t1() ->
+ case lists:keyfind({17}, 1, [{{17.0}, true}]) of
+ false ->
+ a;
+ {_, _} ->
+ b
+ end.
+
+t2() ->
+ case lists:keyfind({17.0}, 1, [{{17}, true}]) of
+ false ->
+ a;
+ {_, _} ->
+ b
+ end.
+
+%% Note: #{1.0 => a} =/= #{1 => a}.
+im() ->
+ case lists:keyfind(#{1.0 => a}, 1, [{#{1 => a}, foo}]) of
+ false ->
+ a;
+ {_, _} ->
+ b
+ end.
diff --git a/lib/dialyzer/test/small_SUITE_data/src/spec_other_module.erl b/lib/dialyzer/test/small_SUITE_data/src/spec_other_module.erl
new file mode 100644
index 0000000000..b36742b1bd
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/spec_other_module.erl
@@ -0,0 +1,7 @@
+-module(spec_other_module).
+
+%% OTP-15562 and ERL-845. Example provided by Kostis.
+
+-type deep_list(A) :: [A | deep_list(A)].
+
+-spec lists:flatten(deep_list(A)) -> [A].
diff --git a/lib/dialyzer/vsn.mk b/lib/dialyzer/vsn.mk
index 98ab533a58..7221993963 100644
--- a/lib/dialyzer/vsn.mk
+++ b/lib/dialyzer/vsn.mk
@@ -1 +1 @@
-DIALYZER_VSN = 3.3.1
+DIALYZER_VSN = 3.3.2
diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml
index 0a0194af2d..85522c99b2 100644
--- a/lib/diameter/doc/src/diameter.xml
+++ b/lib/diameter/doc/src/diameter.xml
@@ -1,7 +1,9 @@
<?xml version="1.0" encoding="utf-8" ?>
<!DOCTYPE erlref SYSTEM "erlref.dtd" [
- <!ENTITY spawn_opt
+ <!ENTITY spawn_opt2
'<seealso marker="erts:erlang#spawn_opt-2">erlang:spawn_opt/2</seealso>'>
+ <!ENTITY spawn_opt5
+ '<seealso marker="erts:erlang#spawn_opt-5">erlang:spawn_opt/5</seealso>'>
<!ENTITY nodes
'<seealso marker="erts:erlang#nodes-0">erlang:nodes/0</seealso>'>
<!ENTITY make_ref
@@ -21,7 +23,7 @@
<copyright>
<year>2011</year>
-<year>2017</year>
+<year>2019</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -1384,12 +1386,22 @@ the same peer.</p>
</item>
<tag>
-<marker id="spawn_opt"/><c>{spawn_opt, [term()]}</c></tag>
+<marker id="spawn_opt"/><c>{spawn_opt, [term()] | {M,F,A}}</c></tag>
<item>
<p>
-Options passed to &spawn_opt; when spawning a process for an
-incoming Diameter request.
-Options <c>monitor</c> and <c>link</c> are ignored.</p>
+An options list passed to &spawn_opt2; to spawn a handler process for an
+incoming Diameter request on the local node, or an MFA that returns
+the pid of a handler process.</p>
+
+<p>
+Options <c>monitor</c> and <c>link</c> are ignored in the list-valued
+case.
+An MFA is applied with an additional term prepended to its argument
+list, and should return either the pid of the handler process that
+invokes <c>diameter_traffic:request/1</c> on the term in order to
+process the request, or the atom <c>discard</c>.
+The handler process need not be local, but diameter must be started on
+the remote node.</p>
<p>
Defaults to the empty list.</p>
diff --git a/lib/diameter/doc/src/diameter_transport.xml b/lib/diameter/doc/src/diameter_transport.xml
index 67fd54bc56..0a8ef321c6 100644
--- a/lib/diameter/doc/src/diameter_transport.xml
+++ b/lib/diameter/doc/src/diameter_transport.xml
@@ -14,7 +14,8 @@
<erlref>
<header>
<copyright>
-<year>2011</year><year>2016</year>
+<year>2011</year>
+<year>2019</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -174,10 +175,13 @@ its parent.</p>
<taglist>
-<tag><c>{diameter, {send, &message;}}</c></tag>
+<tag><c>{diameter, {send, &message; | false}}</c></tag>
<item>
<p>
-An outbound Diameter message.</p>
+An outbound Diameter message.
+The atom <c>false</c> can only be received when request
+acknowledgements have been requests: see the <c>ack</c> message
+below.</p>
</item>
<tag><c>{diameter, {close, Pid}}</c></tag>
@@ -246,6 +250,27 @@ A <c>LocalAddr</c> list has the same semantics as one returned from
&start;.</p>
</item>
+<tag><c>{diameter, ack}</c></tag>
+<item>
+<p>
+Request acknowledgements of unanswered requests.
+A transport process should send this once before passing incoming
+Diameter messages into diameter.
+As a result, every Diameter request passed into diameter with a
+<c>recv</c> message (below) will be answered with a
+<c>send</c> message (above), either a &message; for the transport
+process to send or the atom <c>false</c> if the request has been
+discarded or otherwise not answered.</p>
+
+<p>
+This is to allow a transport process to keep count of the number
+of incoming request messages that have not yet been answered or
+discarded, to allow it to regulate the amount of incoming traffic.
+Both diameter_tcp and diameter_sctp request acknowledgements when a
+<c>message_cb</c> is configured, turning send/recv message into
+callbacks that can be used to regulate traffic.</p>
+</item>
+
<tag><c>{diameter, {recv, &message;}}</c></tag>
<item>
<p>
diff --git a/lib/diameter/doc/src/notes.xml b/lib/diameter/doc/src/notes.xml
index 4bfc98de40..5777225ae7 100644
--- a/lib/diameter/doc/src/notes.xml
+++ b/lib/diameter/doc/src/notes.xml
@@ -43,6 +43,41 @@ first.</p>
<!-- ===================================================================== -->
+<section><title>diameter 2.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix failure of incoming answer message with faulty
+ Experimental-Result-Code. Failure to decode the AVP
+ resulted in an uncaught exception, with no no
+ handle_answer/error callback as a consequence.</p>
+ <p>
+ Own Id: OTP-15569 Aux Id: ERIERL-302 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Add spawn_opt MFA configuration to allow a callback to
+ spawn a handler process for an incoming Diameter request
+ on an an arbitrary node. Module diameter_dist provides a
+ route_session/2 that can be used to distribute requests
+ based on Session-Id, although this module is currently
+ only documented in the module itself and may change.</p>
+ <p>
+ Own Id: OTP-15398</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>diameter 2.1.6</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -78,6 +113,24 @@ first.</p>
</section>
+<section><title>diameter 2.1.4.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix failure of incoming answer message with faulty
+ Experimental-Result-Code. Failure to decode the AVP
+ resulted in an uncaught exception, with no no
+ handle_answer/error callback as a consequence.</p>
+ <p>
+ Own Id: OTP-15569 Aux Id: ERIERL-302 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>diameter 2.1.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl
index b90b794611..7f172e1fa1 100644
--- a/lib/diameter/src/base/diameter.erl
+++ b/lib/diameter/src/base/diameter.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -365,7 +365,7 @@ call(SvcName, App, Message) ->
| {connect_timer, 'Unsigned32'()}
| {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}}
| {watchdog_config, [{okay|suspect, non_neg_integer()}]}
- | {spawn_opt, list()}.
+ | {spawn_opt, list() | mfa()}.
%% Options passed to start_service/2
diff --git a/lib/diameter/src/base/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl
index d04a416bef..3bcf550cd8 100644
--- a/lib/diameter/src/base/diameter_callback.erl
+++ b/lib/diameter/src/base/diameter_callback.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -70,7 +70,7 @@
-module(diameter_callback).
-%% Default callbacks when no aleternate is specified.
+%% Default callbacks when no alternate is specified.
-export([peer_up/3,
peer_down/3,
pick_peer/4,
diff --git a/lib/diameter/src/base/diameter_dist.erl b/lib/diameter/src/base/diameter_dist.erl
new file mode 100644
index 0000000000..5c29ea95a4
--- /dev/null
+++ b/lib/diameter/src/base/diameter_dist.erl
@@ -0,0 +1,525 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(diameter_dist).
+
+-behaviour(gen_server).
+
+%%
+%% Implements callbacks that can be configured as a spawn_opt
+%% transport configuration, to be able to distribute incoming Diameter
+%% requests to handler processes (local or remote) in various ways.
+%%
+
+%% spawn_opt callbacks
+-export([spawn_local/2,
+ spawn_local/1,
+ route_session/2,
+ route_session/1]).
+
+%% signal availability for handling incoming requests to route_sesssion/2
+-export([attach/1,
+ detach/1]).
+
+%% consistent hashing
+-export([hash/3, %% for use as default MFA in route_session/2 options map
+ hash/2]). %% arbitrary key/values
+
+-include_lib("diameter/include/diameter.hrl").
+
+%% server start
+-export([start_link/0]).
+
+%% gen_server callbacks
+-export([init/1,
+ handle_info/2,
+ handle_cast/2,
+ handle_call/3,
+ code_change/3,
+ terminate/2]).
+
+-type request() :: tuple(). %% callback argument from diameter_traffic
+
+-define(SERVER, ?MODULE). %% server monitoring node connections
+
+%% Maps a node name binary to the corresponding atom. Used by
+%% route_session/2 to map the optional value of a Session-Id to
+%% node().
+-define(NODE_TABLE, diameter_dist_node).
+
+%% Maps a diameter:service_name() to a node() that has called attach/1
+%% to declare its willingness to handle incoming requests for the
+%% service. Use by route_session/2 in case the optional value mapping
+%% has failed.
+-define(SERVICE_TABLE, diameter_dist_service).
+
+-define(B(A), atom_to_binary(A, utf8)).
+-define(ORCOND(List), list_to_tuple(['orelse', false | List])).
+-define(HASH(T), erlang:phash2(T, 16#100000000)).
+
+%% spawn_local/2
+%%
+%% Callback that is equivalent to an options list. That is, the
+%% following are equivalent when passed as options to
+%% diameter:add_transport/2.
+%%
+%% {spawn_opt, Opts}
+%% {spawn_opt, {diameter_dist, spawn_local, [Opts]}}
+
+-spec spawn_local(ReqT :: request(), Opts :: list())
+ -> pid().
+
+spawn_local(ReqT, Opts) ->
+ spawn_opt(diameter_traffic, request, [ReqT], Opts).
+
+%% spawn_local/1
+
+spawn_local(ReqT) ->
+ spawn_local(ReqT, []).
+
+%% route_session/2
+%%
+%% Callback that maps the Session-Id of an incoming request to a
+%% handler node.
+%%
+%% With an options list, maps an id whose optional value is the name
+%% of a connected node to the same node, to handle the case that the
+%% session id has been returned from diameter:session_id/1; otherwise
+%% to a node that has called diameter_dist:attach/1 using the
+%% consistent hashing provided by hash/3, or to the local node() if a
+%% session id could not be extracted or there are no attached nodes. A
+%% handler process is spawned on the selected node using
+%% erlang:spawn_opt/4.
+%%
+%% Different behaviour can be configured by supplying an options map
+%% of the following form:
+%%
+%% #{search => non_neg_integer(),
+%% id => [binary()],
+%% default => discard | local | mfa(),
+%% dispatch => list() | mfa()}
+%%
+%% The search member limits the number of AVPs that are examined in
+%% the message (from the front), to avoid searching entire message in
+%% case it's known that peers follow RFC 6733's recommendation that
+%% Session-Id be placed at the head of a message. The default is to
+%% search the entire message.
+%%
+%% The id member restricts the optional value mapping to session ids
+%% whose DiamterIdentity is one of those specified. Set this to the
+%% list of Diameter identities advertised by the service in question
+%% (typically one) to ensure that only locally generated session ids
+%% are mapped; or to the empty list to disable the mapping.
+%%
+%% The default member determines where to handle a message whose
+%% Session-Id isn't found or whose optional value isn't mapped to the
+%% name of a connected node. The atom local says the local node, an
+%% MFA is invoked on Session-Id | false, the name of the diameter
+%% service, and the message binary, and should return either a node()
+%% or false to discard the message. Defaults to {diameter_dist, hash, []}.
+%%
+%% The dispatch member determines how the pid() of the request handler
+%% process is retrieved. An MFA is applied to a previously selected
+%% node(), and the module, function, and arguments list to apply in
+%% the handler process to handle the request, the MFA being supplied
+%% by diameter, and returns pid() | discard. A list is equivalent to
+%% {erlang, spawn_opt, []}. Defaults to [].
+%%
+%% This can be used with search = 0 to route on something other than
+%% Session-Id, but this is probably no simpler than just implementing
+%% an own spawn_opt callback. (Except with the default dispatch possibly.)
+%%
+%% Note that if the peer is also implemented with OTP diameter and
+%% generating session ids with diameter:session_id/1 then
+%% route_session/2 can map an optional value to a local node that
+%% happens to have the same name as one of the peer's nodes. This
+%% could lead to an uneven distribution; for example, if the peer
+%% nodes are a subset of the local nodes. In practice, it's typically
+%% known if it's peers or the local node originating sessions; if the
+%% former then setting id = [] disables the optional value mapping, if
+%% the latter then setting default = local disables the hashing.
+-spec route_session(ReqT :: request(), Opts)
+ -> discard
+ | pid()
+ when Opts :: pos_integer() %% aka #{search => N}
+ | list() %% aka #{dispatch => Opts}
+ | #{search => non_neg_integer(), %% limit number of examined AVPs
+ id => [binary()], %% restrict optional value map on DiamIdent
+ default => local %% handle locally
+ | discard
+ | mfa(), %% return node() | false
+ dispatch => list() %% spawn options
+ | mfa()}. %% (Node, M, F, A) -> pid() | discard
+
+route_session(ReqT, Opts) ->
+ {_, Bin} = Info = diameter_traffic:request_info(ReqT),
+ Sid = session_id(avps(Bin), search(Opts)),
+ Node = default(node_of_session_id(Sid, Opts), Sid, Opts, Info),
+ dispatch(Node, ReqT, dispatch(Opts)).
+
+%% avps/1
+
+avps(<<_:20/binary, Bin/binary>>) ->
+ Bin;
+
+avps(_) ->
+ false.
+
+%% dispatch/3
+
+dispatch(false, _, _) ->
+ discard;
+
+dispatch(Node, ReqT, {M,F,A}) ->
+ apply(M, F, [Node, diameter_traffic, request, [ReqT] | A]);
+
+dispatch(Node, ReqT, Opts) ->
+ spawn_opt(Node, diameter_traffic, request, [ReqT], Opts).
+
+%% route_session/1
+
+route_session(ReqT) ->
+ route_session(ReqT, []).
+
+%% node_of_session_id/2
+%%
+%% Return the node name encoded as optional value in a Session-Id,
+%% assuming the id has been created with diameter:session_id/0. Lookup
+%% the node name to ensure we don't convert arbitrary binaries to
+%% atom.
+
+node_of_session_id([Id, _, _, Bin], #{id := Ids}) ->
+ lists:member(Id, Ids) andalso nodemap(Bin);
+
+node_of_session_id([_, _, _, Bin], _) ->
+ nodemap(Bin);
+
+node_of_session_id(_, _) ->
+ false.
+
+%% nodemap/1
+
+nodemap(Bin) ->
+ try
+ ets:lookup_element(?NODE_TABLE, Bin, 2)
+ catch
+ error: badarg -> false
+ end.
+
+%% session_id/2
+
+session_id(_, 0) -> %% give up
+ false;
+
+%% Session-Id = Command Code 263, V-bit = 0.
+session_id(<<263:32, 0:1, _:7, Len:24, _/binary>> = Bin, _) ->
+ case Bin of
+ <<Avp:Len/binary, _/binary>> ->
+ <<_:8/binary, Sid/binary>> = Avp,
+ split(Sid);
+ _ ->
+ false
+ end;
+
+%% Jump to the next AVP. This is potentially costly for a message with
+%% many AVPs and no Session-Id, which an attacker is prone to send.
+%% 8.8 or RFC 6733 says that Session-Id SHOULD (but not MUST) appear
+%% immediately following the Diameter Header, so there is no
+%% guarantee.
+session_id(<<_:40, Len:24, _/binary>> = Bin, N) ->
+ Pad = (4 - (Len rem 4)) rem 4,
+ case Bin of
+ <<_:Len/binary, _:Pad/binary, Rest/binary>> ->
+ session_id(Rest, if N == infinity -> N; true -> N-1 end);
+ _ ->
+ false
+ end;
+
+session_id(_, _) ->
+ false.
+
+%% split/1
+%%
+%% Split a Session-Id at no more than three semicolons: the optional
+%% value (if any) follows the third. binary:split/2 does better than
+%% matching character by character, especially when the pattern is
+%% compiled.
+
+split(Bin) ->
+ split(3, Bin, pattern()).
+
+%% split/3
+
+split(0, Bin, _) ->
+ [Bin];
+
+split(N, Bin, Pattern) ->
+ [H|T] = binary:split(Bin, Pattern),
+ [H | case T of
+ [] ->
+ T;
+ [Rest] ->
+ split(N-1, Rest, Pattern)
+ end].
+
+%% pattern/0
+%%
+%% Since this is being called in a watchdog process, compile the
+%% pattern once and maintain it in the process dictionary.
+
+pattern() ->
+ case get(?MODULE) of
+ undefined ->
+ CP = binary:compile_pattern(<<$;>>), %% tuple
+ put(?MODULE, CP),
+ CP;
+ CP ->
+ CP
+ end.
+
+%% dispatch/1
+
+dispatch(#{} = Opts) ->
+ maps:get(dispatch, Opts, []);
+
+dispatch(Opts)
+ when is_list(Opts) ->
+ Opts;
+
+dispatch(_) ->
+ [].
+
+%% search/1
+%%
+%% Bound number of AVPs examined when looking for Session-Id.
+
+search(#{search := N})
+ when is_integer(N), 0 =< N ->
+ N;
+
+search(N)
+ when is_integer(N), 0 =< N ->
+ N;
+
+search(_) ->
+ infinity.
+
+%% default/3
+%%
+%% Choose a node when Session-Id lookup has failed.
+
+default(false, _, #{default := discard}, _) ->
+ false;
+
+default(false, _, #{default := local}, _) ->
+ node();
+
+default(false, Sid, #{default := {M,F,A}}, Info) ->
+ {ServiceName, Bin} = Info,
+ apply(M, F, [Sid, ServiceName, Bin | A]); %% node() | false
+
+default(false, Sid, _, Info) -> %% aka {?MODULE, hash, []}
+ {ServiceName, Bin} = Info,
+ hash(Sid, ServiceName, Bin);
+
+default(Node, _, _, _) ->
+ Node.
+
+%% ===========================================================================
+
+%% hash/3
+%%
+%% Consistent hashing of Session-Id to an attached node, or the local
+%% node if Session-Id = false or no attached nodes.
+
+hash(Sid, ServiceName, _) ->
+ case false /= Sid andalso attached(ServiceName) of
+ [_|_] = Nodes ->
+ hash(Sid, Nodes);
+ _ ->
+ node()
+ end.
+
+%% hash/2
+%%
+%% Consistent hashing on arbitrary key/values. Returns false if the
+%% list is empty.
+
+%% No key or no values.
+hash(_, []) ->
+ false;
+
+%% Not much choice.
+hash(_, [Value]) ->
+ Value;
+
+%% Hash on a circle and choose the closest predecessor.
+hash(Key, Values) ->
+ Hash = ?HASH(Key),
+ tl(lists:foldl(fun(V,A) ->
+ choose(Hash, [?HASH({Key, V}) | V], A)
+ end,
+ false, %% < list()
+ Values)).
+
+%% choose/3
+
+choose(Hash, [Hash1 | _] = T, [Hash2 | _])
+ when Hash1 =< Hash, Hash < Hash2 ->
+ T;
+
+choose(Hash, [Hash1 | _], [Hash2 | _] = T)
+ when Hash2 =< Hash, Hash < Hash1 ->
+ T;
+
+choose(_, T1, T2) ->
+ max(T1, T2).
+
+%% ===========================================================================
+
+%% attach/1
+%%
+%% Register the local node as a handler of incoming requests for the
+%% specified services when using the route_session/2 spawn_opt
+%% callback.
+
+attach(ServiceNames) ->
+ abcast({attach, node(), ServiceNames}).
+
+%% detach/1
+%%
+%% Deregister the local node as a handler of incoming requests.
+
+detach(ServiceNames) ->
+ abcast({detach, node(), ServiceNames}).
+
+%% abcast/1
+
+abcast(T) ->
+ gen_server:abcast([node() | nodes()], ?SERVER, T),
+ ok.
+
+%% attached/1
+
+attached(ServiceName) ->
+ try
+ ets:lookup_element(?SERVICE_TABLE, ServiceName, 2)
+ catch
+ error: badarg -> []
+ end.
+
+%% cast/2
+
+cast(Node, T) ->
+ gen_server:cast({?SERVER, Node}, T).
+
+%% attach/2
+
+attach(Node, S) ->
+ case sets:to_list(S) of
+ [] ->
+ ok;
+ Services ->
+ cast(Node, {attach, node(), Services})
+ end.
+
+%% ===========================================================================
+
+start_link() ->
+ gen_server:start_link({local, ?SERVER}, ?MODULE, _Args = [], _Opts = []).
+
+%% init/1
+%%
+%% Maintain [node() | nodes()] in a table that maps from binary-valued
+%% names, so we can lookup the corresponding atoms rather than convert
+%% binaries that aren't necessarily node names.
+
+init([]) ->
+ ets:new(?NODE_TABLE, [set, named_table]),
+ ets:new(?SERVICE_TABLE, [bag, named_table]),
+ ok = net_kernel:monitor_nodes(true, [{node_type, all}, nodedown_reason]),
+ ets:insert(?NODE_TABLE, [{?B(N), N} || N <- [node() | nodes()]]),
+ abcast({attach, node()}),
+ {ok, sets:new()}.
+
+%% handle_call/3
+
+handle_call(_, _From, S) ->
+ {reply, nok, S}.
+
+%% handle_cast/2
+
+%% Remote node is asking which services the local node wants to handle.
+handle_cast({attach, Node}, S)
+ when Node /= node() ->
+ attach(Node, S),
+ {noreply, S};
+
+%% Node wants to handle incoming requests ...
+handle_cast({attach, Node, ServiceNames}, S) ->
+ ets:insert(?SERVICE_TABLE, [{N, Node} || N <- ServiceNames]),
+ {noreply, case node() of
+ Node ->
+ sets:union(S, sets:from_list(ServiceNames));
+ _ ->
+ S
+ end};
+
+%% ... or not.
+handle_cast({detach, Node, ServiceNames}, S) ->
+ ets:select_delete(?SERVICE_TABLE, [{{'$1', Node},
+ [?ORCOND([{'==', '$1', {const, N}}
+ || N <- ServiceNames])],
+ [true]}]),
+ {noreply, case node() of
+ Node ->
+ sets:subtract(S, sets:from_list(ServiceNames));
+ _ ->
+ S
+ end};
+
+handle_cast(_, S) ->
+ {noreply, S}.
+
+%% handle_info/2
+
+handle_info({nodeup, Node, _}, S) ->
+ ets:insert(?NODE_TABLE, {?B(Node), Node}),
+ cast(Node, {attach, node()}), %% ask which services remote node handles
+ attach(Node, S), %% say which service local node handles
+ {noreply, S};
+
+handle_info({nodedown, Node, _}, S) ->
+ ets:delete(?NODE_TABLE, ?B(Node)),
+ ets:select_delete(?SERVICE_TABLE, [{{'_', Node}, [], [true]}]),
+ {noreply, S};
+
+handle_info(_, S) ->
+ {noreply, S}.
+
+%% terminate/2
+
+terminate(_, _) ->
+ ok.
+
+%% code_change/3
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
diff --git a/lib/diameter/src/base/diameter_gen.erl b/lib/diameter/src/base/diameter_gen.erl
index d110a3015e..564448de48 100644
--- a/lib/diameter/src/base/diameter_gen.erl
+++ b/lib/diameter/src/base/diameter_gen.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
diff --git a/lib/diameter/src/base/diameter_misc_sup.erl b/lib/diameter/src/base/diameter_misc_sup.erl
index 343688be23..fec5a41b5c 100644
--- a/lib/diameter/src/base/diameter_misc_sup.erl
+++ b/lib/diameter/src/base/diameter_misc_sup.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -35,6 +35,7 @@
diameter_stats, %% statistics counter management
diameter_reg, %% service/property publishing
diameter_peer, %% remote peer manager
+ diameter_dist, %% request distribution
diameter_config]). %% configuration/restart
%% start_link/0
diff --git a/lib/diameter/src/base/diameter_traffic.erl b/lib/diameter/src/base/diameter_traffic.erl
index d2856ae530..8423e30269 100644
--- a/lib/diameter/src/base/diameter_traffic.erl
+++ b/lib/diameter/src/base/diameter_traffic.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -42,8 +42,12 @@
peer_up/1,
peer_down/1]).
+%% towards diameter_dist
+-export([request_info/1]).
+
%% internal
-export([send/1, %% send from remote node
+ request/1, %% process request in handler process
init/1]). %% monitor process start
-include_lib("diameter/include/diameter.hrl").
@@ -232,7 +236,7 @@ incr_rc(Dir, Pkt, TPid, MsgDict, AppDict, Dict0) ->
-spec receive_message(pid(), Route, #diameter_packet{}, module(), RecvData)
-> pid() %% request handler
| boolean() %% answer, known request or not
- | discard %% request discarded by MFA
+ | discard %% request discarded
when Route :: {Handler, RequestRef, TPid}
| Ack,
RecvData :: {[SpawnOpt], #recvdata{}},
@@ -252,7 +256,8 @@ receive_message(TPid, Route, Pkt, Dict0, RecvData) ->
recv(true, Ack, TPid, Pkt, Dict0, T)
when is_boolean(Ack) ->
{Opts, RecvData} = T,
- spawn_request(Ack, TPid, Pkt, Dict0, RecvData, Opts);
+ AppT = find_app(TPid, Pkt, RecvData),
+ ack(Ack, TPid, spawn_request(AppT, Opts, Ack, TPid, Pkt, Dict0, RecvData));
%% ... answer to known request ...
recv(false, {Pid, Ref, TPid}, _, Pkt, Dict0, _) ->
@@ -274,58 +279,73 @@ recv(false, false, TPid, Pkt, _, _) ->
incr(TPid, {{unknown, 0}, recv, discarded}),
false.
-%% spawn_request/6
+%% spawn_request/7
+
+spawn_request(false, _, _, _, _, _, _) -> %% no transport
+ discard;
-%% An MFA should return a pid() or the atom 'discard'. The latter
-%% results in an acknowledgment back to the transport process when
-%% appropriate, to ensure that send/recv callbacks can count
-%% outstanding requests. Acknowledgement is implicit if the
+%% An MFA should return the pid() of a process in which the argument
+%% fun in applied, or the atom 'discard' if the fun is not applied.
+%% The latter results in an acknowledgment back to the transport
+%% process when appropriate, to ensure that send/recv callbacks can
+%% count outstanding requests. Acknowledgement is implicit if the
%% handler process dies (in a handle_request callback for example).
-spawn_request(Ack, TPid, Pkt, Dict0, RecvData, {M,F,A}) ->
- ReqF = fun() ->
- ack(Ack, TPid, recv_request(Ack, TPid, Pkt, Dict0, RecvData))
- end,
- ack(Ack, TPid, apply(M, F, [ReqF | A]));
+spawn_request(AppT, {M,F,A}, Ack, TPid, Pkt, Dict0, RecvData) ->
+ %% Term to pass to request/1 in an appropriate process. Module
+ %% diameter_dist implements callbacks.
+ ReqT = {Pkt, AppT, Ack, TPid, Dict0, RecvData},
+ apply(M, F, [ReqT | A]);
%% A spawned process acks implicitly when it dies, so there's no need
%% to handle 'discard'.
-spawn_request(Ack, TPid, Pkt, Dict0, RecvData, Opts) ->
+spawn_request(AppT, Opts, Ack, TPid, Pkt, Dict0, RecvData) ->
spawn_opt(fun() ->
- recv_request(Ack, TPid, Pkt, Dict0, RecvData)
+ recv_request(Ack, TPid, Pkt, Dict0, RecvData, AppT)
end,
Opts).
+%% request_info/1
+%%
+%% Limited request information for diameter_dist.
+
+request_info({Pkt, _AppT, _Ack, _TPid, _Dict0, RecvData} = _ReqT) ->
+ {RecvData#recvdata.service_name, Pkt#diameter_packet.bin}.
+
+%% request/1
+%%
+%% Called from a handler process chosen by a transport spawn_opt MFA
+%% to process an incoming request.
+
+request({Pkt, AppT, Ack, TPid, Dict0, RecvData} = _ReqT) ->
+ ack(Ack, TPid, recv_request(Ack, TPid, Pkt, Dict0, RecvData, AppT)).
+
%% ack/3
ack(Ack, TPid, RC) ->
- RC == discard andalso Ack andalso (TPid ! {send, false}),
+ RC == discard
+ andalso Ack
+ andalso (TPid ! {send, false}),
RC.
%% ---------------------------------------------------------------------------
-%% recv_request/5
+%% recv_request/6
%% ---------------------------------------------------------------------------
-spec recv_request(Ack :: boolean(),
TPid :: pid(),
#diameter_packet{},
Dict0 :: module(),
- #recvdata{})
+ #recvdata{},
+ AppT :: {#diameter_app{}, #diameter_caps{}}
+ | #diameter_caps{}) %% no suitable app
-> ok %% answer was sent
- | discard %% or not
- | false. %% no transport
-
-recv_request(Ack,
- TPid,
- #diameter_packet{header = #diameter_header{application_id = Id}}
- = Pkt,
- Dict0,
- #recvdata{peerT = PeerT,
- apps = Apps,
- counters = Count}
- = RecvData) ->
+ | discard. %% or not
+
+recv_request(Ack, TPid, Pkt, Dict0, RecvData, AppT) ->
Ack andalso (TPid ! {handler, self()}),
- case diameter_service:find_incoming_app(PeerT, TPid, Id, Apps) of
+ case AppT of
{#diameter_app{id = Aid, dictionary = AppDict} = App, Caps} ->
+ Count = RecvData#recvdata.counters,
Count andalso incr(recv, Pkt, TPid, AppDict),
DecPkt = decode(Aid, AppDict, RecvData, Pkt),
Count andalso incr_error(recv, DecPkt, TPid, AppDict),
@@ -349,11 +369,20 @@ recv_request(Ack,
Dict0,
RecvData,
DecPkt,
- [[]]);
- false = No -> %% transport has gone down
- No
+ [[]])
end.
+%% find_app/3
+%%
+%% Lookup the application of a received Diameter request on the node
+%% on which it's received.
+
+find_app(TPid,
+ #diameter_packet{header = #diameter_header{application_id = Id}},
+ #recvdata{peerT = PeerT,
+ apps = Apps}) ->
+ diameter_service:find_incoming_app(PeerT, TPid, Id, Apps).
+
%% decode/4
decode(Id, Dict, #recvdata{codec = Opts}, Pkt) ->
@@ -1925,6 +1954,8 @@ get_avp(Dict, Name, [#diameter_header{} | Avps]) ->
A = find_avp(Code, Vid, Avps),
avp_decode(Dict, Name, ungroup(A))
catch
+ {diameter_gen, _} -> %% faulty Grouped AVP
+ undefined;
error: _ ->
undefined
end;
diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src
index 51830f5276..52263633fb 100644
--- a/lib/diameter/src/diameter.appup.src
+++ b/lib/diameter/src/diameter.appup.src
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -59,7 +59,9 @@
{"2.1.2", [{restart_application, diameter}]}, %% 20.1.3
{"2.1.3", [{restart_application, diameter}]}, %% 20.2
{"2.1.4", [{restart_application, diameter}]}, %% 20.3
- {"2.1.5", [{update, diameter_peer_fsm}]} %% 21.0
+ {"2.1.4.1", [{restart_application, diameter}]}, %% 20.3.8.19
+ {"2.1.5", [{restart_application, diameter}]}, %% 21.0
+ {"2.1.6", [{restart_application, diameter}]} %% 21.1
],
[
{"0.9", [{restart_application, diameter}]},
@@ -100,6 +102,8 @@
{"2.1.2", [{restart_application, diameter}]},
{"2.1.3", [{restart_application, diameter}]},
{"2.1.4", [{restart_application, diameter}]},
- {"2.1.5", [{update, diameter_peer_fsm}]}
+ {"2.1.4.1", [{restart_application, diameter}]},
+ {"2.1.5", [{restart_application, diameter}]},
+ {"2.1.6", [{restart_application, diameter}]}
]
}.
diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk
index bb86de016a..d16292bb88 100644
--- a/lib/diameter/src/modules.mk
+++ b/lib/diameter/src/modules.mk
@@ -1,7 +1,7 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2010-2017. All Rights Reserved.
+# Copyright Ericsson AB 2010-2019. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -40,6 +40,7 @@ RT_MODULES = \
base/diameter_config \
base/diameter_config_sup \
base/diameter_codec \
+ base/diameter_dist \
base/diameter_gen \
base/diameter_lib \
base/diameter_misc_sup \
diff --git a/lib/diameter/src/transport/diameter_tcp.erl b/lib/diameter/src/transport/diameter_tcp.erl
index da059fa7d6..e5e766d2a0 100644
--- a/lib/diameter/src/transport/diameter_tcp.erl
+++ b/lib/diameter/src/transport/diameter_tcp.erl
@@ -92,9 +92,9 @@
-type connect_option() :: {raddr, inet:ip_address()}
| {rport, pos_integer()}
- | {ssl_options, true | [ssl:connect_option()]}
+ | {ssl_options, true | [ssl:tls_client_option()]}
| option()
- | ssl:connect_option()
+ | ssl:tls_client_option()
| gen_tcp:connect_option().
-type match() :: inet:ip_address()
@@ -102,9 +102,9 @@
| [match()].
-type listen_option() :: {accept, match()}
- | {ssl_options, true | [ssl:listen_option()]}
+ | {ssl_options, true | [ssl:tls_server_option()]}
| option()
- | ssl:listen_option()
+ | ssl:tls_server_option()
| gen_tcp:listen_option().
-type option() :: {port, non_neg_integer()}
diff --git a/lib/diameter/test/diameter_dist_SUITE.erl b/lib/diameter/test/diameter_dist_SUITE.erl
new file mode 100644
index 0000000000..b2e4c35b9a
--- /dev/null
+++ b/lib/diameter/test/diameter_dist_SUITE.erl
@@ -0,0 +1,332 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2019. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Tests of traffic between two Diameter nodes, the server being
+%% spread across three Erlang nodes.
+%%
+
+-module(diameter_dist_SUITE).
+
+-export([suite/0,
+ all/0]).
+
+%% testcases
+-export([enslave/1, enslave/0,
+ ping/1,
+ start/1,
+ connect/1,
+ send/1,
+ stop/1, stop/0]).
+
+%% diameter callbacks
+-export([peer_up/3,
+ peer_down/3,
+ pick_peer/4,
+ prepare_request/3,
+ prepare_retransmit/3,
+ handle_answer/4,
+ handle_error/4,
+ handle_request/3]).
+
+-export([call/1]).
+
+-include("diameter.hrl").
+-include("diameter_gen_base_rfc6733.hrl").
+
+%% ===========================================================================
+
+-define(util, diameter_util).
+
+-define(CLIENT, 'CLIENT').
+-define(SERVER, 'SERVER').
+-define(REALM, "erlang.org").
+-define(DICT, diameter_gen_base_rfc6733).
+-define(ADDR, {127,0,0,1}).
+
+%% Config for diameter:start_service/2.
+-define(SERVICE(Host),
+ [{'Origin-Host', Host ++ [$.|?REALM]},
+ {'Origin-Realm', ?REALM},
+ {'Host-IP-Address', [?ADDR]},
+ {'Vendor-Id', 12345},
+ {'Product-Name', "OTP/diameter"},
+ {'Auth-Application-Id', [?DICT:id()]},
+ {'Origin-State-Id', origin()},
+ {spawn_opt, {diameter_dist, route_session, [#{id => []}]}},
+ {sequence, fun sequence/0},
+ {string_decode, false},
+ {application, [{dictionary, ?DICT},
+ {module, ?MODULE},
+ {request_errors, callback},
+ {answer_errors, callback}]}]).
+
+-define(SUCCESS, 2001).
+-define(BUSY, 3004).
+-define(LOGOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_LOGOUT').
+-define(MOVED, ?'DIAMETER_BASE_TERMINATION-CAUSE_USER_MOVED').
+-define(TIMEOUT, ?'DIAMETER_BASE_TERMINATION-CAUSE_SESSION_TIMEOUT').
+
+-define(L, atom_to_list).
+-define(A, list_to_atom).
+
+%% The order here is significant and causes the server to listen
+%% before the clients connect. The server listens on the first node,
+%% and distributes requests to the other two.
+-define(NODES, [{server0, ?SERVER},
+ {server1, ?SERVER},
+ {server2, ?SERVER},
+ {client, ?CLIENT}]).
+
+%% Options to ct_slave:start/2.
+-define(TIMEOUTS, [{T, 15000} || T <- [boot_timeout,
+ init_timeout,
+ start_timeout]]).
+
+%% ===========================================================================
+
+suite() ->
+ [{timetrap, {seconds, 60}}].
+
+all() ->
+ [enslave,
+ ping,
+ start,
+ connect,
+ send,
+ stop].
+
+%% ===========================================================================
+%% start/stop testcases
+
+%% enslave/1
+%%
+%% Start four slave nodes, three to implement a Diameter server,
+%% one to implement a client.
+
+enslave() ->
+ [{timetrap, {seconds, 30*length(?NODES)}}].
+
+enslave(Config) ->
+ Here = filename:dirname(code:which(?MODULE)),
+ Ebin = filename:join([Here, "..", "ebin"]),
+ Dirs = [Here, Ebin],
+ Nodes = [{N,S} || {M,S} <- ?NODES, N <- [slave(M, Dirs)]],
+ ?util:write_priv(Config, nodes, [{N,S} || {{N,ok},S} <- Nodes]),
+ [] = [{T,S} || {{_,E} = T, S} <- Nodes, E /= ok].
+
+slave(Name, Dirs) ->
+ add_pathsa(Dirs, ct_slave:start(Name, ?TIMEOUTS)).
+
+add_pathsa(Dirs, {ok, Node}) ->
+ {Node, rpc:call(Node, code, add_pathsa, [Dirs])};
+add_pathsa(_, No) ->
+ {No, error}.
+
+%% ping/1
+%%
+%% Ensure the server nodes are connected so that diameter_dist can attach.
+
+ping({S, Nodes}) ->
+ ?SERVER = S,
+ [N || {N,_} <- Nodes,
+ node() /= N,
+ pang <- [net_adm:ping(N)]];
+
+ping(Config) ->
+ Nodes = lists:droplast(?util:read_priv(Config, nodes)),
+ [] = [{N,RC} || {N,S} <- Nodes,
+ RC <- [rpc:call(N, ?MODULE, ping, [{S,Nodes}])],
+ RC /= []].
+
+%% start/1
+%%
+%% Start diameter services.
+
+start(SvcName)
+ when is_atom(SvcName) ->
+ ok = diameter:start(),
+ ok = diameter:start_service(SvcName, ?SERVICE((?L(SvcName))));
+
+start(Config) ->
+ Nodes = ?util:read_priv(Config, nodes),
+ [] = [{N,RC} || {N,S} <- Nodes,
+ RC <- [rpc:call(N, ?MODULE, start, [S])],
+ RC /= ok].
+
+sequence() ->
+ sequence(sname()).
+
+sequence(client) ->
+ {0,32};
+sequence(Server) ->
+ "server" ++ N = ?L(Server),
+ {list_to_integer(N), 30}.
+
+origin() ->
+ origin(sname()).
+
+origin(client) ->
+ 99;
+origin(Server) ->
+ "server" ++ N = ?L(Server),
+ list_to_integer(N).
+
+%% connect/1
+%%
+%% Establish one connection from the client, terminated on the first
+%% server node, the others handling requests.
+
+connect({?SERVER, Config, [{Node, _} | _]}) ->
+ if Node == node() -> %% server0
+ ?util:write_priv(Config, lref, {Node, ?util:listen(?SERVER, tcp)});
+ true ->
+ diameter_dist:attach([?SERVER])
+ end,
+ ok;
+
+connect({?CLIENT, Config, _}) ->
+ ?util:connect(?CLIENT, tcp, ?util:read_priv(Config, lref)),
+ ok;
+
+connect(Config) ->
+ Nodes = ?util:read_priv(Config, nodes),
+ [] = [{N,RC} || {N,S} <- Nodes,
+ RC <- [rpc:call(N, ?MODULE, connect, [{S, Config, Nodes}])],
+ RC /= ok].
+
+%% stop/1
+%%
+%% Stop the slave nodes.
+
+stop() ->
+ [{timetrap, {seconds, 30*length(?NODES)}}].
+
+stop(_Config) ->
+ [] = [{N,E} || {N,_} <- ?NODES,
+ {error, _, _} = E <- [ct_slave:stop(N)]].
+
+%% ===========================================================================
+%% traffic testcases
+
+%% send/1
+%%
+%% Send 100 requests and ensure the node name sent as User-Name isn't
+%% the node terminating transport.
+
+send(Config) ->
+ send(Config, 100, dict:new()).
+
+%% send/2
+
+send(Config, 0, Dict) ->
+ [{Server0, _} | _] = ?util:read_priv(Config, nodes) ,
+ Node = atom_to_binary(Server0, utf8),
+ {false, _} = {dict:is_key(Node, Dict), dict:to_list(Dict)};
+
+send(Config, N, Dict) ->
+ #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'User-Name' = [ServerNode]}
+ = send(Config, str(?LOGOUT)),
+ true = is_binary(ServerNode),
+ send(Config, N-1, dict:update_counter(ServerNode, 1, Dict)).
+
+%% ===========================================================================
+
+str(Cause) ->
+ #diameter_base_STR{'Destination-Realm' = ?REALM,
+ 'Auth-Application-Id' = ?DICT:id(),
+ 'Termination-Cause' = Cause}.
+
+%% send/2
+
+send(Config, Req) ->
+ {Node, _} = lists:last(?util:read_priv(Config, nodes)),
+ rpc:call(Node, ?MODULE, call, [Req]).
+
+%% call/1
+
+call(Req) ->
+ diameter:call(?CLIENT, ?DICT, Req, []).
+
+%% sname/0
+
+sname() ->
+ ?A(hd(string:tokens(?L(node()), "@"))).
+
+%% ===========================================================================
+%% diameter callbacks
+
+%% peer_up/3
+
+peer_up(_SvcName, _Peer, State) ->
+ State.
+
+%% peer_down/3
+
+peer_down(_SvcName, _Peer, State) ->
+ State.
+
+%% pick_peer/4
+
+pick_peer([Peer], [], ?CLIENT, _State) ->
+ {ok, Peer}.
+
+%% prepare_request/3
+
+prepare_request(Pkt, ?CLIENT, {_Ref, Caps}) ->
+ #diameter_packet{msg = Req}
+ = Pkt,
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+ {send, Req#diameter_base_STR{'Origin-Host' = OH,
+ 'Origin-Realm' = OR,
+ 'Session-Id' = diameter:session_id(OH)}}.
+
+%% prepare_retransmit/3
+
+prepare_retransmit(_, ?CLIENT, _) ->
+ discard.
+
+%% handle_answer/5
+
+handle_answer(Pkt, _Req, ?CLIENT, _Peer) ->
+ #diameter_packet{msg = Rec, errors = []} = Pkt,
+ Rec.
+
+%% handle_error/5
+
+handle_error(Reason, _Req, ?CLIENT, _Peer) ->
+ {error, Reason}.
+
+%% handle_request/3
+
+handle_request(Pkt, ?SERVER, {_, Caps}) ->
+ #diameter_packet{msg = #diameter_base_STR{'Session-Id' = SId}}
+ = Pkt,
+ #diameter_caps{origin_host = {OH, _},
+ origin_realm = {OR, _}}
+ = Caps,
+ {reply, #diameter_base_STA{'Result-Code' = ?SUCCESS,
+ 'Session-Id' = SId,
+ 'Origin-Host' = OH,
+ 'Origin-Realm' = OR,
+ 'User-Name' = [atom_to_binary(node(), utf8)]}}.
diff --git a/lib/diameter/test/diameter_distribution_SUITE.erl b/lib/diameter/test/diameter_distribution_SUITE.erl
index 5146f68ff1..5fe02284ae 100644
--- a/lib/diameter/test/diameter_distribution_SUITE.erl
+++ b/lib/diameter/test/diameter_distribution_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -76,6 +76,7 @@
{share_peers, peers()},
{use_shared_peers, peers()},
{restrict_connections, false},
+ {spawn_opt, {diameter_dist, spawn_local, []}},
{sequence, fun sequence/0},
{application, [{dictionary, ?DICT},
{module, ?MODULE},
@@ -125,7 +126,7 @@ all() ->
%% enslave/1
%%
%% Start four slave nodes, one to implement a Diameter server,
-%% two three to implement a client.
+%% three to implement a client.
enslave() ->
[{timetrap, {seconds, 30*length(?NODES)}}].
@@ -331,6 +332,8 @@ prepare_request(Pkt, ?CLIENT, {_Ref, Caps}, {_, client0}) ->
'Origin-Realm' = OR,
'Session-Id' = diameter:session_id(OH)}}.
+%% prepare_retransmit/4
+
prepare_retransmit(Pkt, ?CLIENT, _, {_, client0}) ->
#diameter_packet{msg = #diameter_base_STR{'Termination-Cause' = ?MOVED}}
= Pkt, %% assert
diff --git a/lib/diameter/test/diameter_pool_SUITE.erl b/lib/diameter/test/diameter_pool_SUITE.erl
index 97c16940ff..a36a4fa17a 100644
--- a/lib/diameter/test/diameter_pool_SUITE.erl
+++ b/lib/diameter/test/diameter_pool_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2015-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2015-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -51,6 +51,7 @@
{'Auth-Application-Id', [0]}, %% common
{'Acct-Application-Id', [3]}, %% accounting
{restrict_connections, false},
+ {spawn_opt, {diameter_dist, route_session, []}},
{application, [{alias, common},
{dictionary, diameter_gen_base_rfc6733},
{module, diameter_callback}]},
diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl
index 434aef01dd..47b00c25a2 100644
--- a/lib/diameter/test/diameter_traffic_SUITE.erl
+++ b/lib/diameter/test/diameter_traffic_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -539,8 +539,7 @@ add_transports(Config) ->
++ [{unordered, unordered()} || T == sctp],
[{capabilities_cb, fun capx/2},
{pool_size, 8}
- | server_apps()]
- ++ [{spawn_opt, {erlang, spawn, []}} || CS]),
+ | server_apps()]),
Cs = [?util:connect(CN,
[T, {sender, CS} | client_opts(T)],
LRef,
diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk
index 0c73adca12..90b0a25d5f 100644
--- a/lib/diameter/test/modules.mk
+++ b/lib/diameter/test/modules.mk
@@ -1,7 +1,7 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 2010-2017. All Rights Reserved.
+# Copyright Ericsson AB 2010-2019. All Rights Reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
@@ -31,6 +31,7 @@ MODULES = \
diameter_codec_test \
diameter_config_SUITE \
diameter_compiler_SUITE \
+ diameter_dist_SUITE \
diameter_distribution_SUITE \
diameter_dpr_SUITE \
diameter_event_SUITE \
diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk
index 8c75c9e55e..a900e8f28e 100644
--- a/lib/diameter/vsn.mk
+++ b/lib/diameter/vsn.mk
@@ -17,5 +17,5 @@
# %CopyrightEnd%
APPLICATION = diameter
-DIAMETER_VSN = 2.1.6
+DIAMETER_VSN = 2.2
APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN)
diff --git a/lib/edoc/doc/src/notes.xml b/lib/edoc/doc/src/notes.xml
index e818887eb8..145856bcaa 100644
--- a/lib/edoc/doc/src/notes.xml
+++ b/lib/edoc/doc/src/notes.xml
@@ -32,6 +32,22 @@
<p>This document describes the changes made to the EDoc
application.</p>
+<section><title>Edoc 0.10</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> Print a helpful message explaining that adding
+ <c>{preprocess, true}</c> can help if reading a source
+ file fails. </p>
+ <p>
+ Own Id: OTP-15605 Aux Id: ERL-841 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Edoc 0.9.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl
index b641118c5d..e9d62d3283 100644
--- a/lib/edoc/src/edoc.erl
+++ b/lib/edoc/src/edoc.erl
@@ -578,7 +578,7 @@ read_source(Name, Opts0) ->
Opts = expand_opts(Opts0),
case read_source_1(Name, Opts) of
{ok, Forms} ->
- check_forms(Forms, Name),
+ check_forms(Forms, Name, Opts),
Forms;
{error, R} ->
edoc_report:error({"error reading file '~ts'.",
@@ -692,13 +692,19 @@ fll([T | L], LastLine, Ts) ->
fll(L, _LastLine, Ts) ->
lists:reverse(L, Ts).
-check_forms(Fs, Name) ->
+check_forms(Fs, Name, Opts) ->
Fun = fun (F) ->
case erl_syntax:type(F) of
error_marker ->
case erl_syntax:error_marker_info(F) of
{L, M, D} ->
- edoc_report:error(L, Name, {format_error, M, D});
+ edoc_report:error(L, Name, {format_error, M, D}),
+ case proplists:get_bool(preprocess, Opts) of
+ true ->
+ ok;
+ false ->
+ helpful_message(Name)
+ end;
Other ->
edoc_report:report(Name, "unknown error in "
"source code: ~w.", [Other])
@@ -710,6 +716,11 @@ check_forms(Fs, Name) ->
end,
lists:foreach(Fun, Fs).
+helpful_message(Name) ->
+ Ms = ["If the error is caused by too exotic macro",
+ "definitions or uses of macros, adding option",
+ "{preprocess, true} can help. See also edoc(3)."],
+ lists:foreach(fun(M) -> edoc_report:report(Name, M, []) end, Ms).
%% @spec get_doc(File::filename()) -> {ModuleName, edoc_module()}
%% @equiv get_doc(File, [])
diff --git a/lib/edoc/vsn.mk b/lib/edoc/vsn.mk
index 0b3636f030..b6e1422623 100644
--- a/lib/edoc/vsn.mk
+++ b/lib/edoc/vsn.mk
@@ -1 +1 @@
-EDOC_VSN = 0.9.4
+EDOC_VSN = 0.10
diff --git a/lib/erl_docgen/doc/src/notes.xml b/lib/erl_docgen/doc/src/notes.xml
index 97c842a324..54f0a36b27 100644
--- a/lib/erl_docgen/doc/src/notes.xml
+++ b/lib/erl_docgen/doc/src/notes.xml
@@ -31,7 +31,31 @@
</header>
<p>This document describes the changes made to the <em>erl_docgen</em> application.</p>
- <section><title>Erl_Docgen 0.8.1</title>
+ <section><title>Erl_Docgen 0.9</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ The HTML reference documentation shows the OTP version
+ where modules and functions were first introduced.
+ Versions older than R13B04 are not shown.</p>
+ <p>
+ Own Id: OTP-15460</p>
+ </item>
+ <item>
+ <p>
+ Make html documentation of C functions with many
+ arguments more readable.</p>
+ <p>
+ Own Id: OTP-15637 Aux Id: PR-2160 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erl_Docgen 0.8.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/erl_docgen/priv/css/otp_doc.css b/lib/erl_docgen/priv/css/otp_doc.css
index 89b278215c..17d9f8dd56 100644
--- a/lib/erl_docgen/priv/css/otp_doc.css
+++ b/lib/erl_docgen/priv/css/otp_doc.css
@@ -74,7 +74,7 @@ a:visited { color: #1b6ec2; text-decoration: none }
/* Invisible table for function specs,
* just to get since-version out in right margin */
-.func-table, .func-tr, .func-td, .func-since-td {
+.func-table, .func-tr, .func-td, .cfunc-td, .func-since-td {
width: 200%;
border: 0;
padding: 0;
@@ -86,7 +86,13 @@ a:visited { color: #1b6ec2; text-decoration: none }
}
.func-td {
- width: 50%
+ width: 50%;
+}
+
+.cfunc-td {
+ width: 50%;
+ padding-left: 100px;
+ text-indent: -100px;
}
.func-since-td {
diff --git a/lib/erl_docgen/priv/xsl/db_html.xsl b/lib/erl_docgen/priv/xsl/db_html.xsl
index c5150d447c..c9be926e1e 100644
--- a/lib/erl_docgen/priv/xsl/db_html.xsl
+++ b/lib/erl_docgen/priv/xsl/db_html.xsl
@@ -2119,17 +2119,10 @@
<xsl:when test="ancestor::cref">
<table class="func-table">
<tr class="func-tr">
- <td class="func-td">
+ <td class="cfunc-td">
<span class="bold_code bc-7">
<xsl:call-template name="title_link">
<xsl:with-param name="link" select="substring-before(nametext, '(')"/>
- <xsl:with-param name="title">
- <xsl:value-of select="ret"/>
- <xsl:call-template name="maybe-space-after-ret">
- <xsl:with-param name="s" select="ret"/>
- </xsl:call-template>
- <xsl:value-of select="nametext"/>
- </xsl:with-param>
</xsl:call-template>
</span>
</td>
@@ -2199,18 +2192,6 @@
</xsl:template>
- <xsl:template name="maybe-space-after-ret">
- <xsl:param name="s"/>
- <xsl:variable name="last_char"
- select="substring($s, string-length($s), 1)"/>
- <xsl:choose>
- <xsl:when test="$last_char != '*'">
- <xsl:text> </xsl:text>
- </xsl:when>
- </xsl:choose>
- </xsl:template>
-
-
<!-- Type -->
<xsl:template match="type">
<xsl:param name="partnum"/>
@@ -2264,7 +2245,7 @@
</xsl:template>
<xsl:template name="title_link">
- <xsl:param name="title"/>
+ <xsl:param name="title" select="'APPLY'"/>
<xsl:param name="link" select="erl:to-link(title)"/>
<xsl:param name="ghlink" select="ancestor-or-self::*[@ghlink][position() = 1]/@ghlink"/>
<xsl:variable name="id" select="concat(concat($link,'-'), generate-id(.))"/>
@@ -2274,7 +2255,16 @@
<xsl:with-param name="id" select="$id"/>
<xsl:with-param name="ghlink" select="$ghlink"/>
</xsl:call-template>
- <a class="title_link" name="{$link}" href="#{$link}"><xsl:value-of select="$title"/></a>
+ <a class="title_link" name="{$link}" href="#{$link}">
+ <xsl:choose>
+ <xsl:when test="$title = 'APPLY'">
+ <xsl:apply-templates/> <!-- like <ret> and <nametext> -->
+ </xsl:when>
+ <xsl:otherwise>
+ <xsl:value-of select="$title"/>
+ </xsl:otherwise>
+ </xsl:choose>
+ </a>
</span>
</xsl:template>
@@ -2704,4 +2694,46 @@
<xsl:value-of select="normalize-space(.)"/>
</xsl:template>
+ <xsl:template match="ret">
+ <xsl:value-of select="."/>
+ <xsl:variable name="last_char" select="substring(., string-length(.), 1)"/>
+ <xsl:if test="$last_char != '*'">
+ <xsl:text> </xsl:text>
+ </xsl:if>
+ </xsl:template>
+
+ <xsl:template match="nametext">
+ <xsl:value-of select="substring-before(.,'(')"/>
+ <xsl:text>(</xsl:text>
+ <xsl:variable name="arglist" select="substring-after(.,'(')"/>
+ <xsl:choose>
+ <xsl:when test="$arglist = ')' or $arglist = 'void)'">
+ <xsl:value-of select="$arglist"/>
+ </xsl:when>
+ <xsl:otherwise>
+ <br/>
+ <xsl:call-template name="cfunc-arglist">
+ <xsl:with-param name="text" select="$arglist"/>
+ </xsl:call-template>
+ </xsl:otherwise>
+ </xsl:choose>
+ </xsl:template>
+
+ <!-- Format C function argument list with <br> after comma -->
+ <xsl:template name="cfunc-arglist">
+ <xsl:param name="text"/>
+ <xsl:variable name="line" select="normalize-space($text)"/>
+ <xsl:choose>
+ <xsl:when test="contains($line,',')">
+ <xsl:value-of select="substring-before($line,',')"/>,<br/>
+ <xsl:call-template name="cfunc-arglist">
+ <xsl:with-param name="text" select="substring-after($line,',')"/>
+ </xsl:call-template>
+ </xsl:when>
+ <xsl:otherwise>
+ <xsl:value-of select="$line"/>
+ </xsl:otherwise>
+ </xsl:choose>
+ </xsl:template>
+
</xsl:stylesheet>
diff --git a/lib/erl_docgen/vsn.mk b/lib/erl_docgen/vsn.mk
index 3b2f6db6a1..6321f229dd 100644
--- a/lib/erl_docgen/vsn.mk
+++ b/lib/erl_docgen/vsn.mk
@@ -1 +1 @@
-ERL_DOCGEN_VSN = 0.8.1
+ERL_DOCGEN_VSN = 0.9
diff --git a/lib/erl_interface/configure.in b/lib/erl_interface/configure.in
index 14f06f946f..f0e9b2eb3f 100644
--- a/lib/erl_interface/configure.in
+++ b/lib/erl_interface/configure.in
@@ -360,6 +360,7 @@ LDFLAGS="$LDFLAGS $sanitizers"
# XXX
# ---------------------------------------------------------------------------
+
AC_OUTPUT(
src/$host/Makefile:src/Makefile.in
src/$host/eidefs.mk:src/eidefs.mk.in
diff --git a/lib/erl_interface/doc/src/ei.xml b/lib/erl_interface/doc/src/ei.xml
index 16f4e18637..f081ca926a 100644
--- a/lib/erl_interface/doc/src/ei.xml
+++ b/lib/erl_interface/doc/src/ei.xml
@@ -35,6 +35,9 @@
<lib>ei</lib>
<libsummary>Routines for handling the Erlang binary term format.</libsummary>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+
<p>The library <c>ei</c> contains macros and functions to encode
and decode the Erlang binary term format.</p>
@@ -733,6 +736,21 @@ ei_encode_tuple_header(buf, &amp;i, 0);</pre>
</func>
<func>
+ <name since="OTP 21.3"><ret>int</ret><nametext>ei_init(void)</nametext></name>
+ <fsummary>Initialize the ei library.</fsummary>
+ <desc>
+ <p>Initialize the <c>ei</c> library. This function should be called once
+ (and only once) before calling any other functionality in the <c>ei</c>
+ library. However, note the exception below.</p>
+ <p>If the <c>ei</c> library is used together with the <c>erl_interface</c>
+ library, this function should <em>not</em> be called directly. It will be
+ called by the <c>erl_init()</c> function which should be used to initialize
+ the combination of the two libraries instead.</p>
+ <p>On success zero is returned. On failure a posix error code is returned.</p>
+ </desc>
+ </func>
+
+ <func>
<name since=""><ret>int</ret><nametext>ei_print_term(FILE* fp, const char* buf, int* index)</nametext></name>
<name since=""><ret>int</ret><nametext>ei_s_print_term(char** s, const char* buf, int* index)</nametext></name>
<fsummary>Print a term in clear text.</fsummary>
diff --git a/lib/erl_interface/doc/src/ei_connect.xml b/lib/erl_interface/doc/src/ei_connect.xml
index e318dd6664..795f1249b3 100644
--- a/lib/erl_interface/doc/src/ei_connect.xml
+++ b/lib/erl_interface/doc/src/ei_connect.xml
@@ -34,6 +34,9 @@
<lib>ei_connect</lib>
<libsummary>Communicate with distributed Erlang.</libsummary>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+
<p>This module enables C-programs to communicate with Erlang nodes,
using the Erlang distribution over TCP/IP.</p>
@@ -409,7 +412,7 @@ typedef struct {
</func>
<func>
- <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_close_connection(int fd)</nametext></name>
+ <name since="OTP 21.3"><ret>int</ret><nametext>ei_close_connection(int fd)</nametext></name>
<fsummary>Close a connection.</fsummary>
<desc>
<p>Closes a previously opened connection or listen socket.</p>
@@ -469,9 +472,9 @@ fd = ei_xconnect(&ec, &addr, ALIVE);
<func>
<name since=""><ret>int</ret><nametext>ei_connect_init(ei_cnode* ec, const char* this_node_name, const char *cookie, short creation)</nametext></name>
- <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_connect_init_ussi(ei_cnode* ec, const char* this_node_name, const char *cookie, short creation, ei_socket_callbacks *cbs, int cbs_sz, void *setup_context)</nametext></name>
+ <name since="OTP 21.3"><ret>int</ret><nametext>ei_connect_init_ussi(ei_cnode* ec, const char* this_node_name, const char *cookie, short creation, ei_socket_callbacks *cbs, int cbs_sz, void *setup_context)</nametext></name>
<name since=""><ret>int</ret><nametext>ei_connect_xinit(ei_cnode* ec, const char *thishostname, const char *thisalivename, const char *thisnodename, Erl_IpAddr thisipaddr, const char *cookie, short creation)</nametext></name>
- <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, const char *thisalivename, const char *thisnodename, Erl_IpAddr thisipaddr, const char *cookie, short creation, ei_socket_callbacks *cbs, int cbs_sz, void *setup_context)</nametext></name>
+ <name since="OTP 21.3"><ret>int</ret><nametext>ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname, const char *thisalivename, const char *thisnodename, Erl_IpAddr thisipaddr, const char *cookie, short creation, ei_socket_callbacks *cbs, int cbs_sz, void *setup_context)</nametext></name>
<fsummary>Initialize for a connection.</fsummary>
<desc>
<p>Initializes the <c>ec</c> structure, to
@@ -592,8 +595,8 @@ if (ei_connect_init(&ec, "madonna", "cookie...", n++) < 0) {
</func>
<func>
- <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_listen(ei_cnode *ec, int *port, int backlog)</nametext></name>
- <name since="OTP @OTP-15442@"><ret>int</ret><nametext>ei_xlisten(ei_cnode *ec, Erl_IpAddr adr, int *port, int backlog)</nametext></name>
+ <name since="OTP 21.3"><ret>int</ret><nametext>ei_listen(ei_cnode *ec, int *port, int backlog)</nametext></name>
+ <name since="OTP 21.3"><ret>int</ret><nametext>ei_xlisten(ei_cnode *ec, Erl_IpAddr adr, int *port, int backlog)</nametext></name>
<fsummary>Create a listen socket.</fsummary>
<desc>
<p>Used by a server process to setup a listen socket which
diff --git a/lib/erl_interface/doc/src/ei_users_guide.xml b/lib/erl_interface/doc/src/ei_users_guide.xml
index 0eed50b50b..7ca10d1a99 100644
--- a/lib/erl_interface/doc/src/ei_users_guide.xml
+++ b/lib/erl_interface/doc/src/ei_users_guide.xml
@@ -34,6 +34,18 @@
</header>
<section>
+ <title>Deprecation and Removal</title>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
+ </section>
+
+ <section>
<title>Introduction</title>
<p>The <c>Erl_Interface</c> library contains functions that help you
integrate programs written in C and Erlang. The functions in
@@ -162,12 +174,20 @@ $ ld -L/usr/local/otp/lib/erl_interface-3.2.3/
</section>
<section>
- <title>Initializing the Erl_Interface Library</title>
- <p>Before calling any of the other <c>Erl_Interface</c> functions, call
- <c>erl_init()</c> exactly once to initialize the library.
+ <title>Initializing the Libraries</title>
+ <p>
+ Before calling any of the other functions in the <c>erl_interface</c>
+ and <c>ei</c> libraries, call <c>erl_init()</c> exactly once to initialize
+ both libraries.
<c>erl_init()</c> takes two arguments. However, the arguments
- are no longer used by <c>Erl_Interface</c> and are therefore to be
- specified as <c>erl_init(NULL,0)</c>.</p>
+ are no longer used by <c>erl_interface</c> and are therefore to be
+ specified as <c>erl_init(NULL,0)</c>.
+ </p>
+ <p>
+ If you only use the <c>ei</c> library, instead initialize it by calling
+ <c>ei_init()</c> exactly once before calling any other functions in
+ the <c>ei</c> library.
+ </p>
</section>
<section>
diff --git a/lib/erl_interface/doc/src/erl_connect.xml b/lib/erl_interface/doc/src/erl_connect.xml
index 139ac9e2f0..9492a82864 100644
--- a/lib/erl_interface/doc/src/erl_connect.xml
+++ b/lib/erl_interface/doc/src/erl_connect.xml
@@ -35,6 +35,15 @@
<lib>erl_connect</lib>
<libsummary>Communicate with distributed Erlang.</libsummary>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
+
<p>This module provides support for communication between distributed
Erlang nodes and C-nodes, in a manner that is transparent to Erlang
processes.</p>
diff --git a/lib/erl_interface/doc/src/erl_eterm.xml b/lib/erl_interface/doc/src/erl_eterm.xml
index 070ed30dfe..295760b4e6 100644
--- a/lib/erl_interface/doc/src/erl_eterm.xml
+++ b/lib/erl_interface/doc/src/erl_eterm.xml
@@ -35,6 +35,15 @@
<lib>erl_eterm</lib>
<libsummary>Functions for Erlang term construction.</libsummary>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
+
<p>This module provides functions for creating and manipulating
Erlang terms.</p>
diff --git a/lib/erl_interface/doc/src/erl_global.xml b/lib/erl_interface/doc/src/erl_global.xml
index 72d43e81d5..39085b46f0 100644
--- a/lib/erl_interface/doc/src/erl_global.xml
+++ b/lib/erl_interface/doc/src/erl_global.xml
@@ -35,6 +35,15 @@
<lib>erl_global</lib>
<libsummary>Access globally registered names.</libsummary>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
+
<p>This module provides support for registering, looking
up, and unregistering names in the <c>global</c> module.
For more information, see
diff --git a/lib/erl_interface/doc/src/erl_interface.xml b/lib/erl_interface/doc/src/erl_interface.xml
index 4e66655b39..decd66046a 100644
--- a/lib/erl_interface/doc/src/erl_interface.xml
+++ b/lib/erl_interface/doc/src/erl_interface.xml
@@ -58,6 +58,18 @@
</list>
<section>
+ <title>Deprecation and Removal</title>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
+ </section>
+
+ <section>
<title>Compiling and Linking Your Code</title>
<p>In order to use any of the Erl_Interface functions, include the
following lines in your code:</p>
diff --git a/lib/erl_interface/doc/src/erl_malloc.xml b/lib/erl_interface/doc/src/erl_malloc.xml
index aae3b7e078..6650620064 100644
--- a/lib/erl_interface/doc/src/erl_malloc.xml
+++ b/lib/erl_interface/doc/src/erl_malloc.xml
@@ -35,6 +35,14 @@
<lib>erl_malloc</lib>
<libsummary>Memory allocation functions.</libsummary>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
<p>This module provides functions for allocating and deallocating
memory.</p>
</description>
diff --git a/lib/erl_interface/doc/src/erl_marshal.xml b/lib/erl_interface/doc/src/erl_marshal.xml
index 1a6d3bb43c..33d359d871 100644
--- a/lib/erl_interface/doc/src/erl_marshal.xml
+++ b/lib/erl_interface/doc/src/erl_marshal.xml
@@ -35,6 +35,14 @@
<lib>erl_marshal</lib>
<libsummary>Encoding and decoding of Erlang terms.</libsummary>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
<p>This module contains functions for encoding Erlang terms into
a sequence of bytes, and for decoding Erlang terms from a
sequence of bytes.</p>
diff --git a/lib/erl_interface/doc/src/notes.xml b/lib/erl_interface/doc/src/notes.xml
index 07ddd82718..b686cfbf33 100644
--- a/lib/erl_interface/doc/src/notes.xml
+++ b/lib/erl_interface/doc/src/notes.xml
@@ -31,6 +31,23 @@
</header>
<p>This document describes the changes made to the Erl_interface application.</p>
+<section><title>Erl_Interface 3.11</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Support for plugin of a <seealso
+ marker="ei_connect#ussi">user supplied socket
+ implementation</seealso> has been added.</p>
+ <p>
+ Own Id: OTP-15442 Aux Id: ERIERL-258 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erl_Interface 3.10.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/erl_interface/doc/src/ref_man.xml b/lib/erl_interface/doc/src/ref_man.xml
index 1e20637cb7..a4f947c79f 100644
--- a/lib/erl_interface/doc/src/ref_man.xml
+++ b/lib/erl_interface/doc/src/ref_man.xml
@@ -29,6 +29,14 @@
<file>ref_man.xml</file>
</header>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
</description>
<xi:include href="ei.xml"/>
<xi:include href="ei_connect.xml"/>
diff --git a/lib/erl_interface/doc/src/ref_man_ei.xml b/lib/erl_interface/doc/src/ref_man_ei.xml
index 92ff9ed328..d8d1deaea1 100644
--- a/lib/erl_interface/doc/src/ref_man_ei.xml
+++ b/lib/erl_interface/doc/src/ref_man_ei.xml
@@ -30,8 +30,14 @@
<file>ref_man_ei.xml</file>
</header>
<description>
- <p>The <c>ei</c> library is a <c>C</c> interface library for
- communication with <c>Erlang</c>.</p>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
<note>
<p>By default, the <c>ei</c> library is only guaranteed
to be compatible with other Erlang/OTP components from the same
diff --git a/lib/erl_interface/doc/src/ref_man_erl_interface.xml b/lib/erl_interface/doc/src/ref_man_erl_interface.xml
index 4b1d0e9981..2b69d0fa74 100644
--- a/lib/erl_interface/doc/src/ref_man_erl_interface.xml
+++ b/lib/erl_interface/doc/src/ref_man_erl_interface.xml
@@ -30,6 +30,14 @@
<file>ref_man_erl_interface.xml</file>
</header>
<description>
+ <note><p>The support for VxWorks is deprecated as of OTP 22, and
+ will be removed in OTP 23.</p></note>
+ <note><p>The old legacy <c>erl_interface</c> library (functions
+ with prefix <c>erl_</c>) is deprecated as of OTP 22, and will be
+ removed in OTP 23. This does not apply to the <c>ei</c>
+ library. Reasonably new <c>gcc</c> compilers will issue deprecation
+ warnings. In order to disable these warnings, define the macro
+ <c>EI_NO_DEPR_WARN</c>.</p></note>
<p>The <c>erl_interface</c> library is a <c>C</c> interface library
for communication with <c>Erlang</c>.</p>
<note>
diff --git a/lib/erl_interface/include/ei.h b/lib/erl_interface/include/ei.h
index 92674571e2..aa2a49098f 100644
--- a/lib/erl_interface/include/ei.h
+++ b/lib/erl_interface/include/ei.h
@@ -36,6 +36,8 @@
#include <windows.h>
#include <winbase.h>
typedef LONG_PTR ssize_t; /* Sigh... */
+#else
+#include <sys/types.h> /* ssize_t */
#endif
#include <stdio.h> /* Need type FILE */
@@ -45,6 +47,25 @@ typedef LONG_PTR ssize_t; /* Sigh... */
# include <netdb.h>
#endif
+#ifdef __has_attribute
+#if __has_attribute(deprecated)
+#define EI_HAVE_DEPRECATED_ATTR__ 1
+#else
+#undef EI_HAVE_DEPRECATED_ATTR__
+#endif
+#endif
+
+#ifdef EI_NO_DEPR_WARN
+#undef EI_HAVE_DEPRECATED_ATTR__
+#endif
+
+#ifdef EI_HAVE_DEPRECATED_ATTR__
+#define EI_DEPRECATED_ATTR_NAME deprecated
+#define EI_DEPRECATED_ATTR __attribute__((EI_DEPRECATED_ATTR_NAME))
+#else
+#define EI_DEPRECATED_ATTR_NAME
+#define EI_DEPRECATED_ATTR
+#endif
/* -------------------------------------------------------------------- */
/* Defines part of API */
@@ -667,6 +688,8 @@ struct ei_reg_tabstat {
};
+int ei_init(void);
+
/* -------------------------------------------------------------------- */
/* XXXXXXXXXXX */
/* -------------------------------------------------------------------- */
diff --git a/lib/erl_interface/include/erl_interface.h b/lib/erl_interface/include/erl_interface.h
index c22f21af2b..7c87223a38 100644
--- a/lib/erl_interface/include/erl_interface.h
+++ b/lib/erl_interface/include/erl_interface.h
@@ -25,8 +25,6 @@
/* Note: the 'ei' interface is the prefered C API. */
/************************************************************************/
-/* FIXME only include if needed? */
-
#include "ei.h" /* ei is the base */
/* -------------------------------------------------------------------- */
@@ -195,11 +193,11 @@ typedef struct {
int lenL;
} Erl_Atom_data;
-char* erl_atom_ptr_latin1(Erl_Atom_data*);
-char* erl_atom_ptr_utf8(Erl_Atom_data*);
-int erl_atom_size_latin1(Erl_Atom_data*);
-int erl_atom_size_utf8(Erl_Atom_data*);
-char* erl_atom_init_latin1(Erl_Atom_data*, const char*);
+char* erl_atom_ptr_latin1(Erl_Atom_data*) EI_DEPRECATED_ATTR;
+char* erl_atom_ptr_utf8(Erl_Atom_data*) EI_DEPRECATED_ATTR;
+int erl_atom_size_latin1(Erl_Atom_data*) EI_DEPRECATED_ATTR;
+int erl_atom_size_utf8(Erl_Atom_data*) EI_DEPRECATED_ATTR;
+char* erl_atom_init_latin1(Erl_Atom_data*, const char*) EI_DEPRECATED_ATTR;
typedef struct {
Erl_Header h;
@@ -324,110 +322,117 @@ typedef unsigned char Erl_Heap;
/* The functions */
/* -------------------------------------------------------------------- */
-void erl_init(void *x, long y);
-void erl_set_compat_rel(unsigned);
-int erl_connect_init(int, char*,short);
-int erl_connect_xinit(char*,char*,char*,struct in_addr*,char*,short);
-int erl_connect(char*);
-int erl_xconnect(struct in_addr*,char *);
-int erl_close_connection(int);
-int erl_receive(int, unsigned char*, int);
-int erl_receive_msg(int, unsigned char*, int, ErlMessage*);
-int erl_xreceive_msg(int, unsigned char**, int*, ErlMessage*);
-int erl_send(int, ETERM*, ETERM*);
-int erl_reg_send(int, char*, ETERM*);
-ETERM *erl_rpc(int,char*,char*,ETERM*);
-int erl_rpc_to(int,char*,char*,ETERM*);
-int erl_rpc_from(int,int,ErlMessage*);
+void erl_init(void *x, long y) EI_DEPRECATED_ATTR;
+void erl_set_compat_rel(unsigned) EI_DEPRECATED_ATTR;
+int erl_connect_init(int, char*,short) EI_DEPRECATED_ATTR;
+int erl_connect_xinit(char*,char*,char*,struct in_addr*,char*,short) EI_DEPRECATED_ATTR;
+int erl_connect(char*) EI_DEPRECATED_ATTR;
+int erl_xconnect(struct in_addr*,char *) EI_DEPRECATED_ATTR;
+int erl_close_connection(int) EI_DEPRECATED_ATTR;
+int erl_receive(int, unsigned char*, int) EI_DEPRECATED_ATTR;
+int erl_receive_msg(int, unsigned char*, int, ErlMessage*) EI_DEPRECATED_ATTR;
+int erl_xreceive_msg(int, unsigned char**, int*, ErlMessage*) EI_DEPRECATED_ATTR;
+int erl_send(int, ETERM*, ETERM*) EI_DEPRECATED_ATTR;
+int erl_reg_send(int, char*, ETERM*) EI_DEPRECATED_ATTR;
+ETERM *erl_rpc(int,char*,char*,ETERM*) EI_DEPRECATED_ATTR;
+int erl_rpc_to(int,char*,char*,ETERM*) EI_DEPRECATED_ATTR;
+int erl_rpc_from(int,int,ErlMessage*) EI_DEPRECATED_ATTR;
/* erl_publish returns open descriptor on success, or -1 */
-int erl_publish(int port);
-int erl_accept(int,ErlConnect*);
+int erl_publish(int port) EI_DEPRECATED_ATTR;
+int erl_accept(int,ErlConnect*) EI_DEPRECATED_ATTR;
-const char *erl_thiscookie(void);
-const char *erl_thisnodename(void);
-const char *erl_thishostname(void);
-const char *erl_thisalivename(void);
-short erl_thiscreation(void);
+const char *erl_thiscookie(void) EI_DEPRECATED_ATTR;
+const char *erl_thisnodename(void) EI_DEPRECATED_ATTR;
+const char *erl_thishostname(void) EI_DEPRECATED_ATTR;
+const char *erl_thisalivename(void) EI_DEPRECATED_ATTR;
+short erl_thiscreation(void) EI_DEPRECATED_ATTR;
/* returns 0 on success, -1 if node not known to epmd or epmd not reached */
-int erl_unpublish(const char *alive);
+int erl_unpublish(const char *alive) EI_DEPRECATED_ATTR;
+
+#ifdef EI_HAVE_DEPRECATED_ATTR__
+#define EI_DEPR_ATTR_EXTRA , EI_DEPRECATED_ATTR_NAME
+#else
+#define EI_DEPR_ATTR_EXTRA
+#endif
+
/* Report generic error to stderr. */
void erl_err_msg(const char * __template, ...)
- __attribute__ ((__format__ (printf, 1, 2)));
+ __attribute__ ((__format__ (printf, 1, 2) EI_DEPR_ATTR_EXTRA)) ;
/* Report generic error to stderr and die. */
void erl_err_quit(const char * __template, ...)
- __attribute__ ((__format__ (printf, 1, 2), __noreturn__));
+ __attribute__ ((__format__ (printf, 1, 2), __noreturn__ EI_DEPR_ATTR_EXTRA));
/* Report system/libc error to stderr. */
void erl_err_ret(const char * __template, ...)
- __attribute__ ((__format__ (printf, 1, 2)));
+ __attribute__ ((__format__ (printf, 1, 2) EI_DEPR_ATTR_EXTRA));
/* Report system/libc error to stderr and die. */
void erl_err_sys(const char * __template, ...)
- __attribute__ ((__format__ (printf, 1, 2), __noreturn__));
-
-ETERM *erl_cons(ETERM*,ETERM*);
-ETERM *erl_copy_term(const ETERM*);
-ETERM *erl_element(int,const ETERM*);
-
-ETERM *erl_hd(const ETERM*);
-ETERM* erl_iolist_to_binary(const ETERM* term);
-char* erl_iolist_to_string(const ETERM* term);
-int erl_iolist_length(const ETERM*);
-int erl_length(const ETERM*);
-ETERM *erl_mk_atom(const char*);
-ETERM *erl_mk_binary(const char*,int);
-ETERM *erl_mk_empty_list(void);
-ETERM *erl_mk_estring(const char*, int);
-ETERM *erl_mk_float(double);
-ETERM *erl_mk_int(int);
-ETERM *erl_mk_longlong(long long);
-ETERM *erl_mk_list(ETERM**,int);
-ETERM *erl_mk_pid(const char*,unsigned int,unsigned int,unsigned char);
-ETERM *erl_mk_port(const char*,unsigned int,unsigned char);
-ETERM *erl_mk_ref(const char*,unsigned int,unsigned char);
+ __attribute__ ((__format__ (printf, 1, 2), __noreturn__ EI_DEPR_ATTR_EXTRA));
+
+ETERM *erl_cons(ETERM*,ETERM*) EI_DEPRECATED_ATTR;
+ETERM *erl_copy_term(const ETERM*) EI_DEPRECATED_ATTR;
+ETERM *erl_element(int,const ETERM*) EI_DEPRECATED_ATTR;
+
+ETERM *erl_hd(const ETERM*) EI_DEPRECATED_ATTR;
+ETERM* erl_iolist_to_binary(const ETERM* term) EI_DEPRECATED_ATTR;
+char* erl_iolist_to_string(const ETERM* term) EI_DEPRECATED_ATTR;
+int erl_iolist_length(const ETERM*) EI_DEPRECATED_ATTR;
+int erl_length(const ETERM*) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_atom(const char*) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_binary(const char*,int) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_empty_list(void) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_estring(const char*, int) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_float(double) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_int(int) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_longlong(long long) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_list(ETERM**,int) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_pid(const char*,unsigned int,unsigned int,unsigned char) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_port(const char*,unsigned int,unsigned char) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_ref(const char*,unsigned int,unsigned char) EI_DEPRECATED_ATTR;
ETERM *erl_mk_long_ref(const char*,unsigned int,unsigned int,
- unsigned int,unsigned char);
-ETERM *erl_mk_string(const char*);
-ETERM *erl_mk_tuple(ETERM**,int);
-ETERM *erl_mk_uint(unsigned int);
-ETERM *erl_mk_ulonglong(unsigned long long);
-ETERM *erl_mk_var(const char*);
-int erl_print_term(FILE*,const ETERM*);
-/* int erl_sprint_term(char*,const ETERM*); */
-int erl_size(const ETERM*);
-ETERM *erl_tl(const ETERM*);
-ETERM *erl_var_content(const ETERM*, const char*);
-
-ETERM *erl_format(char*, ... );
-int erl_match(ETERM*, ETERM*);
-
-char **erl_global_names(int fd, int *count);
-int erl_global_register(int fd, const char *name, ETERM *pid);
-int erl_global_unregister(int fd, const char *name);
-ETERM *erl_global_whereis(int fd, const char *name, char *node);
-
-void erl_init_malloc(Erl_Heap*,long);
-ETERM *erl_alloc_eterm(unsigned char);
-void erl_eterm_release(void);
-void erl_eterm_statistics(unsigned long*,unsigned long*);
-void erl_free_array(ETERM**,int);
-void erl_free_term(ETERM*);
-void erl_free_compound(ETERM*);
-void *erl_malloc(long);
-void erl_free(void*);
-
-int erl_compare_ext(unsigned char*, unsigned char*);
-ETERM *erl_decode(unsigned char*);
-ETERM *erl_decode_buf(unsigned char**);
-int erl_encode(ETERM*,unsigned char*t);
-int erl_encode_buf(ETERM*,unsigned char**);
-int erl_ext_size(unsigned char*);
-unsigned char erl_ext_type(unsigned char*); /* Note: returned 'char' before R9C */
-unsigned char *erl_peek_ext(unsigned char*,int);
-int erl_term_len(ETERM*);
-
-int cmp_latin1_vs_utf8(const char* sL, int lenL, const char* sU, int lenU);
+ unsigned int,unsigned char) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_string(const char*) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_tuple(ETERM**,int) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_uint(unsigned int) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_ulonglong(unsigned long long) EI_DEPRECATED_ATTR;
+ETERM *erl_mk_var(const char*) EI_DEPRECATED_ATTR;
+int erl_print_term(FILE*,const ETERM*) EI_DEPRECATED_ATTR;
+/* int erl_sprint_term(char*,const ETERM*) EI_DEPRECATED_ATTR; */
+int erl_size(const ETERM*) EI_DEPRECATED_ATTR;
+ETERM *erl_tl(const ETERM*) EI_DEPRECATED_ATTR;
+ETERM *erl_var_content(const ETERM*, const char*) EI_DEPRECATED_ATTR;
+
+ETERM *erl_format(char*, ... ) EI_DEPRECATED_ATTR;
+int erl_match(ETERM*, ETERM*) EI_DEPRECATED_ATTR;
+
+char **erl_global_names(int fd, int *count) EI_DEPRECATED_ATTR;
+int erl_global_register(int fd, const char *name, ETERM *pid) EI_DEPRECATED_ATTR;
+int erl_global_unregister(int fd, const char *name) EI_DEPRECATED_ATTR;
+ETERM *erl_global_whereis(int fd, const char *name, char *node) EI_DEPRECATED_ATTR;
+
+void erl_init_malloc(Erl_Heap*,long) EI_DEPRECATED_ATTR;
+ETERM *erl_alloc_eterm(unsigned char) EI_DEPRECATED_ATTR;
+void erl_eterm_release(void) EI_DEPRECATED_ATTR;
+void erl_eterm_statistics(unsigned long*,unsigned long*) EI_DEPRECATED_ATTR;
+void erl_free_array(ETERM**,int) EI_DEPRECATED_ATTR;
+void erl_free_term(ETERM*) EI_DEPRECATED_ATTR;
+void erl_free_compound(ETERM*) EI_DEPRECATED_ATTR;
+void *erl_malloc(long) EI_DEPRECATED_ATTR;
+void erl_free(void*) EI_DEPRECATED_ATTR;
+
+int erl_compare_ext(unsigned char*, unsigned char*) EI_DEPRECATED_ATTR;
+ETERM *erl_decode(unsigned char*) EI_DEPRECATED_ATTR;
+ETERM *erl_decode_buf(unsigned char**) EI_DEPRECATED_ATTR;
+int erl_encode(ETERM*,unsigned char*t) EI_DEPRECATED_ATTR;
+int erl_encode_buf(ETERM*,unsigned char**) EI_DEPRECATED_ATTR;
+int erl_ext_size(unsigned char*) EI_DEPRECATED_ATTR;
+unsigned char erl_ext_type(unsigned char*) EI_DEPRECATED_ATTR; /* Note: returned 'char' before R9C */
+unsigned char *erl_peek_ext(unsigned char*,int) EI_DEPRECATED_ATTR;
+int erl_term_len(ETERM*) EI_DEPRECATED_ATTR;
+
+int cmp_latin1_vs_utf8(const char* sL, int lenL, const char* sU, int lenU) EI_DEPRECATED_ATTR;
/* -------------------------------------------------------------------- */
/* Wrappers around ei functions */
@@ -437,29 +442,29 @@ int cmp_latin1_vs_utf8(const char* sL, int lenL, const char* sU, int lenU);
* Undocumented before R9C, included for compatibility with old code
*/
-struct hostent *erl_gethostbyname(const char *name);
-struct hostent *erl_gethostbyaddr(const char *addr, int len, int type);
+struct hostent *erl_gethostbyname(const char *name) EI_DEPRECATED_ATTR;
+struct hostent *erl_gethostbyaddr(const char *addr, int len, int type) EI_DEPRECATED_ATTR;
struct hostent *erl_gethostbyname_r(const char *name,
struct hostent *hostp,
char *buffer,
int buflen,
- int *h_errnop);
+ int *h_errnop) EI_DEPRECATED_ATTR;
struct hostent *erl_gethostbyaddr_r(const char *addr,
int length,
int type,
struct hostent *hostp,
char *buffer,
int buflen,
- int *h_errnop);
+ int *h_errnop) EI_DEPRECATED_ATTR;
/*
* Undocumented, included for compatibility with old code
*/
-void erl_init_resolve(void);
-int erl_distversion(int fd);
-int erl_epmd_connect(struct in_addr *inaddr);
-int erl_epmd_port(struct in_addr *inaddr, const char *alive, int *dist);
+void erl_init_resolve(void) EI_DEPRECATED_ATTR;
+int erl_distversion(int fd) EI_DEPRECATED_ATTR;
+int erl_epmd_connect(struct in_addr *inaddr) EI_DEPRECATED_ATTR;
+int erl_epmd_port(struct in_addr *inaddr, const char *alive, int *dist) EI_DEPRECATED_ATTR;
#ifdef __cplusplus
}
diff --git a/lib/erl_interface/src/Makefile b/lib/erl_interface/src/Makefile
index 800557fbfe..00c49f1622 100644
--- a/lib/erl_interface/src/Makefile
+++ b/lib/erl_interface/src/Makefile
@@ -27,7 +27,9 @@ include $(ERL_TOP)/make/output.mk
include $(ERL_TOP)/make/target.mk
debug opt shared purify quantify purecov gcov:
+ifndef TERTIARY_BOOTSTRAP
$(make_verbose)$(MAKE) -f $(TARGET)/Makefile TYPE=$@
+endif
clean depend docs release release_docs tests release_tests check xmllint:
$(make_verbose)$(MAKE) -f $(TARGET)/Makefile $@
diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in
index 614e7325a9..b2600f0fab 100644
--- a/lib/erl_interface/src/Makefile.in
+++ b/lib/erl_interface/src/Makefile.in
@@ -31,12 +31,13 @@
.PHONY : debug opt release clean distclean depend
-TARGET = @TARGET@
+include $(ERL_TOP)/make/target.mk
# ----------------------------------------------------
# Application version and release dir specification
# ----------------------------------------------------
include ../vsn.mk
+include $(ERL_TOP)/make/target.mk
include $(TARGET)/eidefs.mk
include $(ERL_TOP)/make/output.mk
@@ -126,6 +127,8 @@ else
WARNFLAGS = @WFLAGS@
endif
+WARNFLAGS += -DEI_NO_DEPR_WARN
+
CFLAGS = @LIB_CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS)
PROG_CFLAGS = @CFLAGS@ $(WARNFLAGS) $(INCFLAGS) $(TYPE_FLAGS) -Ilegacy
@@ -417,7 +420,8 @@ MISCSRC = \
misc/eimd5.c \
misc/get_type.c \
misc/show_msg.c \
- misc/ei_compat.c
+ misc/ei_compat.c \
+ misc/ei_init.c
REGISTRYSRC = \
registry/hash_dohash.c \
diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c
index 1132c9fc23..7a304e6d4f 100644
--- a/lib/erl_interface/src/connect/ei_connect.c
+++ b/lib/erl_interface/src/connect/ei_connect.c
@@ -21,6 +21,8 @@
* Purpose: Connect to any node at any host. (EI version)
*/
+#include "eidef.h"
+
#include <stdlib.h>
#include <sys/types.h>
#include <fcntl.h>
@@ -40,10 +42,8 @@
#include <inetLib.h>
#include <unistd.h>
-#include <sys/types.h>
#include <sys/times.h>
#include <unistd.h>
-#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netinet/tcp.h>
@@ -53,7 +53,6 @@
#else /* some other unix */
#include <unistd.h>
-#include <sys/types.h>
#include <sys/times.h>
#if TIME_WITH_SYS_TIME
@@ -84,7 +83,6 @@
#include <ctype.h>
#include <stddef.h>
-#include "eidef.h"
#include "eiext.h"
#include "ei_portio.h"
#include "ei_internal.h"
@@ -98,6 +96,7 @@
#include "ei_epmd.h"
#include "ei_internal.h"
+static int ei_connect_initialized = 0;
int ei_tracelevel = 0;
#define COOKIE_FILE "/.erlang.cookie"
@@ -244,7 +243,7 @@ typedef struct {
static ei_socket_info_data__ *socket_info_data = NULL;
-static int init_socket_info(void)
+static int init_socket_info(int late)
{
int max_fds;
int i;
@@ -252,7 +251,7 @@ static int init_socket_info(void)
ei_socket_info_data__ *info_data, *xchg;
if (EI_ATOMIC_LOAD_ACQ(&socket_info_data) != NULL)
- return !0; /* Already initialized... */
+ return 0; /* Already initialized... */
#if defined(HAVE_SYSCONF) && defined(_SC_OPEN_MAX)
max_fds = sysconf(_SC_OPEN_MAX);
@@ -261,14 +260,14 @@ static int init_socket_info(void)
#endif
if (max_fds < 0)
- return 0;
+ return EIO;
segments_len = ((max_fds-1)/EI_SOCKET_INFO_SEG_SIZE + 1);
info_data = malloc(sizeof(ei_socket_info_data__)
+ (sizeof(ei_socket_info *)*(segments_len-1)));
if (!info_data)
- return 0;
+ return ENOMEM;
info_data->max_fds = max_fds;
for (i = 0; i < segments_len; i++)
@@ -278,7 +277,7 @@ static int init_socket_info(void)
if (!EI_ATOMIC_CMPXCHG_ACQ_REL(&socket_info_data, &xchg, info_data))
free(info_data); /* Already initialized... */
- return !0;
+ return 0;
}
static int put_ei_socket_info(int fd, int dist_version, char* cookie, ei_cnode *ec,
@@ -362,14 +361,16 @@ ei_socket_info *ei_sockets = NULL;
ei_mutex_t* ei_sockets_lock = NULL;
#endif /* _REENTRANT */
-static int init_socket_info(void)
+static int init_socket_info(int late)
{
#ifdef _REENTRANT
- if (ei_sockets_lock == NULL) {
- ei_sockets_lock = ei_mutex_create();
- }
+ if (late)
+ return ENOTSUP; /* Refuse doing unsafe initialization... */
+ ei_sockets_lock = ei_mutex_create();
+ if (!ei_sockets_lock)
+ return ENOMEM;
#endif /* _REENTRANT */
- return !0;
+ return 0;
}
static int put_ei_socket_info(int fd, int dist_version, char* cookie, ei_cnode *ec,
@@ -602,6 +603,38 @@ static int initWinSock(void)
}
#endif
+static int init_connect(int late)
+{
+ int error;
+
+ /*
+ * 'late' is non-zero when not called via ei_init(). Such a
+ * call is not supported, but we for now save the day if
+ * it easy to do so; otherwise, return ENOTSUP.
+ */
+
+#ifdef __WIN32__
+ if (!initWinSock()) {
+ EI_TRACE_ERR0("ei_init_connect","can't initiate winsock");
+ return EIO;
+ }
+#endif /* win32 */
+
+ error = init_socket_info(late);
+ if (error) {
+ EI_TRACE_ERR0("ei_init_connect","can't initiate socket info");
+ return error;
+ }
+
+ ei_connect_initialized = !0;
+ return 0;
+}
+
+int ei_init_connect(void)
+{
+ return init_connect(0);
+}
+
/*
* Perhaps run this routine instead of ei_connect_init/2 ?
* Initailize by setting:
@@ -615,24 +648,12 @@ int ei_connect_xinit_ussi(ei_cnode* ec, const char *thishostname,
{
char *dbglevel;
+ if (!ei_connect_initialized)
+ init_connect(!0);
+
if (cbs != &ei_default_socket_callbacks)
EI_SET_HAVE_PLUGIN_SOCKET_IMPL__;
-/* FIXME this code was enabled for 'erl'_connect_xinit(), why not here? */
-#if 0
-#ifdef __WIN32__
- if (!initWinSock()) {
- EI_TRACE_ERR0("ei_connect_xinit","can't initiate winsock");
- return ERL_ERROR;
- }
-#endif
-#endif
-
- if (!init_socket_info()) {
- EI_TRACE_ERR0("ei_connect_xinit","can't initiate socket info");
- return ERL_ERROR;
- }
-
if (cbs_sz < EI_SOCKET_CALLBACKS_SZ_V1) {
EI_TRACE_ERR0("ei_connect_xinit","invalid size of ei_socket_callbacks struct");
return ERL_ERROR;
@@ -720,13 +741,9 @@ int ei_connect_init_ussi(ei_cnode* ec, const char* this_node_name,
int ei_h_errno;
int res;
-#ifdef __WIN32__
- if (!initWinSock()) {
- EI_TRACE_ERR0("ei_connect_xinit","can't initiate winsock");
- return ERL_ERROR;
- }
-#endif /* win32 */
-
+ if (!ei_connect_initialized)
+ init_connect(!0);
+
/* gethostname requires len to be max(hostname) + 1 */
if (gethostname(thishostname, EI_MAXHOSTNAMELEN+1) == -1) {
#ifdef __WIN32__
@@ -1279,7 +1296,6 @@ int ei_accept_tmo(ei_cnode* ec, int lfd, ErlConnect *conp, unsigned ms)
}
if (conp) {
memcpy((void *) conp->ipadr, (void *) &addr.sin_addr, sizeof(conp->ipadr));
- strcpy(&conp->nodename[0], her_name);
}
if (cbs->accept_handshake_complete) {
diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c
index 022a43d255..225fddc784 100644
--- a/lib/erl_interface/src/connect/ei_resolve.c
+++ b/lib/erl_interface/src/connect/ei_resolve.c
@@ -57,9 +57,9 @@
#ifdef HAVE_GETHOSTBYNAME_R
-void ei_init_resolve(void)
+int ei_init_resolve(void)
{
- return; /* Do nothing */
+ return 0; /* Do nothing */
}
#else /* !HAVE_GETHOSTBYNAME_R */
@@ -103,7 +103,7 @@ static int verify_dns_configuration(void);
* our own, which are just wrappers around hostGetByName() and
* hostGetByAddr(). Here we look up the functions.
*/
-void ei_init_resolve(void)
+int ei_init_resolve(void)
{
#ifdef VXWORKS
@@ -134,9 +134,12 @@ void ei_init_resolve(void)
#ifdef _REENTRANT
ei_gethost_sem = ei_mutex_create();
+ if (!ei_gethost_sem)
+ return ENOMEM;
#endif /* _REENTRANT */
ei_resolve_initialized = 1;
+ return 0;
}
#ifdef VXWORKS
@@ -312,9 +315,11 @@ static struct hostent *my_gethostbyname_r(const char *name,
struct hostent *src;
struct hostent *rval = NULL;
- /* FIXME this should have been done in 'erl'_init()? */
- if (!ei_resolve_initialized) ei_init_resolve();
-
+ if (!ei_resolve_initialized) {
+ *h_errnop = NO_RECOVERY;
+ return NULL;
+ }
+
#ifdef _REENTRANT
/* === BEGIN critical section === */
if (ei_mutex_lock(ei_gethost_sem,0) != 0) {
@@ -377,7 +382,10 @@ static struct hostent *my_gethostbyaddr_r(const char *addr,
struct hostent *rval = NULL;
/* FIXME this should have been done in 'erl'_init()? */
- if (!ei_resolve_initialized) ei_init_resolve();
+ if (!ei_resolve_initialized) {
+ *h_errnop = NO_RECOVERY;
+ return NULL;
+ }
#ifdef _REENTRANT
/* === BEGIN critical section === */
diff --git a/lib/erl_interface/src/connect/ei_resolve.h b/lib/erl_interface/src/connect/ei_resolve.h
index 10a49ffbc6..5711d7da76 100644
--- a/lib/erl_interface/src/connect/ei_resolve.h
+++ b/lib/erl_interface/src/connect/ei_resolve.h
@@ -20,6 +20,6 @@
#ifndef _EI_RESOLVE_H
#define _EI_RESOLVE_H
-void ei_init_resolve(void);
+int ei_init_resolve(void);
#endif /* _EI_RESOLVE_H */
diff --git a/lib/erl_interface/src/legacy/erl_eterm.c b/lib/erl_interface/src/legacy/erl_eterm.c
index 9ad92121f4..7ed2bdbc93 100644
--- a/lib/erl_interface/src/legacy/erl_eterm.c
+++ b/lib/erl_interface/src/legacy/erl_eterm.c
@@ -65,7 +65,7 @@ void erl_init(void *hp,long heap_size)
{
erl_init_malloc(hp, heap_size);
erl_init_marshal();
- ei_init_resolve();
+ (void) ei_init();
}
void erl_set_compat_rel(unsigned rel)
diff --git a/lib/erl_interface/src/misc/ei_init.c b/lib/erl_interface/src/misc/ei_init.c
new file mode 100644
index 0000000000..5357968657
--- /dev/null
+++ b/lib/erl_interface/src/misc/ei_init.c
@@ -0,0 +1,32 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2019. All Rights Reserved.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *
+ * %CopyrightEnd%
+ */
+
+#include "ei.h"
+#include "ei_resolve.h"
+#include "ei_internal.h"
+
+int
+ei_init(void)
+{
+ int error = ei_init_connect();
+ if (error)
+ return error;
+ return ei_init_resolve();
+}
diff --git a/lib/erl_interface/src/misc/ei_internal.h b/lib/erl_interface/src/misc/ei_internal.h
index 0c58245c0a..f28dd6d668 100644
--- a/lib/erl_interface/src/misc/ei_internal.h
+++ b/lib/erl_interface/src/misc/ei_internal.h
@@ -153,6 +153,8 @@
extern int ei_tracelevel;
+int ei_init_connect(void);
+
void ei_trace_printf(const char *name, int level, const char *format, ...);
int ei_internal_use_r9_pids_ports(void);
diff --git a/lib/erl_interface/src/misc/ei_portio.c b/lib/erl_interface/src/misc/ei_portio.c
index 726b1af82d..bccc86c1b1 100644
--- a/lib/erl_interface/src/misc/ei_portio.c
+++ b/lib/erl_interface/src/misc/ei_portio.c
@@ -19,6 +19,9 @@
*
*/
+
+#include "eidef.h"
+
#ifdef __WIN32__
#include <winsock2.h>
#include <windows.h>
@@ -47,10 +50,8 @@ static unsigned long param_one = 1;
#include <taskLib.h>
#include <inetLib.h>
#include <selectLib.h>
-#include <sys/types.h>
#include <ioLib.h>
#include <unistd.h>
-#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netinet/tcp.h>
@@ -65,7 +66,6 @@ static unsigned long param_one = 1;
#else /* other unix */
#include <stdlib.h>
-#include <sys/types.h>
#include <sys/socket.h>
#include <unistd.h>
#include <fcntl.h>
@@ -86,6 +86,7 @@ static unsigned long param_one = 1;
/* common includes */
+#include <sys/types.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
@@ -94,7 +95,9 @@ static unsigned long param_one = 1;
#else
#include <time.h>
#endif
-#include "eidef.h"
+#ifdef HAVE_SYS_SELECT_H
+#include <sys/select.h>
+#endif
#include "ei_portio.h"
#include "ei_internal.h"
@@ -246,7 +249,7 @@ static int tcp_accept(void **ctx, void *addr, int *len, unsigned unused)
if (res)
return res;
- res = accept(fd, (struct sockaddr*) &addr, &addr_len);
+ res = accept(fd, (struct sockaddr*) addr, &addr_len);
if (MEANS_SOCKET_ERROR(res))
return get_error();
diff --git a/lib/erl_interface/src/prog/erl_start.c b/lib/erl_interface/src/prog/erl_start.c
index 670a5900c9..ba495ac818 100644
--- a/lib/erl_interface/src/prog/erl_start.c
+++ b/lib/erl_interface/src/prog/erl_start.c
@@ -97,7 +97,7 @@
#endif
#ifndef RSH
-#define RSH "/usr/bin/rsh"
+#define RSH "/usr/bin/ssh"
#endif
#ifndef HAVE_SOCKLEN_T
diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c
index f41d741609..c209f506b1 100644
--- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c
+++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c
@@ -74,6 +74,8 @@ TESTCASE(interpret)
int i;
ei_term term;
+ ei_init();
+
ei_x_new(&x);
while (get_bin_term(&x, &term) == 0) {
char* buf = x.buff, func[MAXATOMLEN];
diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c b/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c
index c850d20f3c..90c7a2259f 100644
--- a/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c
+++ b/lib/erl_interface/test/ei_accept_SUITE_data/eiaccnode.c
@@ -178,6 +178,8 @@ MAIN(int argc, char *argv[])
no_threads = 1;
#endif
+ ei_init();
+
for (i = 0; i < n; ++i) {
if (!no_threads) {
#ifndef VXWORKS
diff --git a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c
index 29c03d7604..58c0c7f8d8 100644
--- a/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c
+++ b/lib/erl_interface/test/ei_connect_SUITE_data/ei_connect_test.c
@@ -73,6 +73,8 @@ TESTCASE(interpret)
int i;
ei_term term;
+ ei_init();
+
ei_x_new(&x);
while (get_bin_term(&x, &term) == 0) {
char* buf = x.buff, func[MAXATOMLEN];
diff --git a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c
index f945a7d378..e516f310b6 100644
--- a/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c
+++ b/lib/erl_interface/test/ei_decode_SUITE_data/ei_decode_test.c
@@ -321,6 +321,8 @@ int ei_decode_my_string(const char *buf, int *index, char *to,
TESTCASE(test_ei_decode_long)
{
+ ei_init();
+
EI_DECODE_2 (decode_long, 2, long, 0);
EI_DECODE_2 (decode_long, 2, long, 255);
EI_DECODE_2 (decode_long, 5, long, 256);
@@ -363,6 +365,8 @@ TESTCASE(test_ei_decode_long)
TESTCASE(test_ei_decode_ulong)
{
+ ei_init();
+
EI_DECODE_2 (decode_ulong, 2, unsigned long, 0);
EI_DECODE_2 (decode_ulong, 2, unsigned long, 255);
EI_DECODE_2 (decode_ulong, 5, unsigned long, 256);
@@ -409,6 +413,8 @@ TESTCASE(test_ei_decode_ulong)
TESTCASE(test_ei_decode_longlong)
{
+ ei_init();
+
#ifndef VXWORKS
EI_DECODE_2 (decode_longlong, 2, EI_LONGLONG, 0);
EI_DECODE_2 (decode_longlong, 2, EI_LONGLONG, 255);
@@ -443,6 +449,8 @@ TESTCASE(test_ei_decode_longlong)
TESTCASE(test_ei_decode_ulonglong)
{
+ ei_init();
+
#ifndef VXWORKS
EI_DECODE_2 (decode_ulonglong, 2, EI_ULONGLONG, 0);
EI_DECODE_2 (decode_ulonglong, 2, EI_ULONGLONG, 255);
@@ -478,6 +486,8 @@ TESTCASE(test_ei_decode_ulonglong)
TESTCASE(test_ei_decode_char)
{
+ ei_init();
+
EI_DECODE_2(decode_char, 2, char, 0);
EI_DECODE_2(decode_char, 2, char, 0x7f);
EI_DECODE_2(decode_char, 2, char, 0xff);
@@ -491,6 +501,8 @@ TESTCASE(test_ei_decode_char)
TESTCASE(test_ei_decode_nonoptimal)
{
+ ei_init();
+
EI_DECODE_2(decode_char, 2, char, 42);
EI_DECODE_2(decode_char, 5, char, 42);
EI_DECODE_2(decode_char, 4, char, 42);
@@ -612,6 +624,8 @@ TESTCASE(test_ei_decode_nonoptimal)
TESTCASE(test_ei_decode_misc)
{
+ ei_init();
+
/*
EI_DECODE_0(decode_version);
*/
@@ -647,6 +661,7 @@ TESTCASE(test_ei_decode_misc)
TESTCASE(test_ei_decode_utf8_atom)
{
+ ei_init();
EI_DECODE_STRING_4(decode_my_atom_as, 4, P99({229,0}), /* LATIN1 "�" */
P99({ERLANG_ANY,ERLANG_LATIN1,ERLANG_LATIN1}));
diff --git a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c
index 9977683d59..55d9ed1b1a 100644
--- a/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c
+++ b/lib/erl_interface/test/ei_decode_encode_SUITE_data/ei_decode_encode_test.c
@@ -477,6 +477,8 @@ TESTCASE(test_ei_decode_encode)
{
int i;
+ ei_init();
+
decode_encode_one(&fun_type);
decode_encode_one(&pid_type);
decode_encode_one(&port_type);
diff --git a/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c b/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c
index 32811fdf22..6f63cc5d7e 100644
--- a/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c
+++ b/lib/erl_interface/test/ei_encode_SUITE_data/ei_encode_test.c
@@ -403,6 +403,8 @@
TESTCASE(test_ei_encode_long)
{
+ ei_init();
+
EI_ENCODE_1(encode_long, 0);
EI_ENCODE_1(encode_long, 255);
@@ -430,6 +432,8 @@ TESTCASE(test_ei_encode_long)
TESTCASE(test_ei_encode_ulong)
{
+ ei_init();
+
EI_ENCODE_1(encode_ulong, 0);
EI_ENCODE_1(encode_ulong, 255);
@@ -454,6 +458,7 @@ TESTCASE(test_ei_encode_ulong)
TESTCASE(test_ei_encode_longlong)
{
+ ei_init();
#ifndef VXWORKS
@@ -494,6 +499,7 @@ TESTCASE(test_ei_encode_longlong)
TESTCASE(test_ei_encode_ulonglong)
{
+ ei_init();
#ifndef VXWORKS
@@ -527,6 +533,8 @@ TESTCASE(test_ei_encode_ulonglong)
TESTCASE(test_ei_encode_char)
{
+ ei_init();
+
EI_ENCODE_1(encode_char, 0);
EI_ENCODE_1(encode_char, 0x7f);
@@ -540,6 +548,8 @@ TESTCASE(test_ei_encode_char)
TESTCASE(test_ei_encode_misc)
{
+ ei_init();
+
EI_ENCODE_0(encode_version);
EI_ENCODE_1(encode_double, 0.0);
@@ -594,6 +604,8 @@ TESTCASE(test_ei_encode_fails)
char buf[1024];
int index;
+ ei_init();
+
/* FIXME the ei_x versions are not tested */
index = 0;
@@ -660,6 +672,7 @@ TESTCASE(test_ei_encode_fails)
TESTCASE(test_ei_encode_utf8_atom)
{
+ ei_init();
EI_ENCODE_3(encode_atom_as, "�", ERLANG_LATIN1, ERLANG_UTF8);
EI_ENCODE_3(encode_atom_as, "�", ERLANG_LATIN1, ERLANG_LATIN1);
@@ -686,6 +699,7 @@ TESTCASE(test_ei_encode_utf8_atom)
TESTCASE(test_ei_encode_utf8_atom_len)
{
+ ei_init();
EI_ENCODE_4(encode_atom_len_as, "���", 1, ERLANG_LATIN1, ERLANG_UTF8);
EI_ENCODE_4(encode_atom_len_as, "���", 2, ERLANG_LATIN1, ERLANG_LATIN1);
diff --git a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
index 8450332b28..1c0443c0f4 100644
--- a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
+++ b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
@@ -48,6 +48,8 @@ send_format(char* format)
TESTCASE(atoms)
{
+ ei_init();
+
send_format("''");
send_format("'a'");
send_format("'A'");
@@ -82,6 +84,8 @@ TESTCASE(atoms)
TESTCASE(tuples)
{
+ ei_init();
+
send_format("{}");
send_format("{a}");
send_format("{a, b}");
@@ -108,6 +112,8 @@ TESTCASE(lists)
ei_x_buff x;
static char str[65537];
+ ei_init();
+
send_format("[]");
send_format("[a]");
send_format("[a, b]");
@@ -177,6 +183,8 @@ TESTCASE(format_wo_ver) {
*/
ei_x_buff x;
+ ei_init();
+
ei_x_new (&x);
ei_x_format(&x, "[-1, +2, ~c, {~a,~s},{~a,~i}]", 'c', "a", "b", "c", 10);
send_bin_term(&x);
diff --git a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c
index 15cfbcae34..80be3016e6 100644
--- a/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c
+++ b/lib/erl_interface/test/ei_print_SUITE_data/ei_print_test.c
@@ -84,6 +84,8 @@ static void send_printed3f(char* format, float f1, float f2)
TESTCASE(atoms)
{
+ ei_init();
+
send_printed("''");
send_printed("'a'");
send_printed("'A'");
@@ -118,6 +120,8 @@ TESTCASE(atoms)
TESTCASE(tuples)
{
+ ei_init();
+
send_printed("{}");
send_printed("{a}");
send_printed("{a, b}");
@@ -138,6 +142,8 @@ TESTCASE(lists)
{
ei_x_buff x;
+ ei_init();
+
send_printed("[]");
send_printed("[a]");
send_printed("[a, b]");
@@ -164,6 +170,8 @@ TESTCASE(strings)
{
ei_x_buff x;
+ ei_init();
+
send_printed("\"\n\"");
send_printed("\"\r\n\"");
send_printed("\"a\"");
diff --git a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c
index 39846e4a58..693e405f75 100644
--- a/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c
+++ b/lib/erl_interface/test/ei_tmo_SUITE_data/ei_tmo_test.c
@@ -96,6 +96,8 @@ TESTCASE(framework_check)
int i;
#endif
+ ei_init();
+
OPEN_DEBUGFILE(1);
DEBUGF(("B�rjar... \n"));
@@ -340,6 +342,7 @@ TESTCASE(recv_tmo)
int com_sock = -1;
ei_cnode nodeinfo;
+ ei_init();
OPEN_DEBUGFILE(5);
@@ -450,6 +453,7 @@ TESTCASE(send_tmo)
int com_sock = -1;
ei_cnode nodeinfo;
+ ei_init();
OPEN_DEBUGFILE(4);
@@ -591,7 +595,7 @@ TESTCASE(connect_tmo)
int com_sock = -1;
ei_cnode nodeinfo;
-
+ ei_init();
OPEN_DEBUGFILE(3);
@@ -680,7 +684,7 @@ TESTCASE(accept_tmo)
ErlConnect peer;
ei_cnode nodeinfo;
-
+ ei_init();
OPEN_DEBUGFILE(2);
diff --git a/lib/erl_interface/vsn.mk b/lib/erl_interface/vsn.mk
index 06ef907d6c..0ed5c07bca 100644
--- a/lib/erl_interface/vsn.mk
+++ b/lib/erl_interface/vsn.mk
@@ -1,2 +1,2 @@
-EI_VSN = 3.10.4
+EI_VSN = 3.11
ERL_INTERFACE_VSN = $(EI_VSN)
diff --git a/lib/ftp/doc/src/ftp.xml b/lib/ftp/doc/src/ftp.xml
index ead2367925..9645b03364 100644
--- a/lib/ftp/doc/src/ftp.xml
+++ b/lib/ftp/doc/src/ftp.xml
@@ -550,7 +550,7 @@
<v>ipfamily() = inet | inet6 | inet6fb4 (default is inet)</v>
<v>port() = integer() > 0 (default is 21)</v>
<v>mode() = active | passive (default is passive)</v>
- <v>tls_options() = [<seealso marker="ssl:ssl#type-ssloption">ssl:ssloption()</seealso>]</v>
+ <v>tls_options() = [<seealso marker="ssl:ssl#type-tls_option">ssl:tls_option()</seealso>]</v>
<v>sock_opts() = [<seealso marker="kernel:gen_tcp#type-option">gen_tcp:option()</seealso> except for ipv6_v6only, active, packet, mode, packet_size and header</v>
<v>timeout() = integer() > 0 (default is 60000 milliseconds)</v>
<v>dtimeout() = integer() > 0 | infinity (default is infinity)</v>
diff --git a/lib/ftp/doc/src/notes.xml b/lib/ftp/doc/src/notes.xml
index 01c1f88cf1..61da079900 100644
--- a/lib/ftp/doc/src/notes.xml
+++ b/lib/ftp/doc/src/notes.xml
@@ -33,7 +33,23 @@
<file>notes.xml</file>
</header>
- <section><title>Ftp 1.0.1</title>
+ <section><title>Ftp 1.0.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed timing related bug that could make ftp functions
+ behave badly.</p>
+ <p>
+ Own Id: OTP-15659 Aux Id: ERIERL-316 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Ftp 1.0.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/ftp/src/ftp.erl b/lib/ftp/src/ftp.erl
index 40f6b53fa3..18cd8c7524 100644
--- a/lib/ftp/src/ftp.erl
+++ b/lib/ftp/src/ftp.erl
@@ -1065,9 +1065,9 @@ handle_call({_, {open, ip_comm, Opts, {CtrlOpts, DataPassOpts, DataActOpts}}}, F
end
end;
-handle_call({_, {open, tls_upgrade, TLSOptions}}, From, State) ->
- _ = send_ctrl_message(State, mk_cmd("AUTH TLS", [])),
- activate_ctrl_connection(State),
+handle_call({_, {open, tls_upgrade, TLSOptions}}, From, State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("AUTH TLS", [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{client = From, caller = open, tls_options = TLSOptions}};
handle_call({_, {user, User, Password}}, From,
@@ -1081,17 +1081,17 @@ handle_call({_, {user, User, Password, Acc}}, From,
handle_call({_, {account, Acc}}, From, State)->
handle_user_account(Acc, State#state{client = From});
-handle_call({_, pwd}, From, #state{chunk = false} = State) ->
- _ = send_ctrl_message(State, mk_cmd("PWD", [])),
- activate_ctrl_connection(State),
+handle_call({_, pwd}, From, #state{chunk = false} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("PWD", [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{client = From, caller = pwd}};
handle_call({_, lpwd}, From, #state{ldir = LDir} = State) ->
{reply, {ok, LDir}, State#state{client = From}};
-handle_call({_, {cd, Dir}}, From, #state{chunk = false} = State) ->
- _ = send_ctrl_message(State, mk_cmd("CWD ~s", [Dir])),
- activate_ctrl_connection(State),
+handle_call({_, {cd, Dir}}, From, #state{chunk = false} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("CWD ~s", [Dir])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{client = From, caller = cd}};
handle_call({_,{lcd, Dir}}, _From, #state{ldir = LDir0} = State) ->
@@ -1108,41 +1108,41 @@ handle_call({_, {dir, Len, Dir}}, {_Pid, _} = From,
setup_data_connection(State#state{caller = {dir, Dir, Len},
client = From});
handle_call({_, {rename, CurrFile, NewFile}}, From,
- #state{chunk = false} = State) ->
- _ = send_ctrl_message(State, mk_cmd("RNFR ~s", [CurrFile])),
- activate_ctrl_connection(State),
+ #state{chunk = false} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("RNFR ~s", [CurrFile])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {rename, NewFile}, client = From}};
handle_call({_, {delete, File}}, {_Pid, _} = From,
- #state{chunk = false} = State) ->
- _ = send_ctrl_message(State, mk_cmd("DELE ~s", [File])),
- activate_ctrl_connection(State),
+ #state{chunk = false} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("DELE ~s", [File])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{client = From}};
-handle_call({_, {mkdir, Dir}}, From, #state{chunk = false} = State) ->
- _ = send_ctrl_message(State, mk_cmd("MKD ~s", [Dir])),
- activate_ctrl_connection(State),
+handle_call({_, {mkdir, Dir}}, From, #state{chunk = false} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("MKD ~s", [Dir])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{client = From}};
-handle_call({_,{rmdir, Dir}}, From, #state{chunk = false} = State) ->
- _ = send_ctrl_message(State, mk_cmd("RMD ~s", [Dir])),
- activate_ctrl_connection(State),
+handle_call({_,{rmdir, Dir}}, From, #state{chunk = false} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("RMD ~s", [Dir])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{client = From}};
-handle_call({_,{type, Type}}, From, #state{chunk = false} = State) ->
+handle_call({_,{type, Type}}, From, #state{chunk = false} = State0) ->
case Type of
ascii ->
- _ = send_ctrl_message(State, mk_cmd("TYPE A", [])),
- activate_ctrl_connection(State),
+ _ = send_ctrl_message(State0, mk_cmd("TYPE A", [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = type, type = ascii,
client = From}};
binary ->
- _ = send_ctrl_message(State, mk_cmd("TYPE I", [])),
- activate_ctrl_connection(State),
+ _ = send_ctrl_message(State0, mk_cmd("TYPE I", [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = type, type = binary,
client = From}};
_ ->
- {reply, {error, etype}, State}
+ {reply, {error, etype}, State0}
end;
handle_call({_,{recv, RemoteFile, LocalFile}}, From,
@@ -1181,8 +1181,8 @@ handle_call({_, recv_chunk}, _From, #state{chunk = true,
} = State0) ->
%% The ftp:recv_chunk call was the last event we waited for, finnish and clean up
?DBG("recv_chunk_closing ftp:recv_chunk, last event",[]),
- activate_ctrl_connection(State0),
- {reply, ok, State0#state{caller = undefined,
+ State = activate_ctrl_connection(State0),
+ {reply, ok, State#state{caller = undefined,
chunk = false,
client = undefined}};
@@ -1238,18 +1238,18 @@ handle_call({_, {transfer_chunk, Bin}}, _, #state{chunk = true} = State) ->
handle_call({_, {transfer_chunk, _}}, _, #state{chunk = false} = State) ->
{reply, {error, echunk}, State};
-handle_call({_, chunk_end}, From, #state{chunk = true} = State) ->
- close_data_connection(State),
- activate_ctrl_connection(State),
+handle_call({_, chunk_end}, From, #state{chunk = true} = State0) ->
+ close_data_connection(State0),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{client = From, dsock = undefined,
caller = end_chunk_transfer, chunk = false}};
handle_call({_, chunk_end}, _, #state{chunk = false} = State) ->
{reply, {error, echunk}, State};
-handle_call({_, {quote, Cmd}}, From, #state{chunk = false} = State) ->
- _ = send_ctrl_message(State, mk_cmd(Cmd, [])),
- activate_ctrl_connection(State),
+handle_call({_, {quote, Cmd}}, From, #state{chunk = false} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd(Cmd, [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{client = From, caller = quote}};
handle_call({_, _Req}, _From, #state{csock = CSock} = State)
@@ -1325,38 +1325,38 @@ handle_info({Trpt, Socket, Data}, #state{dsock = {Trpt,Socket}} = State0) when T
Data/binary>>}};
handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket},
- caller = {recv_file, Fd}} = State)
+ caller = {recv_file, Fd}} = State0)
when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
file_close(Fd),
- progress_report({transfer_size, 0}, State),
- activate_ctrl_connection(State),
+ progress_report({transfer_size, 0}, State0),
+ State = activate_ctrl_connection(State0),
?DBG("Data channel close",[]),
{noreply, State#state{dsock = undefined, data = <<>>}};
handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket},
client = Client,
- caller = recv_chunk} = State)
+ caller = recv_chunk} = State0)
when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
?DBG("Data channel close recv_chunk",[]),
- activate_ctrl_connection(State),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{dsock = undefined,
caller = #recv_chunk_closing{dconn_closed = true,
client_called_us = Client =/= undefined}
}};
handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, caller = recv_bin,
- data = Data} = State)
+ data = Data} = State0)
when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
?DBG("Data channel close",[]),
- activate_ctrl_connection(State),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{dsock = undefined, data = <<>>,
caller = {recv_bin, Data}}};
handle_info({Cls, Socket}, #state{dsock = {Trpt,Socket}, data = Data,
- caller = {handle_dir_result, Dir}}
- = State) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
+ caller = {handle_dir_result, Dir}}
+ = State0) when {Cls,Trpt}=={tcp_closed,tcp} ; {Cls,Trpt}=={ssl_closed,ssl} ->
?DBG("Data channel close",[]),
- activate_ctrl_connection(State),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{dsock = undefined,
caller = {handle_dir_result, Dir, Data},
% data = <<?CR,?LF>>}};
@@ -1377,7 +1377,7 @@ handle_info({Transport, Socket, Data}, #state{csock = {Transport, Socket},
client = From,
ctrl_data = {CtrlData, AccLines,
LineStatus}}
- = State) ->
+ = State0) ->
?DBG('--ctrl ~p ----> ~s~p~n',[Socket,<<CtrlData/binary, Data/binary>>,State]),
case ftp_response:parse_lines(<<CtrlData/binary, Data/binary>>,
AccLines, LineStatus) of
@@ -1387,21 +1387,21 @@ handle_info({Transport, Socket, Data}, #state{csock = {Transport, Socket},
case Caller of
quote ->
gen_server:reply(From, string:tokens(Lines, [?CR, ?LF])),
- {noreply, State#state{client = undefined,
- caller = undefined,
- latest_ctrl_response = Lines,
- ctrl_data = {NextMsgData, [],
- start}}};
+ {noreply, State0#state{client = undefined,
+ caller = undefined,
+ latest_ctrl_response = Lines,
+ ctrl_data = {NextMsgData, [],
+ start}}};
_ ->
?DBG(' ...handle_ctrl_result(~p,...) ctrl_data=~p~n',[CtrlResult,{NextMsgData, [], start}]),
handle_ctrl_result(CtrlResult,
- State#state{latest_ctrl_response = Lines,
- ctrl_data =
- {NextMsgData, [], start}})
+ State0#state{latest_ctrl_response = Lines,
+ ctrl_data =
+ {NextMsgData, [], start}})
end;
{continue, NewCtrlData} ->
?DBG(' ...Continue... ctrl_data=~p~n',[NewCtrlData]),
- activate_ctrl_connection(State),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{ctrl_data = NewCtrlData}}
end;
@@ -1567,19 +1567,19 @@ start_link(Opts, GenServerOptions) ->
%%% Help functions to handle_call and/or handle_ctrl_result
%%--------------------------------------------------------------------------
%% User handling
-handle_user(User, Password, Acc, State) ->
- _ = send_ctrl_message(State, mk_cmd("USER ~s", [User])),
- activate_ctrl_connection(State),
+handle_user(User, Password, Acc, State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("USER ~s", [User])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {handle_user, Password, Acc}}}.
-handle_user_passwd(Password, Acc, State) ->
- _ = send_ctrl_message(State, mk_cmd("PASS ~s", [Password])),
- activate_ctrl_connection(State),
+handle_user_passwd(Password, Acc, State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("PASS ~s", [Password])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {handle_user_passwd, Acc}}}.
-handle_user_account(Acc, State) ->
- _ = send_ctrl_message(State, mk_cmd("ACCT ~s", [Acc])),
- activate_ctrl_connection(State),
+handle_user_account(Acc, State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("ACCT ~s", [Acc])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = handle_user_account}}.
@@ -1594,9 +1594,9 @@ handle_ctrl_result({tls_upgrade, _}, #state{csock = {tcp, Socket},
?DBG('<--ctrl ssl:connect(~p, ~p)~n~p~n',[Socket,TLSOptions,State0]),
case ssl:connect(Socket, TLSOptions, Timeout) of
{ok, TLSSocket} ->
- State = State0#state{csock = {ssl,TLSSocket}},
- _ = send_ctrl_message(State, mk_cmd("PBSZ 0", [])),
- activate_ctrl_connection(State),
+ State1 = State0#state{csock = {ssl,TLSSocket}},
+ _ = send_ctrl_message(State1, mk_cmd("PBSZ 0", [])),
+ State = activate_ctrl_connection(State1),
{noreply, State#state{tls_upgrading_data_connection = {true, pbsz}} };
{error, _} = Error ->
gen_server:reply(From, {Error, self()}),
@@ -1605,9 +1605,9 @@ handle_ctrl_result({tls_upgrade, _}, #state{csock = {tcp, Socket},
tls_upgrading_data_connection = false}}
end;
-handle_ctrl_result({pos_compl, _}, #state{tls_upgrading_data_connection = {true, pbsz}} = State) ->
- _ = send_ctrl_message(State, mk_cmd("PROT P", [])),
- activate_ctrl_connection(State),
+handle_ctrl_result({pos_compl, _}, #state{tls_upgrading_data_connection = {true, pbsz}} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("PROT P", [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{tls_upgrading_data_connection = {true, prot}}};
handle_ctrl_result({pos_compl, _}, #state{tls_upgrading_data_connection = {true, prot},
@@ -1801,10 +1801,10 @@ handle_ctrl_result({pos_compl, _}, #state{caller = {handle_dir_result, Dir,
handle_ctrl_result({pos_compl, Lines},
#state{caller = {handle_dir_data, Dir, DirData}} =
- State) ->
+ State0) ->
OldDir = pwd_result(Lines),
- _ = send_ctrl_message(State, mk_cmd("CWD ~s", [Dir])),
- activate_ctrl_connection(State),
+ _ = send_ctrl_message(State0, mk_cmd("CWD ~s", [Dir])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {handle_dir_data_second_phase, OldDir,
DirData}}};
handle_ctrl_result({Status, _},
@@ -1818,9 +1818,9 @@ handle_ctrl_result(S={_Status, _},
handle_ctrl_result({pos_compl, _},
#state{caller = {handle_dir_data_second_phase, OldDir,
- DirData}} = State) ->
- _ = send_ctrl_message(State, mk_cmd("CWD ~s", [OldDir])),
- activate_ctrl_connection(State),
+ DirData}} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("CWD ~s", [OldDir])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {handle_dir_data_third_phase, DirData}}};
handle_ctrl_result({Status, _},
#state{caller = {handle_dir_data_second_phase, _, _}}
@@ -1840,9 +1840,9 @@ handle_ctrl_result(Status={epath, _}, #state{caller = {dir,_}} = State) ->
%%--------------------------------------------------------------------------
%% File renaming
handle_ctrl_result({pos_interm, _}, #state{caller = {rename, NewFile}}
- = State) ->
- _ = send_ctrl_message(State, mk_cmd("RNTO ~s", [NewFile])),
- activate_ctrl_connection(State),
+ = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("RNTO ~s", [NewFile])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = rename_second_phase}};
handle_ctrl_result({Status, _},
@@ -1916,10 +1916,10 @@ handle_ctrl_result({pos_compl, _}, #state{client = From,
%% The pos_compl was the last event we waited for, finnish and clean up
?DBG("recv_chunk_closing pos_compl, last event",[]),
gen_server:reply(From, ok),
- activate_ctrl_connection(State0),
- {noreply, State0#state{caller = undefined,
- chunk = false,
- client = undefined}};
+ State = activate_ctrl_connection(State0),
+ {noreply, State#state{caller = undefined,
+ chunk = false,
+ client = undefined}};
handle_ctrl_result({pos_compl, _}, #state{caller = #recv_chunk_closing{}=R}
= State0) ->
@@ -2013,71 +2013,71 @@ ctrl_result_response(_, #state{client = From} = State, ErrorMsg) ->
{noreply, State#state{client = undefined, caller = undefined}}.
%%--------------------------------------------------------------------------
-handle_caller(#state{caller = {dir, Dir, Len}} = State) ->
+handle_caller(#state{caller = {dir, Dir, Len}} = State0) ->
Cmd = case Len of
short -> "NLST";
long -> "LIST"
end,
_ = case Dir of
"" ->
- send_ctrl_message(State, mk_cmd(Cmd, ""));
+ send_ctrl_message(State0, mk_cmd(Cmd, ""));
_ ->
- send_ctrl_message(State, mk_cmd(Cmd ++ " ~s", [Dir]))
+ send_ctrl_message(State0, mk_cmd(Cmd ++ " ~s", [Dir]))
end,
- activate_ctrl_connection(State),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {dir, Dir}}};
-handle_caller(#state{caller = {recv_bin, RemoteFile}} = State) ->
- _ = send_ctrl_message(State, mk_cmd("RETR ~s", [RemoteFile])),
- activate_ctrl_connection(State),
+handle_caller(#state{caller = {recv_bin, RemoteFile}} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("RETR ~s", [RemoteFile])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = recv_bin}};
handle_caller(#state{caller = {start_chunk_transfer, Cmd, RemoteFile}} =
- State) ->
- _ = send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
- activate_ctrl_connection(State),
+ State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("~s ~s", [Cmd, RemoteFile])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = start_chunk_transfer}};
-handle_caller(#state{caller = {recv_file, RemoteFile, Fd}} = State) ->
- _ = send_ctrl_message(State, mk_cmd("RETR ~s", [RemoteFile])),
- activate_ctrl_connection(State),
+handle_caller(#state{caller = {recv_file, RemoteFile, Fd}} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("RETR ~s", [RemoteFile])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {recv_file, Fd}}};
handle_caller(#state{caller = {transfer_file, {Cmd, LocalFile, RemoteFile}},
- ldir = LocalDir, client = From} = State) ->
+ ldir = LocalDir, client = From} = State0) ->
case file_open(filename:absname(LocalFile, LocalDir), read) of
{ok, Fd} ->
- _ = send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
- activate_ctrl_connection(State),
+ _ = send_ctrl_message(State0, mk_cmd("~s ~s", [Cmd, RemoteFile])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {transfer_file, Fd}}};
{error, _} ->
gen_server:reply(From, {error, epath}),
- {noreply, State#state{client = undefined, caller = undefined,
- dsock = undefined}}
+ {noreply, State0#state{client = undefined, caller = undefined,
+ dsock = undefined}}
end;
handle_caller(#state{caller = {transfer_data, {Cmd, Bin, RemoteFile}}} =
- State) ->
- _ = send_ctrl_message(State, mk_cmd("~s ~s", [Cmd, RemoteFile])),
- activate_ctrl_connection(State),
+ State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("~s ~s", [Cmd, RemoteFile])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {transfer_data, Bin}}}.
%% ----------- FTP SERVER COMMUNICATION -------------------------
%% Connect to FTP server at Host (default is TCP port 21)
%% in order to establish a control connection.
-setup_ctrl_connection(Host, Port, Timeout, #state{sockopts_ctrl = SockOpts} = State) ->
+setup_ctrl_connection(Host, Port, Timeout, #state{sockopts_ctrl = SockOpts} = State0) ->
MsTime = erlang:monotonic_time(),
- case connect(Host, Port, SockOpts, Timeout, State) of
+ case connect(Host, Port, SockOpts, Timeout, State0) of
{ok, IpFam, CSock} ->
- NewState = State#state{csock = {tcp, CSock}, ipfamily = IpFam},
- activate_ctrl_connection(NewState),
+ State1 = State0#state{csock = {tcp, CSock}, ipfamily = IpFam},
+ State = activate_ctrl_connection(State1),
case Timeout - millisec_passed(MsTime) of
Timeout2 when (Timeout2 >= 0) ->
- {ok, NewState#state{caller = open}, Timeout2};
+ {ok, State#state{caller = open}, Timeout2};
_ ->
%% Oups: Simulate timeout
- {ok, NewState#state{caller = open}, 0}
+ {ok, State#state{caller = open}, 0}
end;
Error ->
Error
@@ -2087,7 +2087,7 @@ setup_data_connection(#state{mode = active,
caller = Caller,
csock = CSock,
sockopts_data_active = SockOpts,
- ftp_extension = FtpExt} = State) ->
+ ftp_extension = FtpExt} = State0) ->
case (catch sockname(CSock)) of
{ok, {{_, _, _, _, _, _, _, _} = IP0, _}} ->
IP = proplists:get_value(ip, SockOpts, IP0),
@@ -2098,8 +2098,8 @@ setup_data_connection(#state{mode = active,
{ok, {_, Port}} = sockname({tcp,LSock}),
IpAddress = inet_parse:ntoa(IP),
Cmd = mk_cmd("EPRT |2|~s|~p|", [IpAddress, Port]),
- _ = send_ctrl_message(State, Cmd),
- activate_ctrl_connection(State),
+ _ = send_ctrl_message(State0, Cmd),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {setup_data_connection,
{LSock, Caller}}}};
{ok, {{_,_,_,_} = IP0, _}} ->
@@ -2112,37 +2112,37 @@ setup_data_connection(#state{mode = active,
false ->
{IP1, IP2, IP3, IP4} = IP,
{Port1, Port2} = {Port div 256, Port rem 256},
- send_ctrl_message(State,
+ send_ctrl_message(State0,
mk_cmd("PORT ~w,~w,~w,~w,~w,~w",
[IP1, IP2, IP3, IP4, Port1, Port2]));
true ->
IpAddress = inet_parse:ntoa(IP),
Cmd = mk_cmd("EPRT |1|~s|~p|", [IpAddress, Port]),
- send_ctrl_message(State, Cmd)
+ send_ctrl_message(State0, Cmd)
end,
- activate_ctrl_connection(State),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {setup_data_connection,
{LSock, Caller}}}}
end;
setup_data_connection(#state{mode = passive, ipfamily = inet6,
- caller = Caller} = State) ->
- _ = send_ctrl_message(State, mk_cmd("EPSV", [])),
- activate_ctrl_connection(State),
+ caller = Caller} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("EPSV", [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {setup_data_connection, Caller}}};
setup_data_connection(#state{mode = passive, ipfamily = inet,
caller = Caller,
- ftp_extension = false} = State) ->
- _ = send_ctrl_message(State, mk_cmd("PASV", [])),
- activate_ctrl_connection(State),
+ ftp_extension = false} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("PASV", [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {setup_data_connection, Caller}}};
setup_data_connection(#state{mode = passive, ipfamily = inet,
caller = Caller,
- ftp_extension = true} = State) ->
- _ = send_ctrl_message(State, mk_cmd("EPSV", [])),
- activate_ctrl_connection(State),
+ ftp_extension = true} = State0) ->
+ _ = send_ctrl_message(State0, mk_cmd("EPSV", [])),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = {setup_data_connection, Caller}}}.
connect(Host, Port, SockOpts, Timeout, #state{ipfamily = inet = IpFam}) ->
@@ -2248,14 +2248,15 @@ send_message({tcp, Socket}, Message) ->
send_message({ssl, Socket}, Message) ->
ssl:send(Socket, Message).
-activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}}) ->
- activate_connection(CSock);
-activate_ctrl_connection(#state{csock = CSock}) ->
+activate_ctrl_connection(#state{csock = CSock, ctrl_data = {<<>>, _, _}} = State) ->
+ activate_connection(CSock),
+ State;
+activate_ctrl_connection(#state{csock = CSock} = State0) ->
activate_connection(CSock),
%% We have already received at least part of the next control message,
%% that has been saved in ctrl_data, process this first.
- self() ! {socket_type(CSock), unwrap_socket(CSock), <<>>},
- ok.
+ {noreply, State} = handle_info({socket_type(CSock), unwrap_socket(CSock), <<>>}, State0),
+ State.
activate_data_connection(#state{dsock = DSock} = State) ->
activate_connection(DSock),
@@ -2290,22 +2291,22 @@ close_connection({ssl, Socket}) -> ignore_return_value( ssl:close(Socket) ).
%% ------------ FILE HANDLING ----------------------------------------
send_file(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Fd) ->
{noreply, State#state{tls_upgrading_data_connection = {true, CTRL, ?MODULE, send_file, Fd}}};
-send_file(State, Fd) ->
+send_file(State0, Fd) ->
case file_read(Fd) of
{ok, N, Bin} when N > 0 ->
- send_data_message(State, Bin),
- progress_report({binary, Bin}, State),
- send_file(State, Fd);
+ send_data_message(State0, Bin),
+ progress_report({binary, Bin}, State0),
+ send_file(State0, Fd);
{ok, _, _} ->
file_close(Fd),
- close_data_connection(State),
- progress_report({transfer_size, 0}, State),
- activate_ctrl_connection(State),
+ close_data_connection(State0),
+ progress_report({transfer_size, 0}, State0),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = transfer_file_second_phase,
dsock = undefined}};
{error, Reason} ->
- gen_server:reply(State#state.client, {error, Reason}),
- {stop, normal, State#state{client = undefined}}
+ gen_server:reply(State0#state.client, {error, Reason}),
+ {stop, normal, State0#state{client = undefined}}
end.
file_open(File, Option) ->
@@ -2347,10 +2348,10 @@ cast(GenServer, Msg) ->
send_bin(#state{tls_upgrading_data_connection = {true, CTRL, _}} = State, Bin) ->
State#state{tls_upgrading_data_connection = {true, CTRL, ?MODULE, send_bin, Bin}};
-send_bin(State, Bin) ->
- send_data_message(State, Bin),
- close_data_connection(State),
- activate_ctrl_connection(State),
+send_bin(State0, Bin) ->
+ send_data_message(State0, Bin),
+ close_data_connection(State0),
+ State = activate_ctrl_connection(State0),
{noreply, State#state{caller = transfer_data_second_phase,
dsock = undefined}}.
diff --git a/lib/ftp/test/ftp_SUITE.erl b/lib/ftp/test/ftp_SUITE.erl
index 7c87d5cbdb..0b070ee8cb 100644
--- a/lib/ftp/test/ftp_SUITE.erl
+++ b/lib/ftp/test/ftp_SUITE.erl
@@ -96,6 +96,7 @@ ftp_tests()->
recv_chunk,
recv_chunk_twice,
recv_chunk_three_times,
+ recv_chunk_delay,
type,
quote,
error_elogin,
@@ -669,9 +670,9 @@ recv_chunk(Config0) ->
Contents = list_to_binary( lists:duplicate(1000, lists:seq(0,255)) ),
Config = set_state([reset, {mkfile,File,Contents}], Config0),
Pid = proplists:get_value(ftp, Config),
- {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
+ {error, "ftp:recv_chunk_start/2 not called"} = do_recv_chunk(Pid),
ok = ftp:recv_chunk_start(Pid, id2ftp(File,Config)),
- {ok, ReceivedContents, _Ncunks} = recv_chunk(Pid, <<>>),
+ {ok, ReceivedContents} = do_recv_chunk(Pid),
find_diff(ReceivedContents, Contents).
recv_chunk_twice() ->
@@ -683,11 +684,11 @@ recv_chunk_twice(Config0) ->
Contents2 = crypto:strong_rand_bytes(1200),
Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}], Config0),
Pid = proplists:get_value(ftp, Config),
- {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
+ {error, "ftp:recv_chunk_start/2 not called"} = do_recv_chunk(Pid),
ok = ftp:recv_chunk_start(Pid, id2ftp(File1,Config)),
- {ok, ReceivedContents1, _Ncunks1} = recv_chunk(Pid, <<>>),
+ {ok, ReceivedContents1} = do_recv_chunk(Pid),
ok = ftp:recv_chunk_start(Pid, id2ftp(File2,Config)),
- {ok, ReceivedContents2, _Ncunks2} = recv_chunk(Pid, <<>>),
+ {ok, ReceivedContents2} = do_recv_chunk(Pid),
find_diff(ReceivedContents1, Contents1),
find_diff(ReceivedContents2, Contents2).
@@ -704,46 +705,56 @@ recv_chunk_three_times(Config0) ->
Config = set_state([reset, {mkfile,File1,Contents1}, {mkfile,File2,Contents2}, {mkfile,File3,Contents3}], Config0),
Pid = proplists:get_value(ftp, Config),
- {{error, "ftp:recv_chunk_start/2 not called"},_} = recv_chunk(Pid, <<>>),
+ {error, "ftp:recv_chunk_start/2 not called"} = do_recv_chunk(Pid),
+ ok = ftp:recv_chunk_start(Pid, id2ftp(File3,Config)),
+ {ok, ReceivedContents3} = do_recv_chunk(Pid),
+
ok = ftp:recv_chunk_start(Pid, id2ftp(File1,Config)),
- {ok, ReceivedContents1, Nchunks1} = recv_chunk(Pid, <<>>),
+ {ok, ReceivedContents1} = do_recv_chunk(Pid),
ok = ftp:recv_chunk_start(Pid, id2ftp(File2,Config)),
- {ok, ReceivedContents2, _Nchunks2} = recv_chunk(Pid, <<>>),
-
- ok = ftp:recv_chunk_start(Pid, id2ftp(File3,Config)),
- {ok, ReceivedContents3, _Nchunks3} = recv_chunk(Pid, <<>>, 10000, 0, Nchunks1),
+ {ok, ReceivedContents2} = do_recv_chunk(Pid),
find_diff(ReceivedContents1, Contents1),
find_diff(ReceivedContents2, Contents2),
find_diff(ReceivedContents3, Contents3).
-
+do_recv_chunk(Pid) ->
+ recv_chunk(Pid, <<>>).
recv_chunk(Pid, Acc) ->
- recv_chunk(Pid, Acc, 0, 0, undefined).
-
-
-
-%% ExpectNchunks :: integer() | undefined
-recv_chunk(Pid, Acc, DelayMilliSec, N, ExpectNchunks) when N+1 < ExpectNchunks ->
- %% for all I in integer(), I < undefined
- recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks);
-
-recv_chunk(Pid, Acc, DelayMilliSec, N, ExpectNchunks) ->
- %% N >= ExpectNchunks-1
- timer:sleep(DelayMilliSec),
- recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks).
+ case ftp:recv_chunk(Pid) of
+ ok ->
+ {ok, Acc};
+ {ok, Bin} ->
+ recv_chunk(Pid, <<Acc/binary, Bin/binary>>);
+ Error ->
+ Error
+ end.
+recv_chunk_delay(Config0) when is_list(Config0) ->
+ File1 = "big_file1.txt",
+ Contents = list_to_binary(lists:duplicate(1000, lists:seq(0,255))),
+ Config = set_state([reset, {mkfile,File1,Contents}], Config0),
+ Pid = proplists:get_value(ftp, Config),
+ ok = ftp:recv_chunk_start(Pid, id2ftp(File1,Config)),
+ {ok, ReceivedContents} = delay_recv_chunk(Pid),
+ find_diff(ReceivedContents, Contents).
-recv_chunk1(Pid, Acc, DelayMilliSec, N, ExpectNchunks) ->
- ct:log("Call ftp:recv_chunk",[]),
+delay_recv_chunk(Pid) ->
+ delay_recv_chunk(Pid, <<>>).
+delay_recv_chunk(Pid, Acc) ->
+ ct:pal("Recived size ~p", [byte_size(Acc)]),
case ftp:recv_chunk(Pid) of
- ok -> {ok, Acc, N};
- {ok, Bin} -> recv_chunk(Pid, <<Acc/binary, Bin/binary>>, DelayMilliSec, N+1, ExpectNchunks);
- Error -> {Error, N}
- end.
+ ok ->
+ {ok, Acc};
+ {ok, Bin} ->
+ ct:sleep(100),
+ delay_recv_chunk(Pid, <<Acc/binary, Bin/binary>>);
+ Error ->
+ Error
+ end.
%%-------------------------------------------------------------------------
type() ->
diff --git a/lib/ftp/vsn.mk b/lib/ftp/vsn.mk
index d5d6c45b28..9f14658099 100644
--- a/lib/ftp/vsn.mk
+++ b/lib/ftp/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = ftp
-FTP_VSN = 1.0.1
+FTP_VSN = 1.0.2
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(FTP_VSN)$(PRE_VSN)"
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 48ce641ab9..8ae1cd4ab7 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -2225,10 +2225,7 @@ type_order() ->
t_map(), t_list(), t_bitstr()].
key_comparisons_fail(X0, KeyPos, TupleList, Opaques) ->
- X = case t_is_number(t_inf(X0, t_number(), Opaques), Opaques) of
- false -> X0;
- true -> t_number()
- end,
+ X = erl_types:t_widen_to_number(X0),
lists:all(fun(Tuple) ->
Key = type(erlang, element, 2, [KeyPos, Tuple]),
t_is_none(t_inf(Key, X, Opaques))
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 9abb4d31d9..d61cd8664c 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -66,7 +66,6 @@
t_find_opaque_mismatch/3,
t_find_unknown_opaque/3,
t_fixnum/0,
- t_map/2,
t_non_neg_fixnum/0,
t_pos_fixnum/0,
t_float/0,
@@ -205,6 +204,7 @@
t_unopaque/1, t_unopaque/2,
t_var/1,
t_var_name/1,
+ t_widen_to_number/1,
%% t_assign_variables_to_subtype/2,
type_is_defined/4,
record_field_diffs_to_string/2,
@@ -1594,6 +1594,50 @@ lift_list_to_pos_empty(?nil) -> ?nil;
lift_list_to_pos_empty(?list(Content, Termination, _)) ->
?list(Content, Termination, ?unknown_qual).
+-spec t_widen_to_number(erl_type()) -> erl_type().
+
+%% Widens integers and floats to t_number().
+%% Used by erl_bif_types:key_comparison_fail().
+
+t_widen_to_number(?any) -> ?any;
+t_widen_to_number(?none) -> ?none;
+t_widen_to_number(?unit) -> ?unit;
+t_widen_to_number(?atom(_Set) = T) -> T;
+t_widen_to_number(?bitstr(_Unit, _Base) = T) -> T;
+t_widen_to_number(?float) -> t_number();
+t_widen_to_number(?function(Domain, Range)) ->
+ ?function(t_widen_to_number(Domain), t_widen_to_number(Range));
+t_widen_to_number(?identifier(_Types) = T) -> T;
+t_widen_to_number(?int_range(_From, _To)) -> t_number();
+t_widen_to_number(?int_set(_Set)) -> t_number();
+t_widen_to_number(?integer(_Types)) -> t_number();
+t_widen_to_number(?list(Type, Tail, Size)) ->
+ ?list(t_widen_to_number(Type), t_widen_to_number(Tail), Size);
+t_widen_to_number(?map(Pairs, DefK, DefV)) ->
+ L = [{t_widen_to_number(K), MNess, t_widen_to_number(V)} ||
+ {K, MNess, V} <- Pairs],
+ t_map(L, t_widen_to_number(DefK), t_widen_to_number(DefV));
+t_widen_to_number(?matchstate(_P, _Slots) = T) -> T;
+t_widen_to_number(?nil) -> ?nil;
+t_widen_to_number(?number(_Set, _Tag)) -> t_number();
+t_widen_to_number(?opaque(Set)) ->
+ L = [Opaque#opaque{struct = t_widen_to_number(S)} ||
+ #opaque{struct = S} = Opaque <- set_to_list(Set)],
+ ?opaque(ordsets:from_list(L));
+t_widen_to_number(?product(Types)) ->
+ ?product(list_widen_to_number(Types));
+t_widen_to_number(?tuple(?any, _, _) = T) -> T;
+t_widen_to_number(?tuple(Types, Arity, Tag)) ->
+ ?tuple(list_widen_to_number(Types), Arity, Tag);
+t_widen_to_number(?tuple_set(_) = Tuples) ->
+ t_sup([t_widen_to_number(T) || T <- t_tuple_subtypes(Tuples)]);
+t_widen_to_number(?union(List)) ->
+ ?union(list_widen_to_number(List));
+t_widen_to_number(?var(_Id)= T) -> T.
+
+list_widen_to_number(List) ->
+ [t_widen_to_number(E) || E <- List].
+
%%-----------------------------------------------------------------------------
%% Maps
%%
@@ -3104,9 +3148,18 @@ is_compat_arg(?list(Contents1, Termination1, Size1),
is_compat_arg(?product(Types1), ?product(Types2)) ->
is_compat_list(Types1, Types2);
is_compat_arg(?map(Pairs1, DefK1, DefV1), ?map(Pairs2, DefK2, DefV2)) ->
- (is_compat_list(Pairs1, Pairs2) andalso
- is_compat_arg(DefK1, DefK2) andalso
- is_compat_arg(DefV1, DefV2));
+ {Ks1, _, Vs1} = lists:unzip3(Pairs1),
+ {Ks2, _, Vs2} = lists:unzip3(Pairs2),
+ Key1 = t_sup([DefK1 | Ks1]),
+ Key2 = t_sup([DefK2 | Ks2]),
+ case is_compat_arg(Key1, Key2) of
+ true ->
+ Value1 = t_sup([DefV1 | Vs1]),
+ Value2 = t_sup([DefV2 | Vs2]),
+ is_compat_arg(Value1, Value2);
+ false ->
+ false
+ end;
is_compat_arg(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false;
is_compat_arg(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false;
is_compat_arg(?tuple(Elements1, Arity, _),
@@ -4156,39 +4209,6 @@ t_abstract_records(?opaque(_)=Type, RecDict) ->
t_abstract_records(T, _RecDict) ->
T.
-%% Map over types. Depth first. Used by the contract checker. ?list is
-%% not fully implemented so take care when changing the type in Termination.
-
--spec t_map(fun((erl_type()) -> erl_type()), erl_type()) -> erl_type().
-
-t_map(Fun, ?list(Contents, Termination, Size)) ->
- Fun(?list(t_map(Fun, Contents), t_map(Fun, Termination), Size));
-t_map(Fun, ?function(Domain, Range)) ->
- Fun(?function(t_map(Fun, Domain), t_map(Fun, Range)));
-t_map(Fun, ?product(Types)) ->
- Fun(?product([t_map(Fun, T) || T <- Types]));
-t_map(Fun, ?union(Types)) ->
- Fun(t_sup([t_map(Fun, T) || T <- Types]));
-t_map(Fun, ?tuple(?any, ?any, ?any) = T) ->
- Fun(T);
-t_map(Fun, ?tuple(Elements, _Arity, _Tag)) ->
- Fun(t_tuple([t_map(Fun, E) || E <- Elements]));
-t_map(Fun, ?tuple_set(_) = Tuples) ->
- Fun(t_sup([t_map(Fun, T) || T <- t_tuple_subtypes(Tuples)]));
-t_map(Fun, ?opaque(Set)) ->
- L = [Opaque#opaque{struct = NewS} ||
- #opaque{struct = S} = Opaque <- set_to_list(Set),
- not t_is_none(NewS = t_map(Fun, S))],
- Fun(case L of
- [] -> ?none;
- _ -> ?opaque(ordsets:from_list(L))
- end);
-t_map(Fun, ?map(Pairs,DefK,DefV)) ->
- %% TODO:
- Fun(t_map(Pairs, Fun(DefK), Fun(DefV)));
-t_map(Fun, T) ->
- Fun(T).
-
%%=============================================================================
%%
%% Prettyprinter
diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml
index e9cdf42018..9a803cb9df 100644
--- a/lib/hipe/doc/src/notes.xml
+++ b/lib/hipe/doc/src/notes.xml
@@ -31,6 +31,21 @@
</header>
<p>This document describes the changes made to HiPE.</p>
+<section><title>Hipe 3.18.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> Fix a bug in the handling of the <c>Key</c> argument
+ of <c>lists:{keysearch, keyfind, keymember}</c>. </p>
+ <p>
+ Own Id: OTP-15570</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Hipe 3.18.2</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk
index 12d621bf01..39565d721f 100644
--- a/lib/hipe/vsn.mk
+++ b/lib/hipe/vsn.mk
@@ -1 +1 @@
-HIPE_VSN = 3.18.2
+HIPE_VSN = 3.18.3
diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index 2faa49e541..91dd9cd6ed 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -33,7 +33,65 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 7.0.4</title>
+ <section><title>Inets 7.0.6</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix the internal handling of the option
+ erl_script_timeout in httpd. When httpd was started with
+ explicit erl_script_timeout, the value of the option was
+ converted to milliseconds before storage. Subsequent
+ calls to httpd:info/1 returned the input value multiplied
+ by 1000.</p>
+ <p>
+ This change fixes the handing of erl_script_timeout by
+ storing the timeout in seconds and converting to
+ milliseconds before usage.</p>
+ <p>
+ Own Id: OTP-15669 Aux Id: ERIERL-321 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Enhance documentation</p>
+ <p>
+ Own Id: OTP-15508 Aux Id: ERL-816 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 7.0.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed bug that causes a crash in http client when using
+ hostnames (e.g. localhost) with the the option
+ ipv6_host_with_brackets set to true.</p>
+ <p>
+ This change also fixes a regression: httpc:request fails
+ with connection error (nxdomain) if option
+ ipv6_host_with_brackets set to true and host component of
+ the URI is an IPv6 address.</p>
+ <p>
+ Own Id: OTP-15554 Aux Id: ERIERL-289 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 7.0.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/inets/examples/httpd_load_test/hdlt_slave.erl b/lib/inets/examples/httpd_load_test/hdlt_slave.erl
index 5ee005629d..30ddfd76af 100644
--- a/lib/inets/examples/httpd_load_test/hdlt_slave.erl
+++ b/lib/inets/examples/httpd_load_test/hdlt_slave.erl
@@ -44,18 +44,17 @@
%% this to work is that the 'erl' program can be found in PATH.
%%
%% If the master and slave are on different hosts, start/N uses
-%% the 'rsh' program to spawn an Erlang node on the other host.
+%% the 'ssh' program to spawn an Erlang node on the other host.
%% Alternative, if the master was started as
%% 'erl -sname xxx -rsh my_rsh...', then 'my_rsh' will be used instead
-%% of 'rsh' (this is useful for systems where the rsh program is named
-%% 'remsh').
+%% of 'ssh' (this is useful for systems still using rsh or remsh).
%%
%% For this to work, the following conditions must be fulfilled:
%%
-%% 1. There must be an Rsh program on computer; if not an error
+%% 1. There must be an ssh program on computer; if not an error
%% is returned.
%%
-%% 2. The hosts must be configured to allowed 'rsh' access without
+%% 2. The hosts must be configured to allow 'ssh' access without
%% prompts for password.
%%
%% The slave node will have its filer and user server redirected
@@ -244,7 +243,7 @@ register_unique_name(Number) ->
%% Makes up the command to start the nodes.
%% If the node should run on the local host, there is
-%% no need to use rsh.
+%% no need to use ssh.
mk_cmd(Host, Name, Paths, Args, Waiter, Prog) ->
PaPaths = [[" -pa ", Path] || Path <- Paths],
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 8b356d8026..8d443a1477 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -805,12 +805,11 @@ handle_unix_socket_options(#request{unix_socket = UnixSocket},
error({badarg, [{ipfamily, Else}, {unix_socket, UnixSocket}]})
end.
-connect_and_send_first_request(Address, #request{ipv6_host_with_brackets = HasBrackets} = Request,
- #state{options = Options0} = State) ->
+connect_and_send_first_request(Address, Request, #state{options = Options0} = State) ->
SocketType = socket_type(Request),
ConnTimeout = (Request#request.settings)#http_options.connect_timeout,
Options = handle_unix_socket_options(Request, Options0),
- case connect(SocketType, format_address(Address, HasBrackets), Options, ConnTimeout) of
+ case connect(SocketType, format_address(Address), Options, ConnTimeout) of
{ok, Socket} ->
ClientClose =
httpc_request:is_client_closing(
@@ -1739,9 +1738,8 @@ update_session(ProfileName, #session{id = SessionId} = Session, Pos, Value) ->
{stacktrace, Stacktrace}]}}
end.
-
-format_address({Host, Port}, true) when is_list(Host)->
- {ok, Address} = inet:parse_address(string:strip(string:strip(Host, right, $]), left, $[)),
+format_address({[$[|T], Port}) ->
+ {ok, Address} = inet:parse_address(string:strip(T, right, $])),
{Address, Port};
-format_address(HostPort, _) ->
+format_address(HostPort) ->
HostPort.
diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl
index 443b7ee564..f495f12f03 100644
--- a/lib/inets/src/http_server/mod_esi.erl
+++ b/lib/inets/src/http_server/mod_esi.erl
@@ -33,7 +33,7 @@
-include("httpd_internal.hrl").
-define(VMODULE,"ESI").
--define(DEFAULT_ERL_TIMEOUT,15000).
+-define(DEFAULT_ERL_TIMEOUT,15).
%%%=========================================================================
@@ -174,7 +174,7 @@ store({erl_script_alias, Value}, _) ->
{error, {wrong_type, {erl_script_alias, Value}}};
store({erl_script_timeout, TimeoutSec}, _)
when is_integer(TimeoutSec) andalso (TimeoutSec >= 0) ->
- {ok, {erl_script_timeout, TimeoutSec * 1000}};
+ {ok, {erl_script_timeout, TimeoutSec}};
store({erl_script_timeout, Value}, _) ->
{error, {wrong_type, {erl_script_timeout, Value}}};
store({erl_script_nocache, Value} = Conf, _)
@@ -500,7 +500,7 @@ kill_esi_delivery_process(Pid) ->
erl_script_timeout(Db) ->
- httpd_util:lookup(Db, erl_script_timeout, ?DEFAULT_ERL_TIMEOUT).
+ httpd_util:lookup(Db, erl_script_timeout, ?DEFAULT_ERL_TIMEOUT * 1000).
script_elements(FuncAndInput, Input) ->
case input_type(FuncAndInput) of
diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl
index 5b6740fba3..fcb9ad7905 100644
--- a/lib/inets/test/httpd_SUITE.erl
+++ b/lib/inets/test/httpd_SUITE.erl
@@ -78,7 +78,8 @@ all() ->
{group, http_rel_path_script_alias},
{group, http_not_sup},
{group, https_not_sup},
- mime_types_format
+ mime_types_format,
+ erl_script_timeout_option
].
groups() ->
@@ -1777,6 +1778,18 @@ mime_types_format(Config) when is_list(Config) ->
{"hqx","application/mac-binhex40"}]} = httpd_conf:load_mime_types(MimeTypes).
+erl_script_timeout_option(Config) when is_list(Config) ->
+ inets:start(),
+ {ok, Pid} = inets:start(httpd, [{erl_script_timeout, 215},
+ {server_name, "test"},
+ {port,0},
+ {server_root, "."},
+ {document_root, "."}]),
+ Info = httpd:info(Pid),
+ 215 = proplists:get_value(erl_script_timeout, Info),
+ inets:stop().
+
+
%%--------------------------------------------------------------------
%% Internal functions -----------------------------------
%%--------------------------------------------------------------------
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index 1d1560213e..b7ddf39ebd 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 7.0.4
+INETS_VSN = 7.0.6
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
diff --git a/lib/jinterface/doc/src/Makefile b/lib/jinterface/doc/src/Makefile
index d80bb38ec1..f5cba9d074 100644
--- a/lib/jinterface/doc/src/Makefile
+++ b/lib/jinterface/doc/src/Makefile
@@ -137,6 +137,7 @@ clean clean_docs:
jdoc:$(JAVA_SRC_FILES)
(cd ../../java_src;$(JAVADOC) -sourcepath . -d $(JAVADOC_DEST) \
-windowtitle $(JAVADOC_TITLE) $(JAVADOC_PKGS))
+ touch jdoc
man:
@@ -152,15 +153,8 @@ include $(ERL_TOP)/make/otp_release_targets.mk
release_docs_spec: docs
$(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf"
$(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf"
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/html"
- $(INSTALL_DIR) "$(RELSYSDIR)/doc/html/java/$(JAVA_PKG_PATH)"
$(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)"
- ($(CP) -rf ../html "$(RELSYSDIR)/doc")
-
-# $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \
-# "$(RELSYSDIR)/doc/html"
-# $(INSTALL_DATA) $(JAVA_EXTRA_FILES) "$(RELSYSDIR)/doc/html/java"
-# $(INSTALL_DATA) $(TOP_HTML_FILES) "$(RELSYSDIR)/doc"
+ $(INSTALL_DIR_DATA) $(HTMLDIR) "$(RELSYSDIR)/doc/html"
release_spec:
diff --git a/lib/kernel/doc/src/application.xml b/lib/kernel/doc/src/application.xml
index 4e32c1a3a5..83a83ebad2 100644
--- a/lib/kernel/doc/src/application.xml
+++ b/lib/kernel/doc/src/application.xml
@@ -238,6 +238,41 @@ Nodes = [cp1@cave, {cp2@cave, cp3@cave}]</code>
</desc>
</func>
<func>
+ <name name="set_env" arity="1" since="OTP 21.3"/>
+ <name name="set_env" arity="2" since="OTP 21.3"/>
+ <fsummary>Sets the configuration parameters of multiple applications.</fsummary>
+ <desc>
+ <p>Sets the configuration <c><anno>Config</anno></c> for multiple
+ applications. It is equivalent to calling <c>set_env/4</c> on
+ each application individially, except it is more efficient.
+ The given <c><anno>Config</anno></c> is validated before the
+ configuration is set.</p>
+ <p><c>set_env/2</c> uses the standard <c>gen_server</c> time-out
+ value (5000 ms). Option <c>timeout</c> can be specified
+ if another time-out value is useful, for example, in situations
+ where the application controller is heavily loaded.</p>
+ <p>Option <c>persistent</c> can be set to <c>true</c>
+ to guarantee that parameters set with <c>set_env/2</c>
+ are not overridden by those defined in the application resource
+ file on load. This means that persistent values will stick after the application
+ is loaded and also on application reload.</p>
+ <p>If an application is given more than once or if an application
+ has the same key given more than once, the behaviour is undefined
+ and a warning message will be logged. In future releases, an error
+ will be raised.</p>
+ <p><c>set_env/1</c> is equivalent to <c>set_env(Config, [])</c>.</p>
+ <warning>
+ <p>Use this function only if you know what you are doing,
+ that is, on your own applications. It is very
+ application-dependent and
+ configuration parameter-dependent when and how often
+ the value is read by the application. Careless use
+ of this function can put the application in a
+ weird, inconsistent, and malfunctioning state.</p>
+ </warning>
+ </desc>
+ </func>
+ <func>
<name name="permit" arity="2" since=""/>
<fsummary>Change the permission for an application to run at a node.</fsummary>
<desc>
diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
index 15dbdb47dc..7f9609d5c1 100644
--- a/lib/kernel/doc/src/kernel_app.xml
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -369,6 +369,14 @@ MaxT = TickTime + TickTime / 4</code>
performed. This option ensures that <c>global</c> is
synchronized.</p>
</item>
+ <tag><c>start_distribution = true | false</c></tag>
+ <item>
+ <p>Starts all distribution services, such as <c>rpc</c>,
+ <c>global</c>, and <c>net_kernel</c> if the parameter is
+ <c>true</c>. This parameter is to be set to <c>false</c>
+ for systems who want to disable all distribution functionality.</p>
+ <p>Defaults to <c>true</c>.</p>
+ </item>
<tag><c>start_dist_ac = true | false</c></tag>
<item>
<p>Starts the <c>dist_ac</c> server if the parameter is
@@ -510,11 +518,13 @@ MaxT = TickTime + TickTime / 4</code>
parameters for Logger are not set.</p>
<taglist>
<tag><c>error_logger</c></tag>
- <item>Replaced by setting the type of the default
- <seealso marker="logger_std_h#type"><c>logger_std_h</c></seealso>
- to the same value. Example:
+ <item>Replaced by setting the <seealso
+ marker="logger_std_h#type"><c>type</c></seealso>, and possibly
+ <seealso marker="logger_std_h#file"><c>file</c></seealso> and
+ <seealso marker="logger_std_h#modes"><c>modes</c></seealso>
+ parameters of the default <c>logger_std_h</c> handler. Example:
<code type="none">
-erl -kernel logger '[{handler,default,logger_std_h,#{config=>#{type=>{file,"/tmp/erlang.log"}}}}]'
+erl -kernel logger '[{handler,default,logger_std_h,#{config=>#{file=>"/tmp/erlang.log"}}}]'
</code>
</item>
<tag><c>error_logger_format_depth</c></tag>
diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml
index 0668676096..2a060ce1f9 100644
--- a/lib/kernel/doc/src/logger.xml
+++ b/lib/kernel/doc/src/logger.xml
@@ -66,7 +66,7 @@ logger:error("error happened because: ~p", [Reason]). % Without macro
[{kernel,
[{logger,
[{handler, default, logger_std_h,
- #{config => #{type => {file, "path/to/file.log"}}}}]}]}].
+ #{config => #{file => "path/to/file.log"}}}]}]}].
</code>
<p>
For more information about:
@@ -190,7 +190,7 @@ logger:error("error happened because: ~p", [Reason]). % Without macro
<list>
<item><c>pid => self()</c></item>
<item><c>gl => group_leader()</c></item>
- <item><c>time => erlang:system_time(microsecond)</c></item>
+ <item><c>time => logger:timestamp()</c></item>
</list>
<p>When a log macro is used, Logger also inserts location
information:</p>
@@ -288,8 +288,8 @@ logger:error("error happened because: ~p", [Reason]). % Without macro
<name name="timestamp"/>
<desc>
<p>A timestamp produced
- with <seealso marker="erts:erlang#system_time-1">
- <c>erlang:system_time(microsecond)</c></seealso>.</p>
+ with <seealso marker="#timestamp-0">
+ <c>logger:timestamp()</c></seealso>.</p>
</desc>
</datatype>
</datatypes>
@@ -689,6 +689,15 @@ start(_, []) ->
</func>
<func>
+ <name name="i" arity="0" since="OTP 21.3"/>
+ <name name="i" arity="1" since="OTP 21.3"/>
+ <fsummary>Pretty print the Logger configuration.</fsummary>
+ <desc>
+ <p>Pretty print the Logger configuration.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="remove_handler" arity="1" since="OTP 21.0"/>
<fsummary>Remove the handler with the specified identity.</fsummary>
<desc>
@@ -1108,6 +1117,24 @@ logger:set_proxy_config(maps:merge(Old, Config)).
a key-value list before formatting as such.</p>
</desc>
</func>
+
+ <func>
+ <name name="timestamp" arity="0" since="OTP 21.3"/>
+ <fsummary>Return a timestamp to insert in meta data for a log
+ event.</fsummary>
+ <desc>
+ <p>Return a timestamp that can be inserted as the <c>time</c>
+ field in the meta data for a log event. It is produced with
+ <seealso marker="kernel:os#system_time-1">
+ <c>os:system_time(microsecond)</c></seealso>.</p>
+ <p>Notice that Logger automatically inserts a timestamp in the
+ meta data unless it already exists. This function is
+ exported for the rare case when the timestamp must be taken
+ at a different point in time than when the log event is
+ issued.</p>
+ </desc>
+ </func>
+
</funcs>
<section>
@@ -1324,5 +1351,3 @@ logger:set_proxy_config(maps:merge(Old, Config)).
</p>
</section>
</erlref>
-
-
diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml
index 03b9edcf8f..8458ffa042 100644
--- a/lib/kernel/doc/src/logger_chapter.xml
+++ b/lib/kernel/doc/src/logger_chapter.xml
@@ -801,7 +801,7 @@ logger:debug(#{got => connection_request, id => Id, state => State},
[{kernel,
[{logger,
[{handler, default, logger_std_h, % {handler, HandlerId, Module,
- #{config => #{type => {file,"log/erlang.log"}}}} % Config}
+ #{config => #{file => "log/erlang.log"}}} % Config}
]}]}].
</code>
<p>Modify the default handler to print each log event as a
@@ -831,10 +831,10 @@ logger:debug(#{got => connection_request, id => Id, state => State},
[{logger,
[{handler, default, logger_std_h,
#{level => error,
- config => #{type => {file, "log/erlang.log"}}}},
+ config => #{file => "log/erlang.log"}}},
{handler, info, logger_std_h,
#{level => debug,
- config => #{type => {file, "log/debug.log"}}}}
+ config => #{file => "log/debug.log"}}}
]}]}].
</code>
</section>
@@ -1004,10 +1004,10 @@ ok</pre>
<p>Then, add a new handler which prints to file. You can use the
handler
module <seealso marker="logger_std_h"><c>logger_std_h</c></seealso>,
- and specify type <c>{file,File}</c>.:</p>
+ and configure it to log to file:</p>
<pre>
-4> <input>Config = #{config => #{type => {file,"./info.log"}}, level => info}.</input>
-#{config => #{type => {file,"./info.log"}},level => info}
+4> <input>Config = #{config => #{file => "./info.log"}, level => info}.</input>
+#{config => #{file => "./info.log"},level => info}
5> <input>logger:add_handler(myhandler, logger_std_h, Config).</input>
ok</pre>
<p>Since <c>filter_default</c> defaults to <c>log</c>, this
@@ -1246,7 +1246,7 @@ do_log(Fd, LogEvent, #{formatter := {FModule, FConfig}}) ->
<p>A configuration example:</p>
<code type="none">
logger:add_handler(my_standard_h, logger_std_h,
- #{config => #{type => {file,"./system_info.log"},
+ #{config => #{file => "./system_info.log",
sync_mode_qlen => 100,
drop_mode_qlen => 1000,
flush_qlen => 2000}}).
diff --git a/lib/kernel/doc/src/logger_std_h.xml b/lib/kernel/doc/src/logger_std_h.xml
index fcd180abd6..5ed1a2f210 100644
--- a/lib/kernel/doc/src/logger_std_h.xml
+++ b/lib/kernel/doc/src/logger_std_h.xml
@@ -55,30 +55,105 @@
is stored in a sub map with the key <c>config</c>, and can contain the
following parameters:</p>
<taglist>
- <tag><marker id="type"/><c>type</c></tag>
+ <tag><marker id="type"/><c>type = standard_io | standard_error | file</c></tag>
<item>
- <p>This has the value <c>standard_io</c>, <c>standard_error</c>,
- <c>{file,LogFileName}</c>, or <c>{file,LogFileName,LogFileOpts}</c>.</p>
- <p>If <c>LogFileOpts</c> is specified, it replaces the default
- list of options used when opening the log file. The default
- list is <c>[raw,append,delayed_write]</c>. One reason to do
- so can be to change <c>append</c> to, for
- example, <c>write</c>, ensuring that the old log is
- truncated when a node is restarted. See the reference manual
- for <seealso marker="file#open-2"><c>file:open/2</c></seealso>
- for more information about file options.</p>
+ <p>Specifies the log destination.</p>
+ <p>The value is set when the handler is added, and it can not
+ be changed in runtime.</p>
+ <p>Defaults to <c>standard_io</c>, unless
+ parameter <seealso marker="#file"><c>file</c></seealso> is
+ given, in which case it defaults to <c>file</c>.</p>
+ </item>
+ <tag><marker id="file"/><c>file = </c><seealso marker="file#type-filename"><c>file:filename()</c></seealso></tag>
+ <item>
+ <p>This specifies the name of the log file when the handler is
+ of type <c>file</c>.</p>
+ <p>The value is set when the handler is added, and it can not
+ be changed in runtime.</p>
+ <p>Defaults to the same name as the handler identity, in the
+ current directory.</p>
+ </item>
+ <tag><marker id="modes"/><c>modes = [</c><seealso marker="file#type-mode"><c>file:mode()</c></seealso><c>]</c></tag>
+ <item>
+ <p>This specifies the file modes to use when opening the log
+ file,
+ see <seealso marker="file#open-2"><c>file:open/2</c></seealso>.
+ If <c>modes</c> are not specified, the default list used
+ is <c>[raw,append,delayed_write]</c>. If <c>modes</c> are
+ specified, the list replaces the default modes list with the
+ following adjustments:</p>
+ <list>
+ <item>
+ If <c>raw</c> is not found in the list, it is added.
+ </item>
+ <item>
+ If none of <c>write</c>, <c>append</c> or <c>exclusive</c> is
+ found in the list, <c>append</c> is added.</item>
+ <item>If none of <c>delayed_write</c>
+ or <c>{delayed_write,Size,Delay}</c> is found in the
+ list, <c>delayed_write</c> is added.</item>
+ </list>
<p>Log files are always UTF-8 encoded. The encoding can not be
- changed by setting the option <c>{encoding,Encoding}</c>
- in <c>LogFileOpts</c>.</p>
- <p>Notice that the standard handler does not have support for
- circular logging. Use the disk_log handler,
- <seealso marker="logger_disk_log_h"><c>logger_disk_log_h</c></seealso>,
- for this.</p>
+ changed by setting the mode <c>{encoding,Encoding}</c>.</p>
<p>The value is set when the handler is added, and it can not
be changed in runtime.</p>
- <p>Defaults to <c>standard_io</c>.</p>
+ <p>Defaults to <c>[raw,append,delayed_write]</c>.</p>
+ </item>
+ <tag><marker id="max_no_bytes"/><c>max_no_bytes = pos_integer() | infinity</c></tag>
+ <item>
+ <p>This parameter specifies if the log file should be rotated
+ or not. The value <c>infinity</c> means the log file will
+ grow indefinitely, while an integer value specifies at which
+ file size (bytes) the file is rotated.</p>
+ <p>Defaults to <c>infinity</c>.</p>
+ </item>
+ <tag><marker id="max_no_files"/><c>max_no_files = non_neg_integer()</c></tag>
+ <item>
+ <p>This parameter specifies the number of rotated log file
+ archives to keep. This has meaning only
+ if <seealso marker="#max_no_bytes"><c>max_no_bytes</c></seealso>
+ is set to an integer value.</p>
+ <p>The log archives are
+ named <c>FileName.0</c>, <c>FileName.1</c>,
+ ... <c>FileName.N</c>, where <c>FileName</c> is the name of
+ the current log file. <c>FileName.0</c> is the newest of the
+ archives. The maximum value for <c>N</c> is the value
+ of <c>max_no_files</c> minus 1.</p>
+ <p>Notice that setting this value to <c>0</c> does not turn of
+ rotation. It only specifies that no archives are kept.</p>
+ <p>Defaults to <c>0</c>.</p>
+ </item>
+ <tag><marker id="compress_on_rotate"/><c>compress_on_rotate = boolean()</c></tag>
+ <item>
+ <p>This parameter specifies if the rotated log file archives
+ shall be compressed or not. If set to <c>true</c>, all
+ archives are compressed with <c>gzip</c>, and renamed
+ to <c>FileName.N.gz</c></p>
+ <p><c>compress_on_rotate</c> has no meaning if <seealso
+ marker="#max_no_bytes"><c>max_no_bytes</c></seealso> has the
+ value <c>infinity</c>.</p>
+ <p>Defaults to <c>false</c>.</p>
+ </item>
+ <tag><marker id="file_check"/><c>file_check = non_neg_integer()</c></tag>
+ <item>
+ <p>When <c>logger_std_h</c> logs to a file, it reads the file
+ information of the log file prior to each write
+ operation. This is to make sure the file still exists and
+ has the same inode as when it was opened. This implies some
+ performance loss, but ensures that no log events are lost in
+ the case when the file has been removed or renamed by an
+ external actor.</p>
+ <p>In order to allow minimizing the performance loss, the
+ <c>file_check</c> parameter can be set to a positive integer
+ value, <c>N</c>. The handler will then skip reading the file
+ information prior to writing, as long as no more
+ than <c>N</c> milliseconds have passed since it was last
+ read.</p>
+ <p>Notice that the risk of loosing log events grows when
+ the <c>file_check</c> value grows.</p>
+ <p>Defaults to 0.</p>
</item>
- <tag><c>filesync_repeat_interval</c></tag>
+ <tag><c>filesync_repeat_interval = pos_integer() | no_repeat</c></tag>
<item>
<p>This value, in milliseconds, specifies how often the handler does
a file sync operation to write buffered data to disk. The handler attempts
@@ -97,12 +172,13 @@
standard handler and the disk_log handler, and are documented in the
<seealso marker="logger_chapter#overload_protection"><c>User's Guide</c>
</seealso>.</p>
- <p>Notice that if changing the configuration of the handler in runtime,
- the <c>type</c> parameter must not be modified.</p>
+ <p>Notice that if changing the configuration of the handler in
+ runtime, the <c>type</c>, <c>file</c>, or <c>modes</c> parameters
+ must not be modified.</p>
<p>Example of adding a standard handler:</p>
<code type="none">
logger:add_handler(my_standard_h, logger_std_h,
- #{config => #{type => {file,"./system_info.log"},
+ #{config => #{file => "./system_info.log",
filesync_repeat_interval => 1000}}).
</code>
<p>To set the default handler, that starts initially with
@@ -110,7 +186,7 @@ logger:add_handler(my_standard_h, logger_std_h,
change the Kernel default logger configuration. Example:</p>
<code type="none">
erl -kernel logger '[{handler,default,logger_std_h,
- #{config => #{type => {file,"./log.log"}}}}]'
+ #{config => #{file => "./log.log"}}}]'
</code>
<p>An example of how to replace the standard handler with a disk_log handler
at startup is found in the
diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml
index 021ecfa40d..0c187eb19f 100644
--- a/lib/kernel/doc/src/notes.xml
+++ b/lib/kernel/doc/src/notes.xml
@@ -31,6 +31,204 @@
</header>
<p>This document describes the changes made to the Kernel application.</p>
+<section><title>Kernel 6.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ If for example the <c>/etc/hosts</c> did not come into
+ existence until after the kernel application had started,
+ its content was never read. This bug has now been
+ corrected.</p>
+ <p>
+ Own Id: OTP-14702 Aux Id: PR-2066 </p>
+ </item>
+ <item>
+ <p>
+ Fix bug where doing <c>seq_trace:reset_trace()</c> while
+ another process was doing a garbage collection could
+ cause the run-time system to segfault.</p>
+ <p>
+ Own Id: OTP-15490</p>
+ </item>
+ <item>
+ <p>
+ Fix <c>erl_epmd:port_please</c> spec to include
+ <c>atom()</c> and <c>string()</c>.</p>
+ <p>
+ Own Id: OTP-15557 Aux Id: PR-2117 </p>
+ </item>
+ <item>
+ <p>
+ The Logger handler logger_std_h now keeps track of the
+ inode of its log file in order to re-open the file if the
+ inode changes. This may happen, for instance, if the log
+ file is opened and saved by an editor.</p>
+ <p>
+ Own Id: OTP-15578 Aux Id: ERL-850 </p>
+ </item>
+ <item>
+ <p>
+ When user specific file modes are given to the logger
+ handler <c>logger_std_h</c>, they were earlier accepted
+ without any control. This is now changes, so Logger will
+ adjust the file modes as follows:</p>
+ <p>
+ - If <c>raw</c> is not found in the list, it is
+ added.<br/> - If none of <c>write</c>, <c>append</c> or
+ <c>exclusive</c> are found in the list, <c>append</c> is
+ added.<br/> - If none of <c>delayed_write</c> or
+ <c>{delayed_write,Size,Delay}</c> are found in the list,
+ <c>delayed_write</c> is added.</p>
+ <p>
+ Own Id: OTP-15602</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ The standard logger handler, <c>logger_std_h</c>, now has
+ a new internal feature for log rotation. The rotation
+ scheme is as follows:</p>
+ <p>
+ The log file to which the handler currently writes always
+ has the same name, i.e. the name which is configured for
+ the handler. The archived files have the same name, but
+ with extension ".N", where N is an integer. The newest
+ archive has extension ".0", and the oldest archive has
+ the highest number. </p>
+ <p>
+ The size at which the log file is rotated, and the number
+ of archive files that are kept, is specified with the
+ handler specific configuration parameters
+ <c>max_no_bytes</c> and <c>max_no_files</c> respectively. </p>
+ <p>
+ Archives can be compressed, in which case they get a
+ ".gz" file extension after the integer. Compression is
+ specified with the handler specific configuration
+ parameter <c>compress_on_rotate</c>.</p>
+ <p>
+ Own Id: OTP-15479</p>
+ </item>
+ <item>
+ <p>
+ The new functions <c>logger:i/0</c> and <c>logger:i/1</c>
+ are added. These provide the same information as
+ <c>logger:get_config/0</c> and other
+ <c>logger:get_*_config</c> functions, but the information
+ is more logically sorted and more readable.</p>
+ <p>
+ Own Id: OTP-15600</p>
+ </item>
+ <item>
+ <p>
+ Logger is now protected against overload due to massive
+ amounts of log events from the emulator or from remote
+ nodes.</p>
+ <p>
+ Own Id: OTP-15601</p>
+ </item>
+ <item>
+ <p>
+ Logger now uses os:system_time/1 instead of
+ erlang:system_time/1 to generate log event timestamps.</p>
+ <p>
+ Own Id: OTP-15625</p>
+ </item>
+ <item>
+ <p>
+ Add functions <c>application:set_env/1,2</c> and
+ <c>application:set_env/2</c>. These take a list of
+ application configuration parameters, and the behaviour
+ is equivalent to calling <c>application:set_env/4</c>
+ individually for each application/key combination, except
+ it is more efficient.</p>
+ <p>
+ <c>set_env/1,2</c> warns about duplicated applications or
+ keys. The warning is also emitted during boot, if
+ applications or keys are duplicated within one
+ configuration file, e.g. sys.config.</p>
+ <p>
+ Own Id: OTP-15642 Aux Id: PR-2164 </p>
+ </item>
+ <item>
+ <p>
+ Handler specific configuration parameters for the
+ standard handler <c>logger_std_h</c> are changed to be
+ more intuitive and more similar to the disk_log handler.</p>
+ <p>
+ Earlier there was only one parameter, <c>type</c>, which
+ could have the values <c>standard_io</c>,
+ <c>standard_error</c>, <c>{file,FileName}</c> or
+ <c>{file,FileName,Modes}</c>.</p>
+ <p>
+ This is now changed, so the following parameters are
+ allowed:</p>
+ <p>
+ <c>type = standard_io | standard_error | file</c><br/>
+ <c>file = file:filename()</c><br/> <c>modes =
+ [file:mode()]</c></p>
+ <p>
+ All parameters are optional. <c>type</c> defaults to
+ <c>standard_io</c>, unless a file name is given, in which
+ case it defaults to <c>file</c>. If <c>type</c> is set to
+ <c>file</c>, the file name defaults to the same as the
+ handler id.</p>
+ <p>
+ The potential incompatibility is that
+ <c>logger:get_config/0</c> and
+ <c>logger:get_handler_config/1</c> now returns the new
+ parameters, even if the configuration was set with the
+ old variant, e.g. <c>#{type=>{file,FileName}}</c>.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-15662</p>
+ </item>
+ <item>
+ <p>
+ The new configuration parameter <c>file_check</c> is
+ added to the Logger handler <c>logger_std_h</c>. This
+ parameter specifies how long (in milliseconds) the
+ handler may wait before checking if the log file still
+ exists and the inode is the same as when it was opened.</p>
+ <p>
+ The default value is 0, which means that this check is
+ done prior to each write operation. Setting a higher
+ number may improve performance, but adds the risk of
+ loosing log events.</p>
+ <p>
+ Own Id: OTP-15663</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 6.2.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Setting the <c>recbuf</c> size of an inet socket the
+ <c>buffer</c> is also automatically increased. Fix a bug
+ where the auto adjustment of inet buffer size would be
+ triggered even if an explicit inet buffer size had
+ already been set.</p>
+ <p>
+ Own Id: OTP-15651 Aux Id: ERIERL-304 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Kernel 6.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/kernel/include/dist.hrl b/lib/kernel/include/dist.hrl
index 003852f1b0..f06fc328d7 100644
--- a/lib/kernel/include/dist.hrl
+++ b/lib/kernel/include/dist.hrl
@@ -42,6 +42,9 @@
-define(DFLAG_BIG_CREATION, 16#40000).
-define(DFLAG_SEND_SENDER, 16#80000).
-define(DFLAG_BIG_SEQTRACE_LABELS, 16#100000).
+%% -define(DFLAG_NO_MAGIC, 16#200000). %% Used internally only
+-define(DFLAG_EXIT_PAYLOAD, 16#400000).
+-define(DFLAG_FRAGMENTS, 16#800000).
%% Also update dflag2str() in ../src/dist_util.erl
%% when adding flags...
diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile
index 3d1506ea08..43b776f37e 100644
--- a/lib/kernel/src/Makefile
+++ b/lib/kernel/src/Makefile
@@ -123,7 +123,6 @@ MODULES = \
logger_server \
logger_simple_h \
logger_sup \
- net \
net_adm \
net_kernel \
os \
diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl
index bc6be2f8f5..5c2e981e4b 100644
--- a/lib/kernel/src/application.erl
+++ b/lib/kernel/src/application.erl
@@ -25,7 +25,7 @@
which_applications/0, which_applications/1,
loaded_applications/0, permit/2]).
-export([ensure_started/1, ensure_started/2]).
--export([set_env/3, set_env/4, unset_env/2, unset_env/3]).
+-export([set_env/1, set_env/2, set_env/3, set_env/4, unset_env/2, unset_env/3]).
-export([get_env/1, get_env/2, get_env/3, get_all_env/0, get_all_env/1]).
-export([get_key/1, get_key/2, get_all_key/0, get_all_key/1]).
-export([get_application/0, get_application/1, info/0]).
@@ -279,6 +279,26 @@ loaded_applications() ->
info() ->
application_controller:info().
+-spec set_env(Config) -> 'ok' when
+ Config :: [{Application, Env}],
+ Application :: atom(),
+ Env :: [{Par :: atom(), Val :: term()}].
+
+set_env(Config) when is_list(Config) ->
+ set_env(Config, []).
+
+-spec set_env(Config, Opts) -> 'ok' when
+ Config :: [{Application, Env}],
+ Application :: atom(),
+ Env :: [{Par :: atom(), Val :: term()}],
+ Opts :: [{timeout, timeout()} | {persistent, boolean()}].
+
+set_env(Config, Opts) when is_list(Config), is_list(Opts) ->
+ case application_controller:set_env(Config, Opts) of
+ ok -> ok;
+ {error, Msg} -> erlang:error({badarg, Msg}, [Config, Opts])
+ end.
+
-spec set_env(Application, Par, Val) -> 'ok' when
Application :: atom(),
Par :: atom(),
diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl
index a074d2e74b..9a8091fb2e 100644
--- a/lib/kernel/src/application_controller.erl
+++ b/lib/kernel/src/application_controller.erl
@@ -26,7 +26,7 @@
control_application/1,
change_application_data/2, prep_config_change/0, config_change/1,
which_applications/0, which_applications/1,
- loaded_applications/0, info/0,
+ loaded_applications/0, info/0, set_env/2,
get_pid_env/2, get_env/2, get_pid_all_env/1, get_all_env/1,
get_pid_key/2, get_key/2, get_pid_all_key/1, get_all_key/1,
get_master/1, get_application/1, get_application_module/1,
@@ -345,9 +345,6 @@ get_all_env(AppName) ->
map(fun([Key, Val]) -> {Key, Val} end,
ets:match(ac_tab, {{env, AppName, '$1'}, '$2'})).
-
-
-
get_pid_key(Master, Key) ->
case ets:match(ac_tab, {{application_master, '$1'}, Master}) of
[[AppName]] -> get_key(AppName, Key);
@@ -461,6 +458,15 @@ permit_application(ApplName, Flag) ->
{permit_application, ApplName, Flag},
infinity).
+set_env(Config, Opts) ->
+ case check_conf_data(Config) of
+ ok ->
+ Timeout = proplists:get_value(timeout, Opts, 5000),
+ gen_server:call(?AC, {set_env, Config, Opts}, Timeout);
+
+ {error, _} = Error ->
+ Error
+ end.
set_env(AppName, Key, Val) ->
gen_server:call(?AC, {set_env, AppName, Key, Val, []}).
@@ -528,19 +534,17 @@ check_conf_data([]) ->
check_conf_data(ConfData) when is_list(ConfData) ->
[Application | ConfDataRem] = ConfData,
case Application of
- {kernel, List} when is_list(List) ->
- case check_para_kernel(List) of
- ok ->
- check_conf_data(ConfDataRem);
- Error1 ->
- Error1
- end;
{AppName, List} when is_atom(AppName), is_list(List) ->
- case check_para(List, atom_to_list(AppName)) of
- ok ->
- check_conf_data(ConfDataRem);
- Error2 ->
- Error2
+ case lists:keymember(AppName, 1, ConfDataRem) of
+ true ->
+ ?LOG_WARNING("duplicate application config: " ++ atom_to_list(AppName));
+ false ->
+ ok
+ end,
+
+ case check_para(List, AppName) of
+ ok -> check_conf_data(ConfDataRem);
+ Error -> Error
end;
{AppName, List} when is_list(List) ->
ErrMsg = "application: "
@@ -553,36 +557,40 @@ check_conf_data(ConfData) when is_list(ConfData) ->
++ "; parameters must be a list",
{error, ErrMsg};
Else ->
- ErrMsg = "invalid application name: " ++
- lists:flatten(io_lib:format(" ~tp",[Else])),
+ ErrMsg = "invalid application config: "
+ ++ lists:flatten(io_lib:format("~tp",[Else])),
{error, ErrMsg}
end;
check_conf_data(_ConfData) ->
- {error, 'configuration must be a list ended by <dot><whitespace>'}.
-
+ {error, "configuration must be a list ended by <dot><whitespace>"}.
-%% Special check of distributed parameter for kernel
-check_para_kernel([]) ->
+
+check_para([], _AppName) ->
ok;
-check_para_kernel([{distributed, Apps} | ParaList]) when is_list(Apps) ->
- case check_distributed(Apps) of
- {error, _ErrorMsg} = Error ->
- Error;
- _ ->
- check_para_kernel(ParaList)
+check_para([{Para, Val} | ParaList], AppName) when is_atom(Para) ->
+ case lists:keymember(Para, 1, ParaList) of
+ true ->
+ ?LOG_WARNING("application: " ++ atom_to_list(AppName) ++
+ "; duplicate parameter: " ++ atom_to_list(Para));
+ false ->
+ ok
+ end,
+
+ case check_para_value(Para, Val, AppName) of
+ ok -> check_para(ParaList, AppName);
+ {error, _} = Error -> Error
end;
-check_para_kernel([{distributed, _Apps} | _ParaList]) ->
- {error, "application: kernel; erroneous parameter: distributed"};
-check_para_kernel([{Para, _Val} | ParaList]) when is_atom(Para) ->
- check_para_kernel(ParaList);
-check_para_kernel([{Para, _Val} | _ParaList]) ->
- {error, "application: kernel; invalid parameter: " ++
+check_para([{Para, _Val} | _ParaList], AppName) ->
+ {error, "application: " ++ atom_to_list(AppName) ++ "; invalid parameter name: " ++
lists:flatten(io_lib:format("~tp",[Para]))};
-check_para_kernel(Else) ->
- {error, "application: kernel; invalid parameter list: " ++
+check_para([Else | _ParaList], AppName) ->
+ {error, "application: " ++ atom_to_list(AppName) ++ "; invalid parameter: " ++
lists:flatten(io_lib:format("~tp",[Else]))}.
-
+check_para_value(distributed, Apps, kernel) -> check_distributed(Apps);
+check_para_value(_Para, _Val, _AppName) -> ok.
+
+%% Special check of distributed parameter for kernel
check_distributed([]) ->
ok;
check_distributed([{App, List} | Apps]) when is_atom(App), is_list(List) ->
@@ -595,18 +603,6 @@ check_distributed(_Else) ->
{error, "application: kernel; erroneous parameter: distributed"}.
-check_para([], _AppName) ->
- ok;
-check_para([{Para, _Val} | ParaList], AppName) when is_atom(Para) ->
- check_para(ParaList, AppName);
-check_para([{Para, _Val} | _ParaList], AppName) ->
- {error, "application: " ++ AppName ++ "; invalid parameter: " ++
- lists:flatten(io_lib:format("~tp",[Para]))};
-check_para([Else | _ParaList], AppName) ->
- {error, "application: " ++ AppName ++ "; invalid parameter: " ++
- lists:flatten(io_lib:format("~tp",[Else]))}.
-
-
-type calls() :: 'info' | 'prep_config_change' | 'which_applications'
| {'config_change' | 'control_application' |
'load_application' | 'start_type' | 'stop_application' |
@@ -863,6 +859,16 @@ handle_call(which_applications, _From, S) ->
end, S#state.running),
{reply, Reply, S};
+handle_call({set_env, Config, Opts}, _From, S) ->
+ _ = [add_env(AppName, Env) || {AppName, Env} <- Config],
+
+ case proplists:get_value(persistent, Opts, false) of
+ true ->
+ {reply, ok, S#state{conf_data = merge_env(S#state.conf_data, Config)}};
+ false ->
+ {reply, ok, S}
+ end;
+
handle_call({set_env, AppName, Key, Val, Opts}, _From, S) ->
ets:insert(ac_tab, {{env, AppName, Key}, Val}),
case proplists:get_value(persistent, Opts, false) of
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 1b4a67ecb7..68e1205301 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -1434,19 +1434,25 @@ all_loaded(Db) ->
-spec error_msg(io:format(), [term()]) -> 'ok'.
error_msg(Format, Args) ->
+ %% This is equal to calling logger:error/3 which we don't want to
+ %% do from code_server. We don't want to call logger:timestamp()
+ %% either.
logger ! {log,error,Format,Args,
#{pid=>self(),
gl=>group_leader(),
- time=>erlang:system_time(microsecond),
+ time=>os:system_time(microsecond),
error_logger=>#{tag=>error}}},
ok.
-spec info_msg(io:format(), [term()]) -> 'ok'.
info_msg(Format, Args) ->
+ %% This is equal to calling logger:info/3 which we don't want to
+ %% do from code_server. We don't want to call logger:timestamp()
+ %% either.
logger ! {log,info,Format,Args,
#{pid=>self(),
gl=>group_leader(),
- time=>erlang:system_time(microsecond),
+ time=>os:system_time(microsecond),
error_logger=>#{tag=>info_msg}}},
ok.
diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl
index ecc022b28d..09ed31f10c 100644
--- a/lib/kernel/src/dist_util.erl
+++ b/lib/kernel/src/dist_util.erl
@@ -116,6 +116,10 @@ dflag2str(?DFLAG_SEND_SENDER) ->
"SEND_SENDER";
dflag2str(?DFLAG_BIG_SEQTRACE_LABELS) ->
"BIG_SEQTRACE_LABELS";
+dflag2str(?DFLAG_EXIT_PAYLOAD) ->
+ "EXIT_PAYLOAD";
+dflag2str(?DFLAG_FRAGMENTS) ->
+ "FRAGMENTS";
dflag2str(_) ->
"UNKNOWN".
diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl
index b7e8868911..7a14e2635c 100644
--- a/lib/kernel/src/erl_epmd.erl
+++ b/lib/kernel/src/erl_epmd.erl
@@ -77,8 +77,8 @@ stop() ->
%%
-spec port_please(Name, Host) -> {ok, Port, Version} | noport when
- Name :: string(),
- Host :: inet:ip_address(),
+ Name :: atom() | string(),
+ Host :: atom() | string() | inet:ip_address(),
Port :: non_neg_integer(),
Version :: non_neg_integer().
@@ -86,8 +86,8 @@ port_please(Node, Host) ->
port_please(Node, Host, infinity).
-spec port_please(Name, Host, Timeout) -> {ok, Port, Version} | noport when
- Name :: string(),
- Host :: inet:ip_address(),
+ Name :: atom() | string(),
+ Host :: atom() | string() | inet:ip_address(),
Timeout :: non_neg_integer() | infinity,
Port :: non_neg_integer(),
Version :: non_neg_integer().
diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl
index 7f7833ec23..5d4764f8ff 100644
--- a/lib/kernel/src/gen_tcp.erl
+++ b/lib/kernel/src/gen_tcp.erl
@@ -156,7 +156,7 @@ connect(Address, Port, Opts) ->
Options :: [connect_option()],
Timeout :: timeout(),
Socket :: socket(),
- Reason :: inet:posix().
+ Reason :: timeout | inet:posix().
connect(Address, Port, Opts, Time) ->
Timer = inet:start_timer(Time),
@@ -220,7 +220,7 @@ listen(Port, Opts0) ->
-spec accept(ListenSocket) -> {ok, Socket} | {error, Reason} when
ListenSocket :: socket(),
Socket :: socket(),
- Reason :: closed | timeout | system_limit | inet:posix().
+ Reason :: closed | system_limit | inet:posix().
accept(S) ->
case inet_db:lookup_socket(S) of
@@ -312,7 +312,7 @@ recv(S, Length) when is_port(S) ->
Length :: non_neg_integer(),
Timeout :: timeout(),
Packet :: string() | binary() | HttpPacket,
- Reason :: closed | inet:posix(),
+ Reason :: closed | timeout | inet:posix(),
HttpPacket :: term().
recv(S, Length, Time) when is_port(S) ->
diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl
index d6e8652e77..fad7b2f887 100644
--- a/lib/kernel/src/gen_udp.erl
+++ b/lib/kernel/src/gen_udp.erl
@@ -95,7 +95,7 @@
-spec open(Port) -> {ok, Socket} | {error, Reason} when
Port :: inet:port_number(),
Socket :: socket(),
- Reason :: inet:posix().
+ Reason :: system_limit | inet:posix().
open(Port) ->
open(Port, []).
@@ -112,7 +112,7 @@ open(Port) ->
| {bind_to_device, binary()}
| option(),
Socket :: socket(),
- Reason :: inet:posix().
+ Reason :: system_limit | inet:posix().
open(Port, Opts0) ->
{Mod, Opts} = inet:udp_module(Opts0),
@@ -186,7 +186,7 @@ recv(S,Len) when is_port(S), is_integer(Len) ->
Port :: inet:port_number(),
AncData :: inet:ancillary_data(),
Packet :: string() | binary(),
- Reason :: not_owner | inet:posix().
+ Reason :: not_owner | timeout | inet:posix().
recv(S,Len,Time) when is_port(S) ->
case inet_db:lookup_socket(S) of
diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl
index 6cbb6ac2da..3f5a2ea5ee 100644
--- a/lib/kernel/src/inet_db.erl
+++ b/lib/kernel/src/inet_db.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1223,7 +1223,10 @@ handle_set_file(Option, Fname, TagTm, TagInfo, ParseFun, From,
{ok, B, _} -> B;
_ -> <<>>
end;
- _ -> <<>>
+ _ ->
+ ets:insert(Db, {TagInfo, undefined}),
+ TimeZero = - (?RES_FILE_UPDATE_TM + 1), % Early enough
+ ets:insert(Db, {TagTm, TimeZero})
end,
handle_set_file(ParseFun, Bin, From, State);
false -> {reply,error,State}
diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl
index c37212b0f9..c5a114a9ef 100644
--- a/lib/kernel/src/inet_tcp_dist.erl
+++ b/lib/kernel/src/inet_tcp_dist.erl
@@ -212,6 +212,7 @@ do_accept(Driver, Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
[{active, true},
{deliver, port},
{packet, 4},
+ binary,
nodelay()])
end,
f_getll = fun(S) ->
diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src
index a1d9e8e215..8fe6bdd1ca 100644
--- a/lib/kernel/src/kernel.app.src
+++ b/lib/kernel/src/kernel.app.src
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -74,7 +74,6 @@
logger_simple_h,
logger_std_h,
logger_sup,
- net,
net_adm,
net_kernel,
os,
@@ -148,6 +147,6 @@
{logger_sasl_compatible, false}
]},
{mod, {kernel, []}},
- {runtime_dependencies, ["erts-10.1", "stdlib-3.5", "sasl-3.0"]}
+ {runtime_dependencies, ["erts-10.2.5", "stdlib-3.5", "sasl-3.0"]}
]
}.
diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src
index ccf0a82ced..8fa3f5c588 100644
--- a/lib/kernel/src/kernel.appup.src
+++ b/lib/kernel/src/kernel.appup.src
@@ -40,7 +40,10 @@
{<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^6\\.1$">>,[restart_new_emulator]},
{<<"^6\\.1\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}],
+ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^6\\.2$">>,[restart_new_emulator]},
+ {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}],
[{<<"^5\\.3$">>,[restart_new_emulator]},
{<<"^5\\.3\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^5\\.3\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
@@ -54,4 +57,7 @@
{<<"^6\\.0\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^6\\.1$">>,[restart_new_emulator]},
{<<"^6\\.1\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
- {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}.
+ {<<"^6\\.1\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
+ {<<"^6\\.2$">>,[restart_new_emulator]},
+ {<<"^6\\.2\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^6\\.2\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}.
diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl
index c68d04e279..111d103df2 100644
--- a/lib/kernel/src/kernel.erl
+++ b/lib/kernel/src/kernel.erl
@@ -145,26 +145,11 @@ init([]) ->
{ok, {SupFlags,
[Code, File, StdError, User, LoggerSup, Config, RefC, SafeSup]}};
_ ->
- Rpc = #{id => rex,
- start => {rpc, start_link, []},
- restart => permanent,
- shutdown => 2000,
- type => worker,
- modules => [rpc]},
-
- Global = #{id => global_name_server,
- start => {global, start_link, []},
- restart => permanent,
- shutdown => 2000,
- type => worker,
- modules => [global]},
-
- GlGroup = #{id => global_group,
- start => {global_group,start_link,[]},
- restart => permanent,
- shutdown => 2000,
- type => worker,
- modules => [global_group]},
+ DistChildren =
+ case application:get_env(kernel, start_distribution) of
+ {ok, false} -> [];
+ _ -> start_distribution()
+ end,
InetDb = #{id => inet_db,
start => {inet_db, start_link, []},
@@ -173,13 +158,6 @@ init([]) ->
type => worker,
modules => [inet_db]},
- NetSup = #{id => net_sup,
- start => {erl_distribution, start_link, []},
- restart => permanent,
- shutdown => infinity,
- type => supervisor,
- modules => [erl_distribution]},
-
SigSrv = #{id => erl_signal_server,
start => {gen_event, start_link, [{local, erl_signal_server}]},
restart => permanent,
@@ -187,14 +165,11 @@ init([]) ->
type => worker,
modules => dynamic},
- DistAC = start_dist_ac(),
-
Timer = start_timer(),
{ok, {SupFlags,
- [Code, Rpc, Global, InetDb | DistAC] ++
- [NetSup, GlGroup, File, SigSrv,
- StdError, User, Config, RefC, SafeSup, LoggerSup] ++ Timer}}
+ [Code, InetDb | DistChildren] ++
+ [File, SigSrv, StdError, User, Config, RefC, SafeSup, LoggerSup] ++ Timer}}
end;
init(safe) ->
SupFlags = #{strategy => one_for_one,
@@ -213,6 +188,39 @@ init(safe) ->
{ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}.
+start_distribution() ->
+ Rpc = #{id => rex,
+ start => {rpc, start_link, []},
+ restart => permanent,
+ shutdown => 2000,
+ type => worker,
+ modules => [rpc]},
+
+ Global = #{id => global_name_server,
+ start => {global, start_link, []},
+ restart => permanent,
+ shutdown => 2000,
+ type => worker,
+ modules => [global]},
+
+ DistAC = start_dist_ac(),
+
+ NetSup = #{id => net_sup,
+ start => {erl_distribution, start_link, []},
+ restart => permanent,
+ shutdown => infinity,
+ type => supervisor,
+ modules => [erl_distribution]},
+
+ GlGroup = #{id => global_group,
+ start => {global_group,start_link,[]},
+ restart => permanent,
+ shutdown => 2000,
+ type => worker,
+ modules => [global_group]},
+
+ [Rpc, Global | DistAC] ++ [NetSup, GlGroup].
+
start_dist_ac() ->
Spec = [#{id => dist_ac,
start => {dist_ac,start_link,[]},
diff --git a/lib/kernel/src/logger.erl b/lib/kernel/src/logger.erl
index abdd9a9ceb..38bd2f481c 100644
--- a/lib/kernel/src/logger.erl
+++ b/lib/kernel/src/logger.erl
@@ -60,6 +60,8 @@
-export([compare_levels/2]).
-export([set_process_metadata/1, update_process_metadata/1,
unset_process_metadata/0, get_process_metadata/0]).
+-export([i/0, i/1]).
+-export([timestamp/0]).
%% Basic report formatting
-export([format_report/1, format_otp_report/1]).
@@ -153,7 +155,8 @@
filter_return/0,
config_handler/0,
formatter_config/0,
- olp_config/0]).
+ olp_config/0,
+ timestamp/0]).
%%%-----------------------------------------------------------------
%%% API
@@ -353,6 +356,10 @@ internal_log(Level,Term) when is_atom(Level) ->
erlang:display_string("Logger - "++ atom_to_list(Level) ++ ": "),
erlang:display(Term).
+-spec timestamp() -> timestamp().
+timestamp() ->
+ os:system_time(microsecond).
+
%%%-----------------------------------------------------------------
%%% Configuration
-spec add_primary_filter(FilterId,Filter) -> ok | {error,term()} when
@@ -647,6 +654,142 @@ get_config() ->
proxy=>get_proxy_config(),
module_levels=>lists:keysort(1,get_module_level())}.
+-spec i() -> ok.
+i() ->
+ #{primary := Primary,
+ handlers := HandlerConfigs,
+ proxy := Proxy,
+ module_levels := Modules} = get_config(),
+ M = modifier(),
+ i_primary(Primary,M),
+ i_handlers(HandlerConfigs,M),
+ i_proxy(Proxy,M),
+ i_modules(Modules,M).
+
+-spec i(What) -> ok when
+ What :: primary | handlers | proxy | modules | handler_id().
+i(primary) ->
+ i_primary(get_primary_config(),modifier());
+i(handlers) ->
+ i_handlers(get_handler_config(),modifier());
+i(proxy) ->
+ i_proxy(get_proxy_config(),modifier());
+i(modules) ->
+ i_modules(get_module_level(),modifier());
+i(HandlerId) when is_atom(HandlerId) ->
+ case get_handler_config(HandlerId) of
+ {ok,HandlerConfig} ->
+ i_handlers([HandlerConfig],modifier());
+ Error ->
+ Error
+ end;
+i(What) ->
+ erlang:error(badarg,[What]).
+
+
+i_primary(#{level := Level,
+ filters := Filters,
+ filter_default := FilterDefault},
+ M) ->
+ io:format("Primary configuration: ~n",[]),
+ io:format(" Level: ~p~n",[Level]),
+ io:format(" Filter Default: ~p~n", [FilterDefault]),
+ io:format(" Filters: ~n", []),
+ print_filters(" ",Filters,M).
+
+i_handlers(HandlerConfigs,M) ->
+ io:format("Handler configuration: ~n", []),
+ print_handlers(HandlerConfigs,M).
+
+i_proxy(Proxy,M) ->
+ io:format("Proxy configuration: ~n", []),
+ print_custom(" ",Proxy,M).
+
+i_modules(Modules,M) ->
+ io:format("Level set per module: ~n", []),
+ print_module_levels(Modules,M).
+
+encoding() ->
+ case lists:keyfind(encoding, 1, io:getopts()) of
+ false -> latin1;
+ {encoding, Enc} -> Enc
+ end.
+
+modifier() ->
+ modifier(encoding()).
+
+modifier(latin1) -> "";
+modifier(_) -> "t".
+
+print_filters(Indent, {Id, {Fun, Arg}}, M) ->
+ io:format("~sId: ~"++M++"p~n"
+ "~s Fun: ~"++M++"p~n"
+ "~s Arg: ~"++M++"p~n",
+ [Indent, Id, Indent, Fun, Indent, Arg]);
+print_filters(Indent,[],_M) ->
+ io:format("~s(none)~n",[Indent]);
+print_filters(Indent,Filters,M) ->
+ [print_filters(Indent,Filter,M) || Filter <- Filters],
+ ok.
+
+print_handlers(#{id := Id,
+ module := Module,
+ level := Level,
+ filters := Filters, filter_default := FilterDefault,
+ formatter := {FormatterModule,FormatterConfig}} = Config, M) ->
+ io:format(" Id: ~"++M++"p~n"
+ " Module: ~p~n"
+ " Level: ~p~n"
+ " Formatter:~n"
+ " Module: ~p~n"
+ " Config:~n",
+ [Id, Module, Level, FormatterModule]),
+ print_custom(" ",FormatterConfig,M),
+ io:format(" Filter Default: ~p~n"
+ " Filters:~n",
+ [FilterDefault]),
+ print_filters(" ",Filters,M),
+ case maps:find(config,Config) of
+ {ok,HandlerConfig} ->
+ io:format(" Handler Config:~n"),
+ print_custom(" ",HandlerConfig,M);
+ error ->
+ ok
+ end,
+ MyKeys = [filter_default, filters, formatter, level, module, id, config],
+ case maps:without(MyKeys,Config) of
+ Empty when Empty==#{} ->
+ ok;
+ Unhandled ->
+ io:format(" Custom Config:~n"),
+ print_custom(" ",Unhandled,M)
+ end;
+print_handlers([], _M) ->
+ io:format(" (none)~n");
+print_handlers(HandlerConfigs, M) ->
+ [print_handlers(HandlerConfig, M) || HandlerConfig <- HandlerConfigs],
+ ok.
+
+print_custom(Indent, {Key, Value}, M) ->
+ io:format("~s~"++M++"p: ~"++M++"p~n",[Indent,Key,Value]);
+print_custom(Indent, Map, M) when is_map(Map) ->
+ print_custom(Indent,lists:keysort(1,maps:to_list(Map)), M);
+print_custom(Indent, List, M) when is_list(List), is_tuple(hd(List)) ->
+ [print_custom(Indent, X, M) || X <- List],
+ ok;
+print_custom(Indent, Value, M) ->
+ io:format("~s~"++M++"p~n",[Indent,Value]).
+
+print_module_levels({Module,Level},M) ->
+ io:format(" Module: ~"++M++"p~n"
+ " Level: ~p~n",
+ [Module,Level]);
+print_module_levels([],_M) ->
+ io:format(" (none)~n");
+print_module_levels(Modules,M) ->
+ [print_module_levels(Module,M) || Module <- Modules],
+ ok.
+
-spec internal_init_logger() -> ok | {error,term()}.
%% This function is responsible for config of the logger
%% This is done before add_handlers because we want the
@@ -992,7 +1135,7 @@ proc_meta() ->
default(pid) -> self();
default(gl) -> group_leader();
-default(time) -> erlang:system_time(microsecond).
+default(time) -> timestamp().
%% Remove everything upto and including this module from the stacktrace
filter_stacktrace(Module,[{Module,_,_,_}|_]) ->
diff --git a/lib/kernel/src/logger_formatter.erl b/lib/kernel/src/logger_formatter.erl
index ded89bac9f..8696adbd72 100644
--- a/lib/kernel/src/logger_formatter.erl
+++ b/lib/kernel/src/logger_formatter.erl
@@ -64,7 +64,7 @@ format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0)
Config;
Size0 ->
Size =
- case Size0 - string:length([B,A]) of
+ case Size0 - io_lib:chars_length([B,A]) of
S when S>=0 -> S;
_ -> 0
end,
@@ -75,7 +75,11 @@ format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0)
true ->
%% Trim leading and trailing whitespaces, and replace
%% newlines with ", "
- re:replace(string:trim(MsgStr0),",?\r?\n\s*",", ",
+ T = lists:reverse(
+ trim(
+ lists:reverse(
+ trim(MsgStr0,false)),true)),
+ re:replace(T,",?\r?\n\s*",", ",
[{return,list},global,unicode]);
_false ->
MsgStr0
@@ -83,7 +87,26 @@ format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0)
true ->
""
end,
- truncate([B,MsgStr,A],maps:get(max_size,Config)).
+ truncate(B,MsgStr,A,maps:get(max_size,Config)).
+
+trim([H|T],Rev) when H==$\s; H==$\r; H==$\n ->
+ trim(T,Rev);
+trim([H|T],false) when is_list(H) ->
+ case trim(H,false) of
+ [] ->
+ trim(T,false);
+ TrimmedH ->
+ [TrimmedH|T]
+ end;
+trim([H|T],true) when is_list(H) ->
+ case trim(lists:reverse(H),true) of
+ [] ->
+ trim(T,true);
+ TrimmedH ->
+ [lists:reverse(TrimmedH)|T]
+ end;
+trim(String,_) ->
+ String.
do_format(Level,Data,[level|Format],Config) ->
[to_string(level,Level,Config)|do_format(Level,Data,Format,Config)];
@@ -239,21 +262,47 @@ chardata_to_list(Chardata) ->
throw(Error)
end.
-truncate(String,unlimited) ->
- String;
-truncate(String,Size) ->
- Length = string:length(String),
+truncate(B,Msg,A,unlimited) ->
+ [B,Msg,A];
+truncate(B,Msg,A,Size) ->
+ String = [B,Msg,A],
+ Length = io_lib:chars_length(String),
if Length>Size ->
- case lists:reverse(lists:flatten(String)) of
- [$\n|_] ->
- string:slice(String,0,Size-4)++"...\n";
+ {Last,FlatString} =
+ case A of
+ [] ->
+ case Msg of
+ [] ->
+ {get_last(B),lists:flatten(B)};
+ _ ->
+ {get_last(Msg),lists:flatten([B,Msg])}
+ end;
+ _ ->
+ {get_last(A),lists:flatten(String)}
+ end,
+ case Last of
+ $\n->
+ lists:sublist(FlatString,1,Size-4)++"...\n";
_ ->
- string:slice(String,0,Size-3)++"..."
+ lists:sublist(FlatString,1,Size-3)++"..."
end;
true ->
String
end.
+get_last(L) ->
+ get_first(lists:reverse(L)).
+
+get_first([]) ->
+ error;
+get_first([C|_]) when is_integer(C) ->
+ C;
+get_first([L|Rest]) when is_list(L) ->
+ case get_last(L) of
+ error -> get_first(Rest);
+ First -> First
+ end.
+
%% SysTime is the system time in microseconds
format_time(SysTime,#{time_offset:=Offset,time_designator:=Des})
when is_integer(SysTime) ->
diff --git a/lib/kernel/src/logger_h_common.erl b/lib/kernel/src/logger_h_common.erl
index e69f6de38d..16946ff97c 100644
--- a/lib/kernel/src/logger_h_common.erl
+++ b/lib/kernel/src/logger_h_common.erl
@@ -142,8 +142,9 @@ changing_config(SetOrUpdate,
maps:with(?OLP_KEYS,NewHConfig0)),
case logger_olp:set_opts(Olp,NewOlpOpts) of
ok ->
- maybe_set_repeated_filesync(Olp,OldCommonConfig,
- NewCommonConfig),
+ logger_olp:cast(Olp, {config_changed,
+ NewCommonConfig,
+ NewHandlerConfig}),
ReadOnly = maps:with(?READ_ONLY_KEYS,OldHConfig),
NewHConfig =
maps:merge(
@@ -281,11 +282,24 @@ handle_cast(repeated_filesync,
State#{handler_state => HS, last_op => sync}
end,
{noreply,set_repeated_filesync(State1)};
-
-handle_cast({set_repeated_filesync,FSyncInt},State) ->
- State1 = State#{filesync_repeat_interval=>FSyncInt},
- State2 = set_repeated_filesync(cancel_repeated_filesync(State1)),
- {noreply, State2}.
+handle_cast({config_changed, CommonConfig, HConfig},
+ State = #{id := Name,
+ module := Module,
+ handler_state := HandlerState,
+ filesync_repeat_interval := OldFSyncInt}) ->
+ State1 =
+ case maps:get(filesync_repeat_interval,CommonConfig) of
+ OldFSyncInt ->
+ State;
+ FSyncInt ->
+ set_repeated_filesync(
+ cancel_repeated_filesync(
+ State#{filesync_repeat_interval=>FSyncInt}))
+ end,
+ HS = try Module:config_changed(Name, HConfig, HandlerState)
+ catch error:undef -> HandlerState
+ end,
+ {noreply, State1#{handler_state => HS}}.
handle_info(Info, #{id := Name, module := Module,
handler_state := HandlerState} = State) ->
@@ -351,7 +365,7 @@ log_handler_info(Name, Format, Args, #{module:=Module,
{ok,Conf} -> Conf;
_ -> #{formatter=>{?DEFAULT_FORMATTER,?DEFAULT_FORMAT_CONFIG}}
end,
- Meta = #{time=>erlang:system_time(microsecond)},
+ Meta = #{time=>logger:timestamp()},
Bin = log_to_binary(#{level => notice,
msg => {Format,Args},
meta => Meta}, Config),
@@ -447,10 +461,3 @@ cancel_repeated_filesync(State) ->
end.
error_notify(Term) ->
?internal_log(error, Term).
-
-maybe_set_repeated_filesync(_Olp,
- #{filesync_repeat_interval:=FSyncInt},
- #{filesync_repeat_interval:=FSyncInt}) ->
- ok;
-maybe_set_repeated_filesync(Olp,_,#{filesync_repeat_interval:=FSyncInt}) ->
- logger_olp:cast(Olp,{set_repeated_filesync,FSyncInt}).
diff --git a/lib/kernel/src/logger_olp.erl b/lib/kernel/src/logger_olp.erl
index 009280a9c9..8365383fe2 100644
--- a/lib/kernel/src/logger_olp.erl
+++ b/lib/kernel/src/logger_olp.erl
@@ -515,10 +515,11 @@ check_load(State = #{id:=_Name, mode_ref := ModeRef, mode := Mode,
end,
State1 = ?update_other(drops,DROPS,_NewDrops,State),
State2 = ?update_max_qlen(QLen,State1),
- State3 = maybe_notify_mode_change(Mode1,State2),
+ State3 = ?update_max_mem(Mem,State2),
+ State4 = maybe_notify_mode_change(Mode1,State3),
{Mode1, QLen, Mem,
?update_other(flushes,FLUSHES,_NewFlushes,
- State3#{last_qlen => QLen})}.
+ State4#{last_qlen => QLen})}.
limit_burst(#{burst_limit_enable := false}=State) ->
{true,State};
diff --git a/lib/kernel/src/logger_olp.hrl b/lib/kernel/src/logger_olp.hrl
index 9b4f5ebf27..d68b5c048d 100644
--- a/lib/kernel/src/logger_olp.hrl
+++ b/lib/kernel/src/logger_olp.hrl
@@ -114,12 +114,16 @@
flushes => 0, flushed => 0, drops => 0,
burst_drops => 0, casts => 0, calls => 0,
writes => 0, max_qlen => 0, max_time => 0,
- freq => {TIME,0,0}} end).
+ max_mem => 0, freq => {TIME,0,0}} end).
-define(update_max_qlen(QLEN, STATE),
begin #{max_qlen := QLEN0} = STATE,
STATE#{max_qlen => ?max(QLEN0,QLEN)} end).
+ -define(update_max_mem(MEM, STATE),
+ begin #{max_mem := MEM0} = STATE,
+ STATE#{max_mem => ?max(MEM0,MEM)} end).
+
-define(update_calls_or_casts(CALL_OR_CAST, INC, STATE),
case CALL_OR_CAST of
cast ->
@@ -154,6 +158,7 @@
-else. % DEFAULT!
-define(merge_with_stats(STATE), STATE).
-define(update_max_qlen(_QLEN, STATE), STATE).
+ -define(update_max_mem(_MEM, STATE), STATE).
-define(update_calls_or_casts(_CALL_OR_CAST, _INC, STATE), STATE).
-define(update_max_time(_TIME, STATE), STATE).
-define(update_other(_OTHER, _VAR, _INCVAL, STATE), STATE).
diff --git a/lib/kernel/src/logger_simple_h.erl b/lib/kernel/src/logger_simple_h.erl
index fe181722f3..a0d51dba25 100644
--- a/lib/kernel/src/logger_simple_h.erl
+++ b/lib/kernel/src/logger_simple_h.erl
@@ -69,7 +69,7 @@ log(#{msg:=_,meta:=#{time:=_}}=Log,_Config) ->
do_log(
#{level=>error,
msg=>{report,{error,simple_handler_process_dead}},
- meta=>#{time=>erlang:system_time(microsecond)}}),
+ meta=>#{time=>logger:timestamp()}}),
do_log(Log);
_ ->
?MODULE ! {log,Log}
@@ -129,7 +129,7 @@ drop_msg(0) ->
drop_msg(N) ->
[#{level=>info,
msg=>{"Simple handler buffer full, dropped ~w messages",[N]},
- meta=>#{time=>erlang:system_time(microsecond)}}].
+ meta=>#{time=>logger:timestamp()}}].
%%%-----------------------------------------------------------------
%%% Internal
diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl
index 0669164bb6..c8f1acfca4 100644
--- a/lib/kernel/src/logger_std_h.erl
+++ b/lib/kernel/src/logger_std_h.erl
@@ -29,7 +29,7 @@
-export([filesync/1]).
%% logger_h_common callbacks
--export([init/2, check_config/4, reset_state/2,
+-export([init/2, check_config/4, config_changed/3, reset_state/2,
filesync/3, write/4, handle_info/3, terminate/3]).
%% logger callbacks
@@ -105,85 +105,169 @@ filter_config(Config) ->
%%%===================================================================
%%% logger_h_common callbacks
%%%===================================================================
-init(Name, #{type := Type}) ->
- case open_log_file(Name, Type) of
+init(Name, Config) ->
+ MyConfig = maps:with([type,file,modes,file_check,max_no_bytes,
+ max_no_files,compress_on_rotate],Config),
+ case file_ctrl_start(Name, MyConfig) of
{ok,FileCtrlPid} ->
- {ok,#{type=>Type,file_ctrl_pid=>FileCtrlPid}};
+ {ok,MyConfig#{file_ctrl_pid=>FileCtrlPid}};
Error ->
Error
end.
-check_config(_Name,set,undefined,NewHConfig) ->
- check_config(maps:merge(get_default_config(),NewHConfig));
-check_config(_Name,SetOrUpdate,OldHConfig,NewHConfig0) ->
- WriteOnce = maps:with([type],OldHConfig),
+check_config(Name,set,undefined,NewHConfig) ->
+ check_h_config(merge_default_config(Name,normalize_config(NewHConfig)));
+check_config(Name,SetOrUpdate,OldHConfig,NewHConfig0) ->
+ WriteOnce = maps:with([type,file,modes],OldHConfig),
Default =
case SetOrUpdate of
set ->
%% Do not reset write-once fields to defaults
- maps:merge(get_default_config(),WriteOnce);
+ merge_default_config(Name,WriteOnce);
update ->
OldHConfig
end,
- NewHConfig = maps:merge(Default, NewHConfig0),
+ NewHConfig = maps:merge(Default, normalize_config(NewHConfig0)),
%% Fail if write-once fields are changed
- case maps:with([type],NewHConfig) of
+ case maps:with([type,file,modes],NewHConfig) of
WriteOnce ->
- check_config(NewHConfig);
+ check_h_config(NewHConfig);
Other ->
{error,{illegal_config_change,?MODULE,WriteOnce,Other}}
end.
-check_config(#{type:=Type}=HConfig) ->
- case check_h_config(maps:to_list(HConfig)) of
- ok when is_atom(Type) ->
- {ok,HConfig#{filesync_repeat_interval=>no_repeat}};
+check_h_config(HConfig) ->
+ case check_h_config(maps:get(type,HConfig),maps:to_list(HConfig)) of
ok ->
- {ok,HConfig};
+ {ok,fix_file_opts(HConfig)};
{error,{Key,Value}} ->
{error,{invalid_config,?MODULE,#{Key=>Value}}}
end.
-check_h_config([{type,Type} | Config]) when Type == standard_io;
- Type == standard_error ->
- check_h_config(Config);
-check_h_config([{type,{file,File}} | Config]) when is_list(File) ->
- check_h_config(Config);
-check_h_config([{type,{file,File,Modes}} | Config]) when is_list(File),
- is_list(Modes) ->
- check_h_config(Config);
-check_h_config([Other | _]) ->
+check_h_config(Type,[{type,Type} | Config]) when Type =:= standard_io;
+ Type =:= standard_error;
+ Type =:= file ->
+ check_h_config(Type,Config);
+check_h_config(file,[{file,File} | Config]) when is_list(File) ->
+ check_h_config(file,Config);
+check_h_config(file,[{modes,Modes} | Config]) when is_list(Modes) ->
+ check_h_config(file,Config);
+check_h_config(file,[{max_no_bytes,Size} | Config])
+ when (is_integer(Size) andalso Size>0) orelse Size=:=infinity ->
+ check_h_config(file,Config);
+check_h_config(file,[{max_no_files,Num} | Config]) when is_integer(Num), Num>=0 ->
+ check_h_config(file,Config);
+check_h_config(file,[{compress_on_rotate,Bool} | Config]) when is_boolean(Bool) ->
+ check_h_config(file,Config);
+check_h_config(file,[{file_check,FileCheck} | Config])
+ when is_integer(FileCheck), FileCheck>=0 ->
+ check_h_config(file,Config);
+check_h_config(_Type,[Other | _]) ->
{error,Other};
-check_h_config([]) ->
+check_h_config(_Type,[]) ->
ok.
-get_default_config() ->
- #{type => standard_io}.
+normalize_config(#{type:={file,File}}=HConfig) ->
+ HConfig#{type=>file,file=>File};
+normalize_config(#{type:={file,File,Modes}}=HConfig) ->
+ HConfig#{type=>file,file=>File,modes=>Modes};
+normalize_config(HConfig) ->
+ HConfig.
+
+merge_default_config(Name,#{type:=Type}=HConfig) ->
+ merge_default_config(Name,Type,HConfig);
+merge_default_config(Name,#{file:=_}=HConfig) ->
+ merge_default_config(Name,file,HConfig);
+merge_default_config(Name,HConfig) ->
+ merge_default_config(Name,standard_io,HConfig).
+
+merge_default_config(Name,Type,HConfig) ->
+ maps:merge(get_default_config(Name,Type),HConfig).
+
+get_default_config(Name,file) ->
+ #{type => file,
+ file => atom_to_list(Name),
+ modes => [raw,append],
+ file_check => 0,
+ max_no_bytes => infinity,
+ max_no_files => 0,
+ compress_on_rotate => false};
+get_default_config(_Name,Type) ->
+ #{type => Type}.
+
+fix_file_opts(#{modes:=Modes}=HConfig) ->
+ HConfig#{modes=>fix_modes(Modes)};
+fix_file_opts(HConfig) ->
+ HConfig#{filesync_repeat_interval=>no_repeat}.
+
+fix_modes(Modes) ->
+ %% Ensure write|append|exclusive
+ Modes1 =
+ case [M || M <- Modes,
+ lists:member(M,[write,append,exclusive])] of
+ [] -> [append|Modes];
+ _ -> Modes
+ end,
+ %% Ensure raw
+ Modes2 =
+ case lists:member(raw,Modes) of
+ false -> [raw|Modes1];
+ true -> Modes1
+ end,
+ %% Ensure delayed_write
+ case lists:partition(fun(delayed_write) -> true;
+ ({delayed_write,_,_}) -> true;
+ (_) -> false
+ end, Modes2) of
+ {[],_} ->
+ [delayed_write|Modes2];
+ _ ->
+ Modes2
+ end.
-filesync(_Name, _Mode, #{type := Type}=State) when is_atom(Type) ->
- {ok,State};
-filesync(_Name, async, #{file_ctrl_pid := FileCtrlPid} = State) ->
- ok = file_ctrl_filesync_async(FileCtrlPid),
- {ok,State};
-filesync(_Name, sync, #{file_ctrl_pid := FileCtrlPid} = State) ->
- Result = file_ctrl_filesync_sync(FileCtrlPid),
+config_changed(_Name,
+ #{file_check:=FileCheck,
+ max_no_bytes:=Size,
+ max_no_files:=Count,
+ compress_on_rotate:=Compress},
+ #{file_check:=FileCheck,
+ max_no_bytes:=Size,
+ max_no_files:=Count,
+ compress_on_rotate:=Compress}=State) ->
+ State;
+config_changed(_Name,
+ #{file_check:=FileCheck,
+ max_no_bytes:=Size,
+ max_no_files:=Count,
+ compress_on_rotate:=Compress},
+ #{file_ctrl_pid := FileCtrlPid} = State) ->
+ FileCtrlPid ! {update_config,#{file_check=>FileCheck,
+ max_no_bytes=>Size,
+ max_no_files=>Count,
+ compress_on_rotate=>Compress}},
+ State#{file_check:=FileCheck,
+ max_no_bytes:=Size,
+ max_no_files:=Count,
+ compress_on_rotate:=Compress};
+config_changed(_Name,_NewHConfig,State) ->
+ State.
+
+filesync(_Name, SyncAsync, #{file_ctrl_pid := FileCtrlPid} = State) ->
+ Result = file_ctrl_filesync(SyncAsync, FileCtrlPid),
{Result,State}.
-write(_Name, async, Bin, #{file_ctrl_pid:=FileCtrlPid} = State) ->
- ok = file_write_async(FileCtrlPid, Bin),
- {ok,State};
-write(_Name, sync, Bin, #{file_ctrl_pid:=FileCtrlPid} = State) ->
- Result = file_write_sync(FileCtrlPid, Bin),
+write(_Name, SyncAsync, Bin, #{file_ctrl_pid:=FileCtrlPid} = State) ->
+ Result = file_write(SyncAsync, FileCtrlPid, Bin),
{Result,State}.
reset_state(_Name, State) ->
State.
-handle_info(_Name, {'EXIT',Pid,Why}, #{type := FileInfo, file_ctrl_pid := Pid}) ->
+handle_info(_Name, {'EXIT',Pid,Why}, #{file_ctrl_pid := Pid}=State) ->
%% file_ctrl_pid died, file error, terminate handler
- exit({error,{write_failed,FileInfo,Why}});
+ exit({error,{write_failed,maps:with([type,file,modes],State),Why}});
handle_info(_, _, State) ->
State.
@@ -211,23 +295,36 @@ terminate(_Name, _Reason, #{file_ctrl_pid:=FWPid}) ->
%%%-----------------------------------------------------------------
%%%
-open_log_file(HandlerName, FileInfo) ->
- case file_ctrl_start(HandlerName, FileInfo) of
- OK = {ok,_FileCtrlPid} -> OK;
- Error -> Error
- end.
-
-do_open_log_file({file,File}) ->
- do_open_log_file({file,File,[raw,append,delayed_write]});
-
-do_open_log_file({file,File,[]}) ->
- do_open_log_file({file,File,[raw,append,delayed_write]});
-
-do_open_log_file({file,File,Modes}) ->
+open_log_file(HandlerName,#{type:=file,
+ file:=FileName,
+ modes:=Modes,
+ file_check:=FileCheck,
+ max_no_bytes:=Size,
+ max_no_files:=Count,
+ compress_on_rotate:=Compress}) ->
try
- case filelib:ensure_dir(File) of
+ case filelib:ensure_dir(FileName) of
ok ->
- file:open(File, Modes);
+ case file:open(FileName, Modes) of
+ {ok, Fd} ->
+ {ok,#file_info{inode=INode}} =
+ file:read_file_info(FileName,[raw]),
+ UpdateModes = [append | Modes--[write,append,exclusive]],
+ State0 = #{handler_name=>HandlerName,
+ file_name=>FileName,
+ modes=>UpdateModes,
+ file_check=>FileCheck,
+ fd=>Fd,
+ inode=>INode,
+ last_check=>timestamp(),
+ synced=>false,
+ write_res=>ok,
+ sync_res=>ok},
+ State = update_rotation({Size,Count,Compress},State0),
+ {ok,State};
+ Error ->
+ Error
+ end;
Error ->
Error
end
@@ -235,21 +332,23 @@ do_open_log_file({file,File,Modes}) ->
_:Reason -> {error,Reason}
end.
-close_log_file(Std) when Std == standard_io; Std == standard_error ->
- ok;
-close_log_file(Fd) ->
+close_log_file(#{fd:=Fd}) ->
_ = file:datasync(Fd),
- _ = file:close(Fd).
+ _ = file:close(Fd),
+ ok;
+close_log_file(_) ->
+ ok.
+
%%%-----------------------------------------------------------------
%%% File control process
-file_ctrl_start(HandlerName, FileInfo) ->
+file_ctrl_start(HandlerName, HConfig) ->
Starter = self(),
FileCtrlPid =
spawn_link(fun() ->
- file_ctrl_init(HandlerName, FileInfo, Starter)
+ file_ctrl_init(HandlerName, HConfig, Starter)
end),
receive
{FileCtrlPid,ok} ->
@@ -264,18 +363,16 @@ file_ctrl_start(HandlerName, FileInfo) ->
file_ctrl_stop(Pid) ->
Pid ! stop.
-file_write_async(Pid, Bin) ->
+file_write(async, Pid, Bin) ->
Pid ! {log,Bin},
- ok.
-
-file_write_sync(Pid, Bin) ->
+ ok;
+file_write(sync, Pid, Bin) ->
file_ctrl_call(Pid, {log,Bin}).
-file_ctrl_filesync_async(Pid) ->
+file_ctrl_filesync(async, Pid) ->
Pid ! filesync,
- ok.
-
-file_ctrl_filesync_sync(Pid) ->
+ ok;
+file_ctrl_filesync(sync, Pid) ->
file_ctrl_call(Pid, filesync).
file_ctrl_call(Pid, Msg) ->
@@ -292,94 +389,255 @@ file_ctrl_call(Pid, Msg) ->
{error,{no_response,Pid}}
end.
-file_ctrl_init(HandlerName, FileInfo, Starter) when is_tuple(FileInfo) ->
+file_ctrl_init(HandlerName,
+ #{type:=file,
+ file:=FileName} = HConfig,
+ Starter) ->
process_flag(message_queue_data, off_heap),
- FileName = element(2, FileInfo),
- case do_open_log_file(FileInfo) of
- {ok,Fd} ->
+ case open_log_file(HandlerName,HConfig) of
+ {ok,State} ->
Starter ! {self(),ok},
- file_ctrl_loop(Fd, FileName, false, ok, ok, HandlerName);
+ file_ctrl_loop(State);
{error,Reason} ->
Starter ! {self(),{error,{open_failed,FileName,Reason}}}
end;
-file_ctrl_init(HandlerName, StdDev, Starter) ->
+file_ctrl_init(HandlerName, #{type:=StdDev}, Starter) ->
Starter ! {self(),ok},
- file_ctrl_loop(StdDev, StdDev, false, ok, ok, HandlerName).
+ file_ctrl_loop(#{handler_name=>HandlerName,dev=>StdDev}).
-file_ctrl_loop(Fd, DevName, Synced,
- PrevWriteResult, PrevSyncResult, HandlerName) ->
+file_ctrl_loop(State) ->
receive
%% asynchronous event
{log,Bin} ->
- Fd1 = ensure(Fd, DevName),
- Result = write_to_dev(Fd1, Bin, DevName, PrevWriteResult, HandlerName),
- file_ctrl_loop(Fd1, DevName, false,
- Result, PrevSyncResult, HandlerName);
+ State1 = write_to_dev(Bin,State),
+ file_ctrl_loop(State1);
%% synchronous event
{{log,Bin},{From,MRef}} ->
- Fd1 = ensure(Fd, DevName),
- Result = write_to_dev(Fd1, Bin, DevName, PrevWriteResult, HandlerName),
+ State1 = ensure_file(State),
+ State2 = write_to_dev(Bin,State1),
From ! {MRef,ok},
- file_ctrl_loop(Fd1, DevName, false,
- Result, PrevSyncResult, HandlerName);
+ file_ctrl_loop(State2);
filesync ->
- Fd1 = ensure(Fd, DevName),
- Result = sync_dev(Fd1, DevName, Synced, PrevSyncResult, HandlerName),
- file_ctrl_loop(Fd1, DevName, true,
- PrevWriteResult, Result, HandlerName);
+ State1 = sync_dev(State),
+ file_ctrl_loop(State1);
{filesync,{From,MRef}} ->
- Fd1 = ensure(Fd, DevName),
- Result = sync_dev(Fd1, DevName, Synced, PrevSyncResult, HandlerName),
+ State1 = ensure_file(State),
+ State2 = sync_dev(State1),
From ! {MRef,ok},
- file_ctrl_loop(Fd1, DevName, true,
- PrevWriteResult, Result, HandlerName);
+ file_ctrl_loop(State2);
+
+ {update_config,#{file_check:=FileCheck,
+ max_no_bytes:=Size,
+ max_no_files:=Count,
+ compress_on_rotate:=Compress}} ->
+ State1 = update_rotation({Size,Count,Compress},State),
+ file_ctrl_loop(State1#{file_check=>FileCheck});
stop ->
- _ = close_log_file(Fd),
+ close_log_file(State),
stopped
end.
+maybe_ensure_file(#{file_check:=0}=State) ->
+ ensure_file(State);
+maybe_ensure_file(#{last_check:=T0,file_check:=CheckInt}=State)
+ when is_integer(CheckInt) ->
+ T = timestamp(),
+ if T-T0 > CheckInt -> ensure_file(State);
+ true -> State
+ end;
+maybe_ensure_file(State) ->
+ State.
+
%% In order to play well with tools like logrotate, we need to be able
%% to re-create the file if it has disappeared (e.g. if rotated by
%% logrotate)
-ensure(Fd,DevName) when is_atom(DevName) ->
- Fd;
-ensure(Fd,FileName) ->
- case file:read_file_info(FileName) of
- {ok,_} ->
- Fd;
+ensure_file(#{fd:=Fd0,inode:=INode0,file_name:=FileName,modes:=Modes}=State) ->
+ case file:read_file_info(FileName,[raw]) of
+ {ok,#file_info{inode=INode0}} ->
+ State#{last_check=>timestamp()};
_ ->
- _ = file:close(Fd),
- _ = file:close(Fd), % delayed_write cause close not to close
- case do_open_log_file({file,FileName}) of
- {ok,Fd1} ->
- Fd1;
+ close_log_file(Fd0),
+ case file:open(FileName,Modes) of
+ {ok,Fd} ->
+ {ok,#file_info{inode=INode}} =
+ file:read_file_info(FileName,[raw]),
+ State#{fd=>Fd,inode=>INode,
+ last_check=>timestamp(),
+ synced=>true,sync_res=>ok};
Error ->
exit({could_not_reopen_file,Error})
end
- end.
+ end;
+ensure_file(State) ->
+ State.
-write_to_dev(DevName, Bin, _DevName, _PrevWriteResult, _HandlerName)
- when is_atom(DevName) ->
- io:put_chars(DevName, Bin);
-write_to_dev(Fd, Bin, FileName, PrevWriteResult, HandlerName) ->
+write_to_dev(Bin,#{dev:=DevName}=State) ->
+ io:put_chars(DevName, Bin),
+ State;
+write_to_dev(Bin, State) ->
+ State1 = #{fd:=Fd} = maybe_ensure_file(State),
Result = ?file_write(Fd, Bin),
- maybe_notify_error(write,Result,PrevWriteResult,FileName,HandlerName).
+ State2 = maybe_rotate_file(Bin,State1),
+ maybe_notify_error(write,Result,State2),
+ State2#{synced=>false,write_res=>Result}.
-sync_dev(_Fd, _FileName, true, PrevSyncResult, _HandlerName) ->
- PrevSyncResult;
-sync_dev(Fd, FileName, false, PrevSyncResult, HandlerName) ->
+sync_dev(#{synced:=false}=State) ->
+ State1 = #{fd:=Fd} = maybe_ensure_file(State),
Result = ?file_datasync(Fd),
- maybe_notify_error(filesync,Result,PrevSyncResult,FileName,HandlerName).
+ maybe_notify_error(filesync,Result,State1),
+ State1#{synced=>true,sync_res=>Result};
+sync_dev(State) ->
+ State.
-maybe_notify_error(_Op, ok, _PrevResult, _FileName, _HandlerName) ->
+update_rotation({infinity,_,_},State) ->
+ maybe_remove_archives(0,State),
+ maps:remove(rotation,State);
+update_rotation({Size,Count,Compress},#{file_name:=FileName} = State) ->
+ maybe_remove_archives(Count,State),
+ {ok,#file_info{size=CurrSize}} = file:read_file_info(FileName,[raw]),
+ State1 = State#{rotation=>#{size=>Size,
+ count=>Count,
+ compress=>Compress,
+ curr_size=>CurrSize}},
+ maybe_update_compress(0,State1),
+ maybe_rotate_file(0,State1).
+
+maybe_remove_archives(Count,#{file_name:=FileName}=State) ->
+ Archive = rot_file_name(FileName,Count,false),
+ CompressedArchive = rot_file_name(FileName,Count,true),
+ case {file:read_file_info(Archive,[raw]),
+ file:read_file_info(CompressedArchive,[raw])} of
+ {{error,enoent},{error,enoent}} ->
+ ok;
+ _ ->
+ _ = file:delete(Archive),
+ _ = file:delete(CompressedArchive),
+ maybe_remove_archives(Count+1,State)
+ end.
+
+maybe_update_compress(Count,#{rotation:=#{count:=Count}}) ->
+ ok;
+maybe_update_compress(N,#{file_name:=FileName,
+ rotation:=#{compress:=Compress}}=State) ->
+ Archive = rot_file_name(FileName,N,not Compress),
+ case file:read_file_info(Archive,[raw]) of
+ {ok,_} when Compress ->
+ compress_file(Archive);
+ {ok,_} ->
+ decompress_file(Archive);
+ _ ->
+ ok
+ end,
+ maybe_update_compress(N+1,State).
+
+maybe_rotate_file(Bin,#{rotation:=_}=State) when is_binary(Bin) ->
+ maybe_rotate_file(byte_size(Bin),State);
+maybe_rotate_file(AddSize,#{rotation:=#{size:=RotSize,
+ curr_size:=CurrSize}=Rotation}=State) ->
+ NewSize = CurrSize + AddSize,
+ if NewSize>RotSize ->
+ rotate_file(State#{rotation=>Rotation#{curr_size=>NewSize}});
+ true ->
+ State#{rotation=>Rotation#{curr_size=>NewSize}}
+ end;
+maybe_rotate_file(_Bin,State) ->
+ State.
+
+rotate_file(#{fd:=Fd0,file_name:=FileName,modes:=Modes,rotation:=Rotation}=State) ->
+ State1 = sync_dev(State),
+ _ = file:close(Fd0),
+ _ = file:close(Fd0),
+ rotate_files(FileName,maps:get(count,Rotation),maps:get(compress,Rotation)),
+ case file:open(FileName,Modes) of
+ {ok,Fd} ->
+ {ok,#file_info{inode=INode}} = file:read_file_info(FileName,[raw]),
+ State1#{fd=>Fd,inode=>INode,rotation=>Rotation#{curr_size=>0}};
+ Error ->
+ exit({could_not_reopen_file,Error})
+ end.
+
+rotate_files(FileName,0,_Compress) ->
+ _ = file:delete(FileName),
+ ok;
+rotate_files(FileName,1,Compress) ->
+ FileName0 = FileName++".0",
+ _ = file:rename(FileName,FileName0),
+ if Compress -> compress_file(FileName0);
+ true -> ok
+ end,
ok;
-maybe_notify_error(_Op, PrevResult, PrevResult, _FileName, _HandlerName) ->
+rotate_files(FileName,Count,Compress) ->
+ _ = file:rename(rot_file_name(FileName,Count-2,Compress),
+ rot_file_name(FileName,Count-1,Compress)),
+ rotate_files(FileName,Count-1,Compress).
+
+rot_file_name(FileName,Count,false) ->
+ FileName ++ "." ++ integer_to_list(Count);
+rot_file_name(FileName,Count,true) ->
+ rot_file_name(FileName,Count,false) ++ ".gz".
+
+compress_file(FileName) ->
+ {ok,In} = file:open(FileName,[read,binary]),
+ {ok,Out} = file:open(FileName++".gz",[write]),
+ Z = zlib:open(),
+ zlib:deflateInit(Z, default, deflated, 31, 8, default),
+ compress_data(Z,In,Out),
+ zlib:deflateEnd(Z),
+ zlib:close(Z),
+ _ = file:close(In),
+ _ = file:close(Out),
+ _ = file:delete(FileName),
+ ok.
+
+compress_data(Z,In,Out) ->
+ case file:read(In,100000) of
+ {ok,Data} ->
+ Compressed = zlib:deflate(Z, Data),
+ _ = file:write(Out,Compressed),
+ compress_data(Z,In,Out);
+ eof ->
+ Compressed = zlib:deflate(Z, <<>>, finish),
+ _ = file:write(Out,Compressed),
+ ok
+ end.
+
+decompress_file(FileName) ->
+ {ok,In} = file:open(FileName,[read,binary]),
+ {ok,Out} = file:open(filename:rootname(FileName,".gz"),[write]),
+ Z = zlib:open(),
+ zlib:inflateInit(Z, 31),
+ decompress_data(Z,In,Out),
+ zlib:inflateEnd(Z),
+ zlib:close(Z),
+ _ = file:close(In),
+ _ = file:close(Out),
+ _ = file:delete(FileName),
+ ok.
+
+decompress_data(Z,In,Out) ->
+ case file:read(In,1000) of
+ {ok,Data} ->
+ Decompressed = zlib:inflate(Z, Data),
+ _ = file:write(Out,Decompressed),
+ decompress_data(Z,In,Out);
+ eof ->
+ ok
+ end.
+
+maybe_notify_error(_Op, ok, _State) ->
+ ok;
+maybe_notify_error(Op, Result, #{write_res:=WR,sync_res:=SR})
+ when (Op==write andalso Result==WR) orelse
+ (Op==filesync andalso Result==SR) ->
%% don't report same error twice
- PrevResult;
-maybe_notify_error(Op, Error, _PrevResult, FileName, HandlerName) ->
+ ok;
+maybe_notify_error(Op, Error, #{handler_name:=HandlerName,file_name:=FileName}) ->
logger_h_common:error_notify({HandlerName,Op,FileName,Error}),
- Error.
+ ok.
+
+timestamp() ->
+ erlang:monotonic_time(millisecond).
diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl
index 4915193196..83d3b4b5e1 100644
--- a/lib/kernel/src/net_kernel.erl
+++ b/lib/kernel/src/net_kernel.erl
@@ -1126,14 +1126,22 @@ do_disconnect(Node, State) ->
{false, State}
end.
-
disconnect_pid(Pid, State) ->
exit(Pid, disconnect),
+
+ %% This code used to only use exit + recv 'EXIT' to sync,
+ %% but since OTP-22 links are no longer broken atomically
+ %% so the exit message below can arrive before any remaining
+ %% exit messages have killed the distribution port
+ Ref = erlang:monitor(process, Pid),
%% Sync wait for connection to die!!!
receive
- {'EXIT',Pid,Reason} ->
- {_,State1} = handle_exit(Pid, Reason, State),
- {true, State1}
+ {'DOWN',Ref,_,_,_} ->
+ receive
+ {'EXIT',Pid,Reason} ->
+ {_,State1} = handle_exit(Pid, Reason, State),
+ {true, State1}
+ end
end.
%%
diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl
index 5d649e5f94..ef5b532960 100644
--- a/lib/kernel/src/standard_error.erl
+++ b/lib/kernel/src/standard_error.erl
@@ -27,7 +27,8 @@
-define(PROCNAME_SUP, standard_error_sup).
%% Defines for control ops
--define(CTRL_OP_GET_WINSIZE,100).
+-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900).
+-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)).
%%
%% The basic server and start-up.
diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl
index 872e63ab53..0c9e1ea303 100644
--- a/lib/kernel/src/user.erl
+++ b/lib/kernel/src/user.erl
@@ -28,7 +28,8 @@
-define(NAME, user).
%% Defines for control ops
--define(CTRL_OP_GET_WINSIZE,100).
+-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900).
+-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)).
%%
%% The basic server and start-up.
diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl
index 9f914aa222..08286dd476 100644
--- a/lib/kernel/src/user_drv.erl
+++ b/lib/kernel/src/user_drv.erl
@@ -32,9 +32,10 @@
-define(OP_BEEP,4).
-define(OP_PUTC_SYNC,5).
% Control op
--define(CTRL_OP_GET_WINSIZE,100).
--define(CTRL_OP_GET_UNICODE_STATE,101).
--define(CTRL_OP_SET_UNICODE_STATE,102).
+-define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900).
+-define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)).
+-define(CTRL_OP_GET_UNICODE_STATE, (101 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)).
+-define(CTRL_OP_SET_UNICODE_STATE, (102 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)).
%% start()
%% start(ArgumentList)
diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile
index 8a6ffe7e72..d203597fc2 100644
--- a/lib/kernel/test/Makefile
+++ b/lib/kernel/test/Makefile
@@ -130,6 +130,9 @@ ERL_COMPILE_FLAGS +=
EBIN = .
+TARGETS = $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
@@ -150,6 +153,9 @@ clean:
docs:
+targets: $(TARGETS)
+
+
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl
index 5c35b82207..94d7c17712 100644
--- a/lib/kernel/test/application_SUITE.erl
+++ b/lib/kernel/test/application_SUITE.erl
@@ -31,6 +31,7 @@
otp_3002/1, otp_3184/1, otp_4066/1, otp_4227/1, otp_5363/1,
otp_5606/1,
start_phases/1, get_key/1, get_env/1,
+ set_env/1, set_env_persistent/1, set_env_errors/1,
permit_false_start_local/1, permit_false_start_dist/1, script_start/1,
nodedown_start/1, init2973/0, loop2973/0, loop5606/1]).
@@ -55,6 +56,7 @@ all() ->
load_use_cache, ensure_started, {group, reported_bugs}, start_phases,
script_start, nodedown_start, permit_false_start_local,
permit_false_start_dist, get_key, get_env, ensure_all_started,
+ set_env, set_env_persistent, set_env_errors,
{group, distr_changed}, config_change, shutdown_func, shutdown_timeout,
shutdown_deadlock, config_relative_paths,
persistent_env].
@@ -1944,6 +1946,101 @@ get_appls([_ | T], Res) ->
get_appls([], Res) ->
Res.
+%% Test set_env/1.
+set_env(Conf) when is_list(Conf) ->
+ ok = application:set_env([{appinc, [{own2, persist}, {not_in_app, persist}]},
+ {unknown_app, [{key, persist}]}]),
+
+ %% own_env1 and own2 are set in appinc
+ undefined = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ {ok, persist} = application:get_env(appinc, not_in_app),
+ {ok, persist} = application:get_env(unknown_app, key),
+
+ ok = application:load(appinc()),
+ {ok, value1} = application:get_env(appinc, own_env1),
+ {ok, val2} = application:get_env(appinc, own2),
+ {ok, persist} = application:get_env(appinc, not_in_app),
+ {ok, persist} = application:get_env(unknown_app, key),
+
+ %% On reload, values are lost
+ ok = application:unload(appinc),
+ ok = application:load(appinc()),
+ {ok, value1} = application:get_env(appinc, own_env1),
+ {ok, val2} = application:get_env(appinc, own2),
+ undefined = application:get_env(appinc, not_in_app),
+
+ %% Clean up
+ ok = application:unload(appinc).
+
+%% Test set_env/2 with persistent true.
+set_env_persistent(Conf) when is_list(Conf) ->
+ Opts = [{persistent, true}],
+ ok = application:set_env([{appinc, [{own2, persist}, {not_in_app, persist}]},
+ {unknown_app, [{key, persist}]}], Opts),
+
+ %% own_env1 and own2 are set in appinc
+ undefined = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ {ok, persist} = application:get_env(appinc, not_in_app),
+ {ok, persist} = application:get_env(unknown_app, key),
+
+ ok = application:load(appinc()),
+ {ok, value1} = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ {ok, persist} = application:get_env(appinc, not_in_app),
+ {ok, persist} = application:get_env(unknown_app, key),
+
+ %% On reload, values are not lost
+ ok = application:unload(appinc),
+ ok = application:load(appinc()),
+ {ok, value1} = application:get_env(appinc, own_env1),
+ {ok, persist} = application:get_env(appinc, own2),
+ {ok, persist} = application:get_env(appinc, not_in_app),
+
+ %% Clean up
+ ok = application:unload(appinc).
+
+set_env_errors(Conf) when is_list(Conf) ->
+ "application: 1; application name must be an atom" =
+ badarg_msg(fun() -> application:set_env([{1, []}]) end),
+
+ "application: foo; parameters must be a list" =
+ badarg_msg(fun() -> application:set_env([{foo, bar}]) end),
+
+ "invalid application config: foo_bar" =
+ badarg_msg(fun() -> application:set_env([foo_bar]) end),
+
+ "application: foo; invalid parameter name: 1" =
+ badarg_msg(fun() -> application:set_env([{foo, [{1, 2}]}]) end),
+
+ "application: foo; invalid parameter: config" =
+ badarg_msg(fun() -> application:set_env([{foo, [config]}]) end),
+
+ "application: kernel; erroneous parameter: distributed" =
+ badarg_msg(fun() -> application:set_env([{kernel, [{distributed, config}]}]) end),
+
+ %% This will raise in the future
+ ct:capture_start(),
+ _ = application:set_env([{foo, []}, {foo, []}]),
+ timer:sleep(100),
+ ct:capture_stop(),
+ [_ | _] = string:find(ct:capture_get(), "duplicate application config: foo"),
+
+ ct:capture_start(),
+ _ = application:set_env([{foo, [{bar, baz}, {bar, bat}]}]),
+ timer:sleep(100),
+ ct:capture_stop(),
+ [_ | _] = string:find(ct:capture_get(), "application: foo; duplicate parameter: bar"),
+
+ ok.
+
+badarg_msg(Fun) ->
+ try Fun() of
+ _ -> ct:fail(try_succeeded)
+ catch
+ error:{badarg, Msg} -> Msg
+ end.
%% Test set_env/4 and unset_env/3 with persistent true.
persistent_env(Conf) when is_list(Conf) ->
diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl
index 8b33f4a679..44ec7e7076 100644
--- a/lib/kernel/test/inet_SUITE.erl
+++ b/lib/kernel/test/inet_SUITE.erl
@@ -21,6 +21,7 @@
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/inet.hrl").
+-include_lib("kernel/src/inet_res.hrl").
-include_lib("kernel/src/inet_dns.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
@@ -34,7 +35,7 @@
ipv4_to_ipv6/0, ipv4_to_ipv6/1,
host_and_addr/0, host_and_addr/1,
t_gethostnative/1,
- gethostnative_parallell/1, cname_loop/1,
+ gethostnative_parallell/1, cname_loop/1, missing_hosts_reload/1,
gethostnative_soft_restart/0, gethostnative_soft_restart/1,
gethostnative_debug_level/0, gethostnative_debug_level/1,
lookup_bad_search_option/1,
@@ -56,7 +57,7 @@ all() ->
[t_gethostbyaddr, t_gethostbyname, t_getaddr,
t_gethostbyaddr_v6, t_gethostbyname_v6, t_getaddr_v6,
ipv4_to_ipv6, host_and_addr, {group, parse},
- t_gethostnative, gethostnative_parallell, cname_loop,
+ t_gethostnative, gethostnative_parallell, cname_loop, missing_hosts_reload,
gethostnative_debug_level, gethostnative_soft_restart,
lookup_bad_search_option,
getif, getif_ifr_name_overflow, getservbyname_overflow,
@@ -840,6 +841,32 @@ cname_loop(Config) when is_list(Config) ->
ok.
+%% Test that hosts file gets reloaded correctly in case when it
+% was missing during initial startup
+missing_hosts_reload(Config) when is_list(Config) ->
+ RootDir = proplists:get_value(priv_dir,Config),
+ HostsFile = filename:join(RootDir, atom_to_list(?MODULE) ++ ".hosts"),
+ InetRc = filename:join(RootDir, "inetrc"),
+ ok = file:write_file(InetRc, "{hosts_file, \"" ++ HostsFile ++ "\"}.\n"),
+ {error, enoent} = file:read_file_info(HostsFile),
+ % start a node
+ Pa = filename:dirname(code:which(?MODULE)),
+ {ok, TestNode} = test_server:start_node(?MODULE, slave,
+ [{args, "-pa " ++ Pa ++ " -kernel inetrc '\"" ++ InetRc ++ "\"'"}]),
+ % ensure it has our RC
+ Rc = rpc:call(TestNode, inet_db, get_rc, []),
+ {hosts_file, HostsFile} = lists:keyfind(hosts_file, 1, Rc),
+ % ensure it does not resolve
+ {error, nxdomain} = rpc:call(TestNode, inet_hosts, gethostbyname, ["somehost"]),
+ % write hosts file
+ ok = file:write_file(HostsFile, "1.2.3.4 somehost"),
+ % wait for cached timestamp to expire
+ timer:sleep(?RES_FILE_UPDATE_TM * 1000 + 100),
+ % ensure it DOES resolve
+ {ok,{hostent,"somehost",[],inet,4,[{1,2,3,4}]}} =
+ rpc:call(TestNode, inet_hosts, gethostbyname, ["somehost"]),
+ % cleanup
+ true = test_server:stop_node(TestNode).
%% These must be run in the whole suite since they need
%% the host list and require inet_gethost_native to be started.
diff --git a/lib/kernel/test/kernel.spec b/lib/kernel/test/kernel.spec
index 62afc9f97b..eaa17f3a59 100644
--- a/lib/kernel/test/kernel.spec
+++ b/lib/kernel/test/kernel.spec
@@ -2,3 +2,4 @@
{config, "../test_server/ts.unix.config"}.
{suites,"../kernel_test", all}.
+{skip_suites,"../kernel_test",[logger_stress_SUITE],"Benchmarks only"}.
diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl
index 9207025a2c..57c44c2498 100644
--- a/lib/kernel/test/kernel_config_SUITE.erl
+++ b/lib/kernel/test/kernel_config_SUITE.erl
@@ -21,7 +21,8 @@
-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, sync/1]).
+-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
+ start_distribution_false/1, sync/1]).
-export([init_per_suite/1, end_per_suite/1]).
@@ -30,7 +31,7 @@ suite() ->
{timetrap,{minutes,2}}].
all() ->
- [sync].
+ [sync, start_distribution_false].
groups() ->
[].
@@ -59,12 +60,9 @@ from(H, [H | T]) -> T;
from(H, [_ | T]) -> from(H, T);
from(_, []) -> [].
-%%-----------------------------------------------------------------
-%% Test suite for sync_nodes. This is quite tricky.
-%%
+%% Test sync_nodes. This is quite tricky.
%% Should be started in a CC view with:
%% erl -sname XXX where XX not in [cp1, cp2]
-%%-----------------------------------------------------------------
sync(Conf) when is_list(Conf) ->
%% Write a config file
Dir = proplists:get_value(priv_dir,Conf),
@@ -106,9 +104,18 @@ wait_for_node(Node) ->
_Other -> wait_for_node(Node)
end.
-
stop_node(Node) ->
M = list_to_atom(lists:concat([Node,
[$@],
from($@,atom_to_list(node()))])),
rpc:cast(M, erlang, halt, []).
+
+start_distribution_false(Config) when is_list(Config) ->
+ %% When distribution is disabled, -sname/-name has no effect
+ Str = os:cmd(ct:get_progname()
+ ++ " -kernel start_distribution false"
+ ++ " -sname no_distribution"
+ ++ " -eval \"erlang:display(node())\""
+ ++ " -noshell -s erlang halt"),
+ "'nonode@nohost'" ++ _ = Str,
+ ok.
diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl
index d831d0d108..035e5d8974 100644
--- a/lib/kernel/test/logger_SUITE.erl
+++ b/lib/kernel/test/logger_SUITE.erl
@@ -101,7 +101,8 @@ all() ->
compare_levels,
process_metadata,
app_config,
- kernel_config].
+ kernel_config,
+ pretty_print].
start_stop(_Config) ->
S = whereis(logger),
@@ -898,14 +899,14 @@ process_metadata(_Config) ->
undefined = logger:get_process_metadata(),
{error,badarg} = ?TRY(logger:set_process_metadata(bad)),
ok = logger:add_handler(h1,?MODULE,#{level=>notice,filter_default=>log}),
- Time = erlang:system_time(microsecond),
+ Time = logger:timestamp(),
ProcMeta = #{time=>Time,line=>0,custom=>proc},
ok = logger:set_process_metadata(ProcMeta),
S1 = ?str,
?LOG_NOTICE(S1,#{custom=>macro}),
check_logged(notice,S1,#{time=>Time,line=>0,custom=>macro}),
- Time2 = erlang:system_time(microsecond),
+ Time2 = logger:timestamp(),
S2 = ?str,
?LOG_NOTICE(S2,#{time=>Time2,line=>1,custom=>macro}),
check_logged(notice,S2,#{time=>Time2,line=>1,custom=>macro}),
@@ -1047,8 +1048,11 @@ kernel_config(Config) ->
ok = rpc:call(Node,logger,internal_init_logger,[]),
ok = rpc:call(Node,logger,add_handlers,[kernel]),
#{primary:=#{filter_default:=log,filters:=[]},
- handlers:=[#{id:=default,filters:=DF,config:=#{type:={file,F}}}],
+ handlers:=[#{id:=default,filters:=DF,
+ config:=#{type:=file,file:=F,modes:=Modes}}],
module_levels:=[]} = rpc:call(Node,logger,get_config,[]),
+ [append,delayed_write,raw] = lists:sort(Modes),
+
%% Same, but using 'logger' parameter instead of 'error_logger'
ok = rpc:call(Node,logger,remove_handler,[default]),% so it can be added again
@@ -1059,26 +1063,27 @@ kernel_config(Config) ->
ok = rpc:call(Node,logger,internal_init_logger,[]),
ok = rpc:call(Node,logger,add_handlers,[kernel]),
#{primary:=#{filter_default:=log,filters:=[]},
- handlers:=[#{id:=default,filters:=DF,config:=#{type:={file,F}}}],
+ handlers:=[#{id:=default,filters:=DF,
+ config:=#{type:=file,file:=F,modes:=Modes}}],
module_levels:=[]} = rpc:call(Node,logger,get_config,[]),
%% Same, but with type={file,File,Modes}
ok = rpc:call(Node,logger,remove_handler,[default]),% so it can be added again
ok = rpc:call(Node,application,unset_env,[kernel,error_logger]),
- M = [raw,write,delayed_write],
+ M = [raw,write],
ok = rpc:call(Node,application,set_env,[kernel,logger,
[{handler,default,logger_std_h,
#{config=>#{type=>{file,F,M}}}}]]),
ok = rpc:call(Node,logger,internal_init_logger,[]),
ok = rpc:call(Node,logger,add_handlers,[kernel]),
#{primary:=#{filter_default:=log,filters:=[]},
- handlers:=[#{id:=default,filters:=DF,config:=#{type:={file,F,M}}}],
+ handlers:=[#{id:=default,filters:=DF,
+ config:=#{type:=file,file:=F,modes:=[delayed_write|M]}}],
module_levels:=[]} = rpc:call(Node,logger,get_config,[]),
%% Same, but with disk_log handler
ok = rpc:call(Node,logger,remove_handler,[default]),% so it can be added again
ok = rpc:call(Node,application,unset_env,[kernel,error_logger]),
- M = [raw,write,delayed_write],
ok = rpc:call(Node,application,set_env,[kernel,logger,
[{handler,default,logger_disk_log_h,
#{config=>#{file=>F}}}]]),
@@ -1141,6 +1146,61 @@ kernel_config(Config) ->
ok.
+pretty_print(Config) ->
+ ok = logger:add_handler(?FUNCTION_NAME,logger_std_h,#{}),
+ ok = logger:set_module_level([module1,module2],debug),
+
+ ct:capture_start(),
+ logger:i(),
+ ct:capture_stop(),
+ I0 = ct:capture_get(),
+
+ ct:capture_start(),
+ logger:i(primary),
+ ct:capture_stop(),
+ IPrim = ct:capture_get(),
+
+ ct:capture_start(),
+ logger:i(handlers),
+ ct:capture_stop(),
+ IHs = ct:capture_get(),
+
+ ct:capture_start(),
+ logger:i(proxy),
+ ct:capture_stop(),
+ IProxy = ct:capture_get(),
+
+ ct:capture_start(),
+ logger:i(modules),
+ ct:capture_stop(),
+ IMs = ct:capture_get(),
+
+ I02 = lists:append([IPrim,IHs,IProxy,IMs]),
+ %% ct:log("~p~n",[I0]),
+ %% ct:log("~p~n",[I02]),
+ I0 = I02,
+
+ ct:capture_start(),
+ logger:i(handlers),
+ ct:capture_stop(),
+ IHs = ct:capture_get(),
+
+ Ids = logger:get_handler_ids(),
+ IHs2 =
+ lists:append(
+ [begin
+ ct:capture_start(),
+ logger:i(Id),
+ ct:capture_stop(),
+ [_|IH] = ct:capture_get(),
+ IH
+ end || Id <- Ids]),
+
+ %% ct:log("~p~n",[IHs]),
+ %% ct:log("~p~n",[["Handler configuration: \n"|IHs2]]),
+ IHs = ["Handler configuration: \n"|IHs2],
+ ok.
+
%%%-----------------------------------------------------------------
%%% Internal
check_logged(Level,Format,Args,Meta) ->
diff --git a/lib/kernel/test/logger_disk_log_h_SUITE.erl b/lib/kernel/test/logger_disk_log_h_SUITE.erl
index 9bbec42de8..13b30835a1 100644
--- a/lib/kernel/test/logger_disk_log_h_SUITE.erl
+++ b/lib/kernel/test/logger_disk_log_h_SUITE.erl
@@ -293,7 +293,7 @@ logging(Config) ->
ok = start_and_add(Name, #{filter_default=>log,
formatter=>{?MODULE,self()}},
#{file => LogFile}),
- MsgFormatter = fun(Term) -> {io_lib:format("Term:~p",[Term]),[]} end,
+ MsgFormatter = fun(Term) -> {"Term:~p",[Term]} end,
logger:notice([{x,y}], #{report_cb => MsgFormatter}),
logger:notice([{x,y}], #{}),
ct:pal("Checking contents of ~p", [?log_no(LogFile,1)]),
diff --git a/lib/kernel/test/logger_formatter_SUITE.erl b/lib/kernel/test/logger_formatter_SUITE.erl
index 8c13f0f908..83e3e6c40a 100644
--- a/lib/kernel/test/logger_formatter_SUITE.erl
+++ b/lib/kernel/test/logger_formatter_SUITE.erl
@@ -867,7 +867,7 @@ my_try(Fun) ->
try Fun() catch C:R:S -> {C,R,hd(S)} end.
timestamp() ->
- erlang:system_time(microsecond).
+ logger:timestamp().
%% necessary?
add_time(#{time:=_}=Meta) ->
diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl
index 484d914ec3..0c5516f82b 100644
--- a/lib/kernel/test/logger_std_h_SUITE.erl
+++ b/lib/kernel/test/logger_std_h_SUITE.erl
@@ -112,6 +112,8 @@ all() ->
add_remove_instance_standard_error,
add_remove_instance_file1,
add_remove_instance_file2,
+ add_remove_instance_file3,
+ add_remove_instance_file4,
default_formatter,
filter_config,
errors,
@@ -141,7 +143,13 @@ all() ->
mem_kill_std,
restart_after,
handler_requests_under_load,
- recreate_deleted_log
+ recreate_deleted_log,
+ reopen_changed_log,
+ rotate_size,
+ rotate_size_compressed,
+ rotate_size_reopen,
+ rotation_opts,
+ rotation_opts_restart_handler
].
add_remove_instance_tty(_Config) ->
@@ -178,10 +186,27 @@ add_remove_instance_file2(Config) ->
add_remove_instance_file2(cleanup,_Config) ->
logger_std_h_remove().
-add_remove_instance_file(Log, Type) ->
+add_remove_instance_file3(_Config) ->
+ Log = atom_to_list(?MODULE),
+ StdHConfig = #{type=>file},
+ add_remove_instance_file(Log, StdHConfig).
+add_remove_instance_file3(cleanup,_Config) ->
+ logger_std_h_remove().
+
+add_remove_instance_file4(Config) ->
+ Dir = ?config(priv_dir,Config),
+ Log = filename:join(Dir,"stdlog4.txt"),
+ StdHConfig = #{file=>Log,modes=>[]},
+ add_remove_instance_file(Log, StdHConfig).
+add_remove_instance_file4(cleanup,_Config) ->
+ logger_std_h_remove().
+
+add_remove_instance_file(Log, Type) when not is_map(Type) ->
+ add_remove_instance_file(Log,#{type=>Type});
+add_remove_instance_file(Log, StdHConfig) when is_map(StdHConfig) ->
ok = logger:add_handler(?MODULE,
logger_std_h,
- #{config => #{type => Type},
+ #{config => StdHConfig,
filter_default=>stop,
filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
formatter=>{?MODULE,self()}}),
@@ -256,9 +281,10 @@ errors(Config) ->
end,
{error,
- {handler_not_added,{open_failed,Log,_}}} =
+ {handler_not_added,
+ {invalid_config,logger_std_h,#{modes:=bad_file_opt}}}} =
logger:add_handler(myh3,logger_std_h,
- #{config=>#{type=>{file,Log,[bad_file_opt]}}}),
+ #{config=>#{type=>{file,Log,bad_file_opt}}}),
ok = logger:notice(?msg).
@@ -606,24 +632,51 @@ reconfig(cleanup, _Config) ->
file_opts(Config) ->
Dir = ?config(priv_dir,Config),
Log = filename:join(Dir, lists:concat([?FUNCTION_NAME,".log"])),
- BadFileOpts = [raw],
- BadType = {file,Log,BadFileOpts},
- {error,{handler_not_added,{open_failed,Log,enoent}}} =
- logger:add_handler(?MODULE, logger_std_h,
- #{config => #{type => BadType}}),
+ MissingOpts = [raw],
+ Type1 = {file,Log,MissingOpts},
+ ok = logger:add_handler(?MODULE, logger_std_h,
+ #{config => #{type => Type1}}),
+ {ok,#{config:=#{type:=file,file:=Log,modes:=Modes1}}} =
+ logger:get_handler_config(?MODULE),
+ [append,delayed_write,raw] = lists:sort(Modes1),
+ ok = logger:remove_handler(?MODULE),
OkFileOpts = [raw,append],
OkType = {file,Log,OkFileOpts},
ok = logger:add_handler(?MODULE,
logger_std_h,
- #{config => #{type => OkType},
+ #{config => #{type => OkType}, % old format
+ filter_default=>log,
+ filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
+ formatter=>{?MODULE,self()}}),
+
+ ModOpts = [delayed_write|OkFileOpts],
+ #{cb_state := #{handler_state := #{type:=file,
+ file:=Log,
+ modes:=ModOpts}}} =
+ logger_olp:info(h_proc_name()),
+ {ok,#{config := #{type:=file,
+ file:=Log,
+ modes:=ModOpts}}} = logger:get_handler_config(?MODULE),
+ ok = logger:remove_handler(?MODULE),
+
+ ok = logger:add_handler(?MODULE,
+ logger_std_h,
+ #{config => #{type => file,
+ file => Log,
+ modes => OkFileOpts}, % new format
filter_default=>log,
filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
formatter=>{?MODULE,self()}}),
- #{cb_state := #{handler_state := #{type := OkType}}} =
+ #{cb_state := #{handler_state := #{type:=file,
+ file:=Log,
+ modes:=ModOpts}}} =
logger_olp:info(h_proc_name()),
- {ok,#{config := #{type := OkType}}} = logger:get_handler_config(?MODULE),
+ {ok,#{config := #{type:=file,
+ file:=Log,
+ modes:=ModOpts}}} =
+ logger:get_handler_config(?MODULE),
logger:notice(M1=?msg,?domain),
?check(M1),
B1 = ?bin(M1),
@@ -639,13 +692,14 @@ sync(Config) ->
Type = {file,Log},
ok = logger:add_handler(?MODULE,
logger_std_h,
- #{config => #{type => Type},
+ #{config => #{type => Type,
+ file_check => 10000},
filter_default=>log,
filters=>?DEFAULT_HANDLER_FILTERS([?MODULE]),
formatter=>{?MODULE,nl}}),
%% check repeated filesync happens
- start_tracer([{logger_std_h, write_to_dev, 5},
+ start_tracer([{logger_std_h, write_to_dev, 2},
{file, datasync, 1}],
[{logger_std_h, write_to_dev, <<"first\n">>},
{file,datasync}]),
@@ -655,7 +709,7 @@ sync(Config) ->
check_tracer(filesync_rep_int()*2),
%% check that explicit filesync is only done once
- start_tracer([{logger_std_h, write_to_dev, 5},
+ start_tracer([{logger_std_h, write_to_dev, 2},
{file, datasync, 1}],
[{logger_std_h, write_to_dev, <<"second\n">>},
{file,datasync},
@@ -674,7 +728,7 @@ sync(Config) ->
#{filesync_repeat_interval => no_repeat}),
no_repeat = maps:get(filesync_repeat_interval,
maps:get(cb_state, logger_olp:info(h_proc_name()))),
- start_tracer([{logger_std_h, write_to_dev, 5},
+ start_tracer([{logger_std_h, write_to_dev, 2},
{file, datasync, 1}],
[{logger_std_h, write_to_dev, <<"third\n">>},
{file,datasync},
@@ -1269,6 +1323,346 @@ recreate_deleted_log(Config) ->
recreate_deleted_log(cleanup, _Config) ->
ok = stop_handler(?MODULE).
+reopen_changed_log(Config) ->
+ {Log,_HConfig,_StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ logger:notice("first",?domain),
+ logger_std_h:filesync(?MODULE),
+ ok = file:rename(Log,Log++".old"),
+ ok = file:write_file(Log,""),
+ logger:notice("second",?domain),
+ logger_std_h:filesync(?MODULE),
+ {ok,<<"first\n">>} = file:read_file(Log++".old"),
+ {ok,<<"second\n">>} = file:read_file(Log),
+ ok.
+reopen_changed_log(cleanup, _Config) ->
+ ok = stop_handler(?MODULE).
+
+rotate_size(Config) ->
+ {Log,_HConfig,_StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ ok = logger:update_handler_config(?MODULE,#{config=>#{max_no_bytes=>1000,
+ max_no_files=>2}}),
+
+ Str = lists:duplicate(19,$a),
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,50)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=1000}} = file:read_file_info(Log),
+ {error,enoent} = file:read_file_info(Log++".0"),
+
+ logger:notice(Str,?domain),
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {ok,#file_info{size=1020}} = file:read_file_info(Log++".0"),
+ {error,enoent} = file:read_file_info(Log++".1"),
+
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,51)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {ok,#file_info{size=1020}} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=1020}} = file:read_file_info(Log++".1"),
+ {error,enoent} = file:read_file_info(Log++".2"),
+
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,50)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=1000}} = file:read_file_info(Log),
+ {ok,#file_info{size=1020}} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=1020}} = file:read_file_info(Log++".1"),
+ {error,enoent} = file:read_file_info(Log++".2"),
+
+ logger:notice("bbbb",?domain),
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {ok,#file_info{size=1005}} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=1020}} = file:read_file_info(Log++".1"),
+ {error,enoent} = file:read_file_info(Log++".2"),
+
+ ok.
+rotate_size(cleanup,_Config) ->
+ ok = stop_handler(?MODULE).
+
+rotate_size_compressed(Config) ->
+ {Log,_HConfig,_StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ ok = logger:update_handler_config(?MODULE,
+ #{config=>#{max_no_bytes=>1000,
+ max_no_files=>2,
+ compress_on_rotate=>true}}),
+ Str = lists:duplicate(19,$a),
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,50)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=1000}} = file:read_file_info(Log),
+ {error,enoent} = file:read_file_info(Log++".0"),
+ {error,enoent} = file:read_file_info(Log++".0.gz"),
+
+ logger:notice(Str,?domain),
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {error,enoent} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=35}} = file:read_file_info(Log++".0.gz"),
+ {error,enoent} = file:read_file_info(Log++".1"),
+ {error,enoent} = file:read_file_info(Log++".1.gz"),
+
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,51)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {error,enoent} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=35}} = file:read_file_info(Log++".0.gz"),
+ {error,enoent} = file:read_file_info(Log++".1"),
+ {ok,#file_info{size=35}} = file:read_file_info(Log++".1.gz"),
+ {error,enoent} = file:read_file_info(Log++".2"),
+ {error,enoent} = file:read_file_info(Log++".2.gz"),
+
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,50)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=1000}} = file:read_file_info(Log),
+ {error,enoent} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=35}} = file:read_file_info(Log++".0.gz"),
+ {error,enoent} = file:read_file_info(Log++".1"),
+ {ok,#file_info{size=35}} = file:read_file_info(Log++".1.gz"),
+ {error,enoent} = file:read_file_info(Log++".2"),
+ {error,enoent} = file:read_file_info(Log++".2.gz"),
+
+ logger:notice("bbbb",?domain),
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {error,enoent} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=38}} = file:read_file_info(Log++".0.gz"),
+ {error,enoent} = file:read_file_info(Log++".1"),
+ {ok,#file_info{size=35}} = file:read_file_info(Log++".1.gz"),
+ {error,enoent} = file:read_file_info(Log++".2"),
+ {error,enoent} = file:read_file_info(Log++".2.gz"),
+
+ ok.
+rotate_size_compressed(cleanup,_Config) ->
+ ok = stop_handler(?MODULE).
+
+rotate_size_reopen(Config) ->
+ {Log,_HConfig,_StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ ok = logger:update_handler_config(?MODULE,#{config=>#{max_no_bytes=>1000,
+ max_no_files=>2}}),
+
+ Str = lists:duplicate(19,$a),
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,40)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=800}} = file:read_file_info(Log),
+
+ {ok,HConfig} = logger:get_handler_config(?MODULE),
+ ok = logger:remove_handler(?MODULE),
+ ok = logger:add_handler(?MODULE,maps:get(module,HConfig),HConfig),
+ {ok,#file_info{size=800}} = file:read_file_info(Log),
+
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,40)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=580}} = file:read_file_info(Log),
+ {ok,#file_info{size=1020}} = file:read_file_info(Log++".0"),
+ ok.
+rotate_size_reopen(cleanup,_Config) ->
+ ok = stop_handler(?MODULE).
+
+rotation_opts(Config) ->
+ {Log,_HConfig,StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ #{max_no_bytes:=infinity,
+ max_no_files:=0,
+ compress_on_rotate:=false} = StdHConfig,
+
+ %% Test bad rotation config
+ {error,{invalid_config,_,_}} =
+ logger:update_handler_config(?MODULE,config,#{max_no_bytes=>0}),
+ {error,{invalid_config,_,_}} =
+ logger:update_handler_config(?MODULE,config,#{max_no_files=>infinity}),
+ {error,{invalid_config,_,_}} =
+ logger:update_handler_config(?MODULE,config,
+ #{compress_on_rotate=>undefined}),
+
+
+ %% Test good rotation config - start with no rotation
+ Str = lists:duplicate(19,$a),
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,10)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=200}} = file:read_file_info(Log),
+ [] = filelib:wildcard(Log++".*"),
+
+ %% Turn on rotation, check that existing file is rotated since its
+ %% size exceeds max_no_bytes
+ ok = logger:update_handler_config(?MODULE,
+ config,
+ #{max_no_bytes=>100,
+ max_no_files=>2}),
+ timer:sleep(100), % give some time to execute config_changed
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ Log0 = Log++".0",
+ {ok,#file_info{size=200}} = file:read_file_info(Log0),
+ [Log0] = filelib:wildcard(Log++".*"),
+
+ %% Fill all logs
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,13)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=20}} = file:read_file_info(Log),
+ {ok,#file_info{size=120}} = file:read_file_info(Log0),
+ {ok,#file_info{size=120}} = file:read_file_info(Log++".1"),
+ [_,_] = filelib:wildcard(Log++".*"),
+
+ %% Extend size and count and check that nothing changes with existing files
+ ok = logger:update_handler_config(?MODULE,
+ config,
+ #{max_no_bytes=>200,
+ max_no_files=>3}),
+ timer:sleep(100), % give some time to execute config_changed
+ {ok,#file_info{size=20}} = file:read_file_info(Log),
+ {ok,#file_info{size=120}} = file:read_file_info(Log0),
+ {ok,#file_info{size=120}} = file:read_file_info(Log++".1"),
+ [_,_] = filelib:wildcard(Log++".*"),
+
+ %% Add more log events and see that extended size and count works
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,10)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {ok,#file_info{size=220}} = file:read_file_info(Log0),
+ {ok,#file_info{size=120}} = file:read_file_info(Log++".1"),
+ {ok,#file_info{size=120}} = file:read_file_info(Log++".2"),
+ [_,_,_] = filelib:wildcard(Log++".*"),
+
+ %% Reduce count and check that archive files that exceed the new
+ %% count are moved
+ ok = logger:update_handler_config(?MODULE,
+ config,
+ #{max_no_files=>1}),
+ timer:sleep(100), % give some time to execute config_changed
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {ok,#file_info{size=220}} = file:read_file_info(Log0),
+ [Log0] = filelib:wildcard(Log++".*"),
+
+ %% Extend size and count again, and turn on compression. Check
+ %% that archives are compressed
+ ok = logger:update_handler_config(?MODULE,
+ config,
+ #{max_no_bytes=>100,
+ max_no_files=>2,
+ compress_on_rotate=>true}),
+ timer:sleep(100), % give some time to execute config_changed
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ Log0gz = Log0++".gz",
+ {ok,#file_info{size=29}} = file:read_file_info(Log0gz),
+ [Log0gz] = filelib:wildcard(Log++".*"),
+
+ %% Fill all logs
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,13)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=20}} = file:read_file_info(Log),
+ {ok,#file_info{size=29}} = file:read_file_info(Log0gz),
+ {ok,#file_info{size=29}} = file:read_file_info(Log++".1.gz"),
+ [_,_] = filelib:wildcard(Log++".*"),
+
+ %% Reduce count and turn off compression. Check that archives that
+ %% exceeds the new count are removed, and the rest are
+ %% uncompressed.
+ ok = logger:update_handler_config(?MODULE,
+ config,
+ #{max_no_files=>1,
+ compress_on_rotate=>false}),
+ timer:sleep(100), % give some time to execute config_changed
+ {ok,#file_info{size=20}} = file:read_file_info(Log),
+ {ok,#file_info{size=120}} = file:read_file_info(Log0),
+ [Log0] = filelib:wildcard(Log++".*"),
+
+ %% Check that config and handler state agree on the current rotation settings
+ {ok,#{config:=#{max_no_bytes:=100,
+ max_no_files:=1,
+ compress_on_rotate:=false}}} =
+ logger:get_handler_config(?MODULE),
+ #{cb_state:=#{handler_state:=#{max_no_bytes:=100,
+ max_no_files:=1,
+ compress_on_rotate:=false}}} =
+ logger_olp:info(h_proc_name()),
+ ok.
+rotation_opts(cleanup,_Config) ->
+ ok = stop_handler(?MODULE).
+
+rotation_opts_restart_handler(Config) ->
+ {Log,_HConfig,_StdHConfig} =
+ start_handler(?MODULE, ?FUNCTION_NAME, Config),
+ ok = logger:update_handler_config(?MODULE,
+ config,
+ #{max_no_bytes=>100,
+ max_no_files=>2}),
+
+ %% Fill all logs
+ Str = lists:duplicate(19,$a),
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,15)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=60}} = file:read_file_info(Log),
+ {ok,#file_info{size=120}} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=120}} = file:read_file_info(Log++".1"),
+ [_,_] = filelib:wildcard(Log++".*"),
+
+ %% Stop/start handler and turn off rotation. Check that archives are removed.
+ {ok,#{config:=StdHConfig1}=HConfig1} = logger:get_handler_config(?MODULE),
+ ok = logger:remove_handler(?MODULE),
+ ok = logger:add_handler(
+ ?MODULE,logger_std_h,
+ HConfig1#{config=>StdHConfig1#{max_no_bytes=>infinity}}),
+ timer:sleep(100),
+ {ok,#file_info{size=60}} = file:read_file_info(Log),
+ [] = filelib:wildcard(Log++".*"),
+
+ %% Add some log events and check that file is no longer rotated.
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,10)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=260}} = file:read_file_info(Log),
+ [] = filelib:wildcard(Log++".*"),
+
+ %% Stop/start handler and trun on rotation. Check that file is rotated.
+ {ok,#{config:=StdHConfig2}=HConfig2} = logger:get_handler_config(?MODULE),
+ ok = logger:remove_handler(?MODULE),
+ ok = logger:add_handler(
+ ?MODULE,logger_std_h,
+ HConfig2#{config=>StdHConfig2#{max_no_bytes=>100,
+ max_no_files=>2}}),
+ timer:sleep(100),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {ok,#file_info{size=260}} = file:read_file_info(Log++".0"),
+ [_] = filelib:wildcard(Log++".*"),
+
+ %% Fill all logs
+ [logger:notice(Str,?domain) || _ <- lists:seq(1,10)],
+ logger_std_h:filesync(?MODULE),
+ {ok,#file_info{size=80}} = file:read_file_info(Log),
+ {ok,#file_info{size=120}} = file:read_file_info(Log++".0"),
+ {ok,#file_info{size=260}} = file:read_file_info(Log++".1"),
+
+ %% Stop/start handler, reduce count and turn on compression. Check
+ %% that excess archives are removed, and the rest compressed.
+ {ok,#{config:=StdHConfig3}=HConfig3} = logger:get_handler_config(?MODULE),
+ ok = logger:remove_handler(?MODULE),
+ ok = logger:add_handler(
+ ?MODULE,logger_std_h,
+ HConfig3#{config=>StdHConfig3#{max_no_bytes=>75,
+ max_no_files=>1,
+ compress_on_rotate=>true}}),
+ timer:sleep(100),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {ok,#file_info{size=29}} = file:read_file_info(Log++".0.gz"),
+ [_] = filelib:wildcard(Log++".*"),
+
+ %% Stop/start handler and turn off compression. Check that achives
+ %% are decompressed.
+ {ok,#{config:=StdHConfig4}=HConfig4} = logger:get_handler_config(?MODULE),
+ ok = logger:remove_handler(?MODULE),
+ ok = logger:add_handler(
+ ?MODULE,logger_std_h,
+ HConfig4#{config=>StdHConfig4#{compress_on_rotate=>false}}),
+ timer:sleep(100),
+ {ok,#file_info{size=0}} = file:read_file_info(Log),
+ {ok,#file_info{size=80}} = file:read_file_info(Log++".0"),
+ [_] = filelib:wildcard(Log++".*"),
+
+ ok.
+rotation_opts_restart_handler(cleanup,_Config) ->
+ ok = stop_handler(?MODULE).
+
%%%-----------------------------------------------------------------
%%%
send_requests(TO, Reqs = [{Mod,Func,Args,Res}|Rs]) ->
@@ -1289,8 +1683,8 @@ start_handler(Name, TTY, _Config) when TTY == standard_io;
ok = logger:add_handler(Name,
logger_std_h,
#{config => #{type => TTY},
- filter_default=>log,
- filters=>?DEFAULT_HANDLER_FILTERS([Name]),
+ filter_default=>stop,
+ filters=>filter_only_this_domain(Name),
formatter=>{?MODULE,op}}),
{ok,HConfig = #{config := StdHConfig}} = logger:get_handler_config(Name),
{HConfig,StdHConfig};
@@ -1304,12 +1698,17 @@ start_handler(Name, FuncName, Config) ->
ok = logger:add_handler(Name,
logger_std_h,
#{config => #{type => Type},
- filter_default=>log,
- filters=>?DEFAULT_HANDLER_FILTERS([Name]),
+ filter_default=>stop,
+ filters=>filter_only_this_domain(Name),
formatter=>{?MODULE,op}}),
{ok,HConfig = #{config := StdHConfig}} = logger:get_handler_config(Name),
{Log,HConfig,StdHConfig}.
+
+filter_only_this_domain(Name) ->
+ [{remote_gl,{fun logger_filters:remote_gl/2,stop}},
+ {domain,{fun logger_filters:domain/2,{log,super,[Name]}}}].
+
stop_handler(Name) ->
R = logger:remove_handler(Name),
ct:pal("Handler ~p stopped! Result: ~p", [Name,R]),
@@ -1642,7 +2041,7 @@ tpl([]) ->
tracer({trace,_,call,{logger_h_common,handle_cast,[Op|_]}},
{Pid,[{Mod,Func,Op}|Expected]}) ->
maybe_tracer_done(Pid,Expected,{Mod,Func,Op});
-tracer({trace,_,call,{Mod=logger_std_h,Func=write_to_dev,[_,Data,_,_,_]}},
+tracer({trace,_,call,{Mod=logger_std_h,Func=write_to_dev,[Data,_]}},
{Pid,[{Mod,Func,Data}|Expected]}) ->
maybe_tracer_done(Pid,Expected,{Mod,Func,Data});
tracer({trace,_,call,{Mod,Func,_}}, {Pid,[{Mod,Func}|Expected]}) ->
@@ -1726,4 +2125,3 @@ filesync_rep_int() ->
file_delete(Log) ->
file:delete(Log).
-
diff --git a/lib/kernel/test/logger_stress_SUITE.erl b/lib/kernel/test/logger_stress_SUITE.erl
index 4072e8c86a..1a278fb1b2 100644
--- a/lib/kernel/test/logger_stress_SUITE.erl
+++ b/lib/kernel/test/logger_stress_SUITE.erl
@@ -67,6 +67,10 @@ all() ->
reject_events,
std_handler,
disk_log_handler,
+ std_handler_time,
+ std_handler_time_big,
+ disk_log_handler_time,
+ disk_log_handler_time_big,
emulator_events,
remote_events,
remote_to_disk_log,
@@ -123,6 +127,20 @@ std_handler(cleanup,_Config) ->
_ = file:delete("default.log"),
ok.
+%% Disable overload protection and just print a lot - measure time.
+%% The IOPS reported is the number of log events written per millisecond.
+std_handler_time(Config) ->
+ measure_handler_time(logger_std_h,#{type=>{file,"default.log"}},Config).
+std_handler_time(cleanup,_Config) ->
+ _ = file:delete("default.log"),
+ ok.
+
+std_handler_time_big(Config) ->
+ measure_handler_time_big(logger_std_h,#{type=>{file,"default.log"}},Config).
+std_handler_time_big(cleanup,_Config) ->
+ _ = file:delete("default.log"),
+ ok.
+
%% Cascading failure that produce gen_server and proc_lib reports -
%% how many of the produced log events are actually written to a log
%% with logger_disk_log_h wrap file handler.
@@ -140,6 +158,20 @@ disk_log_handler(cleanup,_Config) ->
[_ = file:delete(F) || F <- Files],
ok.
+%% Disable overload protection and just print a lot - measure time.
+%% The IOPS reported is the number of log events written per millisecond.
+disk_log_handler_time(Config) ->
+ measure_handler_time(logger_disk_log_h,#{type=>halt},Config).
+disk_log_handler_time(cleanup,_Config) ->
+ _ = file:delete("default"),
+ ok.
+
+disk_log_handler_time_big(Config) ->
+ measure_handler_time_big(logger_disk_log_h,#{type=>halt},Config).
+disk_log_handler_time_big(cleanup,_Config) ->
+ _ = file:delete("default"),
+ ok.
+
%% Cascading failure that produce log events from the emulator - how
%% many of the produced log events pass through the proxy.
emulator_events(Config) ->
@@ -221,6 +253,68 @@ remote_emulator_to_disk_log(cleanup,_Config) ->
%%%-----------------------------------------------------------------
%%% Internal functions
+measure_handler_time(Module,HCfg,Config) ->
+ measure_handler_time(Module,100000,small_fa(),millisecond,HCfg,#{},Config).
+
+measure_handler_time_big(Module,HCfg,Config) ->
+ FCfg = #{chars_limit=>4096, max_size=>1024},
+ measure_handler_time(Module,100,big_fa(),second,HCfg,FCfg,Config).
+
+measure_handler_time(Module,N,FA,Unit,HCfg,FCfg,Config) ->
+ {ok,_,Node} =
+ logger_test_lib:setup(
+ Config,
+ [{logger,
+ [{handler,default,Module,
+ #{formatter => {logger_formatter,
+ maps:merge(#{legacy_header=>false,
+ single_line=>true},FCfg)},
+ config=>maps:merge(#{sync_mode_qlen => N+1,
+ drop_mode_qlen => N+1,
+ flush_qlen => N+1,
+ burst_limit_enable => false,
+ filesync_repeat_interval => no_repeat},
+ HCfg)}}]}]),
+ %% HPid = rpc:call(Node,erlang,whereis,[?name_to_reg_name(Module,default)]),
+ %% {links,[_,FCPid]} = rpc:call(Node,erlang,process_info,[HPid,links]),
+ T0 = erlang:monotonic_time(millisecond),
+ ok = rpc:call(Node,?MODULE,nlogs_wait,[N,FA,Module]),
+ %% ok = rpc:call(Node,fprof,apply,[fun ?MODULE:nlogs_wait/2,[N div 10,FA,Module],[{procs,[HPid,FCPid]}]]),
+ T1 = erlang:monotonic_time(millisecond),
+ T = T1-T0,
+ M = case Unit of
+ millisecond -> 1;
+ second -> 1000
+ end,
+ IOPS = M*N/T,
+ ct:pal("N: ~p~nT: ~p~nIOPS: ~.2f events pr ~w",[N,T,IOPS,Unit]),
+ %% Stats = rpc:call(Node,logger_olp,info,[?name_to_reg_name(Module,default)]),
+ %% ct:pal("Stats: ~p",[Stats]),
+ ct_event:notify(#event{name = benchmark_data,
+ data = [{value,IOPS}]}),
+ {comment,io_lib:format("~.2f events written pr ~w",[IOPS,Unit])}.
+
+nlogs_wait(N,{F,A},Module) ->
+ group_leader(whereis(user),self()),
+ [?LOG_NOTICE(F,A) || _ <- lists:seq(1,N)],
+ wait(Module).
+
+wait(Module) ->
+ case Module:filesync(default) of
+ {error,handler_busy} ->
+ wait(Module);
+ ok ->
+ ok
+ end.
+
+small_fa() ->
+ Str = "\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "[\\]^_`abcdefghijklmnopqr",
+ {"~ts",[Str]}.
+
+big_fa() ->
+ {"~p",[lists:duplicate(1048576,"a")]}.
+
nlogs(N) ->
group_leader(whereis(user),self()),
Str = "\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ"
diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk
index 4b43c6ae9d..7bebe1ba70 100644
--- a/lib/kernel/vsn.mk
+++ b/lib/kernel/vsn.mk
@@ -1 +1 @@
-KERNEL_VSN = 6.2
+KERNEL_VSN = 6.3
diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml
index 8fc3610bb6..01d1666b8d 100644
--- a/lib/mnesia/doc/src/notes.xml
+++ b/lib/mnesia/doc/src/notes.xml
@@ -39,7 +39,22 @@
thus constitutes one section in this document. The title of each
section is the version number of Mnesia.</p>
- <section><title>Mnesia 4.15.5</title>
+ <section><title>Mnesia 4.15.6</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Avoid overload warnings caused by a race condition.</p>
+ <p>
+ Own Id: OTP-15619 Aux Id: ERIERL-310 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Mnesia 4.15.5</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/mnesia/examples/bench/README b/lib/mnesia/examples/bench/README
index 3648fb59da..b8209b19b8 100644
--- a/lib/mnesia/examples/bench/README
+++ b/lib/mnesia/examples/bench/README
@@ -46,7 +46,7 @@ you need to:
- put the $ERL_TOP/bin directory in your path on all nodes
- bind IP adresses to hostnames (e.g via DNS or /etc/hosts)
- - enable usage of rsh so it does not prompt for password
+ - enable usage of ssh so it does not prompt for password
If you cannot achieve this, it is possible to run the benchmark
anyway, but it requires more manual work to be done for each
diff --git a/lib/mnesia/src/mnesia_dumper.erl b/lib/mnesia/src/mnesia_dumper.erl
index a2880d6cf4..8ab11be2d3 100644
--- a/lib/mnesia/src/mnesia_dumper.erl
+++ b/lib/mnesia/src/mnesia_dumper.erl
@@ -67,10 +67,10 @@ get_log_writes() ->
incr_log_writes() ->
Left = mnesia_lib:incr_counter(trans_log_writes_left, -1),
if
- Left > 0 ->
- ignore;
+ Left =:= 0 ->
+ adjust_log_writes(true);
true ->
- adjust_log_writes(true)
+ ignore
end.
adjust_log_writes(DoCast) ->
@@ -272,17 +272,12 @@ do_insert_rec(Tid, Rec, InPlace, InitBy, LogV) ->
end
end,
D = Rec#commit.disc_copies,
- ExtOps = commit_ext(Rec),
insert_ops(Tid, disc_copies, D, InPlace, InitBy, LogV),
- [insert_ops(Tid, Ext, Ops, InPlace, InitBy, LogV) ||
- {Ext, Ops} <- ExtOps,
- storage_semantics(Ext) == disc_copies],
+ insert_ext_ops(Tid, commit_ext(Rec), InPlace, InitBy),
case InitBy of
startup ->
DO = Rec#commit.disc_only_copies,
- insert_ops(Tid, disc_only_copies, DO, InPlace, InitBy, LogV),
- [insert_ops(Tid, Ext, Ops, InPlace, InitBy, LogV) ||
- {Ext, Ops} <- ExtOps, storage_semantics(Ext) == disc_only_copies];
+ insert_ops(Tid, disc_only_copies, DO, InPlace, InitBy, LogV);
_ ->
ignore
end.
@@ -290,11 +285,8 @@ do_insert_rec(Tid, Rec, InPlace, InitBy, LogV) ->
commit_ext(#commit{ext = []}) -> [];
commit_ext(#commit{ext = Ext}) ->
case lists:keyfind(ext_copies, 1, Ext) of
- {_, C} ->
- lists:foldl(fun({Ext0, Op}, D) ->
- orddict:append(Ext0, Op, D)
- end, orddict:new(), C);
- false -> []
+ {_, C} -> C;
+ false -> []
end.
update(_Tid, [], _DumperMode) ->
@@ -330,6 +322,21 @@ perform_update(Tid, SchemaOps, _DumperMode, _UseDir) ->
fatal("Schema update error ~tp ~tp", [{Reason,ST}, SchemaOps])
end.
+insert_ext_ops(Tid, ExtOps, InPlace, InitBy) ->
+ %% Note: ext ops cannot be part of pre-4.3 logs, so there's no need
+ %% to support the old operation order, as in `insert_ops'
+ lists:foreach(
+ fun ({Ext, Op}) ->
+ case storage_semantics(Ext) of
+ Semantics when Semantics == disc_copies;
+ Semantics == disc_only_copies, InitBy == startup ->
+ insert_op(Tid, Ext, Op, InPlace, InitBy);
+ _Other ->
+ ok
+ end
+ end,
+ ExtOps).
+
insert_ops(_Tid, _Storage, [], _InPlace, _InitBy, _) -> ok;
insert_ops(Tid, Storage, [Op], InPlace, InitBy, Ver) when Ver >= "4.3"->
insert_op(Tid, Storage, Op, InPlace, InitBy),
diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk
index 1cfb35c774..781a4830a0 100644
--- a/lib/mnesia/vsn.mk
+++ b/lib/mnesia/vsn.mk
@@ -1 +1 @@
-MNESIA_VSN = 4.15.5
+MNESIA_VSN = 4.15.6
diff --git a/lib/observer/doc/src/notes.xml b/lib/observer/doc/src/notes.xml
index 22035af982..2d914f8c61 100644
--- a/lib/observer/doc/src/notes.xml
+++ b/lib/observer/doc/src/notes.xml
@@ -32,6 +32,45 @@
<p>This document describes the changes made to the Observer
application.</p>
+<section><title>Observer 2.9</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Since Logger was introduced in OTP-21.0, menu choice
+ <em>Log &gt; Toggle Log View</em> in observer would cause
+ a crash unless an <c>error_logger</c> event handler was
+ explicitly installed. This is now corrected.</p>
+ <p>
+ Own Id: OTP-15553 Aux Id: ERL-848 </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Since persistent_term was introduced, observer would
+ sometimes crash when expanding a term from a process
+ state. This is now corrected.</p>
+ <p>
+ Own Id: OTP-15493 Aux Id: ERL-810 </p>
+ </item>
+ <item>
+ <p>
+ Add <c>OBSERVER_SCALE</c> environment variable for HiDPI
+ support.</p>
+ <p>
+ Own Id: OTP-15586 Aux Id: PR-2105 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Observer 2.8.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/observer/src/cdv_detail_wx.erl b/lib/observer/src/cdv_detail_wx.erl
index 4b1984c394..5e1137511a 100644
--- a/lib/observer/src/cdv_detail_wx.erl
+++ b/lib/observer/src/cdv_detail_wx.erl
@@ -84,8 +84,9 @@ destroy_progress(_) ->
ok.
init(Id,ParentFrame,Callback,App,Parent,{Title,Info,TW}) ->
+ Scale = observer_wx:get_scale(),
Frame=wxFrame:new(ParentFrame, ?wxID_ANY, [Title],
- [{style, ?wxDEFAULT_FRAME_STYLE}, {size, {850,600}}]),
+ [{style, ?wxDEFAULT_FRAME_STYLE}, {size, {Scale*850,Scale*600}}]),
MenuBar = wxMenuBar:new(),
create_menus(MenuBar),
wxFrame:setMenuBar(Frame, MenuBar),
diff --git a/lib/observer/src/cdv_table_wx.erl b/lib/observer/src/cdv_table_wx.erl
index 0f28a51017..0cad272262 100644
--- a/lib/observer/src/cdv_table_wx.erl
+++ b/lib/observer/src/cdv_table_wx.erl
@@ -50,11 +50,12 @@ init([ParentWin, {ColumnSpec,Info,TW}]) ->
end,
Grid = wxListCtrl:new(ParentWin, [{style, Style}]),
Li = wxListItem:new(),
+ Scale = observer_wx:get_scale(),
AddListEntry = fun({Name, Align, DefSize}, Col) ->
wxListItem:setText(Li, Name),
wxListItem:setAlign(Li, Align),
wxListCtrl:insertColumn(Grid, Col, Li),
- wxListCtrl:setColumnWidth(Grid, Col, DefSize),
+ wxListCtrl:setColumnWidth(Grid, Col, DefSize*Scale),
Col + 1
end,
lists:foldl(AddListEntry, 0, ColumnSpec),
diff --git a/lib/observer/src/cdv_virtual_list_wx.erl b/lib/observer/src/cdv_virtual_list_wx.erl
index 2702301021..14877b7eab 100644
--- a/lib/observer/src/cdv_virtual_list_wx.erl
+++ b/lib/observer/src/cdv_virtual_list_wx.erl
@@ -132,11 +132,12 @@ create_list_box(Panel, Holder, Callback, Owner) ->
end}
]),
Li = wxListItem:new(),
+ Scale = observer_wx:get_scale(),
AddListEntry = fun({Name, Align, DefSize}, Col) ->
wxListItem:setText(Li, Name),
wxListItem:setAlign(Li, Align),
wxListCtrl:insertColumn(ListCtrl, Col, Li),
- wxListCtrl:setColumnWidth(ListCtrl, Col, DefSize),
+ wxListCtrl:setColumnWidth(ListCtrl, Col, DefSize*Scale),
Col + 1
end,
ListItems = Callback:col_spec(),
diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl
index f64a278a64..7100cc8790 100644
--- a/lib/observer/src/cdv_wx.erl
+++ b/lib/observer/src/cdv_wx.erl
@@ -101,8 +101,9 @@ init(File0) ->
{ok,CdvServer} = crashdump_viewer:start_link(),
catch wxSystemOptions:setOption("mac.listctrl.always_use_generic", 1),
+ Scale = observer_wx:get_scale(),
Frame = wxFrame:new(wx:null(), ?wxID_ANY, "Crashdump Viewer",
- [{size, {850, 600}}, {style, ?wxDEFAULT_FRAME_STYLE}]),
+ [{size, {Scale*850, Scale*600}}, {style, ?wxDEFAULT_FRAME_STYLE}]),
IconFile = filename:join(code:priv_dir(observer), "erlang_observer.png"),
Icon = wxIcon:new(IconFile, [{type,?wxBITMAP_TYPE_PNG}]),
wxFrame:setIcon(Frame, Icon),
diff --git a/lib/observer/src/observer_alloc_wx.erl b/lib/observer/src/observer_alloc_wx.erl
index 54e246f247..da47a30fb1 100644
--- a/lib/observer/src/observer_alloc_wx.erl
+++ b/lib/observer/src/observer_alloc_wx.erl
@@ -282,11 +282,12 @@ create_mem_info(Parent) ->
Grid = wxListCtrl:new(Parent, [{style, Style}]),
Li = wxListItem:new(),
+ Scale = observer_wx:get_scale(),
AddListEntry = fun({Name, Align, DefSize}, Col) ->
wxListItem:setText(Li, Name),
wxListItem:setAlign(Li, Align),
wxListCtrl:insertColumn(Grid, Col, Li),
- wxListCtrl:setColumnWidth(Grid, Col, DefSize),
+ wxListCtrl:setColumnWidth(Grid, Col, DefSize*Scale),
Col + 1
end,
ListItems = [{"Allocator Type", ?wxLIST_FORMAT_LEFT, 200},
diff --git a/lib/observer/src/observer_app_wx.erl b/lib/observer/src/observer_app_wx.erl
index 2a481966da..8c3eef5411 100644
--- a/lib/observer/src/observer_app_wx.erl
+++ b/lib/observer/src/observer_app_wx.erl
@@ -117,16 +117,19 @@ init([Notebook, Parent, _Config]) ->
UseGC = haveGC(),
Version28 = ?wxMAJOR_VERSION =:= 2 andalso ?wxMINOR_VERSION =:= 8,
+ Scale = observer_wx:get_scale(),
Font = case os:type() of
{unix,_} when UseGC, Version28 ->
- wxFont:new(12,?wxFONTFAMILY_DECORATIVE,?wxFONTSTYLE_NORMAL,?wxFONTWEIGHT_NORMAL);
+ wxFont:new(Scale * 12,?wxFONTFAMILY_DECORATIVE,?wxFONTSTYLE_NORMAL,?wxFONTWEIGHT_NORMAL);
_ ->
- wxSystemSettings:getFont(?wxSYS_DEFAULT_GUI_FONT)
+ Font0 = wxSystemSettings:getFont(?wxSYS_DEFAULT_GUI_FONT),
+ wxFont:setPointSize(Font0, Scale * wxFont:getPointSize(Font0)),
+ Font0
end,
SelCol = wxSystemSettings:getColour(?wxSYS_COLOUR_HIGHLIGHT),
GreyBrush = wxBrush:new({230,230,240}),
SelBrush = wxBrush:new(SelCol),
- LinkPen = wxPen:new(SelCol, [{width, 2}]),
+ LinkPen = wxPen:new(SelCol, [{width, Scale * 2}]),
process_flag(trap_exit, true),
{Panel, #state{parent=Parent,
panel =Panel,
@@ -134,7 +137,7 @@ init([Notebook, Parent, _Config]) ->
app_w =DrawingArea,
usegc = UseGC,
paint=#paint{font = Font,
- pen = wxPen:new({80,80,80}, [{width, 2}]),
+ pen = wxPen:new({80,80,80}, [{width, Scale * 2}]),
brush= GreyBrush,
sel = SelBrush,
links= LinkPen
diff --git a/lib/observer/src/observer_perf_wx.erl b/lib/observer/src/observer_perf_wx.erl
index 21c6d26f49..79271addf2 100644
--- a/lib/observer/src/observer_perf_wx.erl
+++ b/lib/observer/src/observer_perf_wx.erl
@@ -110,25 +110,26 @@ setup_graph_drawing(Panels) ->
_ = [Do(Panel) || Panel <- Panels],
UseGC = haveGC(),
Version28 = ?wxMAJOR_VERSION =:= 2 andalso ?wxMINOR_VERSION =:= 8,
+ Scale = observer_wx:get_scale(),
{Font, SmallFont}
= if UseGC, Version28 ->
%% Def font is really small when using Graphics contexts in 2.8
%% Hardcode it
- F = wxFont:new(12,?wxFONTFAMILY_DECORATIVE,?wxFONTSTYLE_NORMAL,?wxFONTWEIGHT_BOLD),
- SF = wxFont:new(10, ?wxFONTFAMILY_DECORATIVE, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL),
+ F = wxFont:new(Scale * 12,?wxFONTFAMILY_DECORATIVE,?wxFONTSTYLE_NORMAL,?wxFONTWEIGHT_BOLD),
+ SF = wxFont:new(Scale * 10, ?wxFONTFAMILY_DECORATIVE, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL),
{F, SF};
true ->
DefFont = wxSystemSettings:getFont(?wxSYS_DEFAULT_GUI_FONT),
DefSize = wxFont:getPointSize(DefFont),
DefFamily = wxFont:getFamily(DefFont),
- F = wxFont:new(DefSize-1, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_BOLD),
- SF = wxFont:new(DefSize-2, DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL),
+ F = wxFont:new(Scale * (DefSize-1), DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_BOLD),
+ SF = wxFont:new(Scale * (DefSize-2), DefFamily, ?wxFONTSTYLE_NORMAL, ?wxFONTWEIGHT_NORMAL),
{F, SF}
end,
- BlackPen = wxPen:new({0,0,0}, [{width, 1}]),
- Pens = [wxPen:new(Col, [{width, 1}, {style, ?wxSOLID}])
+ BlackPen = wxPen:new({0,0,0}, [{width, Scale}]),
+ Pens = [wxPen:new(Col, [{width, Scale}, {style, ?wxSOLID}])
|| Col <- tuple_to_list(colors())],
- DotPens = [wxPen:new(Col, [{width, 1}, {style, ?wxDOT}])
+ DotPens = [wxPen:new(Col, [{width, Scale}, {style, ?wxDOT}])
|| Col <- tuple_to_list(colors())],
#paint{usegc = UseGC,
font = Font,
diff --git a/lib/observer/src/observer_port_wx.erl b/lib/observer/src/observer_port_wx.erl
index 445f3dd6b1..00cf1b5fba 100644
--- a/lib/observer/src/observer_port_wx.erl
+++ b/lib/observer/src/observer_port_wx.erl
@@ -96,11 +96,12 @@ init([Notebook, Parent, Config]) ->
wxListCtrl:setColumnWidth(Grid, Col, DefSize),
Col + 1
end,
- ListItems = [{"Id", ?wxLIST_FORMAT_LEFT, 150},
- {"Connected", ?wxLIST_FORMAT_LEFT, 150},
- {"Name", ?wxLIST_FORMAT_LEFT, 150},
- {"Controls", ?wxLIST_FORMAT_LEFT, 200},
- {"Slot", ?wxLIST_FORMAT_RIGHT, 50}],
+ Scale = observer_wx:get_scale(),
+ ListItems = [{"Id", ?wxLIST_FORMAT_LEFT, Scale*150},
+ {"Connected", ?wxLIST_FORMAT_LEFT, Scale*150},
+ {"Name", ?wxLIST_FORMAT_LEFT, Scale*150},
+ {"Controls", ?wxLIST_FORMAT_LEFT, Scale*200},
+ {"Slot", ?wxLIST_FORMAT_RIGHT, Scale*50}],
lists:foldl(AddListEntry, 0, ListItems),
wxListItem:destroy(Li),
@@ -461,10 +462,11 @@ display_port_info(Parent, PortRec, Opened) ->
do_display_port_info(Parent0, PortRec) ->
Parent = observer_lib:get_wx_parent(Parent0),
Title = "Port Info: " ++ PortRec#port.id_str,
+ Scale = observer_wx:get_scale(),
Frame = wxMiniFrame:new(Parent, ?wxID_ANY, Title,
[{style, ?wxSYSTEM_MENU bor ?wxCAPTION
bor ?wxCLOSE_BOX bor ?wxRESIZE_BORDER},
- {size,{600,400}}]),
+ {size,{Scale * 600, Scale * 400}}]),
ScrolledWin = wxScrolledWindow:new(Frame,[{style,?wxHSCROLL bor ?wxVSCROLL}]),
wxScrolledWindow:enableScrolling(ScrolledWin,true,true),
wxScrolledWindow:setScrollbars(ScrolledWin,20,20,0,0),
diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl
index 04e654a37e..4ab4a78462 100644
--- a/lib/observer/src/observer_pro_wx.erl
+++ b/lib/observer/src/observer_pro_wx.erl
@@ -163,13 +163,14 @@ create_list_box(Panel, Holder) ->
wxListCtrl:setColumnWidth(ListCtrl, Col, DefSize),
Col + 1
end,
- ListItems = [{"Pid", ?wxLIST_FORMAT_CENTRE, 120},
- {"Name or Initial Func", ?wxLIST_FORMAT_LEFT, 200},
-%% {"Time", ?wxLIST_FORMAT_CENTRE, 50},
- {"Reds", ?wxLIST_FORMAT_RIGHT, 100},
- {"Memory", ?wxLIST_FORMAT_RIGHT, 100},
- {"MsgQ", ?wxLIST_FORMAT_RIGHT, 50},
- {"Current Function", ?wxLIST_FORMAT_LEFT, 200}],
+ Scale = observer_wx:get_scale(),
+ ListItems = [{"Pid", ?wxLIST_FORMAT_CENTRE, Scale*120},
+ {"Name or Initial Func", ?wxLIST_FORMAT_LEFT, Scale*200},
+%% {"Time", ?wxLIST_FORMAT_CENTRE, Scale*50},
+ {"Reds", ?wxLIST_FORMAT_RIGHT, Scale*100},
+ {"Memory", ?wxLIST_FORMAT_RIGHT, Scale*100},
+ {"MsgQ", ?wxLIST_FORMAT_RIGHT, Scale*50},
+ {"Current Function", ?wxLIST_FORMAT_LEFT, Scale*200}],
lists:foldl(AddListEntry, 0, ListItems),
wxListItem:destroy(Li),
diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl
index f436886735..bd5fed0951 100644
--- a/lib/observer/src/observer_procinfo.erl
+++ b/lib/observer/src/observer_procinfo.erl
@@ -59,8 +59,9 @@ init([Pid, ParentFrame, Parent]) ->
{registered_name, Registered} -> io_lib:format("~tp (~p)",[Registered, Pid]);
undefined -> throw(process_undefined)
end,
+ Scale = observer_wx:get_scale(),
Frame=wxFrame:new(ParentFrame, ?wxID_ANY, [atom_to_list(node(Pid)), $:, Title],
- [{style, ?wxDEFAULT_FRAME_STYLE}, {size, {850,600}}]),
+ [{style, ?wxDEFAULT_FRAME_STYLE}, {size, {Scale * 850, Scale * 600}}]),
MenuBar = wxMenuBar:new(),
create_menus(MenuBar),
wxFrame:setMenuBar(Frame, MenuBar),
@@ -245,12 +246,13 @@ init_dict_page(Parent, Pid, Table) ->
init_stack_page(Parent, Pid) ->
LCtrl = wxListCtrl:new(Parent, [{style, ?wxLC_REPORT bor ?wxLC_HRULES}]),
Li = wxListItem:new(),
+ Scale = observer_wx:get_scale(),
wxListItem:setText(Li, "Module:Function/Arg"),
wxListCtrl:insertColumn(LCtrl, 0, Li),
- wxListCtrl:setColumnWidth(LCtrl, 0, 300),
+ wxListCtrl:setColumnWidth(LCtrl, 0, Scale * 300),
wxListItem:setText(Li, "File:LineNumber"),
wxListCtrl:insertColumn(LCtrl, 1, Li),
- wxListCtrl:setColumnWidth(LCtrl, 1, 300),
+ wxListCtrl:setColumnWidth(LCtrl, 1, Scale * 300),
wxListItem:destroy(Li),
Update = fun() ->
case observer_wx:try_rpc(node(Pid), erlang, process_info,
diff --git a/lib/observer/src/observer_trace_wx.erl b/lib/observer/src/observer_trace_wx.erl
index 2c3b46a3a1..f458c8c34a 100644
--- a/lib/observer/src/observer_trace_wx.erl
+++ b/lib/observer/src/observer_trace_wx.erl
@@ -188,8 +188,9 @@ create_proc_port_view(Parent) ->
wxListCtrl:setColumnWidth(Procs, Col, DefSize),
Col + 1
end,
- ProcListItems = [{"Process Id", ?wxLIST_FORMAT_CENTER, 120},
- {"Trace Options", ?wxLIST_FORMAT_LEFT, 300}],
+ Scale = observer_wx:get_scale(),
+ ProcListItems = [{"Process Id", ?wxLIST_FORMAT_CENTER, Scale*120},
+ {"Trace Options", ?wxLIST_FORMAT_LEFT, Scale*300}],
lists:foldl(AddProc, 0, ProcListItems),
AddPort = fun({Name, Align, DefSize}, Col) ->
@@ -199,8 +200,8 @@ create_proc_port_view(Parent) ->
wxListCtrl:setColumnWidth(Ports, Col, DefSize),
Col + 1
end,
- PortListItems = [{"Port Id", ?wxLIST_FORMAT_CENTER, 120},
- {"Trace Options", ?wxLIST_FORMAT_LEFT, 300}],
+ PortListItems = [{"Port Id", ?wxLIST_FORMAT_CENTER, Scale*120},
+ {"Trace Options", ?wxLIST_FORMAT_LEFT, Scale*300}],
lists:foldl(AddPort, 0, PortListItems),
wxListItem:destroy(Li),
@@ -242,14 +243,15 @@ create_matchspec_view(Parent) ->
Funcs = wxListCtrl:new(Splitter, [{winid, ?FUNCS_WIN}, {style, Style}]),
Li = wxListItem:new(),
+ Scale = observer_wx:get_scale(),
wxListItem:setText(Li, "Modules"),
wxListCtrl:insertColumn(Modules, 0, Li),
wxListItem:setText(Li, "Functions"),
wxListCtrl:insertColumn(Funcs, 0, Li),
- wxListCtrl:setColumnWidth(Funcs, 0, 150),
+ wxListCtrl:setColumnWidth(Funcs, 0, Scale*150),
wxListItem:setText(Li, "Match Spec"),
wxListCtrl:insertColumn(Funcs, 1, Li),
- wxListCtrl:setColumnWidth(Funcs, 1, 300),
+ wxListCtrl:setColumnWidth(Funcs, 1, Scale*300),
wxListItem:destroy(Li),
wxSplitterWindow:setSashGravity(Splitter, 0.0),
@@ -969,7 +971,8 @@ output_file(true, true, Opts) ->
create_logwindow(_Parent, false) -> {false, false};
create_logwindow(Parent, true) ->
- LogWin = wxFrame:new(Parent, ?LOG_WIN, "Trace Log", [{size, {750, 800}}]),
+ Scale = observer_wx:get_scale(),
+ LogWin = wxFrame:new(Parent, ?LOG_WIN, "Trace Log", [{size, {750*Scale, 800*Scale}}]),
MB = wxMenuBar:new(),
File = wxMenu:new(),
wxMenu:append(File, ?LOG_CLEAR, "Clear Log\tCtrl-C"),
diff --git a/lib/observer/src/observer_traceoptions_wx.erl b/lib/observer/src/observer_traceoptions_wx.erl
index ea292b92af..514d55ff24 100644
--- a/lib/observer/src/observer_traceoptions_wx.erl
+++ b/lib/observer/src/observer_traceoptions_wx.erl
@@ -167,9 +167,10 @@ select_nodes(Parent, Nodes) ->
check_selector(Parent, Choices).
module_selector(Parent, Node) ->
+ Scale = observer_wx:get_scale(),
Dialog = wxDialog:new(Parent, ?wxID_ANY, "Select Module or Event",
[{style, ?wxDEFAULT_DIALOG_STYLE bor ?wxRESIZE_BORDER},
- {size, {400, 400}}]),
+ {size, {400*Scale, 400*Scale}}]),
Panel = wxPanel:new(Dialog),
PanelSz = wxBoxSizer:new(?wxVERTICAL),
MainSz = wxBoxSizer:new(?wxVERTICAL),
@@ -237,9 +238,10 @@ function_selector(Parent, Node, Module) ->
end.
check_selector(Parent, ParsedChoices) ->
+ Scale = observer_wx:get_scale(),
Dialog = wxDialog:new(Parent, ?wxID_ANY, "Trace Functions",
[{style, ?wxDEFAULT_DIALOG_STYLE bor ?wxRESIZE_BORDER},
- {size, {400, 400}}]),
+ {size, {400*Scale, 400*Scale}}]),
Panel = wxPanel:new(Dialog),
PanelSz = wxBoxSizer:new(?wxVERTICAL),
@@ -331,9 +333,10 @@ select_matchspec(Pid, Parent, AllMatchSpecs, Key) ->
{value,{Key,MSs0},Rest} -> {MSs0,Rest};
false -> {[],AllMatchSpecs}
end,
+ Scale = observer_wx:get_scale(),
Dialog = wxDialog:new(Parent, ?wxID_ANY, "Trace Match Specifications",
[{style, ?wxDEFAULT_DIALOG_STYLE bor ?wxRESIZE_BORDER},
- {size, {400, 400}}]),
+ {size, {400*Scale, 400*Scale}}]),
Panel = wxPanel:new(Dialog),
PanelSz = wxBoxSizer:new(?wxVERTICAL),
diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl
index d6dcee2cda..7bd67a0f0b 100644
--- a/lib/observer/src/observer_tv_table.erl
+++ b/lib/observer/src/observer_tv_table.erl
@@ -99,7 +99,8 @@ init([Parent, Opts]) ->
ets -> "TV Ets: " ++ Title0;
mnesia -> "TV Mnesia: " ++ Title0
end,
- Frame = wxFrame:new(Parent, ?wxID_ANY, Title, [{size, {800, 600}}]),
+ Scale = observer_wx:get_scale(),
+ Frame = wxFrame:new(Parent, ?wxID_ANY, Title, [{size, {Scale * 800, Scale * 600}}]),
IconFile = filename:join(code:priv_dir(observer), "erlang_observer.png"),
Icon = wxIcon:new(IconFile, [{type,?wxBITMAP_TYPE_PNG}]),
wxFrame:setIcon(Frame, Icon),
diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl
index dfd19569fd..9743a6ed42 100644
--- a/lib/observer/src/observer_tv_wx.erl
+++ b/lib/observer/src/observer_tv_wx.erl
@@ -87,12 +87,13 @@ init([Notebook, Parent, Config]) ->
wxListCtrl:setColumnWidth(Grid, Col, DefSize),
Col + 1
end,
- ListItems = [{"Table Name", ?wxLIST_FORMAT_LEFT, 200},
- {"Objects", ?wxLIST_FORMAT_RIGHT, 100},
- {"Size (kB)", ?wxLIST_FORMAT_RIGHT, 100},
- {"Owner Pid", ?wxLIST_FORMAT_CENTER, 150},
- {"Owner Name", ?wxLIST_FORMAT_LEFT, 200},
- {"Table Id", ?wxLIST_FORMAT_LEFT, 250}
+ Scale = observer_wx:get_scale(),
+ ListItems = [{"Table Name", ?wxLIST_FORMAT_LEFT, Scale*200},
+ {"Objects", ?wxLIST_FORMAT_RIGHT, Scale*100},
+ {"Size (kB)", ?wxLIST_FORMAT_RIGHT, Scale*100},
+ {"Owner Pid", ?wxLIST_FORMAT_CENTER, Scale*150},
+ {"Owner Name", ?wxLIST_FORMAT_LEFT, Scale*200},
+ {"Table Id", ?wxLIST_FORMAT_LEFT, Scale*250}
],
lists:foldl(AddListEntry, 0, ListItems),
wxListItem:destroy(Li),
diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl
index 1f748cb8d2..de7d821030 100644
--- a/lib/observer/src/observer_wx.erl
+++ b/lib/observer/src/observer_wx.erl
@@ -22,7 +22,7 @@
-export([start/0, stop/0]).
-export([create_menus/2, get_attrib/1, get_tracer/0, get_active_node/0, get_menubar/0,
- set_status/1, create_txt_dialog/4, try_rpc/4, return_to_localnode/2]).
+ get_scale/0, set_status/1, create_txt_dialog/4, try_rpc/4, return_to_localnode/2]).
-export([init/1, handle_event/2, handle_cast/2, terminate/2, code_change/3,
handle_call/3, handle_info/2, check_page_title/1]).
@@ -91,14 +91,24 @@ get_active_node() ->
get_menubar() ->
wx_object:call(observer, get_menubar).
+get_scale() ->
+ ScaleStr = os:getenv("OBSERVER_SCALE", "1"),
+ try list_to_integer(ScaleStr) of
+ Scale when Scale < 1 -> 1;
+ Scale -> Scale
+ catch _:_ ->
+ 1
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
init(_Args) ->
register(observer, self()),
wx:new(),
catch wxSystemOptions:setOption("mac.listctrl.always_use_generic", 1),
+ Scale = get_scale(),
Frame = wxFrame:new(wx:null(), ?wxID_ANY, "Observer",
- [{size, {850, 600}}, {style, ?wxDEFAULT_FRAME_STYLE}]),
+ [{size, {Scale * 850, Scale * 600}}, {style, ?wxDEFAULT_FRAME_STYLE}]),
IconFile = filename:join(code:priv_dir(observer), "erlang_observer.png"),
Icon = wxIcon:new(IconFile, [{type,?wxBITMAP_TYPE_PNG}]),
wxFrame:setIcon(Frame, Icon),
@@ -771,7 +781,11 @@ ensure_sasl_started(Node) ->
ensure_mf_h_handler_used(Node) ->
%% is log_mf_h used ?
- Handlers = rpc:block_call(Node, gen_event, which_handlers, [error_logger]),
+ Handlers =
+ case rpc:block_call(Node, gen_event, which_handlers, [error_logger]) of
+ {badrpc,{'EXIT',noproc}} -> []; % OTP-21+ and no event handler exists
+ Hs -> Hs
+ end,
case lists:any(fun(L)-> L == log_mf_h end, Handlers) of
false -> throw("Error: log_mf_h handler not used in sasl."),
error;
diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl
index d6b5eff9b5..84ed99afa5 100644
--- a/lib/observer/test/crashdump_helper.erl
+++ b/lib/observer/test/crashdump_helper.erl
@@ -24,7 +24,7 @@
create_binaries/0,create_sub_binaries/1,
dump_persistent_terms/0,
create_persistent_terms/0]).
--compile(r18).
+-compile(r20).
-include_lib("common_test/include/ct.hrl").
n1_proc(N2,Creator) ->
diff --git a/lib/observer/vsn.mk b/lib/observer/vsn.mk
index 5ce0aca589..0e9c8b302c 100644
--- a/lib/observer/vsn.mk
+++ b/lib/observer/vsn.mk
@@ -1 +1 @@
-OBSERVER_VSN = 2.8.2
+OBSERVER_VSN = 2.9
diff --git a/lib/odbc/c_src/Makefile.in b/lib/odbc/c_src/Makefile.in
index 784e73c47e..294d832797 100644
--- a/lib/odbc/c_src/Makefile.in
+++ b/lib/odbc/c_src/Makefile.in
@@ -52,7 +52,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/odbc-$(VSN)
# Target Specs
# ----------------------------------------------------
EI_ROOT = $(ERL_TOP)/lib/erl_interface
-EI_INCLUDE = -I$(EI_ROOT)/include
+EI_INCLUDE = -I$(EI_ROOT)/include -I$(EI_ROOT)/include/$(TARGET)
ifeq ($(findstring win32,$(TARGET)),win32)
EI_LIB = -lerl_interface_md -lei_md
ENTRY_OBJ=$(ERL_TOP)/erts/obj/$(TARGET)/port_entry.o
diff --git a/lib/odbc/doc/src/notes.xml b/lib/odbc/doc/src/notes.xml
index dba7663bb9..696fcaa479 100644
--- a/lib/odbc/doc/src/notes.xml
+++ b/lib/odbc/doc/src/notes.xml
@@ -32,7 +32,22 @@
<p>This document describes the changes made to the odbc application.
</p>
- <section><title>ODBC 2.12.2</title>
+ <section><title>ODBC 2.12.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Enhance error handling to avoid stack corruption</p>
+ <p>
+ Own Id: OTP-15667 Aux Id: ERL-808, PR-2065 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>ODBC 2.12.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/odbc/vsn.mk b/lib/odbc/vsn.mk
index bb21016fad..ff023e666b 100644
--- a/lib/odbc/vsn.mk
+++ b/lib/odbc/vsn.mk
@@ -1 +1 @@
-ODBC_VSN = 2.12.2
+ODBC_VSN = 2.12.3
diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml
index b3e6023c41..f6bc0dc797 100644
--- a/lib/public_key/doc/src/notes.xml
+++ b/lib/public_key/doc/src/notes.xml
@@ -35,6 +35,21 @@
<file>notes.xml</file>
</header>
+<section><title>Public_Key 1.6.5</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Add export of dialyzer type</p>
+ <p>
+ Own Id: OTP-15624</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Public_Key 1.6.4</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml
index 4c61139197..fb81ea68a4 100644
--- a/lib/public_key/doc/src/public_key.xml
+++ b/lib/public_key/doc/src/public_key.xml
@@ -423,7 +423,7 @@
<p>Available options:</p>
<taglist>
- <tag>{verify_fun, fun()}</tag>
+ <tag>{verify_fun, {fun(), InitialUserState::term()}</tag>
<item>
<p>The fun must be defined as:</p>
@@ -644,7 +644,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{},
<v>conf_opt() = {cert, der_encoded()} | {key, PrivateKey} |{cacerts, [der_encoded()]}</v>
<d>
This is a subset of the type
- <seealso marker="ssl:ssl#type-ssloption"> ssl:ssl_option()</seealso>.
+ <seealso marker="ssl:ssl#type-tls_option"> ssl:tls_option()</seealso>.
<c>PrivateKey</c> is what
<seealso marker="#generate_key-1">generate_key/1</seealso>
returns.
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index 75d40d2e8a..47c5dbb95a 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -66,7 +66,7 @@
-export_type([public_key/0, private_key/0, pem_entry/0,
pki_asn1_type/0, asn1_type/0, ssh_file/0, der_encoded/0,
- key_params/0, digest_type/0]).
+ key_params/0, digest_type/0, issuer_name/0, oid/0]).
-type public_key() :: rsa_public_key() | dsa_public_key() | ec_public_key() | ed_public_key() .
-type private_key() :: rsa_private_key() | dsa_private_key() | ec_private_key() | ed_private_key() .
diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk
index 5e2643f0ea..11c06fb158 100644
--- a/lib/public_key/vsn.mk
+++ b/lib/public_key/vsn.mk
@@ -1 +1 @@
-PUBLIC_KEY_VSN = 1.6.4
+PUBLIC_KEY_VSN = 1.6.5
diff --git a/lib/reltool/doc/src/reltool.xml b/lib/reltool/doc/src/reltool.xml
index 5afbad0ba8..136ec2ed69 100644
--- a/lib/reltool/doc/src/reltool.xml
+++ b/lib/reltool/doc/src/reltool.xml
@@ -503,6 +503,7 @@ sys() = {root_dir, root_dir()}
| {incl_cond, incl_cond()}
| {boot_rel, boot_rel()}
| {rel, rel_name(), rel_vsn(), [rel_app()]}
+ | {rel, rel_name(), rel_vsn(), [rel_app()], [rel_opt()]}
| {relocatable, relocatable()}
| {app_file, app_file()}
| {debug_info, debug_info()}
@@ -534,6 +535,7 @@ rel_app() = app_name()
| {app_name(), app_type()}
| {app_name(), [incl_app()]}
| {app_name(), app_type(), [incl_app()]}
+rel_opt() = {load_dot_erlang, boolean()}
app_name() = atom()
app_type() = permanent | transient | temporary | load | none
app_vsn() = string()
diff --git a/lib/reltool/doc/src/reltool_examples.xml b/lib/reltool/doc/src/reltool_examples.xml
index f9a6fcf342..3888b643a2 100644
--- a/lib/reltool/doc/src/reltool_examples.xml
+++ b/lib/reltool/doc/src/reltool_examples.xml
@@ -313,9 +313,12 @@ Erlang/OTP 20 [erts-10.0] [source-c13b302] [64-bit] [smp:4:4] [ds:4:4:10] [async
[hipe] [kernel-poll:false]
Eshell V10.0 (abort with ^G)
1&gt;
-1&gt; {ok, Server} = reltool:start_server([{config, {sys, [{boot_rel, "NAME"},
- {rel, "NAME", "VSN",
- [sasl]}]}}]).
+1&gt; {ok, Server} = reltool:start_server([{config,
+ {sys,
+ [{boot_rel, "NAME"},
+ {rel, "NAME", "VSN",
+ [sasl],
+ [{load_dot_erlang, false}]}]}}]).
{ok,&lt;0.1288.0&gt;}
2&gt;
2&gt; reltool:get_config(Server).
diff --git a/lib/reltool/src/reltool.hrl b/lib/reltool/src/reltool.hrl
index d133762818..892aaf8649 100644
--- a/lib/reltool/src/reltool.hrl
+++ b/lib/reltool/src/reltool.hrl
@@ -61,6 +61,7 @@
| {app_name(), app_type()}
| {app_name(), [incl_app()]}
| {app_name(), app_type(), [incl_app()]}.
+-type rel_opt() :: {load_dot_erlang, boolean()}.
-type mod() :: {incl_cond, incl_cond()}
| {debug_info, debug_info()}.
-type app() :: {vsn, app_vsn()}
@@ -92,6 +93,8 @@
| {lib_dirs, [lib_dir()]}
| {boot_rel, boot_rel()}
| {rel, rel_name(), rel_vsn(), [rel_app()]}
+ | {rel, rel_name(), rel_vsn(),
+ [rel_app()], [rel_opt()]}
| {relocatable, relocatable()}
| {erts, app()}
| {escript, escript_file(), [escript()]}
diff --git a/lib/reltool/src/reltool_server.erl b/lib/reltool/src/reltool_server.erl
index 47aba77835..2de8000fd8 100644
--- a/lib/reltool/src/reltool_server.erl
+++ b/lib/reltool/src/reltool_server.erl
@@ -1483,6 +1483,18 @@ decode(#sys{rels = Rels} = Sys, [{rel, Name, Vsn, RelApps} | SysKeyVals])
Rel = #rel{name = Name, vsn = Vsn, rel_apps = []},
Rel2 = decode(Rel, RelApps),
decode(Sys#sys{rels = [Rel2 | Rels]}, SysKeyVals);
+decode(#sys{rels = Rels} = Sys, [{rel, Name, Vsn, RelApps, Opts} | SysKeyVals])
+ when is_list(Name), is_list(Vsn), is_list(RelApps), is_list(Opts) ->
+ Rel1 = lists:foldl(fun(Opt, Rel0) ->
+ case Opt of
+ {load_dot_erlang, Value} when is_boolean(Value) ->
+ Rel0#rel{load_dot_erlang = Value};
+ _ ->
+ reltool_utils:throw_error("Illegal rel option: ~tp", [Opt])
+ end
+ end, #rel{name = Name, vsn = Vsn, rel_apps = []}, Opts),
+ Rel2 = decode(Rel1, RelApps),
+ decode(Sys#sys{rels = [Rel2 | Rels]}, SysKeyVals);
decode(#sys{} = Sys, [{Key, Val} | KeyVals]) ->
Sys3 =
case Key of
diff --git a/lib/reltool/src/reltool_target.erl b/lib/reltool/src/reltool_target.erl
index 64834ecc1d..dfa62479a0 100644
--- a/lib/reltool/src/reltool_target.erl
+++ b/lib/reltool/src/reltool_target.erl
@@ -108,12 +108,8 @@ do_gen_config(#sys{root_dir = RootDir,
emit(incl_cond, A#app.incl_cond, undefined, InclDefs)}
|| A <- Apps, A#app.is_escript],
DefaultRels = reltool_utils:default_rels(),
- RelsItems =
- [{rel, R#rel.name, R#rel.vsn, do_gen_config(R, InclDefs)} ||
- R <- Rels],
- DefaultRelsItems =
- [{rel, R#rel.name, R#rel.vsn, do_gen_config(R, InclDefs)} ||
- R <- DefaultRels],
+ RelsItems = [do_gen_config(R, InclDefs) || R <- Rels],
+ DefaultRelsItems = [do_gen_config(R, InclDefs) || R <- DefaultRels],
RelsItems2 =
case InclDefs of
true -> RelsItems;
@@ -201,11 +197,20 @@ do_gen_config(#mod{name = Name,
_ ->
[]
end;
-do_gen_config(#rel{name = _Name,
- vsn = _Vsn,
- rel_apps = RelApps},
- InclDefs) ->
- [do_gen_config(RA, InclDefs) || RA <- RelApps];
+do_gen_config(#rel{name = Name,
+ vsn = Vsn,
+ rel_apps = RelApps,
+ load_dot_erlang = LoadDotErlang},
+ InclDefs) ->
+ RelAppsConfig = [do_gen_config(RA, InclDefs) || RA <- RelApps],
+ if
+ LoadDotErlang =:= false ->
+ {rel, Name, Vsn, RelAppsConfig, [{load_dot_erlang, false}]};
+ InclDefs =:= true ->
+ {rel, Name, Vsn, RelAppsConfig, [{load_dot_erlang, true}]};
+ LoadDotErlang =:= true ->
+ {rel, Name, Vsn, RelAppsConfig}
+ end;
do_gen_config(#rel_app{name = Name,
app_type = Type,
incl_apps = InclApps},
diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl
index 990bd5c217..bb092e8bbf 100644
--- a/lib/reltool/test/reltool_server_SUITE.erl
+++ b/lib/reltool/test/reltool_server_SUITE.erl
@@ -102,6 +102,7 @@ all() ->
create_release,
create_release_sort,
create_script,
+ create_script_without_dot_erlang,
create_script_sort,
create_target,
create_target_unicode,
@@ -171,7 +172,7 @@ break(_Config) ->
start_server(_Config) ->
{ok, Pid} = ?msym({ok, _}, reltool:start_server([])),
- Libs = lists:sort(erl_libs()),
+ Libs = reltool_test_lib:erl_libs(),
StrippedDefault =
case Libs of
[] -> {sys, []};
@@ -185,7 +186,7 @@ start_server(_Config) ->
%% Start a server process and check that it does not crash
set_config(_Config) ->
- Libs = lists:sort(erl_libs()),
+ Libs = reltool_test_lib:erl_libs(),
Default =
{sys,
[
@@ -219,7 +220,15 @@ get_config(_Config) ->
StdLibDir = filename:join(LibDir,"stdlib-"++StdVsn),
SaslLibDir = filename:join(LibDir,"sasl-"++SaslVsn),
- Sys = {sys,[{incl_cond, exclude},
+ Libs = reltool_test_lib:erl_libs(),
+ LibDirs =
+ case Libs of
+ [] -> [];
+ _ -> [{lib_dirs,Libs}]
+ end,
+
+ Sys = {sys,LibDirs ++
+ [{incl_cond, exclude},
{app,kernel,[{incl_cond,include}]},
{app,sasl,[{incl_cond,include},{vsn,SaslVsn}]},
{app,stdlib,[{incl_cond,include},{lib_dir,StdLibDir}]}]},
@@ -228,13 +237,27 @@ get_config(_Config) ->
?m({ok, Sys}, reltool:get_config(Pid,false,false)),
%% Include derived info
- ?msym({ok,{sys,[{incl_cond, exclude},
- {erts,[]},
- {app,kernel,[{incl_cond,include},{mod,_,[]}|_]},
- {app,sasl,[{incl_cond,include},{vsn,SaslVsn},{mod,_,[]}|_]},
- {app,stdlib,[{incl_cond,include},{lib_dir,StdLibDir},
- {mod,_,[]}|_]}]}},
- reltool:get_config(Pid,false,true)),
+ case Libs of
+ [] ->
+ ?msym({ok,{sys,[{incl_cond, exclude},
+ {erts,[]},
+ {app,kernel,[{incl_cond,include},{mod,_,[]}|_]},
+ {app,sasl,[{incl_cond,include},{vsn,SaslVsn},
+ {mod,_,[]}|_]},
+ {app,stdlib,[{incl_cond,include},{lib_dir,StdLibDir},
+ {mod,_,[]}|_]}]}},
+ reltool:get_config(Pid,false,true));
+ _ ->
+ ?msym({ok,{sys,[{lib_dirs,Libs},
+ {incl_cond, exclude},
+ {erts,[]},
+ {app,kernel,[{incl_cond,include},{mod,_,[]}|_]},
+ {app,sasl,[{incl_cond,include},{vsn,SaslVsn},
+ {mod,_,[]}|_]},
+ {app,stdlib,[{incl_cond,include},{lib_dir,StdLibDir},
+ {mod,_,[]}|_]}]}},
+ reltool:get_config(Pid,false,true))
+ end,
%% Include defaults
?msym({ok,{sys,[{root_dir,_},
@@ -248,9 +271,9 @@ get_config(_Config) ->
{app,stdlib,[{incl_cond,include},{vsn,undefined},
{lib_dir,StdLibDir}]},
{boot_rel,"start_clean"},
- {rel,"no_dot_erlang","1.0",[]},
- {rel,"start_clean","1.0",[]},
- {rel,"start_sasl","1.0",[sasl]},
+ {rel,"no_dot_erlang","1.0",[],[{load_dot_erlang,false}]},
+ {rel,"start_clean","1.0",[],[{load_dot_erlang,true}]},
+ {rel,"start_sasl","1.0",[sasl],[{load_dot_erlang,true}]},
{emu_name,"beam"},
{relocatable,true},
{profile,development},
@@ -279,9 +302,9 @@ get_config(_Config) ->
{app,stdlib,[{incl_cond,include},{vsn,StdVsn},
{lib_dir,StdLibDir},{mod,_,[]}|_]},
{boot_rel,"start_clean"},
- {rel,"no_dot_erlang","1.0",[]},
- {rel,"start_clean","1.0",[]},
- {rel,"start_sasl","1.0",[sasl]},
+ {rel,"no_dot_erlang","1.0",[],[{load_dot_erlang,false}]},
+ {rel,"start_clean","1.0",[],[{load_dot_erlang,true}]},
+ {rel,"start_sasl","1.0",[sasl],[{load_dot_erlang,true}]},
{emu_name,"beam"},
{relocatable,true},
{profile,development},
@@ -305,11 +328,11 @@ get_config(_Config) ->
%% OTP-9135, test that app_file option can be set to all | keep | strip
otp_9135(_Config) ->
- Libs = lists:sort(erl_libs()),
+ Libs = reltool_test_lib:erl_libs(),
StrippedDefaultSys =
case Libs of
[] -> [];
- _ -> {lib_dirs, Libs}
+ _ -> [{lib_dirs, Libs}]
end,
Config1 = {sys,[{app_file, keep}]}, % this is the default
@@ -549,6 +572,32 @@ create_script(_Config) ->
?m(equal, diff_script(OrigScript, Script)),
+ %% A release defaults to load_dot_erlang == true
+ {script, {RelName, RelVsn}, ScriptInstructions} = Script,
+ ?m(true, lists:member({apply,{c,erlangrc,[]}}, ScriptInstructions)),
+
+ %% Stop server
+ ?m(ok, reltool:stop(Pid)),
+ ok.
+
+create_script_without_dot_erlang(_Config) ->
+ %% Configure the server
+ RelName = "Just testing",
+ RelVsn = "1.0",
+ Config =
+ {sys,
+ [
+ {lib_dirs, []},
+ {boot_rel, RelName},
+ {rel, RelName, RelVsn, [stdlib, kernel], [{load_dot_erlang, false}]}
+ ]},
+ {ok, Pid} = ?msym({ok, _}, reltool:start_server([{config, Config}])),
+
+ %% Confirm that load_dot_erlang == false was used
+ {ok, Script} = ?msym({ok, _}, reltool:get_script(Pid, RelName)),
+ {script, {RelName, RelVsn}, ScriptInstructions} = Script,
+ ?m(false, lists:member({apply,{c,erlangrc,[]}}, ScriptInstructions)),
+
%% Stop server
?m(ok, reltool:stop(Pid)),
ok.
@@ -1719,13 +1768,19 @@ set_sys_and_undo(Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
load_config_and_undo(Config) ->
- Sys1 = {sys,[{incl_cond, exclude},
- {app,kernel,[{incl_cond,include}]},
- {app,sasl,[{incl_cond,include}]},
- {app,stdlib,[{incl_cond,include}]},
- {app,tools,[{incl_cond,include}]}]},
+ Sys1 = {sys,Cfg1=[{incl_cond, exclude},
+ {app,kernel,[{incl_cond,include}]},
+ {app,sasl,[{incl_cond,include}]},
+ {app,stdlib,[{incl_cond,include}]},
+ {app,tools,[{incl_cond,include}]}]},
{ok, Pid} = ?msym({ok, _}, reltool:start_server([{config, Sys1}])),
- ?m({ok, Sys1}, reltool:get_config(Pid)),
+ Libs = reltool_test_lib:erl_libs(),
+ Sys11 =
+ case Libs of
+ [] -> Sys1;
+ _ -> {sys, [{lib_dirs, Libs}|Cfg1]}
+ end,
+ ?m({ok, Sys11}, reltool:get_config(Pid)),
?m({ok,[]}, reltool_server:get_status(Pid)),
%% Get app and mod
@@ -1780,13 +1835,19 @@ load_config_and_undo(Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Test that load_config is properly rolled back if it fails
load_config_fail(_Config) ->
- Sys1 = {sys,[{incl_cond, exclude},
- {app,kernel,[{incl_cond,include}]},
- {app,sasl,[{incl_cond,include}]},
- {app,stdlib,[{incl_cond,include}]},
- {app,tools,[{incl_cond,include}]}]},
+ Sys1 = {sys,Cfg1=[{incl_cond, exclude},
+ {app,kernel,[{incl_cond,include}]},
+ {app,sasl,[{incl_cond,include}]},
+ {app,stdlib,[{incl_cond,include}]},
+ {app,tools,[{incl_cond,include}]}]},
{ok, Pid} = ?msym({ok, _}, reltool:start_server([{config, Sys1}])),
- ?m({ok, Sys1}, reltool:get_config(Pid)),
+ Libs = reltool_test_lib:erl_libs(),
+ Sys11 =
+ case Libs of
+ [] -> Sys1;
+ _ -> {sys, [{lib_dirs, Libs}|Cfg1]}
+ end,
+ ?m({ok, Sys11}, reltool:get_config(Pid)),
?m({ok,[]}, reltool_server:get_status(Pid)),
%% Get app and mod
@@ -1804,7 +1865,7 @@ load_config_fail(_Config) ->
reltool_server:load_config(Pid,Sys2)),
%% Check that a rollback is done to the old configuration
- ?m({ok, Sys1}, reltool:get_config(Pid,false,false)),
+ ?m({ok, Sys11}, reltool:get_config(Pid,false,false)),
%% and that tools is not changed (i.e. that the new configuration
%% is not applied)
@@ -2074,25 +2135,42 @@ gen_rel_files(_Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
save_config(Config) ->
PrivDir = ?config(priv_dir,Config),
- Sys = {sys,[{incl_cond, exclude},
- {app,kernel,[{incl_cond,include}]},
- {app,sasl,[{incl_cond,include}]},
- {app,stdlib,[{incl_cond,include}]}]},
+ Sys = {sys,Cfg=[{incl_cond, exclude},
+ {app,kernel,[{incl_cond,include}]},
+ {app,sasl,[{incl_cond,include}]},
+ {app,stdlib,[{incl_cond,include}]}]},
{ok, Pid} = ?msym({ok, _}, reltool:start_server([{config, Sys}])),
- ?m({ok, Sys}, reltool:get_config(Pid)),
+ Libs = reltool_test_lib:erl_libs(),
+ Sys1 =
+ case Libs of
+ [] -> Sys;
+ _ -> {sys, [{lib_dirs, Libs}|Cfg]}
+ end,
+ ?m({ok, Sys1}, reltool:get_config(Pid)),
Simple = filename:join(PrivDir,"save_simple.reltool"),
?m(ok, reltool_server:save_config(Pid,Simple,false,false)),
- ?m({ok,[Sys]}, file:consult(Simple)),
+ ?m({ok,[Sys1]}, file:consult(Simple)),
Derivates = filename:join(PrivDir,"save_derivates.reltool"),
?m(ok, reltool_server:save_config(Pid,Derivates,false,true)),
- ?msym({ok,[{sys,[{incl_cond, exclude},
- {erts,[]},
- {app,kernel,[{incl_cond,include},{mod,_,[]}|_]},
- {app,sasl,[{incl_cond,include},{mod,_,[]}|_]},
- {app,stdlib,[{incl_cond,include},{mod,_,[]}|_]}]}]},
- file:consult(Derivates)),
+ case Libs of
+ [] ->
+ ?msym({ok,[{sys,[{incl_cond, exclude},
+ {erts,[]},
+ {app,kernel,[{incl_cond,include},{mod,_,[]}|_]},
+ {app,sasl,[{incl_cond,include},{mod,_,[]}|_]},
+ {app,stdlib,[{incl_cond,include},{mod,_,[]}|_]}]}]},
+ file:consult(Derivates));
+ _ ->
+ ?msym({ok,[{sys,[{lib_dirs,Libs},
+ {incl_cond, exclude},
+ {erts,[]},
+ {app,kernel,[{incl_cond,include},{mod,_,[]}|_]},
+ {app,sasl,[{incl_cond,include},{mod,_,[]}|_]},
+ {app,stdlib,[{incl_cond,include},{mod,_,[]}|_]}]}]},
+ file:consult(Derivates))
+ end,
Defaults = filename:join(PrivDir,"save_defaults.reltool"),
?m(ok, reltool_server:save_config(Pid,Defaults,true,false)),
@@ -2107,9 +2185,9 @@ save_config(Config) ->
{app,stdlib,[{incl_cond,include},{vsn,undefined},
{lib_dir,undefined}]},
{boot_rel,"start_clean"},
- {rel,"no_dot_erlang","1.0",[]},
- {rel,"start_clean","1.0",[]},
- {rel,"start_sasl","1.0",[sasl]},
+ {rel,"no_dot_erlang","1.0",[],[{load_dot_erlang,false}]},
+ {rel,"start_clean","1.0",[],[{load_dot_erlang,true}]},
+ {rel,"start_sasl","1.0",[sasl],[{load_dot_erlang,true}]},
{emu_name,"beam"},
{relocatable,true},
{profile,development},
@@ -2148,9 +2226,9 @@ save_config(Config) ->
{app,stdlib,[{incl_cond,include},{vsn,StdVsn},
{lib_dir,StdLibDir},{mod,_,[]}|_]},
{boot_rel,"start_clean"},
- {rel,"no_dot_erlang","1.0",[]},
- {rel,"start_clean","1.0",[]},
- {rel,"start_sasl","1.0",[sasl]},
+ {rel,"no_dot_erlang","1.0",[],[{load_dot_erlang,false}]},
+ {rel,"start_clean","1.0",[],[{load_dot_erlang,true}]},
+ {rel,"start_sasl","1.0",[sasl],[{load_dot_erlang,true}]},
{emu_name,"beam"},
{relocatable,true},
{profile,development},
@@ -2560,9 +2638,6 @@ windows_erl_libs(_Config) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Library functions
-erl_libs() ->
- reltool_utils:erl_libs().
-
datadir(Config) ->
%% Removes the trailing slash...
filename:nativename(?config(data_dir,Config)).
diff --git a/lib/reltool/test/reltool_test_lib.erl b/lib/reltool/test/reltool_test_lib.erl
index be48ea4726..033d952d0a 100644
--- a/lib/reltool/test/reltool_test_lib.erl
+++ b/lib/reltool/test/reltool_test_lib.erl
@@ -237,7 +237,8 @@ wait_for_close() ->
wait_for_close()
end.
-
+erl_libs() ->
+ lists:sort([filename:absname(P) || P<-reltool_utils:erl_libs()]).
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% A small test server, which can be run standalone in a shell
diff --git a/lib/reltool/test/reltool_wx_SUITE.erl b/lib/reltool/test/reltool_wx_SUITE.erl
index f6f7721762..983c8f6c52 100644
--- a/lib/reltool/test/reltool_wx_SUITE.erl
+++ b/lib/reltool/test/reltool_wx_SUITE.erl
@@ -74,7 +74,12 @@ start_all_windows(_Config) ->
%% Test that server pid can be fetched, and that server is alive
{ok, Server} = ?msym({ok,_}, reltool:get_server(SysPid)),
?m(true, erlang:is_process_alive(Server)),
- ?m({ok,{sys,[]}}, reltool:get_config(Server)),
+ Sys =
+ case reltool_test_lib:erl_libs() of
+ [] -> [];
+ Libs -> [{lib_dirs,Libs}]
+ end,
+ ?m({ok,{sys,Sys}}, reltool:get_config(Server)),
%% Terminate
check_no_win_crash(),
diff --git a/lib/runtime_tools/doc/src/notes.xml b/lib/runtime_tools/doc/src/notes.xml
index 810bb8207c..58a2a66c4b 100644
--- a/lib/runtime_tools/doc/src/notes.xml
+++ b/lib/runtime_tools/doc/src/notes.xml
@@ -32,6 +32,21 @@
<p>This document describes the changes made to the Runtime_Tools
application.</p>
+<section><title>Runtime_Tools 1.13.2</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Update of systemtap trace example scripts.</p>
+ <p>
+ Own Id: OTP-15670</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Runtime_Tools 1.13.1</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/runtime_tools/vsn.mk b/lib/runtime_tools/vsn.mk
index aa3d702997..fa2f338ec2 100644
--- a/lib/runtime_tools/vsn.mk
+++ b/lib/runtime_tools/vsn.mk
@@ -1 +1 @@
-RUNTIME_TOOLS_VSN = 1.13.1
+RUNTIME_TOOLS_VSN = 1.13.2
diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl
index 101701cec6..c2c91fd667 100644
--- a/lib/sasl/src/systools_make.erl
+++ b/lib/sasl/src/systools_make.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1565,8 +1565,8 @@ preloaded() ->
[atomics,counters,erl_init,erl_prim_loader,erl_tracer,erlang,
erts_code_purger,erts_dirty_process_signal_handler,
erts_internal,erts_literal_area_collector,
- init,persistent_term,prim_buffer,prim_eval,prim_file,
- prim_inet,prim_zip,zlib].
+ init,net,persistent_term,prim_buffer,prim_eval,prim_file,
+ prim_inet,prim_zip,socket,zlib].
%%______________________________________________________________________
%% Kernel processes; processes that are specially treated by the init
diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl
index f5210d4f27..7867d3da39 100644
--- a/lib/sasl/test/test_lib.hrl
+++ b/lib/sasl/test/test_lib.hrl
@@ -1,3 +1,3 @@
-define(ertsvsn,"4.4").
--define(kernelvsn,"5.3").
--define(stdlibvsn,"3.4").
+-define(kernelvsn,"6.0").
+-define(stdlibvsn,"3.5").
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index 0bc4baf5eb..17f14bdea2 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -30,6 +30,23 @@
<file>notes.xml</file>
</header>
+<section><title>Ssh 4.7.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ SSH sftp daemon now accepts an SSH_FXP_STAT message
+ encoded according to the wrong sftp version. Some clients
+ sends such messages.</p>
+ <p>
+ Own Id: OTP-15498 Aux Id: ERL-822, PR-2077 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Ssh 4.7.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl
index 3e3e151781..b12ddfeef6 100644
--- a/lib/ssh/test/ssh_protocol_SUITE.erl
+++ b/lib/ssh/test/ssh_protocol_SUITE.erl
@@ -38,7 +38,11 @@
-define(EXTRA_KEX, 'diffie-hellman-group1-sha1').
-define(CIPHERS, ['aes256-ctr','aes192-ctr','aes128-ctr','aes128-cbc','3des-cbc']).
--define(DEFAULT_CIPHERS, [{client2server,?CIPHERS}, {server2client,?CIPHERS}]).
+-define(DEFAULT_CIPHERS, (fun() -> Ciphs = filter_supported(cipher, ?CIPHERS),
+ [{client2server,Ciphs}, {server2client,Ciphs}]
+ end)()
+ ).
+
-define(v(Key, Config), proplists:get_value(Key, Config)).
-define(v(Key, Config, Default), proplists:get_value(Key, Config, Default)).
diff --git a/lib/ssh/test/ssh_trpt_test_lib.erl b/lib/ssh/test/ssh_trpt_test_lib.erl
index 8de550af15..f2c9892f95 100644
--- a/lib/ssh/test/ssh_trpt_test_lib.erl
+++ b/lib/ssh/test/ssh_trpt_test_lib.erl
@@ -41,15 +41,20 @@
opts = [],
timeout = 5000, % ms
seen_hello = false,
- enc = <<>>,
ssh = #ssh{}, % #ssh{}
alg_neg = {undefined,undefined}, % {own_kexinit, peer_kexinit}
alg, % #alg{}
vars = dict:new(),
reply = [], % Some repy msgs are generated hidden in ssh_transport :[
prints = [],
- return_value
- }).
+ return_value,
+
+ %% Packet retrival and decryption
+ decrypted_data_buffer = <<>>,
+ encrypted_data_buffer = <<>>,
+ aead_data = <<>>,
+ undecrypted_packet_length
+ }).
-define(role(S), ((S#s.ssh)#ssh.role) ).
@@ -475,11 +480,11 @@ recv(S0 = #s{}) ->
%%%================================================================
try_find_crlf(Seen, S0) ->
- case erlang:decode_packet(line,S0#s.enc,[]) of
+ case erlang:decode_packet(line,S0#s.encrypted_data_buffer,[]) of
{more,_} ->
- Line = <<Seen/binary,(S0#s.enc)/binary>>,
+ Line = <<Seen/binary,(S0#s.encrypted_data_buffer)/binary>>,
S0#s{seen_hello = {more,Line},
- enc = <<>>, % didn't find a complete line
+ encrypted_data_buffer = <<>>, % didn't find a complete line
% -> no more characters to test
return_value = {more,Line}
};
@@ -490,13 +495,13 @@ try_find_crlf(Seen, S0) ->
S = opt(print_messages, S0,
fun(X) when X==true;X==detail -> {"Recv info~n~p~n",[Line]} end),
S#s{seen_hello = false,
- enc = Rest,
+ encrypted_data_buffer = Rest,
return_value = {info,Line}};
S1=#s{} ->
S = opt(print_messages, S1,
fun(X) when X==true;X==detail -> {"Recv hello~n~p~n",[Line]} end),
S#s{seen_hello = true,
- enc = Rest,
+ encrypted_data_buffer = Rest,
return_value = {hello,Line}}
end
end.
@@ -511,19 +516,73 @@ handle_hello(Bin, S=#s{ssh=C}) ->
{{Vp,Vs}, server} -> S#s{ssh = C#ssh{c_vsn=Vp, c_version=Vs}}
end.
-receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize,
+receive_binary_msg(S0=#s{}) ->
+ case ssh_transport:handle_packet_part(
+ S0#s.decrypted_data_buffer,
+ S0#s.encrypted_data_buffer,
+ S0#s.aead_data,
+ S0#s.undecrypted_packet_length,
+ S0#s.ssh)
+ of
+ {packet_decrypted, DecryptedBytes, EncryptedDataRest, Ssh1} ->
+ S1 = S0#s{ssh = Ssh1#ssh{recv_sequence = ssh_transport:next_seqnum(Ssh1#ssh.recv_sequence)},
+ decrypted_data_buffer = <<>>,
+ undecrypted_packet_length = undefined,
+ aead_data = <<>>,
+ encrypted_data_buffer = EncryptedDataRest},
+ case
+ catch ssh_message:decode(set_prefix_if_trouble(DecryptedBytes,S1))
+ of
+ {'EXIT',_} -> fail(decode_failed,S1);
+
+ Msg ->
+ Ssh2 = case Msg of
+ #ssh_msg_kexinit{} ->
+ ssh_transport:key_init(opposite_role(Ssh1), Ssh1, DecryptedBytes);
+ _ ->
+ Ssh1
+ end,
+ S2 = opt(print_messages, S1,
+ fun(X) when X==true;X==detail -> {"Recv~n~s~n",[format_msg(Msg)]} end),
+ S3 = opt(print_messages, S2,
+ fun(detail) -> {"decrypted bytes ~p~n",[DecryptedBytes]} end),
+ S3#s{ssh = inc_recv_seq_num(Ssh2),
+ return_value = Msg
+ }
+ end;
+
+ {get_more, DecryptedBytes, EncryptedDataRest, AeadData, TotalNeeded, Ssh1} ->
+ %% Here we know that there are not enough bytes in
+ %% EncryptedDataRest to use. We must wait for more.
+ Remaining = case TotalNeeded of
+ undefined -> 8;
+ _ -> TotalNeeded - size(DecryptedBytes) - size(EncryptedDataRest)
+ end,
+ receive_binary_msg(
+ receive_wait(Remaining,
+ S0#s{encrypted_data_buffer = EncryptedDataRest,
+ decrypted_data_buffer = DecryptedBytes,
+ undecrypted_packet_length = TotalNeeded,
+ aead_data = AeadData,
+ ssh = Ssh1}
+ ))
+ end.
+
+
+
+old_receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize,
recv_mac_size = MacSize
}
}) ->
- case size(S0#s.enc) >= max(8,BlockSize) of
+ case size(S0#s.encrypted_data_buffer) >= max(8,BlockSize) of
false ->
%% Need more bytes to decode the packet_length field
- Remaining = max(8,BlockSize) - size(S0#s.enc),
+ Remaining = max(8,BlockSize) - size(S0#s.encrypted_data_buffer),
receive_binary_msg( receive_wait(Remaining, S0) );
true ->
%% Has enough bytes to decode the packet_length field
{_, <<?UINT32(PacketLen), _/binary>>, _} =
- ssh_transport:decrypt_blocks(S0#s.enc, BlockSize, C0), % FIXME: BlockSize should be at least 4
+ ssh_transport:decrypt_blocks(S0#s.encrypted_data_buffer, BlockSize, C0), % FIXME: BlockSize should be at least 4
%% FIXME: Check that ((4+PacketLen) rem BlockSize) == 0 ?
@@ -534,19 +593,19 @@ receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize,
((4+PacketLen) rem BlockSize) =/= 0 ->
fail(bad_packet_length_modulo, S0); % FIXME: disconnect
- size(S0#s.enc) >= (4 + PacketLen + MacSize) ->
+ size(S0#s.encrypted_data_buffer) >= (4 + PacketLen + MacSize) ->
%% has the whole packet
S0;
true ->
%% need more bytes to get have the whole packet
- Remaining = (4 + PacketLen + MacSize) - size(S0#s.enc),
+ Remaining = (4 + PacketLen + MacSize) - size(S0#s.encrypted_data_buffer),
receive_wait(Remaining, S0)
end,
%% Decrypt all, including the packet_length part (re-use the initial #ssh{})
{C1, SshPacket = <<?UINT32(_),?BYTE(PadLen),Tail/binary>>, EncRest} =
- ssh_transport:decrypt_blocks(S1#s.enc, PacketLen+4, C0),
+ ssh_transport:decrypt_blocks(S1#s.encrypted_data_buffer, PacketLen+4, C0),
PayloadLen = PacketLen - 1 - PadLen,
<<CompressedPayload:PayloadLen/binary, _Padding:PadLen/binary>> = Tail,
@@ -573,7 +632,7 @@ receive_binary_msg(S0=#s{ssh=C0=#ssh{decrypt_block_size = BlockSize,
S3 = opt(print_messages, S2,
fun(detail) -> {"decrypted bytes ~p~n",[SshPacket]} end),
S3#s{ssh = inc_recv_seq_num(C3),
- enc = Rest,
+ encrypted_data_buffer = Rest,
return_value = Msg
}
end
@@ -602,7 +661,7 @@ receive_poll(S=#s{socket=Sock}) ->
inet:setopts(Sock, [{active,once}]),
receive
{tcp,Sock,Data} ->
- receive_poll( S#s{enc = <<(S#s.enc)/binary,Data/binary>>} );
+ receive_poll( S#s{encrypted_data_buffer = <<(S#s.encrypted_data_buffer)/binary,Data/binary>>} );
{tcp_closed,Sock} ->
throw({tcp,tcp_closed});
{tcp_error, Sock, Reason} ->
@@ -616,7 +675,7 @@ receive_wait(S=#s{socket=Sock,
inet:setopts(Sock, [{active,once}]),
receive
{tcp,Sock,Data} ->
- S#s{enc = <<(S#s.enc)/binary,Data/binary>>};
+ S#s{encrypted_data_buffer = <<(S#s.encrypted_data_buffer)/binary,Data/binary>>};
{tcp_closed,Sock} ->
throw({tcp,tcp_closed});
{tcp_error, Sock, Reason} ->
@@ -627,11 +686,11 @@ receive_wait(S=#s{socket=Sock,
receive_wait(N, S=#s{socket=Sock,
timeout=Timeout,
- enc=Enc0}) when N>0 ->
+ encrypted_data_buffer=Enc0}) when N>0 ->
inet:setopts(Sock, [{active,once}]),
receive
{tcp,Sock,Data} ->
- receive_wait(N-size(Data), S#s{enc = <<Enc0/binary,Data/binary>>});
+ receive_wait(N-size(Data), S#s{encrypted_data_buffer = <<Enc0/binary,Data/binary>>});
{tcp_closed,Sock} ->
throw({tcp,tcp_closed});
{tcp_error, Sock, Reason} ->
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 2890d7fe5b..0f9eee887c 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,4 +1,4 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 4.7.3
+SSH_VSN = 4.7.4
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/doc/specs/.gitignore b/lib/ssl/doc/specs/.gitignore
new file mode 100644
index 0000000000..322eebcb06
--- /dev/null
+++ b/lib/ssl/doc/specs/.gitignore
@@ -0,0 +1 @@
+specs_*.xml
diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile
index c72b6d6cc4..7cf251d8f9 100644
--- a/lib/ssl/doc/src/Makefile
+++ b/lib/ssl/doc/src/Makefile
@@ -80,11 +80,16 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
+SPECS_FILES = $(XML_REF3_FILES:%.xml=$(SPECDIR)/specs_%.xml)
+
+TOP_SPECS_FILE = specs.xml
+
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
XML_FLAGS +=
DVIPS_FLAGS +=
+SPECS_FLAGS = -I../../../public_key/include -I../../../public_key/src -I../../..
# ----------------------------------------------------
# Targets
@@ -92,7 +97,7 @@ DVIPS_FLAGS +=
$(HTMLDIR)/%.gif: %.gif
$(INSTALL_DATA) $< $@
-docs: pdf html man
+docs: html pdf man
$(TOP_PDF_FILE): $(XML_FILES)
@@ -105,6 +110,7 @@ clean clean_docs:
rm -rf $(XMLDIR)
rm -f $(MAN3DIR)/*
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+ rm -f $(SPECS_FILES)
rm -f errs core *~
man: $(MAN3_FILES) $(MAN6_FILES)
diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml
index 82eb8ff700..732fdc71e7 100644
--- a/lib/ssl/doc/src/notes.xml
+++ b/lib/ssl/doc/src/notes.xml
@@ -27,6 +27,93 @@
</header>
<p>This document describes the changes made to the SSL application.</p>
+<section><title>SSL 9.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix bug that an incorrect return value for gen_statem
+ could be created when alert was a result of handling
+ renegotiation info extension</p>
+ <p>
+ Own Id: OTP-15502</p>
+ </item>
+ <item>
+ <p>
+ Correct check for 3des_ede_cbc, could cause ssl to claim
+ to support 3des_ede_cbc when cryptolib does not.</p>
+ <p>
+ Own Id: OTP-15539</p>
+ </item>
+ <item>
+ <p>
+ Improved DTLS error handling, avoids unexpected
+ connection failure in rare cases.</p>
+ <p>
+ Own Id: OTP-15561</p>
+ </item>
+ <item>
+ <p>
+ Corrected active once emulation bug that could cause the
+ ssl_closed meassage to not be sent. Bug introduced by
+ OTP-15449</p>
+ <p>
+ Own Id: OTP-15666 Aux Id: ERIERL-316, </p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Add client option {reuse_session, SessionID::binary()}
+ that can be used together with new option value
+ {reuse_sessions, save}. This makes it possible to reuse a
+ session from a specific connection establishment.</p>
+ <p>
+ Own Id: OTP-15369</p>
+ </item>
+ <item>
+ <p>
+ The Reason part of of the error return from the functions
+ connect and handshake has a better and documented format.
+ This will sometimes differ from previous returned
+ reasons, however those where only documented as term()
+ and should for that reason not be relied on.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-15423</p>
+ </item>
+ <item>
+ <p>
+ Refactor of state handling to improve TLS application
+ data throughput and reduce CPU overhead</p>
+ <p>
+ Own Id: OTP-15445</p>
+ </item>
+ <item>
+ <p>
+ The SSL code has been optimized in many small ways to
+ reduce CPU load for encryption/decryption, especially for
+ Erlang's distribution protocol over TLS.</p>
+ <p>
+ Own Id: OTP-15529</p>
+ </item>
+ <item>
+ <p>
+ Add support for active N</p>
+ <p>
+ Own Id: OTP-15665 Aux Id: ERL-811, PR-2072 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>SSL 9.1.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/ssl/doc/src/specs.xml b/lib/ssl/doc/src/specs.xml
new file mode 100644
index 0000000000..50e9428fec
--- /dev/null
+++ b/lib/ssl/doc/src/specs.xml
@@ -0,0 +1,9 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<specs xmlns:xi="http://www.w3.org/2001/XInclude">
+ <xi:include href="../specs/specs_ssl_crl_cache_api.xml"/>
+ <xi:include href="../specs/specs_ssl_crl_cache.xml"/>
+ <xi:include href="../specs/specs_ssl_session_cache_api.xml"/>
+ <xi:include href="../specs/specs_ssl.xml"/>
+</specs>
+
+
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 200fb89a4d..60fa70c90c 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -37,296 +37,364 @@
<seealso marker="ssl_app">ssl(6)</seealso>.
</p>
</description>
-
- <section>
- <title>DATA TYPES</title>
- <p>The following data types are used in the functions for SSL/TLS/DTLS:</p>
-
- <taglist>
-
- <tag><c>boolean() =</c></tag>
- <item><p><c>true | false</c></p></item>
-
- <tag><c>option() =</c></tag>
- <item><p><c>socketoption() | ssl_option() | transport_option()</c></p>
- </item>
-
- <tag><c>socketoption() =</c></tag>
- <item><p><c>proplists:property()</c></p>
- <p>The default socket options are
- <c>[{mode,list},{packet, 0},{header, 0},{active, true}]</c>.</p>
- <p>For valid options, see the
- <seealso marker="kernel:inet">inet(3)</seealso>,
- <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> and
- <seealso marker="kernel:gen_tcp">gen_udp(3)</seealso>
- manual pages
- in Kernel. Note that stream oriented options such as packet are only relevant for SSL/TLS and not DTLS</p></item>
-
- <tag><marker id="type-ssloption"/><c>ssl_option() =</c></tag>
- <item>
- <p><c>{verify, verify_type()}</c></p>
- <p><c>| {verify_fun, {fun(), term()}}</c></p>
- <p><c>| {fail_if_no_peer_cert, boolean()}</c></p>
- <p><c>| {depth, integer()}</c></p>
- <p><c>| {cert, public_key:der_encoded()}</c></p>
- <p><c>| {certfile, path()}</c></p>
- <p><c>| {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey'
- | 'PrivateKeyInfo', public_key:der_encoded()} |
- #{algorithm := rsa | dss | ecdsa,
- engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}</c></p>
- <p><c>| {keyfile, path()}</c></p>
- <p><c>| {password, string()}</c></p>
- <p><c>| {cacerts, [public_key:der_encoded()]}</c></p>
- <p><c>| {cacertfile, path()}</c></p>
- <p><c>| {dh, public_key:der_encoded()}</c></p>
- <p><c>| {dhfile, path()}</c></p>
- <p><c>| {ciphers, ciphers()}</c></p>
- <p><c>| {user_lookup_fun, {fun(), term()}}, {psk_identity, string()},
- {srp_identity, {string(), string()}}</c></p>
- <p><c>| {reuse_sessions, boolean() | save()}</c></p>
- <p><c>| {reuse_session, fun() | binary()} </c></p>
- <p><c>| {next_protocols_advertised, [binary()]}</c></p>
- <p><c>| {client_preferred_next_protocols, {client | server,
- [binary()]} | {client | server, [binary()], binary()}}</c></p>
- <p><c>| {log_alert, boolean()}</c></p>
- <p><c>| {log_level, atom()}</c></p>
- <p><c>| {server_name_indication, hostname() | disable}</c></p>
- <p><c>| {customize_hostname_check, list()}</c></p>
- <p><c>| {sni_hosts, [{hostname(), [ssl_option()]}]}</c></p>
- <p><c>| {sni_fun, SNIfun::fun()}</c></p>
- </item>
-
- <tag><c>transport_option() =</c></tag>
- <item><p><c>{cb_info, {CallbackModule::atom(), DataTag::atom(),
-
- ClosedTag::atom(), ErrTag:atom()}}</c></p>
- <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c> for TLS
- and <c>{gen_udp, udp, udp_closed, udp_error}</c> for DTLS. Can be used
- to customize the transport layer. For TLS the callback module must implement a
- reliable transport protocol, behave as <c>gen_tcp</c>, and have functions
- corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>,
- <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>.
- The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c>
- directly. For DTLS this feature must be considered exprimental.</p>
- <taglist>
- <tag><c>CallbackModule =</c></tag>
- <item><p><c>atom()</c></p></item>
- <tag><c>DataTag =</c></tag>
- <item><p><c>atom()</c></p>
- <p>Used in socket data message.</p></item>
- <tag><c>ClosedTag =</c></tag>
- <item><p><c>atom()</c></p>
- <p>Used in socket close message.</p></item>
- </taglist>
- </item>
-
- <tag><c>verify_type() =</c></tag>
- <item><p><c>verify_none | verify_peer</c></p></item>
-
- <tag><c>path() =</c></tag>
- <item><p><c>string()</c></p>
- <p>Represents a file path.</p></item>
-
- <tag><c>public_key:der_encoded() =</c></tag>
- <item><p><c>binary()</c></p>
- <p>ASN.1 DER-encoded entity as an Erlang binary.</p></item>
- <tag><c>host() =</c></tag>
- <item><p><c>hostname() | ipaddress()</c></p></item>
+ <!--
+ ================================================================
+ = Data types =
+ ================================================================
+ -->
- <tag><c>hostname() =</c></tag>
- <item><p><c>string() - DNS hostname</c></p></item>
+ <datatypes>
+ <datatype_title>Types used in SSL/TLS/DTLS</datatype_title>
- <tag><c>ip_address() =</c></tag>
- <item><p><c>{N1,N2,N3,N4} % IPv4 | {K1,K2,K3,K4,K5,K6,K7,K8} % IPv6
- </c></p></item>
+
+ <datatype>
+ <name name="socket"/>
+ </datatype>
+
+ <datatype>
+ <name name="sslsocket"/>
+ <desc>
+ <p>An opaque reference to the TLS/DTLS connection, may be used for equality matching.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="tls_option"/>
+ </datatype>
+
+ <datatype>
+ <name name="tls_client_option"/>
+ </datatype>
+
+ <datatype>
+ <name name="tls_server_option"/>
+ </datatype>
+
+
+ <datatype>
+ <name name="socket_option"/>
+ <desc>
+ <p>The default socket options are
+ <c>[{mode,list},{packet, 0},{header, 0},{active, true}]</c>.</p>
+ <p>For valid options, see the
+ <seealso marker="kernel:inet">inet(3)</seealso>,
+ <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> and
+ <seealso marker="kernel:gen_tcp">gen_udp(3)</seealso>
+ manual pages in Kernel. Note that stream oriented options such as packet
+ are only relevant for SSL/TLS and not DTLS</p>
+ </desc>
+ </datatype>
- <tag><c>sslsocket() =</c></tag>
- <item><p>opaque()</p></item>
-
- <tag><marker id="type-protocol"/><c> protocol_version() =</c></tag>
- <item><p><c> ssl_tls_protocol() | dtls_protocol() </c></p></item>
+ <datatype>
+ <name name="active_msgs"/>
+ <desc>
+ <p>When a TLS/DTLS socket is in active mode (the default), data from the
+ socket is delivered to the owner of the socket in the form of
+ messages as described above.</p>
+ <p>The <c>ssl_passive</c> message is sent only when the socket is in
+ <c>{active, N}</c> mode and the counter dropped to 0. It indicates
+ that the socket has transitioned to passive (<c>{active, false}</c>) mode.</p>
+ </desc>
+ </datatype>
- <item><p><c>sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item>
-
- <tag><marker id="type-protocol"/><c> dtls_protocol() =</c></tag>
- <item><p><c>'dtlsv1' | 'dtlsv1.2'</c></p></item>
-
- <tag><c>ciphers() =</c></tag>
- <item><p><c>= [ciphersuite()]</c></p>
- <p>Tuples and string formats accepted by versions
- before ssl-8.2.4 will be converted for backwards compatibility</p></item>
-
- <tag><c>ciphersuite() =</c></tag>
- <item><p><c>
- #{key_exchange := key_exchange(),
- cipher := cipher(),
- mac := MAC::hash() | aead,
- prf := PRF::hash() | default_prf} </c></p></item>
-
- <tag><c>key_exchange()=</c></tag>
- <item><p><c>rsa | dhe_dss | dhe_rsa | dh_anon | psk | dhe_psk
- | rsa_psk | srp_anon | srp_dss | srp_rsa | ecdh_anon | ecdh_ecdsa
- | ecdhe_ecdsa | ecdh_rsa | ecdhe_rsa</c></p></item>
-
- <tag><c>cipher() =</c></tag>
- <item><p><c>rc4_128 | des_cbc | '3des_ede_cbc'
- | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305</c></p></item>
-
- <tag><c>hash() =</c></tag>
- <item><p><c>md5 | sha | sha224 | sha256 | sha348 | sha512</c></p></item>
-
- <tag><c>prf_random() =</c></tag>
- <item><p><c>client_random | server_random</c></p></item>
-
- <tag><c>cipher_filters() =</c></tag>
- <item><p><c> [{key_exchange | cipher | mac | prf, algo_filter()}])</c></p></item>
-
- <tag><c>algo_filter() =</c></tag>
- <item><p>fun(key_exchange() | cipher() | hash() | aead | default_prf) -> true | false </p></item>
-
- <tag><c>srp_param_type() =</c></tag>
- <item><p><c>srp_1024 | srp_1536 | srp_2048 | srp_3072
- | srp_4096 | srp_6144 | srp_8192</c></p></item>
-
- <tag><c>SNIfun::fun()</c></tag>
- <item><p><c>= fun(ServerName :: string()) -> [ssl_option()]</c></p></item>
-
- <tag><c>named_curve() =</c></tag>
- <item><p><c>sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1
- | sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1
- | sect283k1 | sect283r1 | brainpoolP256r1 | secp256k1 | secp256r1
- | sect239k1 | sect233k1 | sect233r1 | secp224k1 | secp224r1
- | sect193r1 | sect193r2 | secp192k1 | secp192r1 | sect163k1
- | sect163r1 | sect163r2 | secp160k1 | secp160r1 | secp160r2</c></p></item>
-
- <tag><c>hello_extensions() =</c></tag>
- <item><p><c>#{renegotiation_info => binary() | undefined,
- signature_algs => [{hash(), ecsda| rsa| dsa}] | undefined
- alpn => binary() | undefined,
- next_protocol_negotiation => binary() | undefined,
- srp => string() | undefined,
- ec_point_formats => list() | undefined,
- elliptic_curves => [oid] | undefined,
- sni => string() | undefined}
- }</c></p></item>
-
- <tag><c>signature_scheme() =</c></tag>
- <item>
- <p><c>rsa_pkcs1_sha256</c></p>
- <p><c>| rsa_pkcs1_sha384</c></p>
- <p><c>| rsa_pkcs1_sha512</c></p>
- <p><c>| ecdsa_secp256r1_sha256</c></p>
- <p><c>| ecdsa_secp384r1_sha384</c></p>
- <p><c>| ecdsa_secp521r1_sha512</c></p>
- <p><c>| rsa_pss_rsae_sha256</c></p>
- <p><c>| rsa_pss_rsae_sha384</c></p>
- <p><c>| rsa_pss_rsae_sha512</c></p>
- <p><c>| rsa_pss_pss_sha256</c></p>
- <p><c>| rsa_pss_pss_sha384</c></p>
- <p><c>| rsa_pss_pss_sha512</c></p>
- <p><c>| rsa_pkcs1_sha1</c></p>
- <p><c>| ecdsa_sha1</c></p>
- </item>
-
- </taglist>
- </section>
-
- <section>
- <title>TLS/DTLS OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</title>
+ <datatype>
+ <name name="transport_option"/>
+ <desc>
+ <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c>
+ for TLS and <c>{gen_udp, udp, udp_closed, udp_error}</c> for
+ DTLS. Can be used to customize the transport layer. The tag
+ values should be the values used by the underlying transport
+ in its active mode messages. For TLS the callback module must implement a
+ reliable transport protocol, behave as <c>gen_tcp</c>, and have functions
+ corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>,
+ <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>.
+ The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c>
+ directly. For DTLS this feature must be considered exprimental.
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="host"/>
+ </datatype>
+
+ <datatype>
+ <name name="hostname"/>
+ </datatype>
+
+ <datatype>
+ <name name="ip_address"/>
+ </datatype>
+
+ <datatype>
+ <name name="protocol_version"/>
+ </datatype>
+
+ <datatype>
+ <name name="tls_version"/>
+ </datatype>
+
+ <datatype>
+ <name name="dtls_version"/>
+ </datatype>
+
+ <datatype>
+ <name name="legacy_version"/>
+ </datatype>
+
+ <datatype>
+ <name name="prf_random"/>
+ </datatype>
+
+ <datatype>
+ <name name="verify_type"/>
+ </datatype>
+
+ <datatype>
+ <name name="ciphers"/>
+ </datatype>
+
+ <datatype>
+ <name name="erl_cipher_suite"/>
+ </datatype>
+
+ <datatype>
+ <name name="cipher"/>
+ </datatype>
+
+ <datatype>
+ <name name="legacy_cipher"/>
+ </datatype>
+
+ <datatype>
+ <name name="cipher_filters"/>
+ </datatype>
+
+ <datatype>
+ <name name="hash"/>
+ </datatype>
+
+ <datatype>
+ <name name="sha2"/>
+ </datatype>
+
+ <datatype>
+ <name name="legacy_hash"/>
+ </datatype>
+
+ <datatype>
+ <name name="old_cipher_suite"/>
+ </datatype>
+
+ <datatype>
+ <name name="signature_algs"/>
+ </datatype>
+
+ <datatype>
+ <name name="sign_algo"/>
+ </datatype>
+
+ <datatype>
+ <name name="sign_scheme"/>
+ </datatype>
+
+ <datatype>
+ <name name="kex_algo"/>
+ </datatype>
+
+ <datatype>
+ <name name="algo_filter"/>
+ </datatype>
+
+ <datatype>
+ <name name="eccs"/>
+ </datatype>
+
+ <datatype>
+ <name name="named_curve"/>
+ </datatype>
+
+ <datatype>
+ <name name="psk_identity"/>
+ </datatype>
+
+ <datatype>
+ <name name="srp_identity"/>
+ </datatype>
+
+ <datatype>
+ <name name="srp_param_type"/>
+ </datatype>
+
+ <datatype>
+ <name name="app_level_protocol"/>
+ </datatype>
+
+ <datatype>
+ <name name="protocol_extensions"/>
+ </datatype>
+
+ <datatype>
+ <name name="error_alert"/>
+ </datatype>
+
+ <datatype>
+ <name name="tls_alert"/>
+ </datatype>
+
+ <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</datatype_title>
+
+ <datatype>
+ <name name="common_option"/>
+ </datatype>
+
+ <datatype>
+ <name since="OTP 20" name="protocol"/>
+ <desc>
+ <p>Choose TLS or DTLS protocol for the transport layer security.
+ Defaults to <c>tls</c>. For DTLS other transports than UDP are not yet supported.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="handshake_completion"/>
+ <desc>
+ <p>Defaults to <c>full</c>. If hello is specified the handshake will
+ pause after the hello message and give the user a possibility make decisions
+ based on hello extensions before continuing or aborting the handshake by calling
+ <seealso marker="#handshake_continue-3"> handshake_continue/3</seealso> or
+ <seealso marker="#handshake_cancel-1"> handshake_cancel/1</seealso></p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="cert"/>
+ <desc>
+ <p>The DER-encoded users certificate. If this option
+ is supplied, it overrides option <c>certfile</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="cert_pem"/>
+ <desc>
+ <p>Path to a file containing the user certificate on PEM format.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="key"/>
+ <desc>
+ <p>The DER-encoded user's private key or a map refering to a crypto
+ engine and its key reference that optionally can be password protected,
+ seealso <seealso marker="crypto:crypto#engine_load-4"> crypto:engine_load/4
+ </seealso> and <seealso marker="crypto:engine_load"> Crypto's Users Guide</seealso>. If this option
+ is supplied, it overrides option <c>keyfile</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="key_pem"/>
+ <desc>
+ <p>Path to the file containing the user's
+ private PEM-encoded key. As PEM-files can contain several
+ entries, this option defaults to the same file as given by
+ option <c>certfile</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="key_password"/>
+ <desc>
+ <p>String containing the user's password. Only used if the
+ private keyfile is password-protected.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="cipher_suites"/>
+ <desc>
+ <p>Supported cipher suites. The function
+ <c>cipher_suites/2</c> can be used to find all ciphers that
+ are supported by default. <c>cipher_suites(all, 'tlsv1.2')</c> can be
+ called to find all available cipher suites. Pre-Shared Key
+ (<url href="http://www.ietf.org/rfc/rfc4279.txt">RFC
+ 4279</url> and <url
+ href="http://www.ietf.org/rfc/rfc5487.txt">RFC 5487</url>),
+ Secure Remote Password (<url
+ href="http://www.ietf.org/rfc/rfc5054.txt">RFC 5054</url>),
+ RC4, 3DES, DES cipher suites, and anonymous cipher suites only work if
+ explicitly enabled by this option; they are supported/enabled
+ by the peer also. Anonymous cipher suites are supported for
+ testing purposes only and are not be used when security
+ matters.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="eccs"/>
+ <desc><p> Allows to specify the order of preference for named curves
+ and to restrict their usage when using a cipher suite supporting them.</p>
+ </desc>
+ </datatype>
- <p>The following options have the same meaning in the client and
- the server:</p>
+ <datatype>
+ <name name="signature_schemes"/>
+ <desc>
+ <p>
+ In addition to the signature_algorithms extension from TLS 1.2,
+ <url href="http://www.ietf.org/rfc/rfc8446.txt#section-4.2.3">TLS 1.3
+ (RFC 5246 Section 4.2.3)</url>adds the signature_algorithms_cert extension
+ which enables having special requirements on the signatures used in the
+ certificates that differs from the requirements on digital signatures as a whole.
+ If this is not required this extension is not needed.
+ </p>
+ <p>
+ The client will send a signature_algorithms_cert extension (ClientHello),
+ if TLS version 1.3 or later is used, and the signature_algs_cert option is
+ explicitly specified. By default, only the signature_algs extension is sent.
+ </p>
+ <p>
+ The signature schemes shall be ordered according to the client's preference
+ (favorite choice first).
+ </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="secure_renegotiation"/>
+ <desc><p>Specifies if to reject renegotiation attempt that does
+ not live up to <url
+ href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. By
+ default <c>secure_renegotiate</c> is set to <c>true</c>, that
+ is, secure renegotiation is enforced. If set to <c>false</c>
+ secure renegotiation will still be used if possible, but it
+ falls back to insecure renegotiation if the peer does not
+ support <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC
+ 5746</url>.</p>
+ </desc>
+ </datatype>
- <taglist>
-
- <tag><c>{protocol, tls | dtls}</c></tag>
- <item><p>Choose TLS or DTLS protocol for the transport layer security.
- Defaults to <c>tls</c> Introduced in OTP 20, DTLS support is considered
- experimental in this release. Other transports than UDP are not yet supported.</p></item>
-
- <tag><c>{handshake, hello | full}</c></tag>
- <item><p> Defaults to <c>full</c>. If hello is specified the handshake will
- pause after the hello message and give the user a possibility make decisions
- based on hello extensions before continuing or aborting the handshake by calling
- <seealso marker="#handshake_continue-3"> handshake_continue/3</seealso> or
- <seealso marker="#handshake_cancel-1"> handshake_cancel/1</seealso>
- </p></item>
-
- <tag><c>{cert, public_key:der_encoded()}</c></tag>
- <item><p>The DER-encoded users certificate. If this option
- is supplied, it overrides option <c>certfile</c>.</p></item>
-
- <tag><c>{certfile, path()}</c></tag>
- <item><p>Path to a file containing the user certificate.</p></item>
-
- <tag>
- <marker id="key_option_def"/>
- <c>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey'
- |'PrivateKeyInfo', public_key:der_encoded()} | #{algorithm := rsa | dss | ecdsa,
- engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}</c></tag>
- <item><p>The DER-encoded user's private key or a map refering to a crypto
- engine and its key reference that optionally can be password protected,
- seealso <seealso marker="crypto:crypto#engine_load-4"> crypto:engine_load/4
- </seealso> and <seealso marker="crypto:engine_load"> Crypto's Users Guide</seealso>. If this option
- is supplied, it overrides option <c>keyfile</c>.</p></item>
-
- <tag><c>{keyfile, path()}</c></tag>
- <item><p>Path to the file containing the user's
- private PEM-encoded key. As PEM-files can contain several
- entries, this option defaults to the same file as given by
- option <c>certfile</c>.</p></item>
-
- <tag><c>{password, string()}</c></tag>
- <item><p>String containing the user's password. Only used if the
- private keyfile is password-protected.</p></item>
-
- <tag><c>{ciphers, ciphers()}</c></tag>
- <item><p>Supported cipher suites. The function
- <c>cipher_suites/0</c> can be used to find all ciphers that are
- supported by default. <c>cipher_suites(all)</c> can be called
- to find all available cipher suites. Pre-Shared Key
- (<url href="http://www.ietf.org/rfc/rfc4279.txt">RFC 4279</url> and
- <url href="http://www.ietf.org/rfc/rfc5487.txt">RFC 5487</url>),
- Secure Remote Password
- (<url href="http://www.ietf.org/rfc/rfc5054.txt">RFC 5054</url>), RC4 cipher suites,
- and anonymous cipher suites only work if explicitly enabled by
- this option; they are supported/enabled by the peer also.
- Anonymous cipher suites are supported for testing purposes
- only and are not be used when security matters.</p></item>
-
- <tag><c>{eccs, [named_curve()]}</c></tag>
- <item><p> Allows to specify the order of preference for named curves
- and to restrict their usage when using a cipher suite supporting them.
- </p></item>
-
- <tag><c>{secure_renegotiate, boolean()}</c></tag>
- <item><p>Specifies if to reject renegotiation attempt that does
- not live up to
- <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.
- By default <c>secure_renegotiate</c> is set to <c>true</c>,
- that is, secure renegotiation is enforced. If set to <c>false</c> secure renegotiation
- will still be used if possible,
- but it falls back to insecure renegotiation if the peer
- does not support
- <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.</p>
- </item>
-
- <tag><c>{depth, integer()}</c></tag>
- <item><p>Maximum number of non-self-issued
+ <datatype>
+ <name name="allowed_cert_chain_length"/>
+ <desc><p>Maximum number of non-self-issued
intermediate certificates that can follow the peer certificate
in a valid certification path. So, if depth is 0 the PEER must
be signed by the trusted ROOT-CA directly; if 1 the path can
be PEER, CA, ROOT-CA; if 2 the path can be PEER, CA, CA,
- ROOT-CA, and so on. The default value is 1.</p></item>
-
- <tag><marker id="verify_fun"/><c>{verify_fun, {Verifyfun :: fun(), InitialUserState ::
- term()}}</c></tag>
- <item><p>The verification fun is to be defined as follows:</p>
+ ROOT-CA, and so on. The default value is 1.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="custom_verify"/>
+ <desc>
+ <p>The verification fun is to be defined as follows:</p>
<code>
-fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revoked,
-atom()}} |
+fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() |
+ {revoked, atom()}} |
{extension, #'Extension'{}}, InitialUserState :: term()) ->
{valid, UserState :: term()} | {valid_peer, UserState :: term()} |
{fail, Reason :: term()} | {unknown, UserState :: term()}.
@@ -334,20 +402,21 @@ atom()}} |
<p>The verification fun is called during the X509-path
validation when an error or an extension unknown to the SSL
- application is encountered. It is also called
- when a certificate is considered valid by the path validation
- to allow access to each certificate in the path to the user
- application. It differentiates between the peer
- certificate and the CA certificates by using <c>valid_peer</c> or
- <c>valid</c> as second argument to the verification fun. See the
- <seealso marker="public_key:public_key_records">public_key User's
- Guide</seealso> for definition of <c>#'OTPCertificate'{}</c> and
- <c>#'Extension'{}</c>.</p>
+ application is encountered. It is also called when a
+ certificate is considered valid by the path validation to
+ allow access to each certificate in the path to the user
+ application. It differentiates between the peer certificate
+ and the CA certificates by using <c>valid_peer</c> or
+ <c>valid</c> as second argument to the verification fun. See
+ the <seealso marker="public_key:public_key_records">public_key
+ User's Guide</seealso> for definition of
+ <c>#'OTPCertificate'{}</c> and <c>#'Extension'{}</c>.</p>
<list type="bulleted">
- <item><p>If the verify callback fun returns <c>{fail, Reason}</c>,
- the verification process is immediately stopped, an alert is
- sent to the peer, and the TLS/DTLS handshake terminates.</p></item>
+ <item><p>If the verify callback fun returns <c>{fail,
+ Reason}</c>, the verification process is immediately
+ stopped, an alert is sent to the peer, and the TLS/DTLS
+ handshake terminates.</p></item>
<item><p>If the verify callback fun returns <c>{valid, UserState}</c>,
the verification process continues.</p></item>
<item><p>If the verify callback fun always returns
@@ -397,10 +466,12 @@ atom()}} |
<taglist>
<tag><c>unknown_ca</c></tag>
- <item><p>No trusted CA was found in the trusted store. The trusted CA is
- normally a so called ROOT CA, which is a self-signed certificate. Trust can
- be claimed for an intermediate CA (trusted anchor does not have to be
- self-signed according to X-509) by using option <c>partial_chain</c>.</p>
+ <item><p>No trusted CA was found in the trusted store. The
+ trusted CA is normally a so called ROOT CA, which is a
+ self-signed certificate. Trust can be claimed for an
+ intermediate CA (trusted anchor does not have to be
+ self-signed according to X-509) by using option
+ <c>partial_chain</c>.</p>
</item>
<tag><c>selfsigned_peer</c></tag>
@@ -411,15 +482,17 @@ atom()}} |
marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso>
</p></item>
</taglist>
- </item>
-
- <tag><c>{crl_check, boolean() | peer | best_effort }</c></tag>
- <item>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="crl_check"/>
+ <desc>
<p>Perform CRL (Certificate Revocation List) verification
<seealso marker="public_key:public_key#pkix_crls_validate-3">
- (public_key:pkix_crls_validate/3)</seealso> on all the certificates during the path validation
- <seealso
- marker="public_key:public_key#pkix_path_validation-3">(public_key:pkix_path_validation/3)
+ (public_key:pkix_crls_validate/3)</seealso> on all the
+ certificates during the path validation <seealso
+ marker="public_key:public_key#pkix_path_validation-3">(public_key:pkix_path_validation/3)
</seealso>
of the certificate chain. Defaults to <c>false</c>.</p>
@@ -431,112 +504,111 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid
<item>if certificate revocation status cannot be determined
it will be accepted as valid.</item>
</taglist>
-
+
<p>The CA certificates specified for the connection will be used to
construct the certificate chain validating the CRLs.</p>
<p>The CRLs will be fetched from a local or external cache. See
<seealso marker="ssl:ssl_crl_cache_api">ssl_crl_cache_api(3)</seealso>.</p>
- </item>
-
- <tag><c>{crl_cache, {Module :: atom(), {DbHandle :: internal | term(), Args :: list()}}}</c></tag>
- <item>
- <p>Specify how to perform lookup and caching of certificate revocation lists.
- <c>Module</c> defaults to <seealso marker="ssl:ssl_crl_cache">ssl_crl_cache</seealso>
- with <c> DbHandle </c> being <c>internal</c> and an
- empty argument list.</p>
-
- <p>There are two implementations available:</p>
-
- <taglist>
- <tag><c>ssl_crl_cache</c></tag>
- <item>
- <p>This module maintains a cache of CRLs. CRLs can be
- added to the cache using the function <seealso
- marker="ssl:ssl_crl_cache#insert-1">ssl_crl_cache:insert/1</seealso>,
- and optionally automatically fetched through HTTP if the
- following argument is specified:</p>
-
- <taglist>
- <tag><c>{http, timeout()}</c></tag>
- <item><p>
- Enables fetching of CRLs specified as http URIs in<seealso
- marker="public_key:public_key_records">X509 certificate extensions</seealso>.
- Requires the OTP inets application.</p>
- </item>
- </taglist>
- </item>
-
- <tag><c>ssl_crl_hash_dir</c></tag>
- <item>
- <p>This module makes use of a directory where CRLs are
- stored in files named by the hash of the issuer name.</p>
-
- <p>The file names consist of eight hexadecimal digits
- followed by <c>.rN</c>, where <c>N</c> is an integer,
- e.g. <c>1a2b3c4d.r0</c>. For the first version of the
- CRL, <c>N</c> starts at zero, and for each new version,
- <c>N</c> is incremented by one. The OpenSSL utility
- <c>c_rehash</c> creates symlinks according to this
- pattern.</p>
-
- <p>For a given hash value, this module finds all
- consecutive <c>.r*</c> files starting from zero, and those
- files taken together make up the revocation list. CRL
- files whose <c>nextUpdate</c> fields are in the past, or
- that are issued by a different CA that happens to have the
- same name hash, are excluded.</p>
-
- <p>The following argument is required:</p>
-
- <taglist>
- <tag><c>{dir, string()}</c></tag>
- <item><p>Specifies the directory in which the CRLs can be found.</p></item>
- </taglist>
-
- </item>
-
- <tag><c>max_handshake_size</c></tag>
- <item>
- <p>Integer (24 bits unsigned). Used to limit the size of
- valid TLS handshake packets to avoid DoS attacks.
- Defaults to 256*1024.</p>
- </item>
-
- </taglist>
-
- </item>
+ </desc>
+ </datatype>
- <tag><c>{partial_chain, fun(Chain::[DerCert]) -> {trusted_ca, DerCert} |
- unknown_ca }</c></tag>
- <item><p>Claim an intermediate CA in the chain as trusted. TLS then
- performs <seealso
- marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso>
- with the selected CA as trusted anchor and the rest of the chain.</p></item>
+ <datatype>
+ <name name="crl_cache_opts"/>
+ <desc>
+ <p>Specify how to perform lookup and caching of certificate revocation lists.
+ <c>Module</c> defaults to <seealso marker="ssl:ssl_crl_cache">ssl_crl_cache</seealso>
+ with <c> DbHandle </c> being <c>internal</c> and an
+ empty argument list.</p>
+
+ <p>There are two implementations available:</p>
+
+ <taglist>
+ <tag><c>ssl_crl_cache</c></tag>
+ <item>
+ <p>This module maintains a cache of CRLs. CRLs can be
+ added to the cache using the function <seealso
+ marker="ssl:ssl_crl_cache#insert-1">ssl_crl_cache:insert/1</seealso>,
+ and optionally automatically fetched through HTTP if the
+ following argument is specified:</p>
+
+ <taglist>
+ <tag><c>{http, timeout()}</c></tag>
+ <item><p>
+ Enables fetching of CRLs specified as http URIs in<seealso
+ marker="public_key:public_key_records">X509 certificate extensions</seealso>.
+ Requires the OTP inets application.</p>
+ </item>
+ </taglist>
+ </item>
+
+ <tag><c>ssl_crl_hash_dir</c></tag>
+ <item>
+ <p>This module makes use of a directory where CRLs are
+ stored in files named by the hash of the issuer name.</p>
+
+ <p>The file names consist of eight hexadecimal digits
+ followed by <c>.rN</c>, where <c>N</c> is an integer,
+ e.g. <c>1a2b3c4d.r0</c>. For the first version of the
+ CRL, <c>N</c> starts at zero, and for each new version,
+ <c>N</c> is incremented by one. The OpenSSL utility
+ <c>c_rehash</c> creates symlinks according to this
+ pattern.</p>
+
+ <p>For a given hash value, this module finds all
+ consecutive <c>.r*</c> files starting from zero, and those
+ files taken together make up the revocation list. CRL
+ files whose <c>nextUpdate</c> fields are in the past, or
+ that are issued by a different CA that happens to have the
+ same name hash, are excluded.</p>
+
+ <p>The following argument is required:</p>
+
+ <taglist>
+ <tag><c>{dir, string()}</c></tag>
+ <item><p>Specifies the directory in which the CRLs can be found.</p></item>
+ </taglist>
+ </item>
+ </taglist>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="root_fun"/>
+ <desc>
+ <code>
+fun(Chain::[public_key:der_encoded()]) ->
+ {trusted_ca, DerCert::public_key:der_encoded()} | unknown_ca}
+ </code>
+ <p>Claim an intermediate CA in the chain as trusted. TLS then
+ performs <seealso
+ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso>
+ with the selected CA as trusted anchor and the rest of the chain.</p>
+ </desc>
+ </datatype>
- <tag><c>{versions, [protocol_version()]}</c></tag>
- <item><p>TLS protocol versions supported by started clients and servers.
+ <datatype>
+ <name name="protocol_versions"/>
+ <desc><p>TLS protocol versions supported by started clients and servers.
This option overrides the application environment option
<c>protocol_version</c> and <c>dtls_protocol_version</c>. If the environment option is not set, it defaults
to all versions, except SSL-3.0, supported by the SSL application.
- See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p></item>
+ See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p>
+ </desc>
+ </datatype>
- <tag><c>{hibernate_after, integer()|undefined}</c></tag>
- <item><p>When an integer-value is specified, <c>TLS/DTLS-connection</c>
- goes into hibernation after the specified number of milliseconds
- of inactivity, thus reducing its memory footprint. When
- <c>undefined</c> is specified (this is the default), the process
- never goes into hibernation.</p></item>
- <tag><c>{user_lookup_fun, {Lookupfun :: fun(), UserState :: term()}}</c></tag>
- <item><p>The lookup fun is to defined as follows:</p>
+ <datatype>
+ <name name="custom_user_lookup"/>
+ <desc><p>The lookup fun is to defined as follows:</p>
<code>
fun(psk, PSKIdentity ::string(), UserState :: term()) ->
{ok, SharedSecret :: binary()} | error;
fun(srp, Username :: string(), UserState :: term()) ->
- {ok, {SRPParams :: srp_param_type(), Salt :: binary(), DerivedKey :: binary()}} | error.
+ {ok, {SRPParams :: srp_param_type(), Salt :: binary(),
+ DerivedKey :: binary()}} | error.
</code>
<p>For Pre-Shared Key (PSK) cipher suites, the lookup fun is
@@ -552,20 +624,63 @@ fun(srp, Username :: string(), UserState :: term()) ->
<url href="http://tools.ietf.org/html/rfc5054#section-2.4"> RFC 5054</url>:
<c>crypto:sha([Salt, crypto:sha([Username, &lt;&lt;$:&gt;&gt;, Password])])</c>
</p>
- </item>
+ </desc>
+ </datatype>
- <tag><c>{padding_check, boolean()}</c></tag>
- <item><p>Affects TLS-1.0 connections only.
+ <datatype>
+ <name name="session_id"/>
+ <desc>
+ <p>Identifies a TLS session.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="log_alert"/>
+ <desc><p>If set to <c>false</c>, error reports are not displayed.
+ Deprecated in OTP 22, use {log_level, <seealso marker="#type-logging_level">logging_level()</seealso>} instead.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="logging_level"/>
+ <desc><p>Specifies the log level for TLS/DTLS. At verbosity level <c>notice</c> and above error reports are
+ displayed in TLS/DTLS. The level <c>debug</c> triggers verbose logging of TLS/DTLS protocol
+ messages.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="hibernate_after"/>
+ <desc><p>When an integer-value is specified, <c>TLS/DTLS-connection</c>
+ goes into hibernation after the specified number of milliseconds
+ of inactivity, thus reducing its memory footprint. When
+ <c>undefined</c> is specified (this is the default), the process
+ never goes into hibernation.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="handshake_size"/>
+ <desc>
+ <p>Integer (24 bits unsigned). Used to limit the size of
+ valid TLS handshake packets to avoid DoS attacks.
+ Defaults to 256*1024.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="padding_check"/>
+ <desc><p>Affects TLS-1.0 connections only.
If set to <c>false</c>, it disables the block cipher padding check
to be able to interoperate with legacy software.</p>
<warning><p>Using <c>{padding_check, boolean()}</c> makes TLS
vulnerable to the Poodle attack.</p></warning>
- </item>
-
-
+ </desc>
+ </datatype>
- <tag><c>{beast_mitigation, one_n_minus_one | zero_n | disabled}</c></tag>
- <item><p>Affects SSL-3.0 and TLS-1.0 connections only. Used to change the BEAST
+ <datatype>
+ <name name="beast_mitigation"/>
+ <desc><p>Affects SSL-3.0 and TLS-1.0 connections only. Used to change the BEAST
mitigation strategy to interoperate with legacy software.
Defaults to <c>one_n_minus_one</c>.</p>
@@ -575,139 +690,170 @@ fun(srp, Username :: string(), UserState :: term()) ->
<p><c>disabled</c> - Disable BEAST mitigation.</p>
- <warning><p>Using <c>{beast_mitigation, disabled}</c> makes SSL or TLS
+ <warning><p>Using <c>{beast_mitigation, disabled}</c> makes SSL-3.0 or TLS-1.0
vulnerable to the BEAST attack.</p></warning>
- </item>
- </taglist>
-
- </section>
-
- <section>
- <title>TLS/DTLS OPTION DESCRIPTIONS - CLIENT SIDE</title>
-
- <p>The following options are client-specific or have a slightly different
- meaning in the client than in the server:</p>
-
- <taglist>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="ssl_imp"/>
+ <desc><p>Deprecated since OTP-17, has no affect.</p></desc>
+ </datatype>
+
+ <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - CLIENT</datatype_title>
+
+ <datatype>
+ <name name="client_option"/>
+ </datatype>
+
+ <datatype>
+ <name name="client_verify_type"/>
+ <desc><p>In mode <c>verify_none</c> the default behavior is to allow
+ all x509-path validation errors. See also option <seealso marker="#type-custom_verify">verify_fun</seealso>.</p>
+ </desc>
+ </datatype>
- <tag><c>{verify, verify_type()}</c></tag>
- <item><p>In mode <c>verify_none</c> the default behavior is to allow
- all x509-path validation errors. See also option <c>verify_fun</c>.</p>
- </item>
-
- <tag><marker id="client_reuse_session"/><c>{reuse_session, binary()}</c></tag>
- <item><p>Reuses a specific session earlier saved with the option
- <c>{reuse_sessions, save} since ssl-9.2</c>
- </p></item>
+ <datatype>
+ <name name="client_reuse_session"/>
+ <desc>
+ <p>Reuses a specific session earlier saved with the option
+ <c>{reuse_sessions, save} since OTP-21.3 </c>
+ </p>
+ </desc>
+ </datatype>
- <tag><c>{reuse_sessions, boolean() | save}</c></tag>
- <item><p>When <c>save</c> is specified a new connection will be negotiated
+ <datatype>
+ <name name="client_reuse_sessions"/>
+ <desc>
+ <p>When <c>save</c> is specified a new connection will be negotiated
and saved for later reuse. The session ID can be fetched with
- <seealso marker="#connection_information">connection_information/2</seealso>
- and used with the client option <seealso marker="#client_reuse_session">reuse_session</seealso>
+ <seealso marker="#connection_information-2">connection_information/2</seealso>
+ and used with the client option <seealso marker="#type-client_reuse_session">reuse_session</seealso>
The boolean value true specifies that if possible, automatized session reuse will
be performed. If a new session is created, and is unique in regard
- to previous stored sessions, it will be saved for possible later reuse.
- Value <c>save</c> since ssl-9.2
- </p></item>
-
- <tag><c>{cacerts, [public_key:der_encoded()]}</c></tag>
- <item><p>The DER-encoded trusted certificates. If this option
- is supplied it overrides option <c>cacertfile</c>.</p></item>
-
- <tag><c>{cacertfile, path()}</c></tag>
- <item><p>Path to a file containing PEM-encoded CA certificates. The CA
+ to previous stored sessions, it will be saved for possible later reuse. Since OTP-21.3</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="client_cacerts"/>
+ <desc>
+ <p>The DER-encoded trusted certificates. If this option
+ is supplied it overrides option <c>cacertfile</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="client_cafile"/>
+ <desc>
+ <p>Path to a file containing PEM-encoded CA certificates. The CA
certificates are used during server authentication and when building the
client certificate chain.</p>
- </item>
-
- <tag><c>{alpn_advertised_protocols, [binary()]}</c></tag>
- <item>
- <p>The list of protocols supported by the client to be sent to the
- server to be used for an Application-Layer Protocol Negotiation (ALPN).
- If the server supports ALPN then it will choose a protocol from this
- list; otherwise it will fail the connection with a "no_application_protocol"
- alert. A server that does not support ALPN will ignore this value.</p>
-
- <p>The list of protocols must not contain an empty binary.</p>
-
- <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p>
- </item>
-
- <tag><c>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()]}}</c><br/>
- <c>{client_preferred_next_protocols, {Precedence :: server | client, ClientPrefs :: [binary()], Default :: binary()}}</c></tag>
- <item>
- <p>Indicates that the client is to try to perform Next Protocol
- Negotiation.</p>
-
- <p>If precedence is server, the negotiated protocol is the
- first protocol to be shown on the server advertised list, which is
- also on the client preference list.</p>
-
- <p>If precedence is client, the negotiated protocol is the
- first protocol to be shown on the client preference list, which is
- also on the server advertised list.</p>
-
- <p>If the client does not support any of the server advertised
- protocols or the server does not advertise any protocols, the
- client falls back to the first protocol in its list or to the
- default protocol (if a default is supplied). If the
- server does not support Next Protocol Negotiation, the
- connection terminates if no default protocol is supplied.</p>
- </item>
-
- <tag><c>{psk_identity, string()}</c></tag>
- <item><p>Specifies the identity the client presents to the server.
- The matching secret is found by calling <c>user_lookup_fun</c>.</p>
- </item>
-
- <tag><c>{srp_identity, {Username :: string(), Password :: string()}
- </c></tag>
- <item><p>Specifies the username and password to use to authenticate
- to the server.</p></item>
-
- <tag><c>{server_name_indication, HostName :: hostname()}</c></tag>
- <item><p>Specify the hostname to be used in TLS Server Name Indication extension.
- If not specified it will default to the <c>Host</c> argument of <seealso marker="#connect-3">connect/[3,4]</seealso>
- unless it is of type inet:ipaddress().</p>
- <p>
- The <c>HostName</c> will also be used in the hostname verification of the peer certificate using
- <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>.
- </p>
- </item>
- <tag><c>{server_name_indication, disable}</c></tag>
- <item>
- <p> Prevents the Server Name Indication extension from being sent and
- disables the hostname verification check
- <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> </p>
- </item>
-
- <tag><c>{customize_hostname_check, Options::list()}</c></tag>
- <item>
- <p> Customizes the hostname verification of the peer certificate, as different protocols that use
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="client_alpn"/>
+ <desc>
+ <p>The list of protocols supported by the client to be sent to the
+ server to be used for an Application-Layer Protocol Negotiation (ALPN).
+ If the server supports ALPN then it will choose a protocol from this
+ list; otherwise it will fail the connection with a "no_application_protocol"
+ alert. A server that does not support ALPN will ignore this value.</p>
+
+ <p>The list of protocols must not contain an empty binary.</p>
+
+ <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="client_preferred_next_protocols"/>
+ <desc>
+ <p>Indicates that the client is to try to perform Next Protocol
+ Negotiation.</p>
+
+ <p>If precedence is server, the negotiated protocol is the
+ first protocol to be shown on the server advertised list, which is
+ also on the client preference list.</p>
+
+ <p>If precedence is client, the negotiated protocol is the
+ first protocol to be shown on the client preference list, which is
+ also on the server advertised list.</p>
+
+ <p>If the client does not support any of the server advertised
+ protocols or the server does not advertise any protocols, the
+ client falls back to the first protocol in its list or to the
+ default protocol (if a default is supplied). If the
+ server does not support Next Protocol Negotiation, the
+ connection terminates if no default protocol is supplied.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="client_psk_identity"/>
+ <desc>
+ <p>Specifies the identity the client presents to the server.
+ The matching secret is found by calling <c>user_lookup_fun</c></p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="client_srp_identity"/>
+ <desc>
+ <p>Specifies the username and password to use to authenticate
+ to the server.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="sni"/>
+ <desc>
+ <p>Specify the hostname to be used in TLS Server Name Indication extension.
+ If not specified it will default to the <c>Host</c> argument of <seealso marker="#connect-3">connect/[3,4]</seealso>
+ unless it is of type inet:ipaddress().</p>
+ <p>
+ The <c>HostName</c> will also be used in the hostname verification of the peer certificate using
+ <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>.
+ </p>
+ <p> The special value <c>disable</c> prevents the Server Name Indication extension from being sent and
+ disables the hostname verification check
+ <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="customize_hostname_check"/>
+ <desc>
+ <p> Customizes the hostname verification of the peer certificate, as different protocols that use
TLS such as HTTP or LDAP may want to do it differently, for possible options see
<seealso marker="public_key:public_key#pkix_verify_hostname-3">public_key:pkix_verify_hostname/3</seealso> </p>
- </item>
-
- <tag><c>{fallback, boolean()}</c></tag>
- <item>
- <p> Send special cipher suite TLS_FALLBACK_SCSV to avoid undesired TLS version downgrade.
- Defaults to false</p>
- <warning><p>Note this option is not needed in normal TLS usage and should not be used
- to implement new clients. But legacy clients that retries connections in the following manner</p>
-
- <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv2', 'tlsv1.1', 'tlsv1', 'sslv3']}])</c></p>
- <p><c> ssl:connect(Host, Port, [...{versions, [tlsv1.1', 'tlsv1', 'sslv3']}, {fallback, true}])</c></p>
- <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv1', 'sslv3']}, {fallback, true}]) </c></p>
- <p><c> ssl:connect(Host, Port, [...{versions, ['sslv3']}, {fallback, true}]) </c></p>
-
- <p>may use it to avoid undesired TLS version downgrade. Note that TLS_FALLBACK_SCSV must also
- be supported by the server for the prevention to work.
- </p></warning>
- </item>
- <tag><marker id="client_signature_algs"/><c>{signature_algs, [{hash(), ecdsa | rsa | dsa}]}</c></tag>
- <item>
- <p>In addition to the algorithms negotiated by the cipher
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="fallback"/>
+ <desc>
+ <p> Send special cipher suite TLS_FALLBACK_SCSV to avoid undesired TLS version downgrade.
+ Defaults to false</p>
+ <warning><p>Note this option is not needed in normal TLS usage and should not be used
+ to implement new clients. But legacy clients that retries connections in the following manner</p>
+
+ <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv2', 'tlsv1.1', 'tlsv1', 'sslv3']}])</c></p>
+ <p><c> ssl:connect(Host, Port, [...{versions, [tlsv1.1', 'tlsv1', 'sslv3']}, {fallback, true}])</c></p>
+ <p><c> ssl:connect(Host, Port, [...{versions, ['tlsv1', 'sslv3']}, {fallback, true}]) </c></p>
+ <p><c> ssl:connect(Host, Port, [...{versions, ['sslv3']}, {fallback, true}]) </c></p>
+
+ <p>may use it to avoid undesired TLS version downgrade. Note that TLS_FALLBACK_SCSV must also
+ be supported by the server for the prevention to work.
+ </p></warning>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="client_signature_algs"/>
+ <desc>
+ <p>In addition to the algorithms negotiated by the cipher
suite used for key exchange, payload encryption, message
authentication and pseudo random calculation, the TLS signature
algorithm extension <url
@@ -738,209 +884,227 @@ fun(srp, Username :: string(), UserState :: term()) ->
Selected signature algorithm can restrict which hash functions
that may be selected. Default support for {md5, rsa} removed in ssl-8.0
</p>
- </item>
- <tag><marker id="signature_algs_cert"/><c>{signature_algs_cert, [signature_scheme()]}</c></tag>
- <item>
- <p>
- In addition to the signature_algorithms extension from TLS 1.2,
- <url href="http://www.ietf.org/rfc/rfc8446.txt#section-4.2.3">TLS 1.3
- (RFC 5246 Section 4.2.3)</url>adds the signature_algorithms_cert extension
- which enables having special requirements on the signatures used in the
- certificates that differs from the requirements on digital signatures as a whole.
- If this is not required this extension is not needed.
- </p>
- <p>
- The client will send a signature_algorithms_cert extension (ClientHello),
- if TLS version 1.3 or later is used, and the signature_algs_cert option is
- explicitly specified. By default, only the signature_algs extension is sent.
- </p>
- <p>
- The signature schemes shall be ordered according to the client's preference
- (favorite choice first).
- </p>
- </item>
- </taglist>
- </section>
-
- <section>
- <title>TLS/DTLS OPTION DESCRIPTIONS - SERVER SIDE</title>
-
- <p>The following options are server-specific or have a slightly different
- meaning in the server than in the client:</p>
-
- <taglist>
-
- <tag><c>{cacerts, [public_key:der_encoded()]}</c></tag>
- <item><p>The DER-encoded trusted certificates. If this option
- is supplied it overrides option <c>cacertfile</c>.</p></item>
+ </desc>
+ </datatype>
- <tag><c>{cacertfile, path()}</c></tag>
- <item><p>Path to a file containing PEM-encoded CA
- certificates. The CA certificates are used to build the server
- certificate chain and for client authentication. The CAs are
- also used in the list of acceptable client CAs passed to the
- client when a certificate is requested. Can be omitted if there
- is no need to verify the client and if there are no
- intermediate CAs for the server certificate.</p></item>
-
- <tag><c>{dh, public_key:der_encoded()}</c></tag>
- <item><p>The DER-encoded Diffie-Hellman parameters. If specified,
- it overrides option <c>dhfile</c>.</p></item>
-
- <tag><c>{dhfile, path()}</c></tag>
- <item><p>Path to a file containing PEM-encoded Diffie Hellman parameters
- to be used by the server if a cipher suite using Diffie Hellman key
- exchange is negotiated. If not specified, default parameters are used.
- </p></item>
-
- <tag><c>{verify, verify_type()}</c></tag>
- <item><p>A server only does x509-path validation in mode <c>verify_peer</c>,
- as it then sends a certificate request to the client
- (this message is not sent if the verify option is <c>verify_none</c>).
- You can then also want to specify option <c>fail_if_no_peer_cert</c>.
- </p></item>
-
- <tag><c>{fail_if_no_peer_cert, boolean()}</c></tag>
- <item><p>Used together with <c>{verify, verify_peer}</c> by an TLS/DTLS server.
- If set to <c>true</c>, the server fails if the client does not have
- a certificate to send, that is, sends an empty certificate. If set to
- <c>false</c>, it fails only if the client sends an invalid
- certificate (an empty certificate is considered valid). Defaults to false.</p>
- </item>
-
- <tag><c>{reuse_sessions, boolean()}</c></tag>
- <item><p>The boolean value true specifies that the server will
- agree to reuse sessions. Setting it to false will result in an empty
- session table, that is no sessions will be reused.
- See also option <seealso marker="#server_reuse_session">reuse_session</seealso>
- </p></item>
-
- <tag><marker id="server_reuse_session"/>
- <c>{reuse_session, fun(SuggestedSessionId,
- PeerCert, Compression, CipherSuite) -> boolean()}</c></tag>
- <item><p>Enables the TLS/DTLS server to have a local policy
- for deciding if a session is to be reused or not.
- Meaningful only if <c>reuse_sessions</c> is set to <c>true</c>.
- <c>SuggestedSessionId</c> is a <c>binary()</c>, <c>PeerCert</c> is
- a DER-encoded certificate, <c>Compression</c> is an enumeration integer,
- and <c>CipherSuite</c> is of type <c>ciphersuite()</c>.</p></item>
-
- <tag><c>{alpn_preferred_protocols, [binary()]}</c></tag>
- <item>
- <p>Indicates the server will try to perform Application-Layer
- Protocol Negotiation (ALPN).</p>
-
- <p>The list of protocols is in order of preference. The protocol
- negotiated will be the first in the list that matches one of the
- protocols advertised by the client. If no protocol matches, the
- server will fail the connection with a "no_application_protocol" alert.</p>
-
- <p>The negotiated protocol can be retrieved using the <c>negotiated_protocol/1</c> function.</p>
- </item>
-
- <tag><c>{next_protocols_advertised, Protocols :: [binary()]}</c></tag>
- <item><p>List of protocols to send to the client if the client indicates that
- it supports the Next Protocol extension. The client can 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 the <c>negotiated_next_protocol/1</c> method.</p></item>
-
- <tag><c>{psk_identity, string()}</c></tag>
- <item><p>Specifies the server identity hint, which the server presents to
- the client.</p></item>
-
- <tag><c>{log_alert, boolean()}</c></tag>
- <item><p>If set to <c>false</c>, error reports are not displayed.</p>
- <p>Deprecated in OTP 22, use <seealso marker="#log_level">log_level</seealso> instead.</p>
- </item>
-
- <tag><marker id="log_level"/><c>{log_level, atom()}</c></tag>
- <item><p>Specifies the log level for TLS/DTLS. It can take the following
- values (ordered by increasing verbosity level): <c>emergency, alert, critical, error,
- warning, notice, info, debug.</c></p>
- <p>At verbosity level <c>notice</c> and above error reports are
- displayed in TLS. The level <c>debug</c> triggers verbose logging of TLS protocol
- messages and logging of ignored alerts in DTLS.</p></item>
-
- <tag><c>{honor_cipher_order, boolean()}</c></tag>
- <item><p>If set to <c>true</c>, use the server preference for cipher
- selection. If set to <c>false</c> (the default), use the client
- preference.</p></item>
-
- <tag><c>{sni_hosts, [{hostname(), [ssl_option()]}]}</c></tag>
- <item><p>If the server receives a SNI (Server Name Indication) from the client
- matching a host listed in the <c>sni_hosts</c> option, the specific options for
- that host will override previously specified options.
-
- The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item>
-
- <tag><c>{sni_fun, SNIfun::fun()}</c></tag>
- <item><p>If the server receives a SNI (Server Name Indication) from the client,
- the given function will be called to retrieve <c>[ssl_option()]</c> for the indicated server.
- These options will be merged into predefined <c>[ssl_option()]</c>.
-
- The function should be defined as:
- <c>fun(ServerName :: string()) -> [ssl_option()]</c>
- and can be specified as a fun or as named <c>fun module:function/1</c>
-
- The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item>
-
- <tag><c>{client_renegotiation, boolean()}</c></tag>
- <item>In protocols that support client-initiated renegotiation, the cost
- of resources of such an operation is higher for the server than the
- client. This can act as a vector for denial of service attacks. The SSL
- application already takes measures to counter-act such attempts,
- but client-initiated renegotiation can be strictly disabled by setting
- this option to <c>false</c>. The default value is <c>true</c>.
- Note that disabling renegotiation can result in long-lived connections
- becoming unusable due to limits on the number of messages the underlying
- cipher suite can encipher.
- </item>
-
- <tag><c>{honor_cipher_order, boolean()}</c></tag>
- <item>If true, use the server's preference for cipher selection. If false
- (the default), use the client's preference.
- </item>
+ <datatype_title>TLS/DTLS OPTION DESCRIPTIONS - SERVER </datatype_title>
+
+
+ <datatype>
+ <name name="server_option"/>
+ </datatype>
+
+ <datatype>
+ <name name="server_cacerts"/>
+ <desc><p>The DER-encoded trusted certificates. If this option
+ is supplied it overrides option <c>cacertfile</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="server_cafile"/>
+ <desc><p>Path to a file containing PEM-encoded CA
+ certificates. The CA certificates are used to build the server
+ certificate chain and for client authentication. The CAs are
+ also used in the list of acceptable client CAs passed to the
+ client when a certificate is requested. Can be omitted if
+ there is no need to verify the client and if there are no
+ intermediate CAs for the server certificate.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="dh_der"/>
+ <desc><p>The DER-encoded Diffie-Hellman parameters. If
+ specified, it overrides option <c>dhfile</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="dh_file"/>
+ <desc><p>Path to a file containing PEM-encoded Diffie Hellman
+ parameters to be used by the server if a cipher suite using
+ Diffie Hellman key exchange is negotiated. If not specified,
+ default parameters are used.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="server_verify_type"/>
+ <desc><p>A server only does x509-path validation in mode
+ <c>verify_peer</c>, as it then sends a certificate request to
+ the client (this message is not sent if the verify option is
+ <c>verify_none</c>). You can then also want to specify option
+ <c>fail_if_no_peer_cert</c>. </p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="fail_if_no_peer_cert"/>
+ <desc><p>Used together with <c>{verify, verify_peer}</c> by an
+ TLS/DTLS server. If set to <c>true</c>, the server fails if
+ the client does not have a certificate to send, that is, sends
+ an empty certificate. If set to <c>false</c>, it fails only if
+ the client sends an invalid certificate (an empty certificate
+ is considered valid). Defaults to false.</p>
+ </desc>
+ </datatype>
- <tag><c>{honor_ecc_order, boolean()}</c></tag>
- <item>If true, use the server's preference for ECC curve selection. If false
- (the default), use the client's preference.
- </item>
-
- <tag><c>{signature_algs, [{hash(), ecdsa | rsa | dsa}]}</c></tag>
- <item><p> The algorithms specified by
- this option will be the ones accepted by the server in a signature algorithm
- negotiation, introduced in TLS-1.2. The algorithms will also be offered to the client if a
- client certificate is requested. For more details see the <seealso marker="#client_signature_algs">corresponding client option</seealso>.
- </p> </item>
- </taglist>
- </section>
-
- <section>
- <title>General</title>
+ <datatype>
+ <name name="server_reuse_sessions"/>
+ <desc><p>The boolean value true specifies that the server will
+ agree to reuse sessions. Setting it to false will result in an empty
+ session table, that is no sessions will be reused.
+ See also option <seealso marker="#type-server_reuse_session">reuse_session</seealso>
+ </p>
+ </desc>
+ </datatype>
- <p>When an TLS/DTLS socket is in active mode (the default), data from the
- socket is delivered to the owner of the socket in the form of
- messages:</p>
+ <datatype>
+ <name name="server_reuse_session"/>
+ <desc><p>Enables the TLS/DTLS server to have a local policy
+ for deciding if a session is to be reused or not. Meaningful
+ only if <c>reuse_sessions</c> is set to <c>true</c>.
+ <c>SuggestedSessionId</c> is a <c>binary()</c>,
+ <c>PeerCert</c> is a DER-encoded certificate,
+ <c>Compression</c> is an enumeration integer, and
+ <c>CipherSuite</c> is of type <c>ciphersuite()</c>.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="server_alpn"/>
+ <desc>
+ <p>Indicates the server will try to perform
+ Application-Layer Protocol Negotiation (ALPN).</p>
+
+ <p>The list of protocols is in order of preference. The
+ protocol negotiated will be the first in the list that
+ matches one of the protocols advertised by the client. If no
+ protocol matches, the server will fail the connection with a
+ "no_application_protocol" alert.</p>
+
+ <p>The negotiated protocol can be retrieved using the
+ <c>negotiated_protocol/1</c> function.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="server_next_protocol"/>
+ <desc><p>List of protocols to send to the client if the client
+ indicates that it supports the Next Protocol extension. The
+ client can 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
+ the <c>negotiated_next_protocol/1</c> method.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="server_psk_identity"/>
+ <desc>
+ <p>Specifies the server identity hint, which the server presents to
+ the client.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="honor_cipher_order"/>
+ <desc>
+ <p>If set to <c>true</c>, use the server preference for cipher
+ selection. If set to <c>false</c> (the default), use the client
+ preference.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="sni_hosts"/>
+ <desc><p>If the server receives a SNI (Server Name Indication) from the client
+ matching a host listed in the <c>sni_hosts</c> option, the specific options for
+ that host will override previously specified options.
+
+ The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="sni_fun"/>
+ <desc>
+ <p>If the server receives a SNI (Server Name Indication)
+ from the client, the given function will be called to
+ retrieve <seealso marker="#type-server_option">[server_option()] </seealso> for the indicated server.
+ These options will be merged into predefined
+ <seealso marker="#type-server_option">[server_option()] </seealso> list.
+
+ The function should be defined as:
+ fun(ServerName :: string()) -> <seealso marker="#type-server_option">[server_option()] </seealso>
+ and can be specified as a fun or as named <c>fun module:function/1</c>
+
+ The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="client_renegotiation"/>
+ <desc><p>In protocols that support client-initiated
+ renegotiation, the cost of resources of such an operation is
+ higher for the server than the client. This can act as a
+ vector for denial of service attacks. The SSL application
+ already takes measures to counter-act such attempts, but
+ client-initiated renegotiation can be strictly disabled by
+ setting this option to <c>false</c>. The default value is
+ <c>true</c>. Note that disabling renegotiation can result in
+ long-lived connections becoming unusable due to limits on the
+ number of messages the underlying cipher suite can
+ encipher.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="honor_cipher_order"/>
+ <desc><p>If true, use the server's preference for cipher
+ selection. If false (the default), use the client's
+ preference.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="honor_ecc_order"/>
+ <desc><p>If true, use the server's preference for ECC curve
+ selection. If false (the default), use the client's
+ preference.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="server_signature_algs"/>
+ <desc><p> The algorithms specified by this option will be the
+ ones accepted by the server in a signature algorithm
+ negotiation, introduced in TLS-1.2. The algorithms will also
+ be offered to the client if a client certificate is
+ requested. For more details see the <seealso
+ marker="#type-client_signature_algs">corresponding client
+ option</seealso>.
+ </p>
+ </desc>
+ </datatype>
+ </datatypes>
- <list type="bulleted">
- <item><p><c>{ssl, Socket, Data}</c></p></item>
- <item><p><c>{ssl_closed, Socket}</c></p></item>
- <item><p><c>{ssl_error, Socket, Reason}</c></p></item>
- </list>
+<!--
+ ================================================================
+ = Function definitions =
+ ================================================================
+-->
- <p>A <c>Timeout</c> argument specifies a time-out in milliseconds. The
- default value for argument <c>Timeout</c> is <c>infinity</c>.</p>
- </section>
-
<funcs>
<func>
<name since="OTP 20.3">append_cipher_suites(Deferred, Suites) -> ciphers() </name>
<fsummary></fsummary>
<type>
- <v>Deferred = ciphers() | cipher_filters() </v>
- <v>Suites = ciphers() </v>
+ <v>Deferred = <seealso marker="#type-ciphers">ciphers()</seealso> |
+ <seealso marker="#type-cipher_filters">cipher_filters()</seealso></v>
+ <v>Suites = <seealso marker="#type-ciphers">ciphers()</seealso></v>
</type>
<desc><p>Make <c>Deferred</c> suites become the least preferred
suites, that is put them at the end of the cipher suite list
@@ -953,7 +1117,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<func>
<name since="OTP R14B">cipher_suites() -></name>
- <name since="OTP R14B">cipher_suites(Type) -> old_ciphers()</name>
+ <name since="OTP R14B">cipher_suites(Type) -> [old_cipher_suite()]</name>
<fsummary>Returns a list of supported cipher suites.</fsummary>
<type>
<v>Type = erlang | openssl | all</v>
@@ -969,7 +1133,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
all supported cipher suites.</fsummary>
<type>
<v> Supported = default | all | anonymous </v>
- <v> Version = protocol_version() </v>
+ <v> Version = <seealso marker="#type-protocol_version">protocol_version() </seealso></v>
</type>
<desc><p>Returns all default or all supported (except anonymous),
or all anonymous cipher suites for a
@@ -979,9 +1143,15 @@ fun(srp, Username :: string(), UserState :: term()) ->
<func>
<name since="OTP 19.2">eccs() -></name>
- <name since="OTP 19.2">eccs(protocol_version()) -> [named_curve()]</name>
+ <name since="OTP 19.2">eccs(Version) -> NamedCurves</name>
<fsummary>Returns a list of supported ECCs.</fsummary>
+ <type>
+ <v> Version = <seealso marker="#type-protocol_version">protocol_version() </seealso></v>
+ <v> NamedCurves = <seealso marker="#type-named_curve">[named_curve()] </seealso></v>
+
+ </type>
+
<desc><p>Returns a list of supported ECCs. <c>eccs()</c>
is equivalent to calling <c>eccs(Protocol)</c> with all
supported protocols and then deduplicating the output.</p>
@@ -1001,39 +1171,46 @@ fun(srp, Username :: string(), UserState :: term()) ->
</func>
<func>
- <name since="OTP R14B">connect(Socket, SslOptions) -> </name>
- <name since="">connect(Socket, SslOptions, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext}
+ <name since="OTP R14B">connect(Socket, Options) -> </name>
+ <name since="">connect(Socket, Options, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext}
| {error, Reason}</name>
<fsummary>Upgrades a <c>gen_tcp</c>, or
equivalent, connected socket to an TLS socket.</fsummary>
<type>
- <v>Socket = socket()</v>
- <v>SslOptions = [{handshake, hello| full} | ssl_option()]</v>
- <v>Timeout = integer() | infinity</v>
- <v>SslSocket = sslsocket()</v>
- <v>Ext = hello_extensions()</v>
- <v>Reason = term()</v>
+ <v>Socket = <seealso marker="#type-socket"> socket() </seealso></v>
+ <v>Options = <seealso marker="#type-tls_client_option"> [tls_client_option()] </seealso></v>
+ <v>Timeout = timeout()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
+ <v>Ext = <seealso marker="#type-protocol_extensions">protocol_extensions()</seealso></v>
+ <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v>
</type>
<desc><p>Upgrades a <c>gen_tcp</c>, or equivalent,
connected socket to an TLS socket, that is, performs the
client-side TLS handshake.</p>
- <note><p>If the option <c>verify</c> is set to <c>verify_peer</c>
- the option <c>server_name_indication</c> shall also be specified,
- if it is not no Server Name Indication extension will be sent,
- and <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>
- will be called with the IP-address of the connection as <c>ReferenceID</c>, which is proably not what you want.</p>
+ <note><p>If the option <c>verify</c> is set to
+ <c>verify_peer</c> the option <c>server_name_indication</c>
+ shall also be specified, if it is not no Server Name
+ Indication extension will be sent, and <seealso
+ marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>
+ will be called with the IP-address of the connection as
+ <c>ReferenceID</c>, which is proably not what you want.</p>
</note>
<p> If the option <c>{handshake, hello}</c> is used the
handshake is paused after receiving the server hello message
and the success response is <c>{ok, SslSocket, Ext}</c>
- instead of <c>{ok, SslSocket}</c>. Thereafter the handshake is continued or
- canceled by calling <seealso marker="#handshake_continue-3">
+ instead of <c>{ok, SslSocket}</c>. Thereafter the handshake
+ is continued or canceled by calling <seealso
+ marker="#handshake_continue-3">
<c>handshake_continue/3</c></seealso> or <seealso
- marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>.
+ marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>.
</p>
+ <p> If the option <c>active</c> is set to <c>once</c>, <c>true</c> or an integer value,
+ the process owning the sslsocket will receive messages of type
+ <seealso marker="#type-active_msgs"> active_msgs() </seealso>
+ </p>
</desc>
</func>
@@ -1043,19 +1220,19 @@ fun(srp, Username :: string(), UserState :: term()) ->
{ok, SslSocket}| {ok, SslSocket, Ext} | {error, Reason}</name>
<fsummary>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</fsummary>
<type>
- <v>Host = host()</v>
- <v>Port = integer()</v>
- <v>Options = [option()]</v>
- <v>Timeout = integer() | infinity</v>
- <v>SslSocket = sslsocket()</v>
- <v>Reason = term()</v>
+ <v>Host =<seealso marker="#type-host"> host() </seealso> </v>
+ <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v>
+ <v>Options = <seealso marker="#type-tls_client_option"> [tls_client_option()]</seealso></v>
+ <v>Timeout = timeout()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
+ <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v>
</type>
<desc><p>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</p>
<p> When the option <c>verify</c> is set to <c>verify_peer</c> the check
<seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>
will be performed in addition to the usual x509-path validation checks. If the check fails the error {bad_cert, hostname_check_failed} will
- be propagated to the path validation fun <seealso marker="#verify_fun">verify_fun</seealso>, where it is possible to do customized
+ be propagated to the path validation fun <seealso marker="#type-custom_verify">verify_fun</seealso>, where it is possible to do customized
checks by using the full possibilities of the <seealso marker="public_key:public_key#pkix_verify_hostname-3">public_key:pkix_verify_hostname/3</seealso> API.
When the option <c>server_name_indication</c> is provided, its value (the DNS name) will be used as <c>ReferenceID</c>
@@ -1077,6 +1254,11 @@ fun(srp, Username :: string(), UserState :: term()) ->
<c>handshake_continue/3</c></seealso> or <seealso
marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>.
</p>
+
+ <p> If the option <c>active</c> is set to <c>once</c>, <c>true</c> or an integer value,
+ the process owning the sslsocket will receive messages of type
+ <seealso marker="#type-active_msgs"> active_msgs() </seealso>
+ </p>
</desc>
</func>
@@ -1084,7 +1266,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="">close(SslSocket) -> ok | {error, Reason}</name>
<fsummary>Closes an TLS/DTLS connection.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Reason = term()</v>
</type>
<desc><p>Closes an TLS/DTLS connection.</p>
@@ -1095,7 +1277,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP 18.1">close(SslSocket, How) -> ok | {ok, port()} | {error, Reason}</name>
<fsummary>Closes an TLS connection.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>How = timeout() | {NewController::pid(), timeout()} </v>
<v>Reason = term()</v>
</type>
@@ -1112,7 +1294,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<fsummary>Assigns a new controlling process to the
TLS/DTLS socket.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>NewOwner = pid()</v>
<v>Reason = term()</v>
</type>
@@ -1128,7 +1310,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<fsummary>Returns all the connection information.
</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Item = protocol | selected_cipher_suite | sni_hostname | ecc | session_id | atom()</v>
<d>Meaningful atoms, not specified above, are the ssl option names.</d>
<v>Result = [{Item::atom(), Value::term()}]</v>
@@ -1149,7 +1331,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<fsummary>Returns the requested connection information.
</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Items = [Item]</v>
<v>Item = protocol | cipher_suite | sni_hostname | ecc | session_id | client_random
| server_random | master_secret | atom()</v>
@@ -1169,8 +1351,8 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP 20.3">filter_cipher_suites(Suites, Filters) -> ciphers()</name>
<fsummary></fsummary>
<type>
- <v> Suites = ciphers()</v>
- <v> Filters = cipher_filters()</v>
+ <v> Suites = <seealso marker="#type-ciphers"> ciphers() </seealso></v>
+ <v> Filters = <seealso marker="#type-cipher_filters"> cipher_filters() </seealso></v>
</type>
<desc><p>Removes cipher suites if any of the filter functions
returns false for any part of the cipher suite. This function
@@ -1196,7 +1378,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
{ok, [socketoption()]} | {error, Reason}</name>
<fsummary>Gets the values of the specified options.</fsummary>
<type>
- <v>Socket = sslsocket()</v>
+ <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>OptionNames = [atom()]</v>
</type>
<desc>
@@ -1212,7 +1394,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
{ok, OptionValues} | {error, inet:posix()}</name>
<fsummary>Get one or more statistic options for a socket</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>OptionNames = [atom()]</v>
<v>OptionValues = [{inet:stat_option(), integer()}]</v>
</type>
@@ -1227,27 +1409,32 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP 21.0">handshake(HsSocket, Timeout) -> {ok, SslSocket} | {error, Reason}</name>
<fsummary>Performs server-side SSL/TLS handshake.</fsummary>
<type>
- <v>HsSocket = SslSocket = sslsocket()</v>
- <v>Timeout = integer()</v>
- <v>Reason = term()</v>
+ <v>HsSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
+ <v>Timeout = timeout()</v>
+ <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v>
</type>
<desc>
<p>Performs the SSL/TLS/DTLS server-side handshake.</p>
<p>Returns a new TLS/DTLS socket if the handshake is successful.</p>
+
+ <p> If the option <c>active</c> is set to <c>once</c>, <c>true</c> or an integer value,
+ the process owning the sslsocket will receive messages of type
+ <seealso marker="#type-active_msgs"> active_msgs() </seealso>
+ </p>
</desc>
</func>
<func>
- <name since="OTP 21.0">handshake(Socket, SslOptions) -> </name>
- <name since="OTP 21.0">handshake(Socket, SslOptions, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason}</name>
+ <name since="OTP 21.0">handshake(Socket, Options) -> </name>
+ <name since="OTP 21.0">handshake(Socket, Options, Timeout) -> {ok, SslSocket} | {ok, SslSocket, Ext} | {error, Reason}</name>
<fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary>
<type>
- <v>Socket = socket() | sslsocket() </v>
- <v>SslSocket = sslsocket() </v>
- <v>Ext = hello_extensions()</v>
- <v>SslOptions = [{handshake, hello| full} | ssl_option()]</v>
- <v>Timeout = integer()</v>
- <v>Reason = term()</v>
+ <v>Socket = socket() | <seealso marker="#type-sslsocket"> socket() </seealso> </v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v>
+ <v>Ext = <seealso marker="#type-protocol_extensions">protocol_extensions()</seealso></v>
+ <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso> </v>
+ <v>Timeout = timeout()</v>
+ <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v>
</type>
<desc>
<p>If <c>Socket</c> is a ordinary <c>socket()</c>: upgrades a <c>gen_tcp</c>,
@@ -1259,7 +1446,8 @@ fun(srp, Username :: string(), UserState :: term()) ->
is undefined.
</p></warning>
- <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS/DTLS
+ <p>If <c>Socket</c> is an
+ <seealso marker="#type-sslsocket"> sslsocket() </seealso>: provides extra SSL/TLS/DTLS
options to those specified in
<seealso marker="#listen-2">listen/2 </seealso> and then performs
the SSL/TLS/DTLS handshake. Returns a new TLS/DTLS socket if the handshake is successful.</p>
@@ -1273,6 +1461,12 @@ fun(srp, Username :: string(), UserState :: term()) ->
<c>handshake_continue/3</c></seealso> or <seealso
marker="#handshake_cancel-1"><c>handshake_cancel/1</c></seealso>.
</p>
+
+ <p> If the option <c>active</c> is set to <c>once</c>, <c>true</c> or an integer value,
+ the process owning the sslsocket will receive messages of type
+ <seealso marker="#type-active_msgs"> active_msgs() </seealso>
+ </p>
+
</desc>
</func>
@@ -1280,7 +1474,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP 21.0">handshake_cancel(SslSocket) -> ok </name>
<fsummary>Cancel handshake with a fatal alert</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
</type>
<desc>
<p>Cancel the handshake with a fatal <c>USER_CANCELED</c> alert.</p>
@@ -1288,14 +1482,14 @@ fun(srp, Username :: string(), UserState :: term()) ->
</func>
<func>
- <name since="OTP 21.0">handshake_continue(HsSocket, SSLOptions) -> {ok, SslSocket} | {error, Reason}</name>
- <name since="OTP 21.0">handshake_continue(HsSocket, SSLOptions, Timeout) -> {ok, SslSocket} | {error, Reason}</name>
+ <name since="OTP 21.0">handshake_continue(HsSocket, Options) -> {ok, SslSocket} | {error, Reason}</name>
+ <name since="OTP 21.0">handshake_continue(HsSocket, Options, Timeout) -> {ok, SslSocket} | {error, Reason}</name>
<fsummary>Continue the SSL/TLS handshake.</fsummary>
<type>
- <v>HsSocket = SslSocket = sslsocket()</v>
- <v>SslOptions = [ssl_option()]</v>
- <v>Timeout = integer()</v>
- <v>Reason = term()</v>
+ <v>HsSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
+ <v>Options = <seealso marker="#type-tls_option"> tls_option() </seealso> </v>
+ <v>Timeout = timeout()</v>
+ <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v>
</type>
<desc>
<p>Continue the SSL/TLS handshake possiby with new, additional or changed options.</p>
@@ -1307,9 +1501,9 @@ fun(srp, Username :: string(), UserState :: term()) ->
{ok, ListenSocket} | {error, Reason}</name>
<fsummary>Creates an SSL listen socket.</fsummary>
<type>
- <v>Port = integer()</v>
- <v>Options = options()</v>
- <v>ListenSocket = sslsocket()</v>
+ <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v>
+ <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso></v>
+ <v>ListenSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
</type>
<desc>
<p>Creates an SSL listen socket.</p>
@@ -1320,7 +1514,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP 18.0">negotiated_protocol(SslSocket) -> {ok, Protocol} | {error, protocol_not_negotiated}</name>
<fsummary>Returns the protocol negotiated through ALPN or NPN extensions.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Protocol = binary()</v>
</type>
<desc>
@@ -1334,7 +1528,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="">peercert(SslSocket) -> {ok, Cert} | {error, Reason}</name>
<fsummary>Returns the peer certificate.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Cert = binary()</v>
</type>
<desc>
@@ -1350,9 +1544,9 @@ fun(srp, Username :: string(), UserState :: term()) ->
{error, Reason}</name>
<fsummary>Returns the peer address and port.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Address = ipaddress()</v>
- <v>Port = integer()</v>
+ <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v>
</type>
<desc>
<p>Returns the address and port number of the peer.</p>
@@ -1363,8 +1557,9 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP 20.3">prepend_cipher_suites(Preferred, Suites) -> ciphers()</name>
<fsummary></fsummary>
<type>
- <v>Preferred = ciphers() | cipher_filters() </v>
- <v>Suites = ciphers() </v>
+ <v>Preferred = <seealso marker="#type-ciphers">ciphers()</seealso> |
+ <seealso marker="#type-cipher_filters">cipher_filters()</seealso></v>
+ <v>Suites = <seealso marker="#type-ciphers">ciphers()</seealso></v>
</type>
<desc><p>Make <c>Preferred</c> suites become the most preferred
suites that is put them at the head of the cipher suite list
@@ -1379,10 +1574,10 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP R15B01">prf(Socket, Secret, Label, Seed, WantedLength) -> {ok, binary()} | {error, reason()}</name>
<fsummary>Uses a session Pseudo-Random Function to generate key material.</fsummary>
<type>
- <v>Socket = sslsocket()</v>
+ <v>Socket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Secret = binary() | master_secret</v>
<v>Label = binary()</v>
- <v>Seed = [binary() | prf_random()]</v>
+ <v>Seed = [binary() | <seealso marker="#type-prf_random"> prf_random()</seealso>]</v>
<v>WantedLength = non_neg_integer()</v>
</type>
<desc>
@@ -1401,9 +1596,9 @@ fun(srp, Username :: string(), UserState :: term()) ->
Reason}</name>
<fsummary>Receives data on a socket.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Length = integer()</v>
- <v>Timeout = integer()</v>
+ <v>Timeout = timeout()</v>
<v>Data = [char()] | binary()</v>
</type>
<desc>
@@ -1426,7 +1621,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP R14B">renegotiate(SslSocket) -> ok | {error, Reason}</name>
<fsummary>Initiates a new handshake.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
</type>
<desc><p>Initiates a new handshake. A notable return value is
<c>{error, renegotiation_rejected}</c> indicating that the peer
@@ -1439,7 +1634,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="">send(SslSocket, Data) -> ok | {error, Reason}</name>
<fsummary>Writes data to a socket.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>Data = iodata()</v>
</type>
<desc>
@@ -1453,8 +1648,8 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="">setopts(SslSocket, Options) -> ok | {error, Reason}</name>
<fsummary>Sets socket options.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
- <v>Options = [socketoption]()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
+ <v>Options = <seealso marker="#type-socket_option"> [socket_option()] </seealso></v>
</type>
<desc>
<p>Sets options according to <c>Options</c> for socket
@@ -1463,21 +1658,10 @@ fun(srp, Username :: string(), UserState :: term()) ->
</func>
<func>
- <name since="OTP 22.0">set_log_level(Level) -> ok | {error, Reason}</name>
- <fsummary>Sets log level for the SSL application.</fsummary>
- <type>
- <v>Level = atom()</v>
- </type>
- <desc>
- <p>Sets log level for the SSL application.</p>
- </desc>
- </func>
-
- <func>
<name since="OTP R14B">shutdown(SslSocket, How) -> ok | {error, Reason}</name>
<fsummary>Immediately closes a socket.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
<v>How = read | write | read_write</v>
<v>Reason = reason()</v>
</type>
@@ -1496,9 +1680,9 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="">ssl_accept(SslSocket, Timeout) -> ok | {error, Reason}</name>
<fsummary>Performs server-side SSL/TLS handshake.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
- <v>Timeout = integer()</v>
- <v>Reason = term()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
+ <v>Timeout = timeout()</v>
+ <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v>
</type>
<desc>
<p>Deprecated in OTP 21, use <seealso marker="#handshake-1">handshake/[1,2]</seealso> instead.</p>
@@ -1507,14 +1691,14 @@ fun(srp, Username :: string(), UserState :: term()) ->
</func>
<func>
- <name since="">ssl_accept(Socket, SslOptions) -> </name>
- <name since="OTP R14B">ssl_accept(Socket, SslOptions, Timeout) -> {ok, Socket} | ok | {error, Reason}</name>
+ <name since="">ssl_accept(Socket, Options) -> </name>
+ <name since="OTP R14B">ssl_accept(Socket, Options, Timeout) -> {ok, Socket} | ok | {error, Reason}</name>
<fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary>
<type>
- <v>Socket = socket() | sslsocket() </v>
- <v>SslOptions = [ssl_option()]</v>
- <v>Timeout = integer()</v>
- <v>Reason = term()</v>
+ <v>Socket = socket() | <seealso marker="#type-sslsocket"> sslsocket() </seealso> </v>
+ <v>Options = <seealso marker="#type-tls_server_option"> [server_option()] </seealso> </v>
+ <v>Timeout = timeout()</v>
+ <v>Reason = closed | timeout | <seealso marker="#type-error_alert"> error_alert() </seealso></v>
</type>
<desc>
<p>Deprecated in OTP 21, use <seealso marker="#handshake-3">handshake/[2,3]</seealso> instead.</p>
@@ -1527,9 +1711,9 @@ fun(srp, Username :: string(), UserState :: term()) ->
{error, Reason}</name>
<fsummary>Returns the local address and port.</fsummary>
<type>
- <v>SslSocket = sslsocket()</v>
- <v>Address = ipaddress()</v>
- <v>Port = integer()</v>
+ <v>SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
+ <v>Address = <seealso marker="#type-ip_address">ip_address()</seealso></v>
+ <v>Port = <seealso marker="kernel:inet#type-port_number">inet:port_number()</seealso></v>
</type>
<desc>
<p>Returns the local address and port number of socket
@@ -1562,7 +1746,7 @@ fun(srp, Username :: string(), UserState :: term()) ->
<name since="OTP 21.0">suite_to_str(CipherSuite) -> String</name>
<fsummary>Returns the string representation of a cipher suite.</fsummary>
<type>
- <v>CipherSuite = erl_cipher_suite()</v>
+ <v>CipherSuite = <seealso marker="#type-erl_cipher_suite"> erl_cipher_suite() </seealso></v>
<v>String = string()</v>
</type>
<desc>
@@ -1577,8 +1761,8 @@ fun(srp, Username :: string(), UserState :: term()) ->
<fsummary>Accepts an incoming connection and
prepares for <c>ssl_accept</c>.</fsummary>
<type>
- <v>ListenSocket = SslSocket = sslsocket()</v>
- <v>Timeout = integer()</v>
+ <v>ListenSocket = SslSocket = <seealso marker="#type-sslsocket"> sslsocket() </seealso></v>
+ <v>Timeout = timeout()</v>
<v>Reason = reason()</v>
</type>
<desc>
diff --git a/lib/ssl/doc/src/ssl_crl_cache.xml b/lib/ssl/doc/src/ssl_crl_cache.xml
index b766cfd2d9..a33aec62a7 100644
--- a/lib/ssl/doc/src/ssl_crl_cache.xml
+++ b/lib/ssl/doc/src/ssl_crl_cache.xml
@@ -34,15 +34,27 @@
the following functions are available.
</p>
</description>
+
+ <datatypes>
+ <datatype_title>DATA TYPES</datatype_title>
+
+ <datatype>
+ <name name="crl_src"/>
+ </datatype>
+
+ <datatype>
+ <name name="uri"/>
+ </datatype>
+
+ </datatypes>
<funcs>
<func>
<name since="OTP 18.0">delete(Entries) -> ok | {error, Reason} </name>
<fsummary> </fsummary>
<type>
- <v> Entries = <seealso marker="stdlib:uri_string">uri_string:uri_string()</seealso> | {file, string()} | {der, [<seealso
- marker="public_key:public_key"> public_key:der_encoded() </seealso>]}</v>
- <v> Reason = term()</v>
+ <v> Entries = <seealso marker="#type-crl_src">crl_src()</seealso>]}</v>
+ <v> Reason = crl_reason()</v>
</type>
<desc>
<p>Delete CRLs from the ssl applications local cache. </p>
@@ -53,13 +65,12 @@
<name since="OTP 18.0">insert(URI, CRLSrc) -> ok | {error, Reason}</name>
<fsummary> </fsummary>
<type>
- <v> CRLSrc = {file, string()} | {der, [ <seealso
- marker="public_key:public_key"> public_key:der_encoded() </seealso> ]}</v>
- <v> URI = <seealso marker="stdlib:uri_string">uri_string:uri_string() </seealso> </v>
+ <v> CRLSrc = <seealso marker="#type-crl_src">crl_src()</seealso>]}</v>
+ <v> URI = <seealso marker="#type-uri">uri()</seealso> </v>
<v> Reason = term()</v>
</type>
<desc>
- <p>Insert CRLs into the ssl applications local cache. </p>
+ <p>Insert CRLs, available to fetch on DER format from <c>URI</c>, into the ssl applications local cache. </p>
</desc>
</func>
</funcs>
diff --git a/lib/ssl/doc/src/ssl_crl_cache_api.xml b/lib/ssl/doc/src/ssl_crl_cache_api.xml
index c7e501867f..4cba4e1de1 100644
--- a/lib/ssl/doc/src/ssl_crl_cache_api.xml
+++ b/lib/ssl/doc/src/ssl_crl_cache_api.xml
@@ -39,35 +39,44 @@
a CRL cache.
</p>
</description>
-
- <section>
- <title>DATA TYPES</title>
-
- <p>The following data types are used in the functions below:
- </p>
-
- <taglist>
-
- <tag><c>cache_ref() =</c></tag>
- <item>opaque()</item>
- <tag><c>dist_point() =</c></tag>
- <item><p>#'DistributionPoint'{} see <seealso
- marker="public_key:public_key_records"> X509 certificates records</seealso></p></item>
-
- </taglist>
+
+
+ <!--
+ ================================================================
+ = Data types =
+ ================================================================
+ -->
+
+ <datatypes>
- </section>
+ <datatype>
+ <name name="crl_cache_ref"/>
+ <desc>
+ <p>Reference to the CRL cache.</p>
+ </desc>
+ </datatype>
+
+
+ <datatype>
+ <name name="dist_point"/>
+ <desc>
+ <p>For description see <seealso
+ marker="public_key:public_key_records"> X509 certificates records</seealso></p>
+ </desc>
+ </datatype>
+ </datatypes>
+
<funcs>
<func>
<name since="OTP 18.0">fresh_crl(DistributionPoint, CRL) -> FreshCRL</name>
<fsummary> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to
public_key:pkix_crls_validate/3 </fsummary>
<type>
- <v> DistributionPoint = dist_point() </v>
+ <v> DistributionPoint = <seealso marker="#type-dist_point"> dist_point() </seealso> </v>
<v> CRL = [<seealso
- marker="public_key:public_key">public_key:der_encoded()</seealso>] </v>
+ marker="public_key:public_key#type-der_encoded">public_key:der_encoded()</seealso>] </v>
<v> FreshCRL = [<seealso
- marker="public_key:public_key">public_key:der_encoded()</seealso>] </v>
+ marker="public_key:public_key#type-der_encoded">public_key:der_encoded()</seealso>] </v>
</type>
<desc>
<p> <c>fun fresh_crl/2 </c> will be used as input option <c>update_crl</c> to
@@ -80,12 +89,12 @@
<name since="OTP 18.0">lookup(DistributionPoint, DbHandle) -> not_available | CRLs </name>
<fsummary> </fsummary>
<type>
- <v> DistributionPoint = dist_point() </v>
+ <v> DistributionPoint = <seealso marker="#type-dist_point"> dist_point() </seealso> </v>
<v> Issuer = <seealso
- marker="public_key:public_key">public_key:issuer_name()</seealso> </v>
- <v> DbHandle = cache_ref() </v>
+ marker="public_key:public_key#type-issuer_name">public_key:issuer_name()</seealso> </v>
+ <v> DbHandle = <seealso marker="#type-crl_cache_ref"> crl_cache_ref() </seealso></v>
<v> CRLs = [<seealso
- marker="public_key:public_key">public_key:der_encoded()</seealso>] </v>
+ marker="public_key:public_key#type-der_encoded">public_key:der_encoded()</seealso>] </v>
</type>
<desc> <p>Lookup the CRLs belonging to the distribution point <c> Distributionpoint</c>.
This function may choose to only look in the cache or to follow distribution point
@@ -110,8 +119,8 @@
<fsummary>Select the CRLs in the cache that are issued by <c>Issuer</c></fsummary>
<type>
<v> Issuer = <seealso
- marker="public_key:public_key">public_key:issuer_name()</seealso></v>
- <v> DbHandle = cache_ref() </v>
+ marker="public_key:public_key#type-issuer_name">public_key:issuer_name()</seealso></v>
+ <v> DbHandle = <seealso marker="#type-crl_cache_ref"> cache_ref() </seealso></v>
</type>
<desc>
<p>Select the CRLs in the cache that are issued by <c>Issuer</c> </p>
diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml
index 463cf15309..e841729e57 100644
--- a/lib/ssl/doc/src/ssl_session_cache_api.xml
+++ b/lib/ssl/doc/src/ssl_session_cache_api.xml
@@ -38,30 +38,41 @@
defining a new callback module implementing this API.
</p>
</description>
- <section>
- <title>DATA TYPES</title>
- <p>The following data types are used in the functions for
- <c>ssl_session_cache_api</c>:</p>
-
- <taglist>
- <tag><c>cache_ref() =</c></tag>
- <item><p><c>opaque()</c></p></item>
-
- <tag><c>key() =</c></tag>
- <item><p><c>{partialkey(), session_id()}</c></p></item>
-
- <tag><c>partialkey() =</c></tag>
- <item><p><c>opaque()</c></p></item>
-
- <tag><c>session_id() =</c></tag>
- <item><p><c>binary()</c></p></item>
-
- <tag><c>session()</c> =</tag>
- <item><p><c>opaque()</c></p></item>
- </taglist>
-
- </section>
+ <!--
+ ================================================================
+ = Data types =
+ ================================================================
+ -->
+
+ <datatypes>
+
+ <datatype>
+ <name name="session_cache_ref"/>
+ </datatype>
+
+ <datatype>
+ <name name="session_cache_key"/>
+ <desc>
+ <p>A key to an entry in the session cache.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="partial_key"/>
+ <desc>
+ <p>The opaque part of the key. Does not need to be handled
+ by the callback.</p>
+ </desc>
+ </datatype>
+
+ <datatype>
+ <name name="session"/>
+ <desc>
+ <p>The session data that is stored for each session.</p>
+ </desc>
+ </datatype>
+ </datatypes>
<funcs>
@@ -69,8 +80,8 @@
<name since="OTP R14B">delete(Cache, Key) -> _</name>
<fsummary>Deletes a cache entry.</fsummary>
<type>
- <v>Cache = cache_ref()</v>
- <v>Key = key()</v>
+ <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v>
+ <v>Key = <seealso marker="#type-session_cache_key">session_cache_key() </seealso> </v>
</type>
<desc>
<p>Deletes a cache entry. Is only called from the cache
@@ -83,7 +94,9 @@
<name since="OTP R14B">foldl(Fun, Acc0, Cache) -> Acc</name>
<fsummary></fsummary>
<type>
- <v></v>
+ <v>Fun = fun()</v>
+ <v>Acc0 = Acc = term()</v>
+ <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v>
</type>
<desc>
<p>Calls <c>Fun(Elem, AccIn)</c> on successive elements of the
@@ -96,10 +109,11 @@
</func>
<func>
- <name since="OTP 18.0">init(Args) -> opaque() </name>
+ <name since="OTP 18.0">init(Args) -> Cache </name>
<fsummary>Returns cache reference.</fsummary>
<type>
- <v>Args = proplists:proplist()</v>
+ <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v>
+ <v>Args = <seealso marker="stdlib:proplists#type-proplist">proplists:proplist()</seealso></v>
</type>
<desc>
<p>Includes property <c>{role, client | server}</c>.
@@ -124,9 +138,9 @@
<name since="OTP R14B">lookup(Cache, Key) -> Entry</name>
<fsummary>Looks up a cache entry.</fsummary>
<type>
- <v>Cache = cache_ref()</v>
- <v>Key = key()</v>
- <v>Entry = session() | undefined</v>
+ <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v>
+ <v>Key = <seealso marker="#type-session_cache_key">session_cache_key()</seealso> </v>
+ <v>Session = <seealso marker="#type-session">session()</seealso> | undefined</v>
</type>
<desc>
<p>Looks up a cache entry. Is to be callable from any
@@ -136,12 +150,12 @@
</func>
<func>
- <name since="OTP R14B">select_session(Cache, PartialKey) -> [session()]</name>
+ <name since="OTP R14B">select_session(Cache, PartialKey) -> [Session]</name>
<fsummary>Selects sessions that can be reused.</fsummary>
<type>
- <v>Cache = cache_ref()</v>
- <v>PartialKey = partialkey()</v>
- <v>Session = session()</v>
+ <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v>
+ <v>PartialKey = <seealso marker="#type-partial_key"> partial_key() </seealso></v>
+ <v>Session = <seealso marker="#type-session">session()</seealso></v>
</type>
<desc>
<p>Selects sessions that can be reused. Is to be callable
@@ -154,7 +168,7 @@
<name since="OTP 19.3">size(Cache) -> integer()</name>
<fsummary>Returns the number of sessions in the cache.</fsummary>
<type>
- <v>Cache = cache_ref()</v>
+ <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v>
</type>
<desc>
<p>Returns the number of sessions in the cache. If size
@@ -170,7 +184,8 @@
<fsummary>Called by the process that handles the cache when it
is about to terminate.</fsummary>
<type>
- <v>Cache = term() - as returned by init/0</v>
+ <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v>
+ <d>As returned by init/0</d>
</type>
<desc>
<p>Takes care of possible cleanup that is needed when the
@@ -183,9 +198,9 @@
<name since="OTP R14B">update(Cache, Key, Session) -> _</name>
<fsummary>Caches a new session or updates an already cached one.</fsummary>
<type>
- <v>Cache = cache_ref()</v>
- <v>Key = key()</v>
- <v>Session = session()</v>
+ <v>Cache = <seealso marker="#type-session_cache_ref"> session_cache_ref() </seealso></v>
+ <v>Key = <seealso marker="#type-session_cache_key">session_cache_key()</seealso> </v>
+ <v>Session = <seealso marker="#type-session">session()</seealso></v>
</type>
<desc>
<p>Caches a new session or updates an already cached one. Is
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index cbd5c8e0a9..ed47980a69 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -51,8 +51,7 @@
-export([encode_alert/3, send_alert/2, send_alert_in_connection/2, close/5, protocol_name/0]).
%% Data handling
--export([encode_data/3, next_record/1,
- send/3, socket/5, setopts/3, getopts/3]).
+-export([next_record/1, socket/4, setopts/3, getopts/3]).
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
@@ -81,7 +80,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker}
end.
%%--------------------------------------------------------------------
--spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) ->
+-spec start_link(atom(), ssl:host(), inet:port_number(), port(), list(), pid(), tuple()) ->
{ok, pid()} | ignore | {error, reason()}.
%%
%% Description: Creates a gen_statem process which calls Module:init/1 to
@@ -251,10 +250,11 @@ handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, Stat
handle_protocol_record(#ssl_tls{type = ?HANDSHAKE,
fragment = Data},
StateName,
- #state{protocol_buffers = Buffers0,
- negotiated_version = Version} = State) ->
+ #state{protocol_buffers = Buffers0,
+ connection_env = #connection_env{negotiated_version = Version},
+ ssl_options = Options} = State) ->
try
- case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of
+ case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0, Options) of
{[], Buffers} ->
next_event(StateName, no_record, State#state{protocol_buffers = Buffers});
{Packets, Buffers} ->
@@ -274,7 +274,7 @@ handle_protocol_record(#ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, St
{next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]};
%%% DTLS record protocol level Alert messages
handle_protocol_record(#ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName,
- #state{negotiated_version = Version} = State) ->
+ #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
case decode_alerts(EncAlerts) of
Alerts = [_|_] ->
handle_alerts(Alerts, {next_state, StateName, State});
@@ -306,22 +306,28 @@ send_handshake(Handshake, #state{connection_states = ConnectionStates} = State)
send_handshake_flight(queue_handshake(Handshake, State), Epoch).
queue_handshake(Handshake0, #state{handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv,
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
flight_buffer = #{handshakes := HsBuffer0,
change_cipher_spec := undefined,
- next_sequence := Seq} = Flight0} = State) ->
+ next_sequence := Seq} = Flight0,
+ ssl_options = SslOpts} = State) ->
Handshake = dtls_handshake:encode_handshake(Handshake0, Version, Seq),
Hist = update_handshake_history(Handshake0, Handshake, Hist0),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Handshake0),
+
State#state{flight_buffer = Flight0#{handshakes => [Handshake | HsBuffer0],
next_sequence => Seq +1},
handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}};
queue_handshake(Handshake0, #state{handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv,
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
flight_buffer = #{handshakes_after_change_cipher_spec := Buffer0,
- next_sequence := Seq} = Flight0} = State) ->
+ next_sequence := Seq} = Flight0,
+ ssl_options = SslOpts} = State) ->
Handshake = dtls_handshake:encode_handshake(Handshake0, Version, Seq),
Hist = update_handshake_history(Handshake0, Handshake, Hist0),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Handshake0),
+
State#state{flight_buffer = Flight0#{handshakes_after_change_cipher_spec => [Handshake | Buffer0],
next_sequence => Seq +1},
handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}}.
@@ -329,19 +335,21 @@ queue_handshake(Handshake0, #state{handshake_env = #handshake_env{tls_handshake_
queue_change_cipher(ChangeCipher, #state{flight_buffer = Flight,
connection_states = ConnectionStates0} = State) ->
ConnectionStates =
- dtls_record:next_epoch(ConnectionStates0, write),
+ dtls_record:next_epoch(ConnectionStates0, write),
State#state{flight_buffer = Flight#{change_cipher_spec => ChangeCipher},
connection_states = ConnectionStates}.
reinit(State) ->
%% To be API compatible with TLS NOOP here
reinit_handshake_data(State).
-reinit_handshake_data(#state{protocol_buffers = Buffers,
+reinit_handshake_data(#state{static_env = #static_env{data_tag = DataTag},
+ protocol_buffers = Buffers,
+ protocol_specific = PS,
handshake_env = HsEnv} = State) ->
- State#state{premaster_secret = undefined,
- public_key_info = undefined,
- handshake_env = HsEnv#handshake_env{tls_handshake_history = ssl_handshake:init_handshake_history()},
- flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT},
+ State#state{handshake_env = HsEnv#handshake_env{tls_handshake_history = ssl_handshake:init_handshake_history(),
+ public_key_info = undefined,
+ premaster_secret = undefined},
+ protocol_specific = PS#{flight_state => initial_flight_state(DataTag)},
flight_buffer = new_flight(),
protocol_buffers =
Buffers#protocol_buffers{
@@ -365,13 +373,16 @@ empty_connection_state(ConnectionEnd, BeastMitigation) ->
encode_alert(#alert{} = Alert, Version, ConnectionStates) ->
dtls_record:encode_alert_record(Alert, Version, ConnectionStates).
-send_alert(Alert, #state{negotiated_version = Version,
- static_env = #static_env{socket = Socket,
+send_alert(Alert, #state{static_env = #static_env{socket = Socket,
transport_cb = Transport},
- connection_states = ConnectionStates0} = State0) ->
+
+ connection_env = #connection_env{negotiated_version = Version},
+ connection_states = ConnectionStates0,
+ ssl_options = SslOpts} = State0) ->
{BinMsg, ConnectionStates} =
encode_alert(Alert, Version, ConnectionStates0),
send(Transport, Socket, BinMsg),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'record', BinMsg),
State0#state{connection_states = ConnectionStates}.
send_alert_in_connection(Alert, State) ->
@@ -391,16 +402,13 @@ protocol_name() ->
%% Data handling
%%====================================================================
-encode_data(Data, Version, ConnectionStates0)->
- dtls_record:encode_data(Data, Version, ConnectionStates0).
-
-send(Transport, {_, {{_,_}, _} = Socket}, Data) ->
- send(Transport, Socket, Data);
-send(Transport, Socket, Data) ->
- dtls_socket:send(Transport, Socket, Data).
+send(Transport, {Listener, Socket}, Data) when is_pid(Listener) -> % Server socket
+ dtls_socket:send(Transport, Socket, Data);
+send(Transport, Socket, Data) -> % Client socket
+ dtls_socket:send(Transport, Socket, Data).
-socket(Pid, Transport, Socket, Connection, _) ->
- dtls_socket:socket(Pid, Transport, Socket, Connection).
+socket(Pid, Transport, Socket, _Tracker) ->
+ dtls_socket:socket(Pid, Transport, Socket, ?MODULE).
setopts(Transport, Socket, Other) ->
dtls_socket:setopts(Transport, Socket, Other).
@@ -425,40 +433,33 @@ init({call, From}, {start, Timeout},
session_cache = Cache,
session_cache_cb = CacheCb},
handshake_env = #handshake_env{renegotiation = {Renegotiation, _}},
+ connection_env = CEnv,
ssl_options = SslOpts,
session = #session{own_certificate = Cert} = Session0,
connection_states = ConnectionStates0
} = State0) ->
- Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From),
Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
Cache, CacheCb, Renegotiation, Cert),
Version = Hello#client_hello.client_version,
HelloVersion = dtls_record:hello_version(Version, SslOpts#ssl_options.versions),
- State1 = prepare_flight(State0#state{negotiated_version = Version}),
- {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
- State3 = State2#state{negotiated_version = Version, %% Requested version
+ State1 = prepare_flight(State0#state{connection_env = CEnv#connection_env{negotiated_version = Version}}),
+ {State2, Actions} = send_handshake(Hello, State1#state{connection_env = CEnv#connection_env{negotiated_version = HelloVersion}}),
+ State3 = State2#state{connection_env = CEnv#connection_env{negotiated_version = Version}, %% RequestedVersion
session =
Session0#session{session_id = Hello#client_hello.session_id},
- start_or_recv_from = From,
- timer = Timer,
- flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}
- },
+ start_or_recv_from = From},
{Record, State} = next_record(State3),
- next_event(hello, Record, State, Actions);
-init({call, _} = Type, Event, #state{static_env = #static_env{role = server,
- data_tag = udp}} = State) ->
+ next_event(hello, Record, State, [{{timeout, handshake}, Timeout, close} | Actions]);
+init({call, _} = Type, Event, #state{static_env = #static_env{role = server},
+ protocol_specific = PS} = State) ->
Result = gen_handshake(?FUNCTION_NAME, Type, Event,
- State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT},
- protocol_specific = #{current_cookie_secret => dtls_v1:cookie_secret(),
- previous_cookie_secret => <<>>,
- ignored_alerts => 0,
- max_ignored_alerts => 10}}),
+ State#state{protocol_specific = PS#{current_cookie_secret => dtls_v1:cookie_secret(),
+ previous_cookie_secret => <<>>,
+ ignored_alerts => 0,
+ max_ignored_alerts => 10}}),
erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret),
Result;
-init({call, _} = Type, Event, #state{static_env = #static_env{role = server}} = State) ->
- %% I.E. DTLS over sctp
- gen_handshake(?FUNCTION_NAME, Type, Event, State#state{flight_state = reliable});
init(Type, Event, State) ->
gen_handshake(?FUNCTION_NAME, Type, Event, State).
@@ -495,6 +496,7 @@ hello(internal, #client_hello{cookie = <<>>,
transport_cb = Transport,
socket = Socket},
handshake_env = HsEnv,
+ connection_env = CEnv,
protocol_specific = #{current_cookie_secret := Secret}} = State0) ->
{ok, {IP, Port}} = dtls_socket:peername(Transport, Socket),
Cookie = dtls_handshake:cookie(Secret, IP, Port, Hello),
@@ -505,7 +507,7 @@ hello(internal, #client_hello{cookie = <<>>,
%% version 1.0 regardless of the version of TLS that is expected to be
%% negotiated.
VerifyRequest = dtls_handshake:hello_verify_request(Cookie, ?HELLO_VERIFY_REQUEST_VERSION),
- State1 = prepare_flight(State0#state{negotiated_version = Version}),
+ State1 = prepare_flight(State0#state{connection_env = CEnv#connection_env{negotiated_version = Version}}),
{State2, Actions} = send_handshake(VerifyRequest, State1),
{Record, State} = next_record(State2),
next_event(?FUNCTION_NAME, Record,
@@ -519,6 +521,7 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{static_env = #sta
session_cache = Cache,
session_cache_cb = CacheCb},
handshake_env = #handshake_env{renegotiation = {Renegotiation, _}} = HsEnv,
+ connection_env = CEnv,
ssl_options = SslOpts,
session = #session{own_certificate = OwnCert}
= Session0,
@@ -534,22 +537,26 @@ hello(internal, #hello_verify_request{cookie = Cookie}, #state{static_env = #sta
= ssl_handshake:init_handshake_history()}}),
{State2, Actions} = send_handshake(Hello, State1),
- State = State2#state{negotiated_version = Version, %% Requested version
+ State = State2#state{connection_env = CEnv#connection_env{negotiated_version = Version}, %% Requested version
session =
Session0#session{session_id =
Hello#client_hello.session_id}},
next_event(?FUNCTION_NAME, no_record, State, Actions);
hello(internal, #client_hello{extensions = Extensions} = Hello,
#state{ssl_options = #ssl_options{handshake = hello},
+ handshake_env = HsEnv,
start_or_recv_from = From} = State) ->
{next_state, user_hello, State#state{start_or_recv_from = undefined,
- hello = Hello},
+ handshake_env = HsEnv#handshake_env{hello = Hello}},
[{reply, From, {ok, Extensions}}]};
-hello(internal, #server_hello{extensions = Extensions} = Hello, #state{ssl_options = #ssl_options{handshake = hello},
- start_or_recv_from = From} = State) ->
+hello(internal, #server_hello{extensions = Extensions} = Hello,
+ #state{ssl_options = #ssl_options{handshake = hello},
+ handshake_env = HsEnv,
+ start_or_recv_from = From} = State) ->
{next_state, user_hello, State#state{start_or_recv_from = undefined,
- hello = Hello},
+ handshake_env = HsEnv#handshake_env{hello = Hello}},
[{reply, From, {ok, Extensions}}]};
+
hello(internal, #client_hello{cookie = Cookie} = Hello, #state{static_env = #static_env{role = server,
transport_cb = Transport,
socket = Socket},
@@ -573,8 +580,8 @@ hello(internal, #server_hello{} = Hello,
#state{
static_env = #static_env{role = client},
handshake_env = #handshake_env{renegotiation = {Renegotiation, _}},
+ connection_env = #connection_env{negotiated_version = ReqVersion},
connection_states = ConnectionStates0,
- negotiated_version = ReqVersion,
ssl_options = SslOptions} = State) ->
case dtls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
#alert{} = Alert ->
@@ -621,10 +628,11 @@ abbreviated(internal = Type,
ConnectionStates1 = dtls_record:save_current_connection_state(ConnectionStates0, read),
ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read),
gen_handshake(?FUNCTION_NAME, Type, Event, State#state{connection_states = ConnectionStates});
-abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) ->
+abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates,
+ protocol_specific = PS} = State) ->
gen_handshake(?FUNCTION_NAME, Type, Event,
prepare_flight(State#state{connection_states = ConnectionStates,
- flight_state = connection}));
+ protocol_specific = PS#{flight_state => connection}}));
abbreviated(state_timeout, Event, State) ->
handle_state_timeout(Event, ?FUNCTION_NAME, State);
abbreviated(Type, Event, State) ->
@@ -664,10 +672,11 @@ cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event,
ConnectionStates1 = dtls_record:save_current_connection_state(ConnectionStates0, read),
ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read),
ssl_connection:?FUNCTION_NAME(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE);
-cipher(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) ->
+cipher(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates,
+ protocol_specific = PS} = State) ->
ssl_connection:?FUNCTION_NAME(Type, Event,
prepare_flight(State#state{connection_states = ConnectionStates,
- flight_state = connection}),
+ protocol_specific = PS#{flight_state => connection}}),
?MODULE);
cipher(state_timeout, Event, State) ->
handle_state_timeout(Event, ?FUNCTION_NAME, State);
@@ -685,14 +694,16 @@ connection(info, Event, State) ->
gen_info(Event, ?FUNCTION_NAME, State);
connection(internal, #hello_request{}, #state{static_env = #static_env{host = Host,
port = Port,
+ data_tag = DataTag,
session_cache = Cache,
session_cache_cb = CacheCb
},
handshake_env = #handshake_env{ renegotiation = {Renegotiation, _}},
+ connection_env = CEnv,
session = #session{own_certificate = Cert} = Session0,
-
ssl_options = SslOpts,
- connection_states = ConnectionStates0
+ connection_states = ConnectionStates0,
+ protocol_specific = PS
} = State0) ->
Hello = dtls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
@@ -700,26 +711,26 @@ connection(internal, #hello_request{}, #state{static_env = #static_env{host = Ho
Version = Hello#client_hello.client_version,
HelloVersion = dtls_record:hello_version(Version, SslOpts#ssl_options.versions),
State1 = prepare_flight(State0),
- {State2, Actions} = send_handshake(Hello, State1#state{negotiated_version = HelloVersion}),
+ {State2, Actions} = send_handshake(Hello, State1#state{connection_env = CEnv#connection_env{negotiated_version = HelloVersion}}),
{Record, State} =
next_record(
- State2#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT},
+ State2#state{protocol_specific = PS#{flight_state => initial_flight_state(DataTag)},
session = Session0#session{session_id
- = Hello#client_hello.session_id}}),
+ = Hello#client_hello.session_id}}),
next_event(hello, Record, State, Actions);
connection(internal, #client_hello{} = Hello, #state{static_env = #static_env{role = server},
- allow_renegotiate = true} = State) ->
+ handshake_env = #handshake_env{allow_renegotiate = true} = HsEnv} = State) ->
%% Mitigate Computational DoS attack
%% http://www.educatedguesswork.org/2011/10/ssltls_and_computational_dos.html
%% http://www.thc.org/thc-ssl-dos/ Rather than disabling client
%% initiated renegotiation we will disallow many client initiated
%% renegotiations immediately after each other.
erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate),
- {next_state, hello, State#state{allow_renegotiate = false,
- handshake_env = #handshake_env{renegotiation = {true, peer}}},
+ {next_state, hello, State#state{handshake_env = HsEnv#handshake_env{renegotiation = {true, peer},
+ allow_renegotiate = false}},
[{next_event, internal, Hello}]};
connection(internal, #client_hello{}, #state{static_env = #static_env{role = server},
- allow_renegotiate = false} = State0) ->
+ handshake_env = #handshake_env{allow_renegotiate = false}} = State0) ->
Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION),
State1 = send_alert(Alert, State0),
{Record, State} = ssl_connection:prepare_connection(State1, ?MODULE),
@@ -790,8 +801,10 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User,
#state{static_env = InitStatEnv,
handshake_env = #handshake_env{
tls_handshake_history = ssl_handshake:init_handshake_history(),
- renegotiation = {false, first}
+ renegotiation = {false, first},
+ allow_renegotiate = SSLOptions#ssl_options.client_renegotiation
},
+ connection_env = #connection_env{user_application = {Monitor, User}},
socket_options = SocketOptions,
%% We do not want to save the password in the state so that
%% could be written in the clear into error logs.
@@ -799,20 +812,24 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User,
session = #session{is_resumable = new},
connection_states = ConnectionStates,
protocol_buffers = #protocol_buffers{},
- user_application = {Monitor, User},
- user_data_buffer = <<>>,
- allow_renegotiate = SSLOptions#ssl_options.client_renegotiation,
+ user_data_buffer = {[],0,[]},
start_or_recv_from = undefined,
flight_buffer = new_flight(),
- flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT}
+ protocol_specific = #{flight_state => initial_flight_state(DataTag)}
}.
+initial_flight_state(udp)->
+ {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT};
+initial_flight_state(_) ->
+ reliable.
+
next_dtls_record(Data, StateName, #state{protocol_buffers = #protocol_buffers{
dtls_record_buffer = Buf0,
- dtls_cipher_texts = CT0} = Buffers} = State0) ->
+ dtls_cipher_texts = CT0} = Buffers,
+ ssl_options = SslOpts} = State0) ->
case dtls_record:get_dtls_records(Data,
acceptable_record_versions(StateName, State0),
- Buf0) of
+ Buf0, SslOpts) of
{Records, Buf1} ->
CT1 = CT0 ++ Records,
next_record(State0#state{protocol_buffers =
@@ -824,7 +841,7 @@ next_dtls_record(Data, StateName, #state{protocol_buffers = #protocol_buffers{
acceptable_record_versions(hello, _) ->
[dtls_record:protocol_version(Vsn) || Vsn <- ?ALL_DATAGRAM_SUPPORTED_VERSIONS];
-acceptable_record_versions(_, #state{negotiated_version = Version}) ->
+acceptable_record_versions(_, #state{connection_env = #connection_env{negotiated_version = Version}}) ->
[Version].
dtls_handshake_events(Packets) ->
@@ -843,8 +860,9 @@ decode_cipher_text(#state{protocol_buffers = #protocol_buffers{dtls_cipher_texts
{Alert, State}
end.
-dtls_version(hello, Version, #state{static_env = #static_env{role = server}} = State) ->
- State#state{negotiated_version = Version}; %%Inital version
+dtls_version(hello, Version, #state{static_env = #static_env{role = server},
+ connection_env = CEnv} = State) ->
+ State#state{connection_env = CEnv#connection_env{negotiated_version = Version}}; %%Inital version
dtls_version(_,_, State) ->
State.
@@ -853,10 +871,11 @@ handle_client_hello(#client_hello{client_version = ClientVersion} = Hello,
static_env = #static_env{port = Port,
session_cache = Cache,
session_cache_cb = CacheCb},
- handshake_env = #handshake_env{renegotiation = {Renegotiation, _}} = HsEnv,
+ handshake_env = #handshake_env{kex_algorithm = KeyExAlg,
+ renegotiation = {Renegotiation, _},
+ negotiated_protocol = CurrentProtocol} = HsEnv,
+ connection_env = CEnv,
session = #session{own_certificate = Cert} = Session0,
- negotiated_protocol = CurrentProtocol,
- key_algorithm = KeyExAlg,
ssl_options = SslOpts} = State0) ->
case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
@@ -871,11 +890,12 @@ handle_client_hello(#client_hello{client_version = ClientVersion} = Hello,
end,
State = prepare_flight(State0#state{connection_states = ConnectionStates,
- negotiated_version = Version,
- hashsign_algorithm = HashSign,
- handshake_env = HsEnv#handshake_env{client_hello_version = ClientVersion},
- session = Session,
- negotiated_protocol = Protocol}),
+ connection_env = CEnv#connection_env{negotiated_version = Version},
+ handshake_env = HsEnv#handshake_env{
+ hashsign_algorithm = HashSign,
+ client_hello_version = ClientVersion,
+ negotiated_protocol = Protocol},
+ session = Session}),
ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt},
State, ?MODULE)
@@ -895,9 +915,9 @@ handle_info({Protocol, _, _, _, Data}, StateName,
handle_info({CloseTag, Socket}, StateName,
#state{static_env = #static_env{socket = Socket,
close_tag = CloseTag},
+ connection_env = #connection_env{negotiated_version = Version},
socket_options = #socket_options{active = Active},
- protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs},
- negotiated_version = Version} = State) ->
+ protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs}} = State) ->
%% Note that as of DTLS 1.2 (TLS 1.1),
%% failure to properly close a connection no longer requires that a
%% session not be resumed. This is a change from DTLS 1.0 to conform
@@ -933,9 +953,10 @@ handle_info(Msg, StateName, State) ->
ssl_connection:StateName(info, Msg, State, ?MODULE).
handle_state_timeout(flight_retransmission_timeout, StateName,
- #state{flight_state = {retransmit, NextTimeout}} = State0) ->
- {State1, Actions0} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}},
- retransmit_epoch(StateName, State0)),
+ #state{protocol_specific =
+ #{flight_state := {retransmit, _NextTimeout}}} = State0) ->
+ {State1, Actions0} = send_handshake_flight(State0,
+ retransmit_epoch(StateName, State0)),
{next_state, StateName, State, Actions} = next_event(StateName, no_record, State1, Actions0),
%% This will reset the retransmission timer by repeating the enter state event
{repeat_state, State, Actions}.
@@ -975,7 +996,7 @@ decode_alerts(Bin) ->
ssl_alert:decode(Bin).
gen_handshake(StateName, Type, Event,
- #state{negotiated_version = Version} = State) ->
+ #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try ssl_connection:StateName(Type, Event, State, ?MODULE) of
Result ->
Result
@@ -986,7 +1007,7 @@ gen_handshake(StateName, Type, Event,
Version, StateName, State)
end.
-gen_info(Event, connection = StateName, #state{negotiated_version = Version} = State) ->
+gen_info(Event, connection = StateName, #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try handle_info(Event, StateName, State) of
Result ->
Result
@@ -997,7 +1018,7 @@ gen_info(Event, connection = StateName, #state{negotiated_version = Version} =
Version, StateName, State)
end;
-gen_info(Event, StateName, #state{negotiated_version = Version} = State) ->
+gen_info(Event, StateName, #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try handle_info(Event, StateName, State) of
Result ->
Result
@@ -1041,17 +1062,17 @@ next_flight(Flight) ->
handshakes_after_change_cipher_spec => []}.
handle_flight_timer(#state{static_env = #static_env{data_tag = udp},
- flight_state = {retransmit, Timeout}} = State) ->
+ protocol_specific = #{flight_state := {retransmit, Timeout}}} = State) ->
start_retransmision_timer(Timeout, State);
handle_flight_timer(#state{static_env = #static_env{data_tag = udp},
- flight_state = connection} = State) ->
+ protocol_specific = #{flight_state := connection}} = State) ->
{State, []};
-handle_flight_timer(State) ->
+handle_flight_timer(#state{protocol_specific = #{flight_state := reliable}} = State) ->
%% No retransmision needed i.e DTLS over SCTP
- {State#state{flight_state = reliable}, []}.
+ {State, []}.
-start_retransmision_timer(Timeout, State) ->
- {State#state{flight_state = {retransmit, new_timeout(Timeout)}},
+start_retransmision_timer(Timeout, #state{protocol_specific = PS} = State) ->
+ {State#state{protocol_specific = PS#{flight_state => {retransmit, new_timeout(Timeout)}}},
[{state_timeout, Timeout, flight_retransmission_timeout}]}.
new_timeout(N) when N =< 30 ->
@@ -1061,37 +1082,46 @@ new_timeout(_) ->
send_handshake_flight(#state{static_env = #static_env{socket = Socket,
transport_cb = Transport},
- flight_buffer = #{handshakes := Flight,
+ connection_env = #connection_env{negotiated_version = Version},
+ flight_buffer = #{handshakes := Flight,
change_cipher_spec := undefined},
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Epoch) ->
+ connection_states = ConnectionStates0,
+ ssl_options = #ssl_options{log_level = LogLevel}} = State0,
+ Epoch) ->
%% TODO remove hardcoded Max size
{Encoded, ConnectionStates} =
encode_handshake_flight(lists:reverse(Flight), Version, 1400, Epoch, ConnectionStates0),
- send(Transport, Socket, Encoded),
+ send(Transport, Socket, Encoded),
+ ssl_logger:debug(LogLevel, outbound, 'record', Encoded),
{State0#state{connection_states = ConnectionStates}, []};
send_handshake_flight(#state{static_env = #static_env{socket = Socket,
transport_cb = Transport},
+ connection_env = #connection_env{negotiated_version = Version},
flight_buffer = #{handshakes := [_|_] = Flight0,
change_cipher_spec := ChangeCipher,
handshakes_after_change_cipher_spec := []},
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Epoch) ->
+ connection_states = ConnectionStates0,
+ ssl_options = #ssl_options{log_level = LogLevel}} = State0,
+ Epoch) ->
{HsBefore, ConnectionStates1} =
encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch, ConnectionStates0),
{EncChangeCipher, ConnectionStates} = encode_change_cipher(ChangeCipher, Version, Epoch, ConnectionStates1),
send(Transport, Socket, [HsBefore, EncChangeCipher]),
+ ssl_logger:debug(LogLevel, outbound, 'record', [HsBefore]),
+ ssl_logger:debug(LogLevel, outbound, 'record', [EncChangeCipher]),
{State0#state{connection_states = ConnectionStates}, []};
send_handshake_flight(#state{static_env = #static_env{socket = Socket,
transport_cb = Transport},
+ connection_env = #connection_env{negotiated_version = Version},
flight_buffer = #{handshakes := [_|_] = Flight0,
change_cipher_spec := ChangeCipher,
handshakes_after_change_cipher_spec := Flight1},
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Epoch) ->
+ connection_states = ConnectionStates0,
+ ssl_options = #ssl_options{log_level = LogLevel}} = State0,
+ Epoch) ->
{HsBefore, ConnectionStates1} =
encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch-1, ConnectionStates0),
{EncChangeCipher, ConnectionStates2} =
@@ -1099,20 +1129,27 @@ send_handshake_flight(#state{static_env = #static_env{socket = Socket,
{HsAfter, ConnectionStates} =
encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates2),
send(Transport, Socket, [HsBefore, EncChangeCipher, HsAfter]),
+ ssl_logger:debug(LogLevel, outbound, 'record', [HsBefore]),
+ ssl_logger:debug(LogLevel, outbound, 'record', [EncChangeCipher]),
+ ssl_logger:debug(LogLevel, outbound, 'record', [HsAfter]),
{State0#state{connection_states = ConnectionStates}, []};
send_handshake_flight(#state{static_env = #static_env{socket = Socket,
transport_cb = Transport},
+ connection_env = #connection_env{negotiated_version = Version},
flight_buffer = #{handshakes := [],
change_cipher_spec := ChangeCipher,
handshakes_after_change_cipher_spec := Flight1},
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Epoch) ->
+ connection_states = ConnectionStates0,
+ ssl_options = #ssl_options{log_level = LogLevel}} = State0,
+ Epoch) ->
{EncChangeCipher, ConnectionStates1} =
encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates0),
{HsAfter, ConnectionStates} =
encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates1),
send(Transport, Socket, [EncChangeCipher, HsAfter]),
+ ssl_logger:debug(LogLevel, outbound, 'record', [EncChangeCipher]),
+ ssl_logger:debug(LogLevel, outbound, 'record', [HsAfter]),
{State0#state{connection_states = ConnectionStates}, []}.
retransmit_epoch(_StateName, #state{connection_states = ConnectionStates}) ->
@@ -1160,12 +1197,12 @@ log_ignore_alert(_, _, _, _) ->
send_application_data(Data, From, _StateName,
#state{static_env = #static_env{socket = Socket,
- protocol_cb = Connection,
transport_cb = Transport},
+ connection_env = #connection_env{negotiated_version = Version},
handshake_env = HsEnv,
- negotiated_version = Version,
connection_states = ConnectionStates0,
- ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State0) ->
+ ssl_options = #ssl_options{renegotiate_at = RenegotiateAt,
+ log_level = LogLevel}} = State0) ->
case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of
true ->
@@ -1173,10 +1210,11 @@ send_application_data(Data, From, _StateName,
[{next_event, {call, From}, {application_data, Data}}]);
false ->
{Msgs, ConnectionStates} =
- Connection:encode_data(Data, Version, ConnectionStates0),
+ dtls_record:encode_data(Data, Version, ConnectionStates0),
State = State0#state{connection_states = ConnectionStates},
- case Connection:send(Transport, Socket, Msgs) of
+ case send(Transport, Socket, Msgs) of
ok ->
+ ssl_logger:debug(LogLevel, outbound, 'record', Msgs),
ssl_connection:hibernate_after(connection, State, [{reply, From, ok}]);
Result ->
ssl_connection:hibernate_after(connection, State, [{reply, From, Result}])
@@ -1197,3 +1235,4 @@ is_time_to_renegotiate(N, M) when N < M->
false;
is_time_to_renegotiate(_,_) ->
true.
+
diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl
index eb0f742e70..46e8348ce0 100644
--- a/lib/ssl/src/dtls_handshake.erl
+++ b/lib/ssl/src/dtls_handshake.erl
@@ -37,7 +37,7 @@
-export([fragment_handshake/2, encode_handshake/3]).
%% Handshake decodeing
--export([get_dtls_handshake/3]).
+-export([get_dtls_handshake/4]).
-type dtls_handshake() :: #client_hello{} | #hello_verify_request{} |
ssl_handshake:ssl_handshake().
@@ -46,7 +46,7 @@
%% Handshake handling
%%====================================================================
%%--------------------------------------------------------------------
--spec client_hello(host(), inet:port_number(), ssl_record:connection_states(),
+-spec client_hello(ssl:host(), inet:port_number(), ssl_record:connection_states(),
#ssl_options{}, integer(), atom(), boolean(), der_cert()) ->
#client_hello{}.
%%
@@ -59,7 +59,7 @@ client_hello(Host, Port, ConnectionStates, SslOpts,
Cache, CacheCb, Renegotiation, OwnCert).
%%--------------------------------------------------------------------
--spec client_hello(host(), inet:port_number(), term(), ssl_record:connection_states(),
+-spec client_hello(ssl:host(), inet:port_number(), term(), ssl_record:connection_states(),
#ssl_options{}, integer(), atom(), boolean(), der_cert()) ->
#client_hello{}.
%%
@@ -123,7 +123,7 @@ cookie(Key, Address, Port, #client_hello{client_version = {Major, Minor},
Random, SessionId, CipherSuites, CompressionMethods],
crypto:hmac(sha, Key, CookieData).
%%--------------------------------------------------------------------
--spec hello_verify_request(binary(), dtls_record:dtls_version()) -> #hello_verify_request{}.
+-spec hello_verify_request(binary(), ssl_record:ssl_version()) -> #hello_verify_request{}.
%%
%% Description: Creates a hello verify request message sent by server to
%% verify client
@@ -151,15 +151,15 @@ encode_handshake(Handshake, Version, Seq) ->
%%--------------------------------------------------------------------
%%--------------------------------------------------------------------
--spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) ->
+-spec get_dtls_handshake(ssl_record:ssl_version(), binary(), #protocol_buffers{}, #ssl_options{}) ->
{[dtls_handshake()], #protocol_buffers{}}.
%%
%% Description: Given buffered and new data from dtls_record, collects
%% and returns it as a list of handshake messages, also returns
%% possible leftover data in the new "protocol_buffers".
%%--------------------------------------------------------------------
-get_dtls_handshake(Version, Fragment, ProtocolBuffers) ->
- handle_fragments(Version, Fragment, ProtocolBuffers, []).
+get_dtls_handshake(Version, Fragment, ProtocolBuffers, Options) ->
+ handle_fragments(Version, Fragment, ProtocolBuffers, Options, []).
%%--------------------------------------------------------------------
%%% Internal functions
@@ -310,20 +310,21 @@ address_to_bin({A,B,C,D,E,F,G,H}, Port) ->
%%--------------------------------------------------------------------
-handle_fragments(Version, FragmentData, Buffers0, Acc) ->
+handle_fragments(Version, FragmentData, Buffers0, Options, Acc) ->
Fragments = decode_handshake_fragments(FragmentData),
- do_handle_fragments(Version, Fragments, Buffers0, Acc).
+ do_handle_fragments(Version, Fragments, Buffers0, Options, Acc).
-do_handle_fragments(_, [], Buffers, Acc) ->
+do_handle_fragments(_, [], Buffers, _Options, Acc) ->
{lists:reverse(Acc), Buffers};
-do_handle_fragments(Version, [Fragment | Fragments], Buffers0, Acc) ->
+do_handle_fragments(Version, [Fragment | Fragments], Buffers0, Options, Acc) ->
case reassemble(Version, Fragment, Buffers0) of
{more_data, Buffers} when Fragments == [] ->
{lists:reverse(Acc), Buffers};
{more_data, Buffers} ->
- do_handle_fragments(Version, Fragments, Buffers, Acc);
- {HsPacket, Buffers} ->
- do_handle_fragments(Version, Fragments, Buffers, [HsPacket | Acc])
+ do_handle_fragments(Version, Fragments, Buffers, Options, Acc);
+ {{Handshake, _} = HsPacket, Buffers} ->
+ ssl_logger:debug(Options#ssl_options.log_level, inbound, 'handshake', Handshake),
+ do_handle_fragments(Version, Fragments, Buffers, Options, [HsPacket | Acc])
end.
decode_handshake(Version, <<?BYTE(Type), Bin/binary>>) ->
@@ -363,9 +364,9 @@ decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?UINT24(_), ?UINT16(_),
decode_handshake(Version, Tag, <<?UINT24(_), ?UINT16(_),
?UINT24(_), ?UINT24(_), Msg/binary>>) ->
%% DTLS specifics stripped
- decode_tls_thandshake(Version, Tag, Msg).
+ decode_tls_handshake(Version, Tag, Msg).
-decode_tls_thandshake(Version, Tag, Msg) ->
+decode_tls_handshake(Version, Tag, Msg) ->
TLSVersion = dtls_v1:corresponding_tls_version(Version),
ssl_handshake:decode_handshake(TLSVersion, Tag, Msg).
diff --git a/lib/ssl/src/dtls_handshake.hrl b/lib/ssl/src/dtls_handshake.hrl
index a16489bbd1..de2be1daeb 100644
--- a/lib/ssl/src/dtls_handshake.hrl
+++ b/lib/ssl/src/dtls_handshake.hrl
@@ -26,22 +26,13 @@
-ifndef(dtls_handshake).
-define(dtls_handshake, true).
+-include("tls_handshake.hrl"). %% Common TLS and DTLS records and Constantes
-include("ssl_handshake.hrl"). %% Common TLS and DTLS records and Constantes
+-include("ssl_api.hrl").
-define(HELLO_VERIFY_REQUEST, 3).
-define(HELLO_VERIFY_REQUEST_VERSION, {254, 255}).
--record(client_hello, {
- client_version,
- random,
- session_id, % opaque SessionID<0..32>
- cookie, % opaque<2..2^16-1>
- cipher_suites, % cipher_suites<2..2^16-1>
- compression_methods, % compression_methods<1..2^8-1>,
- %% Extensions
- extensions
- }).
-
-record(hello_verify_request, {
protocol_version,
cookie
diff --git a/lib/ssl/src/dtls_packet_demux.erl b/lib/ssl/src/dtls_packet_demux.erl
index e03a4e9cb9..e0423b07b4 100644
--- a/lib/ssl/src/dtls_packet_demux.erl
+++ b/lib/ssl/src/dtls_packet_demux.erl
@@ -145,11 +145,11 @@ handle_info({Transport, Socket, IP, InPortNo, _} = Msg, #state{listener = Socket
%% UDP socket does not have a connection and should not receive an econnreset
%% This does however happens on some windows versions. Just ignoring it
%% appears to make things work as expected!
-handle_info({Error, Socket, econnreset = Error}, #state{listener = Socket, transport = {_,_,_, udp_error}} = State) ->
+handle_info({udp_error, Socket, econnreset = Error}, #state{listener = Socket, transport = {_,_,_, udp_error}} = State) ->
Report = io_lib:format("Ignore SSL UDP Listener: Socket error: ~p ~n", [Error]),
?LOG_NOTICE(Report),
{noreply, State};
-handle_info({Error, Socket, Error}, #state{listener = Socket, transport = {_,_,_, Error}} = State) ->
+handle_info({ErrorTag, Socket, Error}, #state{listener = Socket, transport = {_,_,_, ErrorTag}} = State) ->
Report = io_lib:format("SSL Packet muliplxer shutdown: Socket error: ~p ~n", [Error]),
?LOG_NOTICE(Report),
{noreply, State#state{close=true}};
@@ -298,6 +298,9 @@ do_set_emulated_opts([], Opts) ->
Opts;
do_set_emulated_opts([{mode, Value} | Rest], Opts) ->
do_set_emulated_opts(Rest, Opts#socket_options{mode = Value});
+do_set_emulated_opts([{active, N0} | Rest], Opts=#socket_options{active = Active}) when is_integer(N0) ->
+ N = tls_socket:update_active_n(N0, Active),
+ do_set_emulated_opts(Rest, Opts#socket_options{active = N});
do_set_emulated_opts([{active, Value} | Rest], Opts) ->
do_set_emulated_opts(Rest, Opts#socket_options{active = Value}).
diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl
index b7346d3ec8..a4846f42c5 100644
--- a/lib/ssl/src/dtls_record.erl
+++ b/lib/ssl/src/dtls_record.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,7 +30,7 @@
-include("ssl_cipher.hrl").
%% Handling of incoming data
--export([get_dtls_records/3, init_connection_states/2, empty_connection_state/1]).
+-export([get_dtls_records/4, init_connection_states/2, empty_connection_state/1]).
-export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2,
init_connection_state_seq/2, current_connection_state_epoch/2]).
@@ -49,9 +49,8 @@
is_acceptable_version/2, hello_version/2]).
--export_type([dtls_version/0, dtls_atom_version/0]).
+-export_type([dtls_atom_version/0]).
--type dtls_version() :: ssl_record:ssl_version().
-type dtls_atom_version() :: dtlsv1 | 'dtlsv1.2'.
-define(REPLAY_WINDOW_SIZE, 64).
@@ -135,7 +134,7 @@ set_connection_state_by_epoch(ReadState, Epoch, #{saved_read := #{epoch := Epoch
States#{saved_read := ReadState}.
%%--------------------------------------------------------------------
--spec init_connection_state_seq(dtls_version(), ssl_record:connection_states()) ->
+-spec init_connection_state_seq(ssl_record:ssl_version(), ssl_record:connection_states()) ->
ssl_record:connection_state().
%%
%% Description: Copy the read sequence number to the write sequence number
@@ -163,24 +162,25 @@ current_connection_state_epoch(#{current_write := #{epoch := Epoch}},
Epoch.
%%--------------------------------------------------------------------
--spec get_dtls_records(binary(), [dtls_version()], binary()) -> {[binary()], binary()} | #alert{}.
+-spec get_dtls_records(binary(), [ssl_record:ssl_version()], binary(),
+ #ssl_options{}) -> {[binary()], binary()} | #alert{}.
%%
%% Description: Given old buffer and new data from UDP/SCTP, packs up a records
%% and returns it as a list of tls_compressed binaries also returns leftover
%% data
%%--------------------------------------------------------------------
-get_dtls_records(Data, Versions, Buffer) ->
+get_dtls_records(Data, Versions, Buffer, SslOpts) ->
BinData = list_to_binary([Buffer, Data]),
case erlang:byte_size(BinData) of
N when N >= 3 ->
case assert_version(BinData, Versions) of
true ->
- get_dtls_records_aux(BinData, []);
+ get_dtls_records_aux(BinData, [], SslOpts);
false ->
?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
end;
_ ->
- get_dtls_records_aux(BinData, [])
+ get_dtls_records_aux(BinData, [], SslOpts)
end.
%%====================================================================
@@ -188,7 +188,7 @@ get_dtls_records(Data, Versions, Buffer) ->
%%====================================================================
%%--------------------------------------------------------------------
--spec encode_handshake(iolist(), dtls_version(), integer(), ssl_record:connection_states()) ->
+-spec encode_handshake(iolist(), ssl_record:ssl_version(), integer(), ssl_record:connection_states()) ->
{iolist(), ssl_record:connection_states()}.
%
%% Description: Encodes a handshake message to send on the ssl-socket.
@@ -198,7 +198,7 @@ encode_handshake(Frag, Version, Epoch, ConnectionStates) ->
%%--------------------------------------------------------------------
--spec encode_alert_record(#alert{}, dtls_version(), ssl_record:connection_states()) ->
+-spec encode_alert_record(#alert{}, ssl_record:ssl_version(), ssl_record:connection_states()) ->
{iolist(), ssl_record:connection_states()}.
%%
%% Description: Encodes an alert message to send on the ssl-socket.
@@ -210,7 +210,7 @@ encode_alert_record(#alert{level = Level, description = Description},
ConnectionStates).
%%--------------------------------------------------------------------
--spec encode_change_cipher_spec(dtls_version(), integer(), ssl_record:connection_states()) ->
+-spec encode_change_cipher_spec(ssl_record:ssl_version(), integer(), ssl_record:connection_states()) ->
{iolist(), ssl_record:connection_states()}.
%%
%% Description: Encodes a change_cipher_spec-message to send on the ssl socket.
@@ -219,7 +219,7 @@ encode_change_cipher_spec(Version, Epoch, ConnectionStates) ->
encode_plain_text(?CHANGE_CIPHER_SPEC, Version, Epoch, ?byte(?CHANGE_CIPHER_SPEC_PROTO), ConnectionStates).
%%--------------------------------------------------------------------
--spec encode_data(binary(), dtls_version(), ssl_record:connection_states()) ->
+-spec encode_data(binary(), ssl_record:ssl_version(), ssl_record:connection_states()) ->
{iolist(),ssl_record:connection_states()}.
%%
%% Description: Encodes data to send on the ssl-socket.
@@ -248,8 +248,8 @@ decode_cipher_text(#ssl_tls{epoch = Epoch} = CipherText, ConnnectionStates0) ->
%%====================================================================
%%--------------------------------------------------------------------
--spec protocol_version(dtls_atom_version() | dtls_version()) ->
- dtls_version() | dtls_atom_version().
+-spec protocol_version(dtls_atom_version() | ssl_record:ssl_version()) ->
+ ssl_record:ssl_version() | dtls_atom_version().
%%
%% Description: Creates a protocol version record from a version atom
%% or vice versa.
@@ -263,7 +263,7 @@ protocol_version({254, 253}) ->
protocol_version({254, 255}) ->
dtlsv1.
%%--------------------------------------------------------------------
--spec lowest_protocol_version(dtls_version(), dtls_version()) -> dtls_version().
+-spec lowest_protocol_version(ssl_record:ssl_version(), ssl_record:ssl_version()) -> ssl_record:ssl_version().
%%
%% Description: Lowes protocol version of two given versions
%%--------------------------------------------------------------------
@@ -277,7 +277,7 @@ lowest_protocol_version(_,Version) ->
Version.
%%--------------------------------------------------------------------
--spec lowest_protocol_version([dtls_version()]) -> dtls_version().
+-spec lowest_protocol_version([ssl_record:ssl_version()]) -> ssl_record:ssl_version().
%%
%% Description: Lowest protocol version present in a list
%%--------------------------------------------------------------------
@@ -288,7 +288,7 @@ lowest_protocol_version(Versions) ->
lowest_list_protocol_version(Ver, Vers).
%%--------------------------------------------------------------------
--spec highest_protocol_version([dtls_version()]) -> dtls_version().
+-spec highest_protocol_version([ssl_record:ssl_version()]) -> ssl_record:ssl_version().
%%
%% Description: Highest protocol version present in a list
%%--------------------------------------------------------------------
@@ -299,7 +299,7 @@ highest_protocol_version(Versions) ->
highest_list_protocol_version(Ver, Vers).
%%--------------------------------------------------------------------
--spec highest_protocol_version(dtls_version(), dtls_version()) -> dtls_version().
+-spec highest_protocol_version(ssl_record:ssl_version(), ssl_record:ssl_version()) -> ssl_record:ssl_version().
%%
%% Description: Highest protocol version of two given versions
%%--------------------------------------------------------------------
@@ -315,7 +315,7 @@ highest_protocol_version(_,Version) ->
Version.
%%--------------------------------------------------------------------
--spec is_higher(V1 :: dtls_version(), V2::dtls_version()) -> boolean().
+-spec is_higher(V1 :: ssl_record:ssl_version(), V2::ssl_record:ssl_version()) -> boolean().
%%
%% Description: Is V1 > V2
%%--------------------------------------------------------------------
@@ -327,7 +327,7 @@ is_higher(_, _) ->
false.
%%--------------------------------------------------------------------
--spec supported_protocol_versions() -> [dtls_version()].
+-spec supported_protocol_versions() -> [ssl_record:ssl_version()].
%%
%% Description: Protocol versions supported
%%--------------------------------------------------------------------
@@ -370,7 +370,7 @@ supported_protocol_versions([_|_] = Vsns) ->
end.
%%--------------------------------------------------------------------
--spec is_acceptable_version(dtls_version(), Supported :: [dtls_version()]) -> boolean().
+-spec is_acceptable_version(ssl_record:ssl_version(), Supported :: [ssl_record:ssl_version()]) -> boolean().
%%
%% Description: ssl version 2 is not acceptable security risks are too big.
%%
@@ -378,7 +378,7 @@ supported_protocol_versions([_|_] = Vsns) ->
is_acceptable_version(Version, Versions) ->
lists:member(Version, Versions).
--spec hello_version(dtls_version(), [dtls_version()]) -> dtls_version().
+-spec hello_version(ssl_record:ssl_version(), [ssl_record:ssl_version()]) -> ssl_record:ssl_version().
hello_version(Version, Versions) ->
case dtls_v1:corresponding_tls_version(Version) of
TLSVersion when TLSVersion >= {3, 3} ->
@@ -410,42 +410,47 @@ assert_version(<<?BYTE(_), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>>, Versions) -
get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer),
?UINT16(Epoch), ?UINT48(SequenceNumber),
- ?UINT16(Length), Data:Length/binary, Rest/binary>>,
- Acc) ->
+ ?UINT16(Length), Data:Length/binary, Rest/binary>> = RawDTLSRecord,
+ Acc, SslOpts) ->
+ ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'record', [RawDTLSRecord]),
get_dtls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA,
version = {MajVer, MinVer},
epoch = Epoch, sequence_number = SequenceNumber,
- fragment = Data} | Acc]);
+ fragment = Data} | Acc], SslOpts);
get_dtls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer),
?UINT16(Epoch), ?UINT48(SequenceNumber),
?UINT16(Length),
- Data:Length/binary, Rest/binary>>, Acc) when MajVer >= 128 ->
+ Data:Length/binary, Rest/binary>> = RawDTLSRecord,
+ Acc, SslOpts) when MajVer >= 128 ->
+ ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'record', [RawDTLSRecord]),
get_dtls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE,
version = {MajVer, MinVer},
epoch = Epoch, sequence_number = SequenceNumber,
- fragment = Data} | Acc]);
+ fragment = Data} | Acc], SslOpts);
get_dtls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer),
?UINT16(Epoch), ?UINT48(SequenceNumber),
?UINT16(Length), Data:Length/binary,
- Rest/binary>>, Acc) ->
+ Rest/binary>> = RawDTLSRecord, Acc, SslOpts) ->
+ ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'record', [RawDTLSRecord]),
get_dtls_records_aux(Rest, [#ssl_tls{type = ?ALERT,
version = {MajVer, MinVer},
epoch = Epoch, sequence_number = SequenceNumber,
- fragment = Data} | Acc]);
+ fragment = Data} | Acc], SslOpts);
get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer),
?UINT16(Epoch), ?UINT48(SequenceNumber),
- ?UINT16(Length), Data:Length/binary, Rest/binary>>,
- Acc) ->
+ ?UINT16(Length), Data:Length/binary, Rest/binary>> = RawDTLSRecord,
+ Acc, SslOpts) ->
+ ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'record', [RawDTLSRecord]),
get_dtls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC,
version = {MajVer, MinVer},
epoch = Epoch, sequence_number = SequenceNumber,
- fragment = Data} | Acc]);
+ fragment = Data} | Acc], SslOpts);
get_dtls_records_aux(<<?BYTE(_), ?BYTE(_MajVer), ?BYTE(_MinVer),
?UINT16(Length), _/binary>>,
- _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH ->
+ _Acc, _) when Length > ?MAX_CIPHER_TEXT_LENGTH ->
?ALERT_REC(?FATAL, ?RECORD_OVERFLOW);
-get_dtls_records_aux(Data, Acc) ->
+get_dtls_records_aux(Data, Acc, _) ->
case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of
true ->
{lists:reverse(Acc), Data};
@@ -547,15 +552,15 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version,
compression_algorithm = CompAlg}} = ReadState0,
ConnnectionStates0) ->
AAD = start_additional_data(Type, Version, Epoch, Seq),
- CipherS1 = ssl_record:nonce_seed(BulkCipherAlgo, <<?UINT16(Epoch), ?UINT48(Seq)>>, CipherS0),
+ CipherS = ssl_record:nonce_seed(BulkCipherAlgo, <<?UINT16(Epoch), ?UINT48(Seq)>>, CipherS0),
TLSVersion = dtls_v1:corresponding_tls_version(Version),
- case ssl_record:decipher_aead(BulkCipherAlgo, CipherS1, AAD, CipherFragment, TLSVersion) of
- {PlainFragment, CipherState} ->
- {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
+ case ssl_record:decipher_aead(BulkCipherAlgo, CipherS, AAD, CipherFragment, TLSVersion) of
+ PlainFragment when is_binary(PlainFragment) ->
+ {Plain, CompressionS} = ssl_record:uncompress(CompAlg,
PlainFragment, CompressionS0),
- ReadState0 = ReadState0#{compression_state => CompressionS1,
- cipher_state => CipherState},
- ReadState = update_replay_window(Seq, ReadState0),
+ ReadState1 = ReadState0#{compression_state := CompressionS,
+ cipher_state := CipherS},
+ ReadState = update_replay_window(Seq, ReadState1),
ConnnectionStates = set_connection_state_by_epoch(ReadState, Epoch, ConnnectionStates0, read),
{CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
#alert{} = Alert ->
diff --git a/lib/ssl/src/dtls_socket.erl b/lib/ssl/src/dtls_socket.erl
index 2001afd02f..4d07372e31 100644
--- a/lib/ssl/src/dtls_socket.erl
+++ b/lib/ssl/src/dtls_socket.erl
@@ -38,7 +38,9 @@ listen(Port, #config{transport_info = TransportInfo,
case dtls_listener_sup:start_child([Port, TransportInfo, emulated_socket_options(EmOpts, #socket_options{}),
Options ++ internal_inet_values(), SslOpts]) of
{ok, Pid} ->
- {ok, #sslsocket{pid = {dtls, Config#config{dtls_handler = {Pid, Port}}}}};
+ Socket = #sslsocket{pid = {dtls, Config#config{dtls_handler = {Pid, Port}}}},
+ check_active_n(EmOpts, Socket),
+ {ok, Socket};
Err = {error, _} ->
Err
end.
@@ -81,8 +83,9 @@ socket(Pids, Transport, Socket, ConnectionCb) ->
#sslsocket{pid = Pids,
%% "The name "fd" is keept for backwards compatibility
fd = {Transport, Socket, ConnectionCb}}.
-setopts(_, #sslsocket{pid = {dtls, #config{dtls_handler = {ListenPid, _}}}}, Options) ->
- SplitOpts = tls_socket:split_options(Options),
+setopts(_, Socket = #sslsocket{pid = {dtls, #config{dtls_handler = {ListenPid, _}}}}, Options) ->
+ SplitOpts = {_, EmOpts} = tls_socket:split_options(Options),
+ check_active_n(EmOpts, Socket),
dtls_packet_demux:set_sock_opts(ListenPid, SplitOpts);
%%% Following clauses will not be called for emulated options, they are handled in the connection process
setopts(gen_udp, Socket, Options) ->
@@ -90,6 +93,32 @@ setopts(gen_udp, Socket, Options) ->
setopts(Transport, Socket, Options) ->
Transport:setopts(Socket, Options).
+check_active_n(EmulatedOpts, Socket = #sslsocket{pid = {dtls, #config{dtls_handler = {ListenPid, _}}}}) ->
+ %% We check the resulting options to send an ssl_passive message if necessary.
+ case proplists:lookup(active, EmulatedOpts) of
+ %% The provided value is out of bound.
+ {_, N} when is_integer(N), N < -32768 ->
+ throw(einval);
+ {_, N} when is_integer(N), N > 32767 ->
+ throw(einval);
+ {_, N} when is_integer(N) ->
+ {ok, #socket_options{active = Active}, _} = dtls_packet_demux:get_all_opts(ListenPid),
+ case Active of
+ Atom when is_atom(Atom), N =< 0 ->
+ self() ! {ssl_passive, Socket};
+ %% The result of the addition is out of bound.
+ %% We do not need to check < -32768 because Active can't be below 1.
+ A when is_integer(A), A + N > 32767 ->
+ throw(einval);
+ A when is_integer(A), A + N =< 0 ->
+ self() ! {ssl_passive, Socket};
+ _ ->
+ ok
+ end;
+ _ ->
+ ok
+ end.
+
getopts(_, #sslsocket{pid = {dtls, #config{dtls_handler = {ListenPid, _}}}}, Options) ->
SplitOpts = tls_socket:split_options(Options),
dtls_packet_demux:get_sock_opts(ListenPid, SplitOpts);
@@ -161,9 +190,18 @@ emulated_socket_options(InetValues, #socket_options{
mode = proplists:get_value(mode, InetValues, Mode),
packet = proplists:get_value(packet, InetValues, Packet),
packet_size = proplists:get_value(packet_size, InetValues, PacketSize),
- active = proplists:get_value(active, InetValues, Active)
+ active = emulated_active_option(InetValues, Active)
}.
+emulated_active_option([], Active) ->
+ Active;
+emulated_active_option([{active, Active} | _], _) when Active =< 0 ->
+ false;
+emulated_active_option([{active, Active} | _], _) ->
+ Active;
+emulated_active_option([_|Tail], Active) ->
+ emulated_active_option(Tail, Active).
+
emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) ->
validate_inet_option(mode, Value),
emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]);
@@ -185,6 +223,9 @@ validate_inet_option(mode, Value)
when Value =/= list, Value =/= binary ->
throw({error, {options, {mode,Value}}});
validate_inet_option(active, Value)
+ when Value >= -32768, Value =< 32767 ->
+ ok;
+validate_inet_option(active, Value)
when Value =/= true, Value =/= false, Value =/= once ->
throw({error, {options, {active,Value}}});
validate_inet_option(_, _) ->
diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl
index ce771343fe..e7fab7ebc5 100644
--- a/lib/ssl/src/inet_tls_dist.erl
+++ b/lib/ssl/src/inet_tls_dist.erl
@@ -481,22 +481,25 @@ allowed_nodes(PeerCert, Allowed, PeerIP, Node, Host) ->
allowed_nodes(PeerCert, Allowed, PeerIP)
end.
-
-
setup(Node, Type, MyNode, LongOrShortNames, SetupTime) ->
gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime).
gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
Kernel = self(),
monitor_pid(
- spawn_opt(
- fun() ->
- do_setup(
- Driver, Kernel, Node, Type,
- MyNode, LongOrShortNames, SetupTime)
- end,
- [link, {priority, max}])).
+ spawn_opt(setup_fun(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime),
+ [link, {priority, max}])).
+
+-spec setup_fun(_,_,_,_,_,_,_) -> fun(() -> no_return()).
+setup_fun(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
+ fun() ->
+ do_setup(
+ Driver, Kernel, Node, Type,
+ MyNode, LongOrShortNames, SetupTime)
+ end.
+
+-spec do_setup(_,_,_,_,_,_,_) -> no_return().
do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
{Name, Address} = split_node(Driver, Node, LongOrShortNames),
ErlEpmd = net_kernel:epmd_module(),
@@ -521,6 +524,8 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) ->
trace({getaddr_failed, Driver, Address, Other}))
end.
+-spec do_setup_connect(_,_,_,_,_,_,_,_,_,_) -> no_return().
+
do_setup_connect(Driver, Kernel, Node, Address, Ip, TcpPort, Version, Type, MyNode, Timer) ->
Opts = trace(connect_options(get_ssl_options(client))),
dist_util:reset_timer(Timer),
@@ -565,7 +570,7 @@ gen_close(Driver, Socket) ->
%% Determine if EPMD module supports address resolving. Default
%% is to use inet_tcp:getaddr/2.
%% ------------------------------------------------------------
-get_address_resolver(EpmdModule, Driver) ->
+get_address_resolver(EpmdModule, _Driver) ->
case erlang:function_exported(EpmdModule, address_please, 3) of
true -> {EpmdModule, address_please};
_ -> {erl_epmd, address_please}
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 616e9e26e7..f7500b6f5f 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -55,23 +55,344 @@
format_error/1, renegotiate/1, prf/5, negotiated_protocol/1,
connection_information/1, connection_information/2]).
%% Misc
--export([handle_options/2, tls_version/1, new_ssl_options/3, suite_to_str/1,
- set_log_level/1]).
+-export([handle_options/2, tls_version/1, new_ssl_options/3, suite_to_str/1]).
-deprecated({ssl_accept, 1, eventually}).
-deprecated({ssl_accept, 2, eventually}).
-deprecated({ssl_accept, 3, eventually}).
+-export_type([socket/0,
+ sslsocket/0,
+ socket_option/0,
+ active_msgs/0,
+ host/0,
+ tls_option/0,
+ tls_client_option/0,
+ tls_server_option/0,
+ erl_cipher_suite/0,
+ old_cipher_suite/0,
+ ciphers/0,
+ cipher/0,
+ hash/0,
+ key/0,
+ kex_algo/0,
+ prf_random/0,
+ cipher_filters/0,
+ sign_algo/0,
+ protocol_version/0,
+ protocol_extensions/0,
+ session_id/0,
+ error_alert/0,
+ srp_param_type/0]).
+
+%% -------------------------------------------------------------------------------------------------------
+-type socket() :: gen_tcp:socket().
+-type socket_option() :: gen_tcp:connect_option() | gen_tcp:listen_option() | gen_udp:option().
+-type sslsocket() :: any().
+-type tls_option() :: tls_client_option() | tls_server_option().
+-type tls_client_option() :: client_option() | common_option() | socket_option() | transport_option().
+-type tls_server_option() :: server_option() | common_option() | socket_option() | transport_option().
+-type active_msgs() :: {ssl, sslsocket(), Data::binary() | list()} | {ssl_closed, sslsocket()} |
+ {ssl_error, sslsocket(), Reason::term()} | {ssl_passive, sslsocket()}.
+-type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(),
+ ClosedTag::atom(), ErrTag::atom()}}.
+-type host() :: hostname() | ip_address().
+-type hostname() :: string().
+-type ip_address() :: inet:ip_address().
+-type session_id() :: binary().
+-type protocol_version() :: tls_version() | dtls_version().
+-type tls_version() :: tlsv1 | 'tlsv1.1' | 'tlsv1.2' | 'tlsv1.3' | legacy_version().
+-type dtls_version() :: 'dtlsv1' | 'dtlsv1.2'.
+-type legacy_version() :: sslv3.
+-type verify_type() :: verify_none | verify_peer.
+-type cipher() :: aes_128_cbc |
+ aes_256_cbc |
+ aes_128_gcm |
+ aes_256_gcm |
+ chacha20_poly1305 |
+ legacy_cipher().
+-type legacy_cipher() :: rc4_128 |
+ des_cbc |
+ '3des_ede_cbc'.
+
+-type hash() :: sha |
+ sha2() |
+ legacy_hash().
+
+-type sha2() :: sha224 |
+ sha256 |
+ sha384 |
+ sha512.
+
+-type legacy_hash() :: md5.
+
+-type sign_algo() :: rsa | dsa | ecdsa.
+
+-type sign_scheme() :: rsa_pkcs1_sha256
+ | rsa_pkcs1_sha384
+ | rsa_pkcs1_sha512
+ | ecdsa_secp256r1_sha256
+ | ecdsa_secp384r1_sha384
+ | ecdsa_secp521r1_sha512
+ | rsa_pss_rsae_sha256
+ | rsa_pss_rsae_sha384
+ | rsa_pss_rsae_sha512
+ | rsa_pss_pss_sha256
+ | rsa_pss_pss_sha384
+ | rsa_pss_pss_sha512
+ | rsa_pkcs1_sha1
+ | ecdsa_sha1.
+-type kex_algo() :: rsa |
+ dhe_rsa | dhe_dss |
+ ecdhe_ecdsa | ecdh_ecdsa | ecdh_rsa |
+ srp_rsa| srp_dss |
+ psk | dhe_psk | rsa_psk |
+ dh_anon | ecdh_anon | srp_anon |
+ any. %% TLS 1.3
+-type erl_cipher_suite() :: #{key_exchange := kex_algo(),
+ cipher := cipher(),
+ mac := hash() | aead,
+ prf := hash() | default_prf %% Old cipher suites, version dependent
+ }.
+
+-type old_cipher_suite() :: {kex_algo(), cipher(), hash()} % Pre TLS 1.2
+ %% TLS 1.2, internally PRE TLS 1.2 will use default_prf
+ | {kex_algo(), cipher(), hash() | aead, hash()}.
+
+-type named_curve() :: sect571r1 |
+ sect571k1 |
+ secp521r1 |
+ brainpoolP512r1 |
+ sect409k1 |
+ sect409r1 |
+ brainpoolP384r1 |
+ secp384r1 |
+ sect283k1 |
+ sect283r1 |
+ brainpoolP256r1 |
+ secp256k1 |
+ secp256r1 |
+ sect239k1 |
+ sect233k1 |
+ sect233r1 |
+ secp224k1 |
+ secp224r1 |
+ sect193r1 |
+ sect193r2 |
+ secp192k1 |
+ secp192r1 |
+ sect163k1 |
+ sect163r1 |
+ sect163r2 |
+ secp160k1 |
+ secp160r1 |
+ secp160r2.
+
+-type srp_param_type() :: srp_1024 |
+ srp_1536 |
+ srp_2048 |
+ srp_3072 |
+ srp_4096 |
+ srp_6144 |
+ srp_8192.
+
+-type error_alert() :: {tls_alert, {tls_alert(), Description::string()}}.
+
+-type tls_alert() :: close_notify |
+ unexpected_message |
+ bad_record_mac |
+ record_overflow |
+ handshake_failure |
+ bad_certificate |
+ unsupported_certificate |
+ certificate_revoked |
+ certificate_expired |
+ certificate_unknown |
+ illegal_parameter |
+ unknown_ca |
+ access_denied |
+ decode_error |
+ decrypt_error |
+ export_restriction|
+ protocol_version |
+ insufficient_security |
+ internal_error |
+ inappropriate_fallback |
+ user_canceled |
+ no_renegotiation |
+ unsupported_extension |
+ certificate_unobtainable |
+ unrecognized_name |
+ bad_certificate_status_response |
+ bad_certificate_hash_value |
+ unknown_psk_identity |
+ no_application_protocol.
+%% -------------------------------------------------------------------------------------------------------
+-type common_option() :: {protocol, protocol()} |
+ {handshake, handshake_completion()} |
+ {cert, cert()} |
+ {certfile, cert_pem()} |
+ {key, key()} |
+ {keyfile, key_pem()} |
+ {password, key_password()} |
+ {ciphers, cipher_suites()} |
+ {eccs, eccs()} |
+ {signature_algs_cert, signature_schemes()} |
+ {secure_renegotiate, secure_renegotiation()} |
+ {depth, allowed_cert_chain_length()} |
+ {verify_fun, custom_verify()} |
+ {crl_check, crl_check()} |
+ {crl_cache, crl_cache_opts()} |
+ {max_handshake_size, handshake_size()} |
+ {partial_chain, root_fun()} |
+ {versions, protocol_versions()} |
+ {user_lookup_fun, custom_user_lookup()} |
+ {log_level, logging_level()} |
+ {log_alert, log_alert()} |
+ {hibernate_after, hibernate_after()} |
+ {padding_check, padding_check()} |
+ {beast_mitigation, beast_mitigation()} |
+ {ssl_imp, ssl_imp()}.
+
+-type protocol() :: tls | dtls.
+-type handshake_completion() :: hello | full.
+-type cert() :: public_key:der_encoded().
+-type cert_pem() :: file:filename().
+-type key() :: {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo',
+ public_key:der_encoded()} |
+ #{algorithm := rsa | dss | ecdsa,
+ engine := crypto:engine_ref(),
+ key_id := crypto:key_id(),
+ password => crypto:password()}.
+-type key_pem() :: file:filename().
+-type key_password() :: string().
+-type cipher_suites() :: ciphers().
+-type ciphers() :: [erl_cipher_suite()] |
+ string(). % (according to old API)
+-type cipher_filters() :: list({key_exchange | cipher | mac | prf,
+ algo_filter()}).
+-type algo_filter() :: fun((kex_algo()|cipher()|hash()|aead|default_prf) -> true | false).
+-type eccs() :: [named_curve()].
+-type secure_renegotiation() :: boolean().
+-type allowed_cert_chain_length() :: integer().
+
+-type custom_verify() :: {Verifyfun :: fun(), InitialUserState :: term()}.
+-type crl_check() :: boolean() | peer | best_effort.
+-type crl_cache_opts() :: [term()].
+-type handshake_size() :: integer().
+-type hibernate_after() :: timeout().
+-type root_fun() :: fun().
+-type protocol_versions() :: [protocol_version()].
+-type signature_algs() :: [{hash(), sign_algo()}].
+-type signature_schemes() :: [sign_scheme()].
+-type custom_user_lookup() :: {Lookupfun :: fun(), UserState :: term()}.
+-type padding_check() :: boolean().
+-type beast_mitigation() :: one_n_minus_one | zero_n | disabled.
+-type srp_identity() :: {Username :: string(), Password :: string()}.
+-type psk_identity() :: string().
+-type log_alert() :: boolean().
+-type logging_level() :: logger:level().
+
+%% -------------------------------------------------------------------------------------------------------
+
+-type client_option() :: {verify, client_verify_type()} |
+ {reuse_session, client_reuse_session()} |
+ {reuse_sessions, client_reuse_sessions()} |
+ {cacerts, client_cacerts()} |
+ {cacertfile, client_cafile()} |
+ {alpn_advertised_protocols, client_alpn()} |
+ {client_preferred_next_protocols, client_preferred_next_protocols()} |
+ {psk_identity, client_psk_identity()} |
+ {srp_identity, client_srp_identity()} |
+ {server_name_indication, sni()} |
+ {customize_hostname_check, customize_hostname_check()} |
+ {signature_algs, client_signature_algs()} |
+ {fallback, fallback()}.
+
+-type client_verify_type() :: verify_type().
+-type client_reuse_session() :: session_id().
+-type client_reuse_sessions() :: boolean() | save.
+-type client_cacerts() :: [public_key:der_encoded()].
+-type client_cafile() :: file:filename().
+-type app_level_protocol() :: binary().
+-type client_alpn() :: [app_level_protocol()].
+-type client_preferred_next_protocols() :: {Precedence :: server | client,
+ ClientPrefs :: [app_level_protocol()]} |
+ {Precedence :: server | client,
+ ClientPrefs :: [app_level_protocol()],
+ Default::app_level_protocol()}.
+-type client_psk_identity() :: psk_identity().
+-type client_srp_identity() :: srp_identity().
+-type customize_hostname_check() :: list().
+-type sni() :: HostName :: hostname() | disable.
+-type client_signature_algs() :: signature_algs().
+-type fallback() :: boolean().
+-type ssl_imp() :: new | old.
+
+%% -------------------------------------------------------------------------------------------------------
+
+-type server_option() :: {cacerts, server_cacerts()} |
+ {cacertfile, server_cafile()} |
+ {dh, dh_der()} |
+ {dhfile, dh_file()} |
+ {verify, server_verify_type()} |
+ {fail_if_no_peer_cert, fail_if_no_peer_cert()} |
+ {reuse_sessions, server_reuse_sessions()} |
+ {reuse_session, server_reuse_session()} |
+ {alpn_preferred_protocols, server_alpn()} |
+ {next_protocols_advertised, server_next_protocol()} |
+ {psk_identity, server_psk_identity()} |
+ {honor_cipher_order, boolean()} |
+ {sni_hosts, sni_hosts()} |
+ {sni_fun, sni_fun()} |
+ {honor_cipher_order, honor_cipher_order()} |
+ {honor_ecc_order, honor_ecc_order()} |
+ {client_renegotiation, client_renegotiation()}|
+ {signature_algs, server_signature_algs()}.
+
+-type server_cacerts() :: [public_key:der_encoded()].
+-type server_cafile() :: file:filename().
+-type server_alpn() :: [app_level_protocol()].
+-type server_next_protocol() :: [app_level_protocol()].
+-type server_psk_identity() :: psk_identity().
+-type dh_der() :: binary().
+-type dh_file() :: file:filename().
+-type server_verify_type() :: verify_type().
+-type fail_if_no_peer_cert() :: boolean().
+-type server_signature_algs() :: signature_algs().
+-type server_reuse_session() :: fun().
+-type server_reuse_sessions() :: boolean().
+-type sni_hosts() :: [{hostname(), [server_option() | common_option()]}].
+-type sni_fun() :: fun().
+-type honor_cipher_order() :: boolean().
+-type honor_ecc_order() :: boolean().
+-type client_renegotiation() :: boolean().
+%% -------------------------------------------------------------------------------------------------------
+-type prf_random() :: client_random | server_random.
+-type protocol_extensions() :: #{renegotiation_info => binary(),
+ signature_algs => signature_algs(),
+ alpn => app_level_protocol(),
+ srp => binary(),
+ next_protocol => app_level_protocol(),
+ ec_point_formats => [0..2],
+ elliptic_curves => [public_key:oid()],
+ sni => hostname()}.
+%% -------------------------------------------------------------------------------------------------------
+
+%%%--------------------------------------------------------------------
+%%% API
+%%%--------------------------------------------------------------------
+
%%--------------------------------------------------------------------
--spec start() -> ok | {error, reason()}.
--spec start(permanent | transient | temporary) -> ok | {error, reason()}.
%%
%% Description: Utility function that starts the ssl and applications
%% that it depends on.
%% see application(3)
%%--------------------------------------------------------------------
+-spec start() -> ok | {error, reason()}.
start() ->
start(temporary).
+-spec start(permanent | transient | temporary) -> ok | {error, reason()}.
start(Type) ->
case application:ensure_all_started(ssl, Type) of
{ok, _} ->
@@ -88,21 +409,17 @@ stop() ->
application:stop(ssl).
%%--------------------------------------------------------------------
-
--spec connect(host() | port(), [connect_option()]) -> {ok, #sslsocket{}} |
- {error, reason()}.
--spec connect(host() | port(), [connect_option()] | inet:port_number(),
- timeout() | list()) ->
- {ok, #sslsocket{}} | {error, reason()}.
--spec connect(host() | port(), inet:port_number(), list(), timeout()) ->
- {ok, #sslsocket{}} | {error, reason()}.
-
%%
%% Description: Connect to an ssl server.
%%--------------------------------------------------------------------
+-spec connect(host() | port(), [tls_client_option()]) -> {ok, #sslsocket{}} |
+ {error, reason()}.
connect(Socket, SslOptions) when is_port(Socket) ->
connect(Socket, SslOptions, infinity).
+-spec connect(host() | port(), [tls_client_option()] | inet:port_number(),
+ timeout() | list()) ->
+ {ok, #sslsocket{}} | {error, reason()}.
connect(Socket, SslOptions0, Timeout) when is_port(Socket),
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
{Transport,_,_,_} = proplists:get_value(cb_info, SslOptions0,
@@ -119,6 +436,9 @@ connect(Socket, SslOptions0, Timeout) when is_port(Socket),
connect(Host, Port, Options) ->
connect(Host, Port, Options, infinity).
+-spec connect(host() | port(), inet:port_number(), list(), timeout()) ->
+ {ok, #sslsocket{}} | {error, reason()}.
+
connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
try
{ok, Config} = handle_options(Options, client, Host),
@@ -134,7 +454,7 @@ connect(Host, Port, Options, Timeout) when (is_integer(Timeout) andalso Timeout
end.
%%--------------------------------------------------------------------
--spec listen(inet:port_number(), [listen_option()]) ->{ok, #sslsocket{}} | {error, reason()}.
+-spec listen(inet:port_number(), [tls_server_option()]) ->{ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Creates an ssl listen socket.
@@ -150,16 +470,16 @@ listen(Port, Options0) ->
Error
end.
%%--------------------------------------------------------------------
--spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} |
- {error, reason()}.
--spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} |
- {error, reason()}.
%%
%% Description: Performs transport accept on an ssl listen socket
%%--------------------------------------------------------------------
+-spec transport_accept(#sslsocket{}) -> {ok, #sslsocket{}} |
+ {error, reason()}.
transport_accept(ListenSocket) ->
transport_accept(ListenSocket, infinity).
+-spec transport_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} |
+ {error, reason()}.
transport_accept(#sslsocket{pid = {ListenSocket,
#config{connection_cb = ConnectionCb} = Config}}, Timeout)
when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
@@ -171,25 +491,25 @@ transport_accept(#sslsocket{pid = {ListenSocket,
end.
%%--------------------------------------------------------------------
--spec ssl_accept(#sslsocket{}) -> ok | {error, reason()}.
--spec ssl_accept(#sslsocket{} | port(), timeout()| [ssl_option()
- | transport_option()]) ->
- ok | {ok, #sslsocket{}} | {error, reason()}.
-
--spec ssl_accept(#sslsocket{} | port(), [ssl_option()] | [ssl_option()| transport_option()], timeout()) ->
- ok | {ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Performs accept on an ssl listen socket. e.i. performs
%% ssl handshake.
%%--------------------------------------------------------------------
+-spec ssl_accept(#sslsocket{}) -> ok | {error, timeout | closed | {options, any()}| error_alert()}.
ssl_accept(ListenSocket) ->
ssl_accept(ListenSocket, [], infinity).
+
+-spec ssl_accept(#sslsocket{} | port(), timeout()| [tls_server_option()]) ->
+ ok | {ok, #sslsocket{}} | {error, timeout | closed | {options, any()}| error_alert()}.
ssl_accept(Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity) ->
ssl_accept(Socket, [], Timeout);
ssl_accept(ListenSocket, SslOptions) when is_port(ListenSocket) ->
ssl_accept(ListenSocket, SslOptions, infinity);
ssl_accept(Socket, Timeout) ->
ssl_accept(Socket, [], Timeout).
+
+-spec ssl_accept(#sslsocket{} | port(), [tls_server_option()], timeout()) ->
+ ok | {ok, #sslsocket{}} | {error, timeout | closed | {options, any()}| error_alert()}.
ssl_accept(Socket, SslOptions, Timeout) when is_port(Socket) ->
handshake(Socket, SslOptions, Timeout);
ssl_accept(Socket, SslOptions, Timeout) ->
@@ -200,22 +520,19 @@ ssl_accept(Socket, SslOptions, Timeout) ->
Error
end.
%%--------------------------------------------------------------------
--spec handshake(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}.
--spec handshake(#sslsocket{} | port(), timeout()| [ssl_option()
- | transport_option()]) ->
- {ok, #sslsocket{}} | {error, reason()}.
-
--spec handshake(#sslsocket{} | port(), [ssl_option()] | [ssl_option()| transport_option()], timeout()) ->
- {ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Performs accept on an ssl listen socket. e.i. performs
%% ssl handshake.
%%--------------------------------------------------------------------
%% Performs the SSL/TLS/DTLS server-side handshake.
+-spec handshake(#sslsocket{}) -> {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}.
+
handshake(ListenSocket) ->
handshake(ListenSocket, infinity).
+-spec handshake(#sslsocket{} | port(), timeout()| [tls_server_option()]) ->
+ {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}.
handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or
(Timeout == infinity) ->
ssl_connection:handshake(Socket, Timeout);
@@ -229,6 +546,8 @@ handshake(#sslsocket{} = Socket, Timeout) when (is_integer(Timeout) andalso Tim
handshake(ListenSocket, SslOptions) when is_port(ListenSocket) ->
handshake(ListenSocket, SslOptions, infinity).
+-spec handshake(#sslsocket{} | port(), [tls_server_option()], timeout()) ->
+ {ok, #sslsocket{}} | {error, timeout | closed | {options, any()} | error_alert()}.
handshake(#sslsocket{} = Socket, [], Timeout) when (is_integer(Timeout) andalso Timeout >= 0) or
(Timeout == infinity)->
handshake(Socket, Timeout);
@@ -271,7 +590,7 @@ handshake(Socket, SslOptions, Timeout) when is_port(Socket),
%%--------------------------------------------------------------------
--spec handshake_continue(#sslsocket{}, [ssl_option()]) ->
+-spec handshake_continue(#sslsocket{}, [tls_client_option() | tls_server_option()]) ->
{ok, #sslsocket{}} | {error, reason()}.
%%
%%
@@ -280,7 +599,7 @@ handshake(Socket, SslOptions, Timeout) when is_port(Socket),
handshake_continue(Socket, SSLOptions) ->
handshake_continue(Socket, SSLOptions, infinity).
%%--------------------------------------------------------------------
--spec handshake_continue(#sslsocket{}, [ssl_option()], timeout()) ->
+-spec handshake_continue(#sslsocket{}, [tls_client_option() | tls_server_option()], timeout()) ->
{ok, #sslsocket{}} | {error, reason()}.
%%
%%
@@ -332,7 +651,7 @@ close(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport,_, _, _}
send(#sslsocket{pid = [Pid]}, Data) when is_pid(Pid) ->
ssl_connection:send(Pid, Data);
send(#sslsocket{pid = [_, Pid]}, Data) when is_pid(Pid) ->
- tls_sender:send_data(Pid, erlang:iolist_to_binary(Data));
+ tls_sender:send_data(Pid, erlang:iolist_to_iovec(Data));
send(#sslsocket{pid = {_, #config{transport_info={_, udp, _, _}}}}, _) ->
{error,enotconn}; %% Emulate connection behaviour
send(#sslsocket{pid = {dtls,_}}, _) ->
@@ -341,13 +660,14 @@ send(#sslsocket{pid = {ListenSocket, #config{transport_info={Transport, _, _, _}
Transport:send(ListenSocket, Data). %% {error,enotconn}
%%--------------------------------------------------------------------
--spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}.
--spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}.
%%
%% Description: Receives data when active = false
%%--------------------------------------------------------------------
+-spec recv(#sslsocket{}, integer()) -> {ok, binary()| list()} | {error, reason()}.
recv(Socket, Length) ->
recv(Socket, Length, infinity).
+
+-spec recv(#sslsocket{}, integer(), timeout()) -> {ok, binary()| list()} | {error, reason()}.
recv(#sslsocket{pid = [Pid|_]}, Length, Timeout) when is_pid(Pid),
(is_integer(Timeout) andalso Timeout >= 0) or (Timeout == infinity)->
ssl_connection:recv(Pid, Length, Timeout);
@@ -450,13 +770,13 @@ negotiated_protocol(#sslsocket{pid = [Pid|_]}) when is_pid(Pid) ->
ssl_connection:negotiated_protocol(Pid).
%%--------------------------------------------------------------------
--spec cipher_suites() -> [ssl_cipher_format:old_erl_cipher_suite()] | [string()].
+-spec cipher_suites() -> [old_cipher_suite()] | [string()].
%%--------------------------------------------------------------------
cipher_suites() ->
cipher_suites(erlang).
%%--------------------------------------------------------------------
-spec cipher_suites(erlang | openssl | all) ->
- [ssl_cipher_format:old_erl_cipher_suite() | string()].
+ [old_cipher_suite() | string()].
%% Description: Returns all supported cipher suites.
%%--------------------------------------------------------------------
cipher_suites(erlang) ->
@@ -470,9 +790,9 @@ cipher_suites(all) ->
[ssl_cipher_format:erl_suite_definition(Suite) || Suite <- available_suites(all)].
%%--------------------------------------------------------------------
--spec cipher_suites(default | all | anonymous, tls_record:tls_version() | dtls_record:dtls_version() |
+-spec cipher_suites(default | all | anonymous, ssl_record:ssl_version() |
tls_record:tls_atom_version() | dtls_record:dtls_atom_version()) ->
- [ssl_cipher_format:erl_cipher_suite()].
+ [erl_cipher_suite()].
%% Description: Returns all default and all supported cipher suites for a
%% TLS/DTLS version
%%--------------------------------------------------------------------
@@ -488,9 +808,10 @@ cipher_suites(Base, Version) ->
[ssl_cipher_format:suite_definition(Suite) || Suite <- supported_suites(Base, Version)].
%%--------------------------------------------------------------------
--spec filter_cipher_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()],
+-spec filter_cipher_suites([erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()] ,
[{key_exchange | cipher | mac | prf, fun()}] | []) ->
- [ssl_cipher_format:erl_cipher_suite() ] | [ssl_cipher_format:cipher_suite()].
+ [erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()].
+
%% Description: Removes cipher suites if any of the filter functions returns false
%% for any part of the cipher suite. This function also calls default filter functions
%% to make sure the cipher suite are supported by crypto.
@@ -507,10 +828,10 @@ filter_cipher_suites(Suites, Filters0) ->
prf_filters => add_filter(proplists:get_value(prf, Filters0), PrfF)},
ssl_cipher:filter_suites(Suites, Filters).
%%--------------------------------------------------------------------
--spec prepend_cipher_suites([ssl_cipher_format:erl_cipher_suite()] |
+-spec prepend_cipher_suites([erl_cipher_suite()] |
[{key_exchange | cipher | mac | prf, fun()}],
- [ssl_cipher_format:erl_cipher_suite()]) ->
- [ssl_cipher_format:erl_cipher_suite()].
+ [erl_cipher_suite()]) ->
+ [erl_cipher_suite()].
%% Description: Make <Preferred> suites become the most prefered
%% suites that is put them at the head of the cipher suite list
%% and remove them from <Suites> if present. <Preferred> may be a
@@ -525,10 +846,10 @@ prepend_cipher_suites(Filters, Suites) ->
Preferred = filter_cipher_suites(Suites, Filters),
Preferred ++ (Suites -- Preferred).
%%--------------------------------------------------------------------
--spec append_cipher_suites(Deferred :: [ssl_cipher_format:erl_cipher_suite()] |
+-spec append_cipher_suites(Deferred :: [erl_cipher_suite()] |
[{key_exchange | cipher | mac | prf, fun()}],
- [ssl_cipher_format:erl_cipher_suite()]) ->
- [ssl_cipher_format:erl_cipher_suite()].
+ [erl_cipher_suite()]) ->
+ [erl_cipher_suite()].
%% Description: Make <Deferred> suites suites become the
%% least prefered suites that is put them at the end of the cipher suite list
%% and removed them from <Suites> if present.
@@ -550,8 +871,8 @@ eccs() ->
eccs_filter_supported(Curves).
%%--------------------------------------------------------------------
--spec eccs(tls_record:tls_version() | tls_record:tls_atom_version() |
- dtls_record:dtls_version() | dtls_record:dtls_atom_version()) ->
+-spec eccs(tls_record:tls_atom_version() |
+ ssl_record:ssl_version() | dtls_record:dtls_atom_version()) ->
tls_v1:curves().
%% Description: returns the curves supported for a given version of
%% ssl/tls.
@@ -747,7 +1068,7 @@ versions() ->
SupportedDTLSVsns = [dtls_record:protocol_version(Vsn) || Vsn <- DTLSVsns],
AvailableTLSVsns = ?ALL_AVAILABLE_VERSIONS,
AvailableDTLSVsns = ?ALL_AVAILABLE_DATAGRAM_VERSIONS,
- [{ssl_app, ?VSN}, {supported, SupportedTLSVsns},
+ [{ssl_app, "9.2"}, {supported, SupportedTLSVsns},
{supported_dtls, SupportedDTLSVsns},
{available, AvailableTLSVsns},
{available_dtls, AvailableDTLSVsns}].
@@ -807,8 +1128,8 @@ format_error(Reason) when is_list(Reason) ->
Reason;
format_error(closed) ->
"TLS connection is closed";
-format_error({tls_alert, Description}) ->
- "TLS Alert: " ++ Description;
+format_error({tls_alert, {_, Description}}) ->
+ Description;
format_error({options,{FileType, File, Reason}}) when FileType == cacertfile;
FileType == certfile;
FileType == keyfile;
@@ -837,7 +1158,7 @@ tls_version({254, _} = Version) ->
%%--------------------------------------------------------------------
--spec suite_to_str(ssl_cipher_format:erl_cipher_suite()) -> string().
+-spec suite_to_str(erl_cipher_suite()) -> string().
%%
%% Description: Return the string representation of a cipher suite.
%%--------------------------------------------------------------------
@@ -845,32 +1166,6 @@ suite_to_str(Cipher) ->
ssl_cipher_format:suite_to_str(Cipher).
-%%--------------------------------------------------------------------
--spec set_log_level(atom()) -> ok | {error, term()}.
-%%
-%% Description: Set log level for the SSL application
-%%--------------------------------------------------------------------
-set_log_level(Level) ->
- case application:get_all_key(ssl) of
- {ok, PropList} ->
- Modules = proplists:get_value(modules, PropList),
- set_module_level(Modules, Level);
- undefined ->
- {error, ssl_not_started}
- end.
-
-set_module_level(Modules, Level) ->
- Fun = fun (Module) ->
- ok = logger:set_module_level(Module, Level)
- end,
- try lists:map(Fun, Modules) of
- _ ->
- ok
- catch
- error:{badmatch, Error} ->
- Error
- end.
-
%%%--------------------------------------------------------------
%%% Internal functions
%%%--------------------------------------------------------------------
@@ -948,7 +1243,6 @@ handle_options(Opts0, Role, Host) ->
handle_verify_options(Opts, CaCerts),
CertFile = handle_option(certfile, Opts, <<>>),
- RecordCb = record_cb(Opts),
[HighestVersion|_] = Versions =
case handle_option(versions, Opts, []) of
@@ -1075,6 +1369,7 @@ handle_options(Opts0, Role, Host) ->
fallback, signature_algs, signature_algs_cert, eccs, honor_ecc_order,
beast_mitigation, max_handshake_size, handshake, customize_hostname_check,
supported_groups],
+
SockOpts = lists:foldl(fun(Key, PropList) ->
proplists:delete(Key, PropList)
end, Opts, SslOptions),
diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl
index ed8156e0be..06b1b005a5 100644
--- a/lib/ssl/src/ssl_alert.erl
+++ b/lib/ssl/src/ssl_alert.erl
@@ -48,8 +48,8 @@ decode(Bin) ->
decode(Bin, [], 0).
%%--------------------------------------------------------------------
--spec reason_code(#alert{}, client | server) ->
- closed | {tls_alert, unicode:chardata()}.
+%% -spec reason_code(#alert{}, client | server) ->
+%% {tls_alert, unicode:chardata()} | closed.
%-spec reason_code(#alert{}, client | server) -> closed | {essl, string()}.
%%
%% Description: Returns the error reason that will be returned to the
@@ -58,8 +58,10 @@ decode(Bin) ->
reason_code(#alert{description = ?CLOSE_NOTIFY}, _) ->
closed;
-reason_code(#alert{description = Description}, _) ->
- {tls_alert, string:casefold(description_txt(Description))}.
+reason_code(#alert{description = Description, role = Role} = Alert, Role) ->
+ {tls_alert, {description_atom(Description), own_alert_txt(Alert)}};
+reason_code(#alert{description = Description} = Alert, Role) ->
+ {tls_alert, {description_atom(Description), alert_txt(Alert#alert{role = Role})}}.
%%--------------------------------------------------------------------
-spec own_alert_txt(#alert{}) -> string().
@@ -159,6 +161,8 @@ description_txt(?INSUFFICIENT_SECURITY) ->
"Insufficient Security";
description_txt(?INTERNAL_ERROR) ->
"Internal Error";
+description_txt(?INAPPROPRIATE_FALLBACK) ->
+ "Inappropriate Fallback";
description_txt(?USER_CANCELED) ->
"User Canceled";
description_txt(?NO_RENEGOTIATION) ->
@@ -177,11 +181,80 @@ description_txt(?BAD_CERTIFICATE_HASH_VALUE) ->
"Bad Certificate Hash Value";
description_txt(?UNKNOWN_PSK_IDENTITY) ->
"Unknown Psk Identity";
-description_txt(?INAPPROPRIATE_FALLBACK) ->
- "Inappropriate Fallback";
description_txt(?CERTIFICATE_REQUIRED) ->
"Certificate required";
description_txt(?NO_APPLICATION_PROTOCOL) ->
"No application protocol";
description_txt(Enum) ->
lists:flatten(io_lib:format("unsupported/unknown alert: ~p", [Enum])).
+
+description_atom(?CLOSE_NOTIFY) ->
+ close_notify;
+description_atom(?UNEXPECTED_MESSAGE) ->
+ unexpected_message;
+description_atom(?BAD_RECORD_MAC) ->
+ bad_record_mac;
+description_atom(?DECRYPTION_FAILED_RESERVED) ->
+ decryption_failed_reserved;
+description_atom(?RECORD_OVERFLOW) ->
+ record_overflow;
+description_atom(?DECOMPRESSION_FAILURE) ->
+ decompression_failure;
+description_atom(?HANDSHAKE_FAILURE) ->
+ handshake_failure;
+description_atom(?NO_CERTIFICATE_RESERVED) ->
+ no_certificate_reserved;
+description_atom(?BAD_CERTIFICATE) ->
+ bad_certificate;
+description_atom(?UNSUPPORTED_CERTIFICATE) ->
+ unsupported_certificate;
+description_atom(?CERTIFICATE_REVOKED) ->
+ certificate_revoked;
+description_atom(?CERTIFICATE_EXPIRED) ->
+ certificate_expired;
+description_atom(?CERTIFICATE_UNKNOWN) ->
+ certificate_unknown;
+description_atom(?ILLEGAL_PARAMETER) ->
+ illegal_parameter;
+description_atom(?UNKNOWN_CA) ->
+ unknown_ca;
+description_atom(?ACCESS_DENIED) ->
+ access_denied;
+description_atom(?DECODE_ERROR) ->
+ decode_error;
+description_atom(?DECRYPT_ERROR) ->
+ decrypt_error;
+description_atom(?EXPORT_RESTRICTION) ->
+ export_restriction;
+description_atom(?PROTOCOL_VERSION) ->
+ protocol_version;
+description_atom(?INSUFFICIENT_SECURITY) ->
+ insufficient_security;
+description_atom(?INTERNAL_ERROR) ->
+ internal_error;
+description_atom(?INAPPROPRIATE_FALLBACK) ->
+ inappropriate_fallback;
+description_atom(?USER_CANCELED) ->
+ user_canceled;
+description_atom(?NO_RENEGOTIATION) ->
+ no_renegotiation;
+description_atom(?MISSING_EXTENSION) ->
+ missing_extension;
+description_atom(?UNSUPPORTED_EXTENSION) ->
+ unsupported_extension;
+description_atom(?CERTIFICATE_UNOBTAINABLE) ->
+ certificate_unobtainable;
+description_atom(?UNRECOGNISED_NAME) ->
+ unrecognised_name;
+description_atom(?BAD_CERTIFICATE_STATUS_RESPONSE) ->
+ bad_certificate_status_response;
+description_atom(?BAD_CERTIFICATE_HASH_VALUE) ->
+ bad_certificate_hash_value;
+description_atom(?UNKNOWN_PSK_IDENTITY) ->
+ unknown_psk_identity;
+description_atom(?CERTIFICATE_REQUIRED) ->
+ certificate_required;
+description_atom(?NO_APPLICATION_PROTOCOL) ->
+ no_application_protocol;
+description_atom(_) ->
+ 'unsupported/unknown_alert'.
diff --git a/lib/ssl/src/ssl_api.hrl b/lib/ssl/src/ssl_api.hrl
index 7b7b1cbcd9..f4594912bd 100644
--- a/lib/ssl/src/ssl_api.hrl
+++ b/lib/ssl/src/ssl_api.hrl
@@ -21,56 +21,7 @@
-ifndef(ssl_api).
-define(ssl_api, true).
--include("ssl_cipher.hrl").
-
-%% Visible in API
--export_type([connect_option/0, listen_option/0, ssl_option/0, transport_option/0,
- prf_random/0, sslsocket/0]).
-
-
%% Looks like it does for backwards compatibility reasons
-record(sslsocket, {fd = nil, pid = nil}).
-
--type sslsocket() :: #sslsocket{}.
--type connect_option() :: socket_connect_option() | ssl_option() | transport_option().
--type socket_connect_option() :: gen_tcp:connect_option().
--type listen_option() :: socket_listen_option() | ssl_option() | transport_option().
--type socket_listen_option() :: gen_tcp:listen_option().
-
--type ssl_option() :: {versions, ssl_record:ssl_atom_version()} |
- {verify, verify_type()} |
- {verify_fun, {fun(), InitialUserState::term()}} |
- {fail_if_no_peer_cert, boolean()} | {depth, integer()} |
- {cert, Der::binary()} | {certfile, path()} |
- {key, {private_key_type(), Der::binary()}} |
- {keyfile, path()} | {password, string()} | {cacerts, [Der::binary()]} |
- {cacertfile, path()} | {dh, Der::binary()} | {dhfile, path()} |
- {user_lookup_fun, {fun(), InitialUserState::term()}} |
- {psk_identity, string()} |
- {srp_identity, {string(), string()}} |
- {ciphers, ciphers()} | {ssl_imp, ssl_imp()} | {reuse_sessions, boolean()} |
- {reuse_session, fun()} | {hibernate_after, integer()|undefined} |
- {alpn_advertised_protocols, [binary()]} |
- {alpn_preferred_protocols, [binary()]} |
- {next_protocols_advertised, list(binary())} |
- {client_preferred_next_protocols, binary(), client | server, list(binary())}.
-
--type verify_type() :: verify_none | verify_peer.
--type path() :: string().
--type ciphers() :: [ssl_cipher_format:erl_cipher_suite()] |
- string(). % (according to old API)
--type ssl_imp() :: new | old.
-
--type transport_option() :: {cb_info, {CallbackModule::atom(), DataTag::atom(),
- ClosedTag::atom(), ErrTag::atom()}}.
--type prf_random() :: client_random | server_random.
-
--type private_key_type() :: rsa | %% Backwards compatibility
- dsa | %% Backwards compatibility
- 'RSAPrivateKey' |
- 'DSAPrivateKey' |
- 'ECPrivateKey' |
- 'PrivateKeyInfo'.
-
-endif. % -ifdef(ssl_api).
diff --git a/lib/ssl/src/ssl_app.erl b/lib/ssl/src/ssl_app.erl
index 2a5047c75c..9e6d676bef 100644
--- a/lib/ssl/src/ssl_app.erl
+++ b/lib/ssl/src/ssl_app.erl
@@ -44,11 +44,11 @@ start_logger() ->
formatter => {ssl_logger, #{}}},
Filter = {fun logger_filters:domain/2,{log,sub,[otp,ssl]}},
logger:add_handler(ssl_handler, logger_std_h, Config),
- logger:add_handler_filter(ssl_handler, filter_non_ssl, Filter).
+ logger:add_handler_filter(ssl_handler, filter_non_ssl, Filter),
+ logger:set_application_level(ssl, debug).
%%
%% Description: Stop SSL logger
stop_logger() ->
+ logger:unset_application_level(ssl),
logger:remove_handler(ssl_handler).
-
-
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index d08b2cc7ad..fe8736d2df 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -1,7 +1,7 @@
%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -42,10 +42,10 @@
rc4_suites/1, des_suites/1, rsa_suites/1,
filter/3, filter_suites/1, filter_suites/2,
hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1,
- random_bytes/1, calc_mac_hash/4,
+ random_bytes/1, calc_mac_hash/4, calc_mac_hash/6,
is_stream_ciphersuite/1, signature_scheme/1,
scheme_to_components/1, hash_size/1, effective_key_bits/1,
- key_material/1]).
+ key_material/1, signature_algorithm_to_scheme/1]).
%% RFC 8446 TLS 1.3
-export([generate_client_shares/1, generate_server_share/1, add_zero_padding/2]).
@@ -112,7 +112,8 @@ cipher_init(?AES_GCM, IV, Key) ->
cipher_init(?CHACHA20_POLY1305, IV, Key) ->
#cipher_state{iv = IV, key = Key, tag_len = 16};
cipher_init(_BCA, IV, Key) ->
- #cipher_state{iv = IV, key = Key}.
+ %% Initialize random IV cache, not used for aead ciphers
+ #cipher_state{iv = IV, key = Key, state = <<>>}.
nonce_seed(Seed, CipherState) ->
CipherState#cipher_state{nonce = Seed}.
@@ -127,12 +128,11 @@ nonce_seed(Seed, CipherState) ->
%% data is calculated and the data plus the HMAC is ecncrypted.
%%-------------------------------------------------------------------
cipher(?NULL, CipherState, <<>>, Fragment, _Version) ->
- GenStreamCipherList = [Fragment, <<>>],
- {GenStreamCipherList, CipherState};
+ {iolist_to_binary(Fragment), CipherState};
cipher(?RC4, CipherState = #cipher_state{state = State0}, Mac, Fragment, _Version) ->
GenStreamCipherList = [Fragment, Mac],
{State1, T} = crypto:stream_encrypt(State0, GenStreamCipherList),
- {T, CipherState#cipher_state{state = State1}};
+ {iolist_to_binary(T), CipherState#cipher_state{state = State1}};
cipher(?DES, CipherState, Mac, Fragment, Version) ->
block_cipher(fun(Key, IV, T) ->
crypto:block_encrypt(des_cbc, Key, IV, T)
@@ -161,8 +161,7 @@ aead_type(?CHACHA20_POLY1305) ->
build_cipher_block(BlockSz, Mac, Fragment) ->
TotSz = byte_size(Mac) + erlang:iolist_size(Fragment) + 1,
- {PaddingLength, Padding} = get_padding(TotSz, BlockSz),
- [Fragment, Mac, PaddingLength, Padding].
+ [Fragment, Mac, padding_with_len(TotSz, BlockSz)].
block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0,
Mac, Fragment, {3, N})
@@ -172,14 +171,21 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0,
NextIV = next_iv(T, IV),
{T, CS0#cipher_state{iv=NextIV}};
-block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0,
+block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV, state = IV_Cache0} = CS0,
Mac, Fragment, {3, N})
when N == 2; N == 3; N == 4 ->
- NextIV = random_iv(IV),
+ IV_Size = byte_size(IV),
+ <<NextIV:IV_Size/binary, IV_Cache/binary>> =
+ case IV_Cache0 of
+ <<>> ->
+ random_bytes(IV_Size bsl 5); % 32 IVs
+ _ ->
+ IV_Cache0
+ end,
L0 = build_cipher_block(BlockSz, Mac, Fragment),
L = [NextIV|L0],
T = Fun(Key, IV, L),
- {T, CS0#cipher_state{iv=NextIV}}.
+ {T, CS0#cipher_state{iv=NextIV, state = IV_Cache}}.
%%--------------------------------------------------------------------
-spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(),
@@ -501,8 +507,8 @@ filter(DerCert, Ciphers0, Version) ->
filter_suites_signature(Sign, Ciphers, Version).
%%--------------------------------------------------------------------
--spec filter_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()], map()) ->
- [ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()].
+-spec filter_suites([ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()], map()) ->
+ [ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()].
%%
%% Description: Filter suites using supplied filter funs
%%-------------------------------------------------------------------
@@ -528,8 +534,8 @@ filter_suite(Suite, Filters) ->
filter_suite(ssl_cipher_format:suite_definition(Suite), Filters).
%%--------------------------------------------------------------------
--spec filter_suites([ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]) ->
- [ssl_cipher_format:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()].
+-spec filter_suites([ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()]) ->
+ [ssl:erl_cipher_suite()] | [ssl_cipher_format:cipher_suite()].
%%
%% Description: Filter suites for algorithms supported by crypto.
%%-------------------------------------------------------------------
@@ -654,12 +660,13 @@ random_bytes(N) ->
calc_mac_hash(Type, Version,
PlainFragment, #{sequence_number := SeqNo,
mac_secret := MacSecret,
- security_parameters:=
- SecPars}) ->
+ security_parameters :=
+ #security_parameters{mac_algorithm = MacAlgorithm}}) ->
+ calc_mac_hash(Type, Version, PlainFragment, MacAlgorithm, MacSecret, SeqNo).
+%%
+calc_mac_hash(Type, Version, PlainFragment, MacAlgorithm, MacSecret, SeqNo) ->
Length = erlang:iolist_size(PlainFragment),
- mac_hash(Version, SecPars#security_parameters.mac_algorithm,
- MacSecret, SeqNo, Type,
- Length, PlainFragment).
+ mac_hash(Version, MacAlgorithm, MacSecret, SeqNo, Type, Length, PlainFragment).
is_stream_ciphersuite(#{cipher := rc4_128}) ->
true;
@@ -765,7 +772,6 @@ expanded_key_material(Cipher) when Cipher == aes_128_cbc;
Cipher == chacha20_poly1305 ->
unknown.
-
effective_key_bits(null) ->
0;
effective_key_bits(des_cbc) ->
@@ -785,18 +791,15 @@ iv_size(Cipher) when Cipher == null;
Cipher == rc4_128;
Cipher == chacha20_poly1305->
0;
-
iv_size(Cipher) when Cipher == aes_128_gcm;
Cipher == aes_256_gcm ->
4;
-
iv_size(Cipher) ->
block_size(Cipher).
block_size(Cipher) when Cipher == des_cbc;
Cipher == '3des_ede_cbc' ->
8;
-
block_size(Cipher) when Cipher == aes_128_cbc;
Cipher == aes_256_cbc;
Cipher == aes_128_gcm;
@@ -897,6 +900,18 @@ scheme_to_components(rsa_pss_pss_sha512) -> {sha512, rsa_pss_pss, undefined};
scheme_to_components(rsa_pkcs1_sha1) -> {sha1, rsa_pkcs1, undefined};
scheme_to_components(ecdsa_sha1) -> {sha1, ecdsa, undefined}.
+
+%% TODO: Add support for EC and RSA-SSA signatures
+signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha1WithRSAEncryption}) ->
+ rsa_pkcs1_sha1;
+signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha256WithRSAEncryption}) ->
+ rsa_pkcs1_sha256;
+signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha384WithRSAEncryption}) ->
+ rsa_pkcs1_sha384;
+signature_algorithm_to_scheme(#'SignatureAlgorithm'{algorithm = ?sha512WithRSAEncryption}) ->
+ rsa_pkcs1_sha512.
+
+
%% RFC 5246: 6.2.3.2. CBC Block Cipher
%%
%% Implementation note: Canvel et al. [CBCTIME] have demonstrated a
@@ -963,21 +978,51 @@ is_correct_padding(GenBlockCipher, {3, 1}, false) ->
%% Padding must be checked in TLS 1.1 and after
is_correct_padding(#generic_block_cipher{padding_length = Len,
padding = Padding}, _, _) ->
- Len == byte_size(Padding) andalso
- binary:copy(?byte(Len), Len) == Padding.
-
-get_padding(Length, BlockSize) ->
- get_padding_aux(BlockSize, Length rem BlockSize).
-
-get_padding_aux(_, 0) ->
- {0, <<>>};
-get_padding_aux(BlockSize, PadLength) ->
- N = BlockSize - PadLength,
- {N, binary:copy(?byte(N), N)}.
+ (Len == byte_size(Padding)) andalso (padding(Len) == Padding).
+
+padding(PadLen) ->
+ case PadLen of
+ 0 -> <<>>;
+ 1 -> <<1>>;
+ 2 -> <<2,2>>;
+ 3 -> <<3,3,3>>;
+ 4 -> <<4,4,4,4>>;
+ 5 -> <<5,5,5,5,5>>;
+ 6 -> <<6,6,6,6,6,6>>;
+ 7 -> <<7,7,7,7,7,7,7>>;
+ 8 -> <<8,8,8,8,8,8,8,8>>;
+ 9 -> <<9,9,9,9,9,9,9,9,9>>;
+ 10 -> <<10,10,10,10,10,10,10,10,10,10>>;
+ 11 -> <<11,11,11,11,11,11,11,11,11,11,11>>;
+ 12 -> <<12,12,12,12,12,12,12,12,12,12,12,12>>;
+ 13 -> <<13,13,13,13,13,13,13,13,13,13,13,13,13>>;
+ 14 -> <<14,14,14,14,14,14,14,14,14,14,14,14,14,14>>;
+ 15 -> <<15,15,15,15,15,15,15,15,15,15,15,15,15,15,15>>;
+ _ ->
+ binary:copy(<<PadLen>>, PadLen)
+ end.
-random_iv(IV) ->
- IVSz = byte_size(IV),
- random_bytes(IVSz).
+padding_with_len(TextLen, BlockSize) ->
+ case BlockSize - (TextLen rem BlockSize) of
+ 0 -> <<0>>;
+ 1 -> <<1,1>>;
+ 2 -> <<2,2,2>>;
+ 3 -> <<3,3,3,3>>;
+ 4 -> <<4,4,4,4,4>>;
+ 5 -> <<5,5,5,5,5,5>>;
+ 6 -> <<6,6,6,6,6,6,6>>;
+ 7 -> <<7,7,7,7,7,7,7,7>>;
+ 8 -> <<8,8,8,8,8,8,8,8,8>>;
+ 9 -> <<9,9,9,9,9,9,9,9,9,9>>;
+ 10 -> <<10,10,10,10,10,10,10,10,10,10,10>>;
+ 11 -> <<11,11,11,11,11,11,11,11,11,11,11,11>>;
+ 12 -> <<12,12,12,12,12,12,12,12,12,12,12,12,12>>;
+ 13 -> <<13,13,13,13,13,13,13,13,13,13,13,13,13,13>>;
+ 14 -> <<14,14,14,14,14,14,14,14,14,14,14,14,14,14,14>>;
+ 15 -> <<15,15,15,15,15,15,15,15,15,15,15,15,15,15,15,15>>;
+ PadLen ->
+ binary:copy(<<PadLen>>, PadLen + 1)
+ end.
next_iv(Bin, IV) ->
BinSz = byte_size(Bin),
diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl
index 5891f3a7cc..00822ad9de 100644
--- a/lib/ssl/src/ssl_cipher.hrl
+++ b/lib/ssl/src/ssl_cipher.hrl
@@ -47,6 +47,7 @@
-record(cipher_state, {
iv,
key,
+ finished_key,
state,
nonce,
tag_len
diff --git a/lib/ssl/src/ssl_cipher_format.erl b/lib/ssl/src/ssl_cipher_format.erl
index 6e480eef45..b592295d56 100644
--- a/lib/ssl/src/ssl_cipher_format.erl
+++ b/lib/ssl/src/ssl_cipher_format.erl
@@ -25,33 +25,25 @@
%%----------------------------------------------------------------------
-module(ssl_cipher_format).
+-include("ssl_api.hrl").
-include("ssl_cipher.hrl").
-include("ssl_internal.hrl").
-include_lib("public_key/include/public_key.hrl").
--export_type([cipher_suite/0,
- erl_cipher_suite/0, old_erl_cipher_suite/0, openssl_cipher_suite/0,
- hash/0, key_algo/0, sign_algo/0]).
+-export_type([old_erl_cipher_suite/0, openssl_cipher_suite/0, cipher_suite/0]).
--type cipher() :: null |rc4_128 | des_cbc | '3des_ede_cbc' | aes_128_cbc | aes_256_cbc | aes_128_gcm | aes_256_gcm | chacha20_poly1305.
--type hash() :: null | md5 | sha | sha224 | sha256 | sha384 | sha512.
--type sign_algo() :: rsa | dsa | ecdsa.
--type key_algo() :: null |
- rsa |
- dhe_rsa | dhe_dss |
- ecdhe_ecdsa | ecdh_ecdsa | ecdh_rsa |
- srp_rsa| srp_dss |
- psk | dhe_psk | rsa_psk |
- dh_anon | ecdh_anon | srp_anon |
- any. %% TLS 1.3
--type erl_cipher_suite() :: #{key_exchange := key_algo(),
- cipher := cipher(),
- mac := hash() | aead,
- prf := hash() | default_prf %% Old cipher suites, version dependent
+-type internal_cipher() :: null | ssl:cipher().
+-type internal_hash() :: null | ssl:hash().
+-type internal_kex_algo() :: null | ssl:kex_algo().
+-type internal_erl_cipher_suite() :: #{key_exchange := internal_kex_algo(),
+ cipher := internal_cipher(),
+ mac := internal_hash() | aead,
+ prf := internal_hash() | default_prf %% Old cipher suites, version dependent
}.
--type old_erl_cipher_suite() :: {key_algo(), cipher(), hash()} % Pre TLS 1.2
+-type old_erl_cipher_suite() :: {ssl:kex_algo(), internal_cipher(), internal_hash()} % Pre TLS 1.2
%% TLS 1.2, internally PRE TLS 1.2 will use default_prf
- | {key_algo(), cipher(), hash(), hash() | default_prf}.
+ | {ssl:kex_algo(), internal_cipher(), internal_hash(),
+ internal_hash() | default_prf}.
-type cipher_suite() :: binary().
-type openssl_cipher_suite() :: string().
@@ -60,7 +52,7 @@
openssl_suite/1, openssl_suite_name/1]).
%%--------------------------------------------------------------------
--spec suite_to_str(erl_cipher_suite()) -> string().
+-spec suite_to_str(internal_erl_cipher_suite()) -> string().
%%
%% Description: Return the string representation of a cipher suite.
%%--------------------------------------------------------------------
@@ -90,7 +82,7 @@ suite_to_str(#{key_exchange := Kex,
"_" ++ string:to_upper(atom_to_list(Mac)).
%%--------------------------------------------------------------------
--spec suite_definition(cipher_suite()) -> erl_cipher_suite().
+-spec suite_definition(cipher_suite()) -> internal_erl_cipher_suite().
%%
%% Description: Return erlang cipher suite definition.
%% Note: Currently not supported suites are commented away.
@@ -845,7 +837,7 @@ suite_definition(?TLS_CHACHA20_POLY1305_SHA256) ->
%%--------------------------------------------------------------------
--spec erl_suite_definition(cipher_suite() | erl_cipher_suite()) -> old_erl_cipher_suite().
+-spec erl_suite_definition(cipher_suite() | internal_erl_cipher_suite()) -> old_erl_cipher_suite().
%%
%% Description: Return erlang cipher suite definition. Filters last value
%% for now (compatibility reasons).
@@ -862,7 +854,7 @@ erl_suite_definition(#{key_exchange := KeyExchange, cipher := Cipher,
end.
%%--------------------------------------------------------------------
--spec suite(erl_cipher_suite()) -> cipher_suite().
+-spec suite(internal_erl_cipher_suite()) -> cipher_suite().
%%
%% Description: Return TLS cipher suite definition.
%%--------------------------------------------------------------------
@@ -1663,7 +1655,7 @@ openssl_suite("TLS_CHACHA20_POLY1305_SHA256") ->
%%--------------------------------------------------------------------
--spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | erl_cipher_suite().
+-spec openssl_suite_name(cipher_suite()) -> openssl_cipher_suite() | internal_erl_cipher_suite().
%%
%% Description: Return openssl cipher suite name if possible
%%-------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index af18ceb322..1e97fe046b 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -39,9 +39,9 @@
%% Setup
--export([connect/8, handshake/7, handshake/2, handshake/3,
+-export([connect/8, handshake/7, handshake/2, handshake/3, handle_common_event/5,
handshake_continue/3, handshake_cancel/1,
- socket_control/4, socket_control/5, start_or_recv_cancel_timer/2]).
+ socket_control/4, socket_control/5]).
%% User Events
-export([send/2, recv/3, close/2, shutdown/2,
@@ -71,14 +71,14 @@
-export([terminate/3, format_status/2]).
%% Erlang Distribution export
--export([get_sslsocket/1, dist_handshake_complete/2]).
+-export([dist_handshake_complete/2]).
%%====================================================================
%% Setup
%%====================================================================
%%--------------------------------------------------------------------
-spec connect(tls_connection | dtls_connection,
- host(), inet:port_number(),
+ ssl:host(), inet:port_number(),
port() | {tuple(), port()}, %% TLS | DTLS
{#ssl_options{}, #socket_options{},
%% Tracker only needed on server side
@@ -144,7 +144,7 @@ handshake(#sslsocket{pid = [Pid|_]} = Socket, SslOptions, Timeout) ->
end.
%%--------------------------------------------------------------------
--spec handshake_continue(#sslsocket{}, [ssl_option()],
+-spec handshake_continue(#sslsocket{}, [ssl:tls_server_option()],
timeout()) -> {ok, #sslsocket{}}| {error, reason()}.
%%
%% Description: Continues handshake with new options
@@ -183,27 +183,23 @@ socket_control(Connection, Socket, Pid, Transport) ->
%%--------------------------------------------------------------------
socket_control(Connection, Socket, Pids, Transport, udp_listener) ->
%% dtls listener process must have the socket control
- {ok, Connection:socket(Pids, Transport, Socket, Connection, undefined)};
+ {ok, Connection:socket(Pids, Transport, Socket, undefined)};
socket_control(tls_connection = Connection, Socket, [Pid|_] = Pids, Transport, ListenTracker) ->
case Transport:controlling_process(Socket, Pid) of
ok ->
- {ok, Connection:socket(Pids, Transport, Socket, Connection, ListenTracker)};
+ {ok, Connection:socket(Pids, Transport, Socket, ListenTracker)};
{error, Reason} ->
{error, Reason}
end;
socket_control(dtls_connection = Connection, {_, Socket}, [Pid|_] = Pids, Transport, ListenTracker) ->
case Transport:controlling_process(Socket, Pid) of
ok ->
- {ok, Connection:socket(Pids, Transport, Socket, Connection, ListenTracker)};
+ {ok, Connection:socket(Pids, Transport, Socket, ListenTracker)};
{error, Reason} ->
{error, Reason}
end.
-start_or_recv_cancel_timer(infinity, _RecvFrom) ->
- undefined;
-start_or_recv_cancel_timer(Timeout, RecvFrom) ->
- erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}).
%%====================================================================
%% User events
@@ -216,9 +212,9 @@ start_or_recv_cancel_timer(Timeout, RecvFrom) ->
%%--------------------------------------------------------------------
send(Pid, Data) ->
call(Pid, {application_data,
- %% iolist_to_binary should really
- %% be called iodata_to_binary()
- erlang:iolist_to_binary(Data)}).
+ %% iolist_to_iovec should really
+ %% be called iodata_to_iovec()
+ erlang:iolist_to_iovec(Data)}).
%%--------------------------------------------------------------------
-spec recv(pid(), integer(), timeout()) ->
@@ -316,9 +312,6 @@ renegotiation(ConnectionPid) ->
internal_renegotiation(ConnectionPid, #{current_write := WriteState}) ->
gen_statem:cast(ConnectionPid, {internal_renegotiate, WriteState}).
-get_sslsocket(ConnectionPid) ->
- call(ConnectionPid, get_sslsocket).
-
dist_handshake_complete(ConnectionPid, DHandle) ->
gen_statem:cast(ConnectionPid, {dist_handshake_complete, DHandle}).
@@ -369,8 +362,8 @@ handle_normal_shutdown(Alert, StateName, #state{static_env = #static_env{role =
transport_cb = Transport,
protocol_cb = Connection,
tracker = Tracker},
- socket_options = Opts,
- user_application = {_Mon, Pid},
+ connection_env = #connection_env{user_application = {_Mon, Pid}},
+ socket_options = Opts,
start_or_recv_from = RecvFrom} = State) ->
Pids = Connection:pids(State),
alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, Connection).
@@ -383,15 +376,17 @@ handle_alert(#alert{level = ?FATAL} = Alert, StateName,
tracker = Tracker,
transport_cb = Transport,
protocol_cb = Connection},
+ connection_env = #connection_env{user_application = {_Mon, Pid}},
ssl_options = SslOpts,
start_or_recv_from = From,
- session = Session, user_application = {_Mon, Pid},
+ session = Session,
socket_options = Opts} = State) ->
invalidate_session(Role, Host, Port, Session),
log_alert(SslOpts#ssl_options.log_level, Role, Connection:protocol_name(),
StateName, Alert#alert{role = opposite_role(Role)}),
Pids = Connection:pids(State),
- alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection),
+ alert_user(Pids, Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert,
+ opposite_role(Role), Connection),
{stop, {shutdown, normal}, State};
handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
@@ -449,106 +444,112 @@ handle_alert(#alert{level = ?WARNING} = Alert, StateName,
%%====================================================================
%% Data handling
%%====================================================================
-passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName, Connection) ->
- case Buffer of
- <<>> ->
- {Record, State} = Connection:next_record(State0),
- Connection:next_event(StateName, Record, State);
+passive_receive(State0 = #state{user_data_buffer = {_,BufferSize,_}}, StateName, Connection, StartTimerAction) ->
+ case BufferSize of
+ 0 ->
+ Connection:next_event(StateName, no_record, State0, StartTimerAction);
_ ->
case read_application_data(<<>>, State0) of
{stop, _, _} = ShutdownError ->
ShutdownError;
{Record, State} ->
- Connection:next_event(StateName, Record, State)
+ case State#state.start_or_recv_from of
+ undefined ->
+ %% Cancel recv timeout as data has been delivered
+ Connection:next_event(StateName, Record, State,
+ [{{timeout, recv}, infinity, timeout}]);
+ _ ->
+ Connection:next_event(StateName, Record, State, StartTimerAction)
+ end
end
end.
read_application_data(
Data,
#state{
- user_data_buffer = Buffer0,
- erl_dist_handle = DHandle} = State) ->
+ user_data_buffer = {Front0,BufferSize0,Rear0},
+ connection_env = #connection_env{erl_dist_handle = DHandle}} = State) ->
%%
- Buffer = bincat(Buffer0, Data),
+ Front = Front0,
+ BufferSize = BufferSize0 + byte_size(Data),
+ Rear = [Data|Rear0],
case DHandle of
undefined ->
- #state{
- socket_options = SocketOpts,
- bytes_to_read = BytesToRead,
- start_or_recv_from = RecvFrom,
- timer = Timer} = State,
- read_application_data(
- Buffer, State, SocketOpts, RecvFrom, Timer, BytesToRead);
+ read_application_data(State, Front, BufferSize, Rear);
_ ->
- try read_application_dist_data(Buffer, State, DHandle)
+ try read_application_dist_data(DHandle, Front, BufferSize, Rear) of
+ Buffer ->
+ {no_record, State#state{user_data_buffer = Buffer}}
catch error:_ ->
{stop,disconnect,
- State#state{
- user_data_buffer = Buffer,
- bytes_to_read = undefined}}
+ State#state{user_data_buffer = {Front,BufferSize,Rear}}}
end
end.
-read_application_dist_data(Buffer, State, DHandle) ->
- case Buffer of
- <<Size:32,Data:Size/binary>> ->
- erlang:dist_ctrl_put_data(DHandle, Data),
- {no_record,
- State#state{
- user_data_buffer = <<>>,
- bytes_to_read = undefined}};
- <<Size:32,Data:Size/binary,Rest/binary>> ->
- erlang:dist_ctrl_put_data(DHandle, Data),
- read_application_dist_data(Rest, State, DHandle);
- _ ->
- {no_record,
- State#state{
- user_data_buffer = Buffer,
- bytes_to_read = undefined}}
- end.
-read_application_data(
- Buffer0, State, SocketOpts0, RecvFrom, Timer, BytesToRead) ->
- %%
- case get_data(SocketOpts0, BytesToRead, Buffer0) of
- {ok, ClientData, Buffer} -> % Send data
- #state{
- static_env =
- #static_env{
- socket = Socket,
- protocol_cb = Connection,
- transport_cb = Transport,
- tracker = Tracker},
- user_application = {_Mon, Pid}} = State,
- SocketOpts =
- deliver_app_data(
- Connection:pids(State),
- Transport, Socket, SocketOpts0,
- ClientData, Pid, RecvFrom, Tracker, Connection),
- cancel_timer(Timer),
+read_application_data(#state{
+ socket_options = SocketOpts,
+ bytes_to_read = BytesToRead,
+ start_or_recv_from = RecvFrom} = State, Front, BufferSize, Rear) ->
+ read_application_data(State, Front, BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead).
+
+%% Pick binary from queue front, if empty wait for more data
+read_application_data(State, [Bin|Front], BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead) ->
+ read_application_data_bin(State, Front, BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead, Bin);
+read_application_data(State, [] = Front, BufferSize, [] = Rear, SocketOpts, RecvFrom, BytesToRead) ->
+ 0 = BufferSize, % Assert
+ {no_record, State#state{socket_options = SocketOpts,
+ bytes_to_read = BytesToRead,
+ start_or_recv_from = RecvFrom,
+ user_data_buffer = {Front,BufferSize,Rear}}};
+read_application_data(State, [], BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead) ->
+ [Bin|Front] = lists:reverse(Rear),
+ read_application_data_bin(State, Front, BufferSize, [], SocketOpts, RecvFrom, BytesToRead, Bin).
+
+read_application_data_bin(State, Front, BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead, <<>>) ->
+ %% Done with this binary - get next
+ read_application_data(State, Front, BufferSize, Rear, SocketOpts, RecvFrom, BytesToRead);
+read_application_data_bin(State, Front0, BufferSize0, Rear0, SocketOpts0, RecvFrom, BytesToRead, Bin0) ->
+ %% Decode one packet from a binary
+ case get_data(SocketOpts0, BytesToRead, Bin0) of
+ {ok, Data, Bin} -> % Send data
+ BufferSize = BufferSize0 - (byte_size(Bin0) - byte_size(Bin)),
+ read_application_data_deliver(
+ State, [Bin|Front0], BufferSize, Rear0, SocketOpts0, RecvFrom, Data);
+ {more, undefined} ->
+ %% We need more data, do not know how much
if
- SocketOpts#socket_options.active =:= false;
- Buffer =:= <<>> ->
- %% Passive mode, wait for active once or recv
- %% Active and empty, get more data
- {no_record,
- State#state{
- user_data_buffer = Buffer,
- start_or_recv_from = undefined,
- timer = undefined,
- bytes_to_read = undefined,
- socket_options = SocketOpts
- }};
- true -> %% We have more data
- read_application_data(
- Buffer, State, SocketOpts,
- undefined, undefined, undefined)
+ byte_size(Bin0) < BufferSize0 ->
+ %% We have more data in the buffer besides the first binary - concatenate all and retry
+ Bin = iolist_to_binary([Bin0,Front0|lists:reverse(Rear0)]),
+ read_application_data_bin(
+ State, [], BufferSize0, [], SocketOpts0, RecvFrom, BytesToRead, Bin);
+ true ->
+ %% All data is in the first binary, no use to retry - wait for more
+ {no_record, State#state{socket_options = SocketOpts0,
+ bytes_to_read = BytesToRead,
+ start_or_recv_from = RecvFrom,
+ user_data_buffer = {[Bin0|Front0],BufferSize0,Rear0}}}
end;
- {more, Buffer} -> % no reply, we need more data
- {no_record, State#state{user_data_buffer = Buffer}};
- {passive, Buffer} ->
- {no_record, State#state{user_data_buffer = Buffer}};
- {error,_Reason} -> %% Invalid packet in packet mode
+ {more, Size} when Size =< BufferSize0 ->
+ %% We have a packet in the buffer - collect it in a binary and decode
+ {Data,Front,Rear} = iovec_from_front(Size - byte_size(Bin0), Front0, Rear0, [Bin0]),
+ Bin = iolist_to_binary(Data),
+ read_application_data_bin(
+ State, Front, BufferSize0, Rear, SocketOpts0, RecvFrom, BytesToRead, Bin);
+ {more, _Size} ->
+ %% We do not have a packet in the buffer - wait for more
+ {no_record, State#state{socket_options = SocketOpts0,
+ bytes_to_read = BytesToRead,
+ start_or_recv_from = RecvFrom,
+ user_data_buffer = {[Bin0|Front0],BufferSize0,Rear0}}};
+ passive ->
+ {no_record, State#state{socket_options = SocketOpts0,
+ bytes_to_read = BytesToRead,
+ start_or_recv_from = RecvFrom,
+ user_data_buffer = {[Bin0|Front0],BufferSize0,Rear0}}};
+ {error,_Reason} ->
+ %% Invalid packet in packet mode
#state{
static_env =
#static_env{
@@ -556,13 +557,137 @@ read_application_data(
protocol_cb = Connection,
transport_cb = Transport,
tracker = Tracker},
- user_application = {_Mon, Pid}} = State,
+ connection_env =
+ #connection_env{user_application = {_Mon, Pid}}} = State,
+ Buffer = iolist_to_binary([Bin0,Front0|lists:reverse(Rear0)]),
deliver_packet_error(
Connection:pids(State), Transport, Socket, SocketOpts0,
- Buffer0, Pid, RecvFrom, Tracker, Connection),
- {stop, {shutdown, normal}, State}
+ Buffer, Pid, RecvFrom, Tracker, Connection),
+ {stop, {shutdown, normal}, State#state{socket_options = SocketOpts0,
+ bytes_to_read = BytesToRead,
+ start_or_recv_from = RecvFrom,
+ user_data_buffer = {[Buffer],BufferSize0,[]}}}
+ end.
+
+read_application_data_deliver(State, Front, BufferSize, Rear, SocketOpts0, RecvFrom, Data) ->
+ #state{
+ static_env =
+ #static_env{
+ socket = Socket,
+ protocol_cb = Connection,
+ transport_cb = Transport,
+ tracker = Tracker},
+ connection_env =
+ #connection_env{user_application = {_Mon, Pid}}} = State,
+ SocketOpts =
+ deliver_app_data(
+ Connection:pids(State), Transport, Socket, SocketOpts0, Data, Pid, RecvFrom, Tracker, Connection),
+ if
+ SocketOpts#socket_options.active =:= false ->
+ %% Passive mode, wait for active once or recv
+ {no_record,
+ State#state{
+ user_data_buffer = {Front,BufferSize,Rear},
+ start_or_recv_from = undefined,
+ bytes_to_read = undefined,
+ socket_options = SocketOpts
+ }};
+ true -> %% Try to deliver more data
+ read_application_data(State, Front, BufferSize, Rear, SocketOpts, undefined, undefined)
+ end.
+
+
+read_application_dist_data(DHandle, [Bin|Front], BufferSize, Rear) ->
+ read_application_dist_data(DHandle, Front, BufferSize, Rear, Bin);
+read_application_dist_data(_DHandle, [] = Front, BufferSize, [] = Rear) ->
+ BufferSize = 0,
+ {Front,BufferSize,Rear};
+read_application_dist_data(DHandle, [], BufferSize, Rear) ->
+ [Bin|Front] = lists:reverse(Rear),
+ read_application_dist_data(DHandle, Front, BufferSize, [], Bin).
+%%
+read_application_dist_data(DHandle, Front0, BufferSize, Rear0, Bin0) ->
+ case Bin0 of
+ %%
+ %% START Optimization
+ %% It is cheaper to match out several packets in one match operation than to loop for each
+ <<SizeA:32, DataA:SizeA/binary,
+ SizeB:32, DataB:SizeB/binary,
+ SizeC:32, DataC:SizeC/binary,
+ SizeD:32, DataD:SizeD/binary, Rest/binary>> ->
+ %% We have 4 complete packets in the first binary
+ erlang:dist_ctrl_put_data(DHandle, DataA),
+ erlang:dist_ctrl_put_data(DHandle, DataB),
+ erlang:dist_ctrl_put_data(DHandle, DataC),
+ erlang:dist_ctrl_put_data(DHandle, DataD),
+ read_application_dist_data(
+ DHandle, Front0, BufferSize - (4*4+SizeA+SizeB+SizeC+SizeD), Rear0, Rest);
+ <<SizeA:32, DataA:SizeA/binary,
+ SizeB:32, DataB:SizeB/binary,
+ SizeC:32, DataC:SizeC/binary, Rest/binary>> ->
+ %% We have 3 complete packets in the first binary
+ erlang:dist_ctrl_put_data(DHandle, DataA),
+ erlang:dist_ctrl_put_data(DHandle, DataB),
+ erlang:dist_ctrl_put_data(DHandle, DataC),
+ read_application_dist_data(
+ DHandle, Front0, BufferSize - (3*4+SizeA+SizeB+SizeC), Rear0, Rest);
+ <<SizeA:32, DataA:SizeA/binary,
+ SizeB:32, DataB:SizeB/binary, Rest/binary>> ->
+ %% We have 2 complete packets in the first binary
+ erlang:dist_ctrl_put_data(DHandle, DataA),
+ erlang:dist_ctrl_put_data(DHandle, DataB),
+ read_application_dist_data(
+ DHandle, Front0, BufferSize - (2*4+SizeA+SizeB), Rear0, Rest);
+ %% END Optimization
+ %%
+ %% Basic one packet code path
+ <<Size:32, Data:Size/binary, Rest/binary>> ->
+ %% We have a complete packet in the first binary
+ erlang:dist_ctrl_put_data(DHandle, Data),
+ read_application_dist_data(DHandle, Front0, BufferSize - (4+Size), Rear0, Rest);
+ <<Size:32, FirstData/binary>> when 4+Size =< BufferSize ->
+ %% We have a complete packet in the buffer
+ %% - fetch the missing content from the buffer front
+ {Data,Front,Rear} = iovec_from_front(Size - byte_size(FirstData), Front0, Rear0, [FirstData]),
+ erlang:dist_ctrl_put_data(DHandle, Data),
+ read_application_dist_data(DHandle, Front, BufferSize - (4+Size), Rear);
+ <<Bin/binary>> ->
+ %% In OTP-21 the match context reuse optimization fails if we use Bin0 in recursion, so here we
+ %% match out the whole binary which will trick the optimization into keeping the match context
+ %% for the first binary contains complete packet code above
+ case Bin of
+ <<_Size:32, _InsufficientData/binary>> ->
+ %% We have a length field in the first binary but there is not enough data
+ %% in the buffer to form a complete packet - await more data
+ {[Bin|Front0],BufferSize,Rear0};
+ <<IncompleteLengthField/binary>> when 4 < BufferSize ->
+ %% We do not have a length field in the first binary but the buffer
+ %% contains enough data to maybe form a packet
+ %% - fetch a tiny binary from the buffer front to complete the length field
+ {LengthField,Front,Rear} =
+ iovec_from_front(4 - byte_size(IncompleteLengthField), Front0, Rear0, [IncompleteLengthField]),
+ LengthBin = iolist_to_binary(LengthField),
+ read_application_dist_data(DHandle, Front, BufferSize, Rear, LengthBin);
+ <<IncompleteLengthField/binary>> ->
+ %% We do not have enough data in the buffer to even form a length field - await more data
+ {[IncompleteLengthField|Front0],BufferSize,Rear0}
+ end
+ end.
+
+iovec_from_front(Size, [], Rear, Acc) ->
+ iovec_from_front(Size, lists:reverse(Rear), [], Acc);
+iovec_from_front(Size, [Bin|Front], Rear, Acc) ->
+ case Bin of
+ <<Last:Size/binary>> -> % Just enough
+ {lists:reverse(Acc, [Last]),Front,Rear};
+ <<Last:Size/binary, Rest/binary>> -> % More than enough, split here
+ {lists:reverse(Acc, [Last]),[Rest|Front],Rear};
+ <<_/binary>> -> % Not enough
+ BinSize = byte_size(Bin),
+ iovec_from_front(Size - BinSize, Front, Rear, [Bin|Acc])
end.
+
%%====================================================================
%% Help functions for tls|dtls_connection.erl
%%====================================================================
@@ -575,8 +700,8 @@ handle_session(#server_hello{cipher_suite = CipherSuite,
compression_method = Compression},
Version, NewId, ConnectionStates, ProtoExt, Protocol0,
#state{session = #session{session_id = OldId},
- negotiated_version = ReqVersion,
- negotiated_protocol = CurrentProtocol} = State0) ->
+ handshake_env = #handshake_env{negotiated_protocol = CurrentProtocol} = HsEnv,
+ connection_env = #connection_env{negotiated_version = ReqVersion} = CEnv} = State0) ->
#{key_exchange := KeyAlgorithm} =
ssl_cipher_format:suite_definition(CipherSuite),
@@ -589,12 +714,12 @@ handle_session(#server_hello{cipher_suite = CipherSuite,
{ProtoExt =:= npn, Protocol0}
end,
- State = State0#state{key_algorithm = KeyAlgorithm,
- negotiated_version = Version,
- connection_states = ConnectionStates,
- premaster_secret = PremasterSecret,
- expecting_next_protocol_negotiation = ExpectNPN,
- negotiated_protocol = Protocol},
+ State = State0#state{connection_states = ConnectionStates,
+ handshake_env = HsEnv#handshake_env{kex_algorithm = KeyAlgorithm,
+ premaster_secret = PremasterSecret,
+ expecting_next_protocol_negotiation = ExpectNPN,
+ negotiated_protocol = Protocol},
+ connection_env = CEnv#connection_env{negotiated_version = Version}},
case ssl_session:is_new(OldId, NewId) of
true ->
@@ -608,11 +733,9 @@ handle_session(#server_hello{cipher_suite = CipherSuite,
%%--------------------------------------------------------------------
-spec ssl_config(#ssl_options{}, client | server, #state{}) -> #state{}.
%%--------------------------------------------------------------------
-ssl_config(Opts, Role, State) ->
- ssl_config(Opts, Role, State, new).
-
-ssl_config(Opts, Role, #state{static_env = InitStatEnv0,
- handshake_env = HsEnv} = State0, Type) ->
+ssl_config(Opts, Role, #state{static_env = InitStatEnv0,
+ handshake_env = HsEnv,
+ connection_env = CEnv} = State0) ->
{ok, #{cert_db_ref := Ref,
cert_db_handle := CertDbHandle,
fileref_db_handle := FileRefHandle,
@@ -624,27 +747,19 @@ ssl_config(Opts, Role, #state{static_env = InitStatEnv0,
ssl_config:init(Opts, Role),
TimeStamp = erlang:monotonic_time(),
Session = State0#state.session,
-
- State = State0#state{session = Session#session{own_certificate = OwnCert,
- time_stamp = TimeStamp},
- static_env = InitStatEnv0#static_env{
- file_ref_db = FileRefHandle,
- cert_db_ref = Ref,
- cert_db = CertDbHandle,
- crl_db = CRLDbHandle,
- session_cache = CacheHandle
- },
- private_key = Key,
- diffie_hellman_params = DHParams,
- ssl_options = Opts},
- case Type of
- new ->
- Hist = ssl_handshake:init_handshake_history(),
- State#state{handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}};
- continue ->
- State
- end.
-
+
+ State0#state{session = Session#session{own_certificate = OwnCert,
+ time_stamp = TimeStamp},
+ static_env = InitStatEnv0#static_env{
+ file_ref_db = FileRefHandle,
+ cert_db_ref = Ref,
+ cert_db = CertDbHandle,
+ crl_db = CRLDbHandle,
+ session_cache = CacheHandle
+ },
+ handshake_env = HsEnv#handshake_env{diffie_hellman_params = DHParams},
+ connection_env = CEnv#connection_env{private_key = Key},
+ ssl_options = Opts}.
%%====================================================================
%% gen_statem general state functions with connection cb argument
@@ -657,8 +772,8 @@ ssl_config(Opts, Role, #state{static_env = InitStatEnv0,
%%--------------------------------------------------------------------
init({call, From}, {start, Timeout}, State0, Connection) ->
- Timer = start_or_recv_cancel_timer(Timeout, From),
- Connection:next_event(hello, no_record, State0#state{start_or_recv_from = From, timer = Timer});
+ Connection:next_event(hello, no_record, State0#state{start_or_recv_from = From},
+ [{{timeout, handshake}, Timeout, close}]);
init({call, From}, {start, {Opts, EmOpts}, Timeout},
#state{static_env = #static_env{role = Role},
ssl_options = OrigSSLOptions,
@@ -705,21 +820,18 @@ hello(info, Msg, State, _) ->
hello(Type, Msg, State, Connection) ->
handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
-user_hello({call, From}, cancel, #state{negotiated_version = Version} = State, _) ->
+user_hello({call, From}, cancel, #state{connection_env = #connection_env{negotiated_version = Version}} = State, _) ->
gen_statem:reply(From, ok),
handle_own_alert(?ALERT_REC(?FATAL, ?USER_CANCELED, user_canceled),
Version, ?FUNCTION_NAME, State);
user_hello({call, From}, {handshake_continue, NewOptions, Timeout},
- #state{hello = Hello,
- static_env = #static_env{role = Role},
- start_or_recv_from = RecvFrom,
+ #state{static_env = #static_env{role = Role},
+ handshake_env = #handshake_env{hello = Hello},
ssl_options = Options0} = State0, _Connection) ->
- Timer = start_or_recv_cancel_timer(Timeout, RecvFrom),
Options = ssl:handle_options(NewOptions, Options0#ssl_options{handshake = full}),
- State = ssl_config(Options, Role, State0, continue),
- {next_state, hello, State#state{start_or_recv_from = From,
- timer = Timer},
- [{next_event, internal, Hello}]};
+ State = ssl_config(Options, Role, State0),
+ {next_state, hello, State#state{start_or_recv_from = From},
+ [{next_event, internal, Hello}, {{timeout, handshake}, Timeout, close}]};
user_hello(_, _, _, _) ->
{keep_state_and_data, [postpone]}.
@@ -733,9 +845,9 @@ abbreviated({call, From}, Msg, State, Connection) ->
handle_call(Msg, From, ?FUNCTION_NAME, State, Connection);
abbreviated(internal, #finished{verify_data = Data} = Finished,
#state{static_env = #static_env{role = server},
- handshake_env = #handshake_env{tls_handshake_history = Hist},
- negotiated_version = Version,
- expecting_finished = true,
+ handshake_env = #handshake_env{tls_handshake_history = Hist,
+ expecting_finished = true} = HsEnv,
+ connection_env = #connection_env{negotiated_version = Version},
session = #session{master_secret = MasterSecret},
connection_states = ConnectionStates0} =
State0, Connection) ->
@@ -746,16 +858,16 @@ abbreviated(internal, #finished{verify_data = Data} = Finished,
ConnectionStates =
ssl_record:set_client_verify_data(current_both, Data, ConnectionStates0),
{Record, State} = prepare_connection(State0#state{connection_states = ConnectionStates,
- expecting_finished = false}, Connection),
- Connection:next_event(connection, Record, State);
+ handshake_env = HsEnv#handshake_env{expecting_finished = false}}, Connection),
+ Connection:next_event(connection, Record, State, [{{timeout, handshake}, infinity, close}]);
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0)
end;
abbreviated(internal, #finished{verify_data = Data} = Finished,
#state{static_env = #static_env{role = client},
handshake_env = #handshake_env{tls_handshake_history = Hist0},
+ connection_env = #connection_env{negotiated_version = Version},
session = #session{master_secret = MasterSecret},
- negotiated_version = Version,
connection_states = ConnectionStates0} = State0, Connection) ->
case ssl_handshake:verify_connection(ssl:tls_version(Version), Finished, server,
get_pending_prf(ConnectionStates0, write),
@@ -763,11 +875,11 @@ abbreviated(internal, #finished{verify_data = Data} = Finished,
verified ->
ConnectionStates1 =
ssl_record:set_server_verify_data(current_read, Data, ConnectionStates0),
- {State1, Actions} =
+ {#state{handshake_env = HsEnv} = State1, Actions} =
finalize_handshake(State0#state{connection_states = ConnectionStates1},
?FUNCTION_NAME, Connection),
- {Record, State} = prepare_connection(State1#state{expecting_finished = false}, Connection),
- Connection:next_event(connection, Record, State, Actions);
+ {Record, State} = prepare_connection(State1#state{handshake_env = HsEnv#handshake_env{expecting_finished = false}}, Connection),
+ Connection:next_event(connection, Record, State, [{{timeout, handshake}, infinity, close} | Actions]);
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0)
end;
@@ -775,19 +887,20 @@ abbreviated(internal, #finished{verify_data = Data} = Finished,
%% & before finished message and it is not allowed during renegotiation
abbreviated(internal, #next_protocol{selected_protocol = SelectedProtocol},
#state{static_env = #static_env{role = server},
- expecting_next_protocol_negotiation = true} = State,
+ handshake_env = #handshake_env{expecting_next_protocol_negotiation = true} = HsEnv} = State,
Connection) ->
Connection:next_event(?FUNCTION_NAME, no_record,
- State#state{negotiated_protocol = SelectedProtocol,
- expecting_next_protocol_negotiation = false});
+ State#state{handshake_env = HsEnv#handshake_env{negotiated_protocol = SelectedProtocol,
+ expecting_next_protocol_negotiation = false}});
abbreviated(internal,
#change_cipher_spec{type = <<1>>},
- #state{connection_states = ConnectionStates0} = State, Connection) ->
+ #state{connection_states = ConnectionStates0,
+ handshake_env = HsEnv} = State, Connection) ->
ConnectionStates1 =
ssl_record:activate_pending_connection_state(ConnectionStates0, read, Connection),
Connection:next_event(?FUNCTION_NAME, no_record, State#state{connection_states =
ConnectionStates1,
- expecting_finished = true});
+ handshake_env = HsEnv#handshake_env{expecting_finished = true}});
abbreviated(info, Msg, State, _) ->
handle_info(Msg, ?FUNCTION_NAME, State);
abbreviated(Type, Msg, State, Connection) ->
@@ -806,7 +919,7 @@ certify(info, Msg, State, _) ->
handle_info(Msg, ?FUNCTION_NAME, State);
certify(internal, #certificate{asn1_certificates = []},
#state{static_env = #static_env{role = server},
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
ssl_options = #ssl_options{verify = verify_peer,
fail_if_no_peer_cert = true}} =
State, _) ->
@@ -820,7 +933,7 @@ certify(internal, #certificate{asn1_certificates = []},
Connection:next_event(?FUNCTION_NAME, no_record, State0#state{client_certificate_requested = false});
certify(internal, #certificate{},
#state{static_env = #static_env{role = server},
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
ssl_options = #ssl_options{verify = verify_none}} =
State, _) ->
Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, unrequested_certificate),
@@ -832,7 +945,7 @@ certify(internal, #certificate{} = Cert,
cert_db = CertDbHandle,
cert_db_ref = CertDbRef,
crl_db = CRLDbInfo},
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
ssl_options = Opts} = State, Connection) ->
case ssl_handshake:certify(Cert, CertDbHandle, CertDbRef,
Opts, CRLDbInfo, Role, Host) of
@@ -844,34 +957,42 @@ certify(internal, #certificate{} = Cert,
end;
certify(internal, #server_key_exchange{exchange_keys = Keys},
#state{static_env = #static_env{role = client},
- negotiated_version = Version,
- key_algorithm = Alg,
- public_key_info = PubKeyInfo,
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ public_key_info = PubKeyInfo} = HsEnv,
+ connection_env = #connection_env{negotiated_version = Version},
session = Session,
connection_states = ConnectionStates} = State, Connection)
- when Alg == dhe_dss; Alg == dhe_rsa;
- Alg == ecdhe_rsa; Alg == ecdhe_ecdsa;
- Alg == dh_anon; Alg == ecdh_anon;
- Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk;
- Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon ->
-
- Params = ssl_handshake:decode_server_key(Keys, Alg, ssl:tls_version(Version)),
+ when KexAlg == dhe_dss;
+ KexAlg == dhe_rsa;
+ KexAlg == ecdhe_rsa;
+ KexAlg == ecdhe_ecdsa;
+ KexAlg == dh_anon;
+ KexAlg == ecdh_anon;
+ KexAlg == psk;
+ KexAlg == dhe_psk;
+ KexAlg == ecdhe_psk;
+ KexAlg == rsa_psk;
+ KexAlg == srp_dss;
+ KexAlg == srp_rsa;
+ KexAlg == srp_anon ->
+
+ Params = ssl_handshake:decode_server_key(Keys, KexAlg, ssl:tls_version(Version)),
%% Use negotiated value if TLS-1.2 otherwhise return default
- HashSign = negotiated_hashsign(Params#server_key_params.hashsign, Alg, PubKeyInfo, ssl:tls_version(Version)),
+ HashSign = negotiated_hashsign(Params#server_key_params.hashsign, KexAlg, PubKeyInfo, ssl:tls_version(Version)),
- case is_anonymous(Alg) of
+ case is_anonymous(KexAlg) of
true ->
calculate_secret(Params#server_key_params.params,
- State#state{hashsign_algorithm = HashSign}, Connection);
+ State#state{handshake_env = HsEnv#handshake_env{hashsign_algorithm = HashSign}}, Connection);
false ->
case ssl_handshake:verify_server_key(Params, HashSign,
ConnectionStates, ssl:tls_version(Version), PubKeyInfo) of
true ->
calculate_secret(Params#server_key_params.params,
- State#state{hashsign_algorithm = HashSign,
- session = session_handle_params(Params#server_key_params.params, Session)},
- Connection);
+ State#state{handshake_env = HsEnv#handshake_env{hashsign_algorithm = HashSign},
+ session = session_handle_params(Params#server_key_params.params, Session)},
+ Connection);
false ->
handle_own_alert(?ALERT_REC(?FATAL, ?DECRYPT_ERROR),
Version, ?FUNCTION_NAME, State)
@@ -879,11 +1000,17 @@ certify(internal, #server_key_exchange{exchange_keys = Keys},
end;
certify(internal, #certificate_request{},
#state{static_env = #static_env{role = client},
- negotiated_version = Version,
- key_algorithm = Alg} = State, _)
- when Alg == dh_anon; Alg == ecdh_anon;
- Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk;
- Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon ->
+ handshake_env = #handshake_env{kex_algorithm = KexAlg},
+ connection_env = #connection_env{negotiated_version = Version}} = State, _)
+ when KexAlg == dh_anon;
+ KexAlg == ecdh_anon;
+ KexAlg == psk;
+ KexAlg == dhe_psk;
+ KexAlg == ecdhe_psk;
+ KexAlg == rsa_psk;
+ KexAlg == srp_dss;
+ KexAlg == srp_rsa;
+ KexAlg == srp_anon ->
handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE),
Version, ?FUNCTION_NAME, State);
certify(internal, #certificate_request{},
@@ -895,9 +1022,10 @@ certify(internal, #certificate_request{},
Connection:next_event(?FUNCTION_NAME, no_record, State#state{client_certificate_requested = true});
certify(internal, #certificate_request{} = CertRequest,
#state{static_env = #static_env{role = client},
+ handshake_env = HsEnv,
+ connection_env = #connection_env{negotiated_version = Version},
session = #session{own_certificate = Cert},
- ssl_options = #ssl_options{signature_algs = SupportedHashSigns},
- negotiated_version = Version} = State, Connection) ->
+ ssl_options = #ssl_options{signature_algs = SupportedHashSigns}} = State, Connection) ->
case ssl_handshake:select_hashsign(CertRequest, Cert,
SupportedHashSigns, ssl:tls_version(Version)) of
#alert {} = Alert ->
@@ -905,53 +1033,55 @@ certify(internal, #certificate_request{} = CertRequest,
NegotiatedHashSign ->
Connection:next_event(?FUNCTION_NAME, no_record,
State#state{client_certificate_requested = true,
- cert_hashsign_algorithm = NegotiatedHashSign})
+ handshake_env = HsEnv#handshake_env{cert_hashsign_algorithm = NegotiatedHashSign}})
end;
%% PSK and RSA_PSK might bypass the Server-Key-Exchange
certify(internal, #server_hello_done{},
#state{static_env = #static_env{role = client},
session = #session{master_secret = undefined},
- negotiated_version = Version,
- psk_identity = PSKIdentity,
- ssl_options = #ssl_options{user_lookup_fun = PSKLookup},
- premaster_secret = undefined,
- key_algorithm = Alg} = State0, Connection)
- when Alg == psk ->
- case ssl_handshake:premaster_secret({Alg, PSKIdentity}, PSKLookup) of
+ connection_env = #connection_env{negotiated_version = Version},
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ premaster_secret = undefined,
+ server_psk_identity = PSKIdentity} = HsEnv,
+ ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection)
+ when KexAlg == psk ->
+ case ssl_handshake:premaster_secret({KexAlg, PSKIdentity}, PSKLookup) of
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0);
PremasterSecret ->
State = master_secret(PremasterSecret,
- State0#state{premaster_secret = PremasterSecret}),
- client_certify_and_key_exchange(State, Connection)
+ State0#state{handshake_env =
+ HsEnv#handshake_env{premaster_secret = PremasterSecret}}),
+ client_certify_and_key_exchange(State, Connection)
end;
certify(internal, #server_hello_done{},
#state{static_env = #static_env{role = client},
+ connection_env = #connection_env{negotiated_version = {Major, Minor}} = Version,
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ premaster_secret = undefined,
+ server_psk_identity = PSKIdentity} = HsEnv,
session = #session{master_secret = undefined},
- ssl_options = #ssl_options{user_lookup_fun = PSKLookup},
- negotiated_version = {Major, Minor} = Version,
- psk_identity = PSKIdentity,
- premaster_secret = undefined,
- key_algorithm = Alg} = State0, Connection)
- when Alg == rsa_psk ->
+ ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} = State0, Connection)
+ when KexAlg == rsa_psk ->
Rand = ssl_cipher:random_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2),
RSAPremasterSecret = <<?BYTE(Major), ?BYTE(Minor), Rand/binary>>,
- case ssl_handshake:premaster_secret({Alg, PSKIdentity}, PSKLookup,
+ case ssl_handshake:premaster_secret({KexAlg, PSKIdentity}, PSKLookup,
RSAPremasterSecret) of
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0);
PremasterSecret ->
State = master_secret(PremasterSecret,
- State0#state{premaster_secret = RSAPremasterSecret}),
+ State0#state{handshake_env =
+ HsEnv#handshake_env{premaster_secret = RSAPremasterSecret}}),
client_certify_and_key_exchange(State, Connection)
end;
%% Master secret was determined with help of server-key exchange msg
certify(internal, #server_hello_done{},
#state{static_env = #static_env{role = client},
- session = #session{master_secret = MasterSecret} = Session,
- connection_states = ConnectionStates0,
- negotiated_version = Version,
- premaster_secret = undefined} = State0, Connection) ->
+ connection_env = #connection_env{negotiated_version = Version},
+ handshake_env = #handshake_env{premaster_secret = undefined},
+ session = #session{master_secret = MasterSecret} = Session,
+ connection_states = ConnectionStates0} = State0, Connection) ->
case ssl_handshake:master_secret(ssl:tls_version(Version), Session,
ConnectionStates0, client) of
{MasterSecret, ConnectionStates} ->
@@ -963,10 +1093,10 @@ certify(internal, #server_hello_done{},
%% Master secret is calculated from premaster_secret
certify(internal, #server_hello_done{},
#state{static_env = #static_env{role = client},
+ connection_env = #connection_env{negotiated_version = Version},
+ handshake_env = #handshake_env{premaster_secret = PremasterSecret},
session = Session0,
- connection_states = ConnectionStates0,
- negotiated_version = Version,
- premaster_secret = PremasterSecret} = State0, Connection) ->
+ connection_states = ConnectionStates0} = State0, Connection) ->
case ssl_handshake:master_secret(ssl:tls_version(Version), PremasterSecret,
ConnectionStates0, client) of
{MasterSecret, ConnectionStates} ->
@@ -985,7 +1115,8 @@ certify(internal = Type, #client_key_exchange{} = Msg,
%% We expect a certificate here
handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection);
certify(internal, #client_key_exchange{exchange_keys = Keys},
- State = #state{key_algorithm = KeyAlg, negotiated_version = Version}, Connection) ->
+ State = #state{handshake_env = #handshake_env{kex_algorithm = KeyAlg},
+ connection_env = #connection_env{negotiated_version = Version}}, Connection) ->
try
certify_client_key_exchange(ssl_handshake:decode_client_key(Keys, KeyAlg, ssl:tls_version(Version)),
State, Connection)
@@ -1009,42 +1140,43 @@ cipher(info, Msg, State, _) ->
cipher(internal, #certificate_verify{signature = Signature,
hashsign_algorithm = CertHashSign},
#state{static_env = #static_env{role = server},
- handshake_env = #handshake_env{tls_handshake_history = Hist},
- key_algorithm = KexAlg,
- public_key_info = PublicKeyInfo,
- negotiated_version = Version,
+ handshake_env = #handshake_env{tls_handshake_history = Hist,
+ kex_algorithm = KexAlg,
+ public_key_info = PubKeyInfo} = HsEnv,
+ connection_env = #connection_env{negotiated_version = Version},
session = #session{master_secret = MasterSecret}
} = State, Connection) ->
TLSVersion = ssl:tls_version(Version),
%% Use negotiated value if TLS-1.2 otherwhise return default
- HashSign = negotiated_hashsign(CertHashSign, KexAlg, PublicKeyInfo, TLSVersion),
- case ssl_handshake:certificate_verify(Signature, PublicKeyInfo,
+ HashSign = negotiated_hashsign(CertHashSign, KexAlg, PubKeyInfo, TLSVersion),
+ case ssl_handshake:certificate_verify(Signature, PubKeyInfo,
TLSVersion, HashSign, MasterSecret, Hist) of
valid ->
Connection:next_event(?FUNCTION_NAME, no_record,
- State#state{cert_hashsign_algorithm = HashSign});
+ State#state{handshake_env = HsEnv#handshake_env{cert_hashsign_algorithm = HashSign}});
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State)
end;
%% client must send a next protocol message if we are expecting it
cipher(internal, #finished{},
#state{static_env = #static_env{role = server},
- expecting_next_protocol_negotiation = true,
- negotiated_protocol = undefined, negotiated_version = Version} = State0,
+ handshake_env = #handshake_env{expecting_next_protocol_negotiation = true,
+ negotiated_protocol = undefined},
+ connection_env = #connection_env{negotiated_version = Version}} = State0,
_Connection) ->
handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, ?FUNCTION_NAME, State0);
cipher(internal, #finished{verify_data = Data} = Finished,
#state{static_env = #static_env{role = Role,
host = Host,
port = Port},
- negotiated_version = Version,
- expecting_finished = true,
+ handshake_env = #handshake_env{tls_handshake_history = Hist,
+ expecting_finished = true} = HsEnv,
+ connection_env = #connection_env{negotiated_version = Version},
session = #session{master_secret = MasterSecret}
= Session0,
ssl_options = SslOpts,
- connection_states = ConnectionStates0,
- handshake_env = #handshake_env{tls_handshake_history = Hist}} = State, Connection) ->
+ connection_states = ConnectionStates0} = State, Connection) ->
case ssl_handshake:verify_connection(ssl:tls_version(Version), Finished,
opposite_role(Role),
get_current_prf(ConnectionStates0, read),
@@ -1052,7 +1184,7 @@ cipher(internal, #finished{verify_data = Data} = Finished,
verified ->
Session = handle_session(Role, SslOpts, Host, Port, Session0),
cipher_role(Role, Data, Session,
- State#state{expecting_finished = false}, Connection);
+ State#state{handshake_env = HsEnv#handshake_env{expecting_finished = false}}, Connection);
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State)
end;
@@ -1060,19 +1192,17 @@ cipher(internal, #finished{verify_data = Data} = Finished,
%% & before finished message and it is not allowed during renegotiation
cipher(internal, #next_protocol{selected_protocol = SelectedProtocol},
#state{static_env = #static_env{role = server},
- expecting_next_protocol_negotiation = true,
- expecting_finished = true} = State0, Connection) ->
- {Record, State} =
- Connection:next_record(State0#state{negotiated_protocol = SelectedProtocol}),
- Connection:next_event(?FUNCTION_NAME, Record,
- State#state{expecting_next_protocol_negotiation = false});
-cipher(internal, #change_cipher_spec{type = <<1>>}, #state{connection_states = ConnectionStates0} =
+ handshake_env = #handshake_env{expecting_finished = true,
+ expecting_next_protocol_negotiation = true} = HsEnv} = State, Connection) ->
+ Connection:next_event(?FUNCTION_NAME, no_record,
+ State#state{handshake_env = HsEnv#handshake_env{negotiated_protocol = SelectedProtocol,
+ expecting_next_protocol_negotiation = false}});
+cipher(internal, #change_cipher_spec{type = <<1>>}, #state{handshake_env = HsEnv, connection_states = ConnectionStates0} =
State, Connection) ->
ConnectionStates =
ssl_record:activate_pending_connection_state(ConnectionStates0, read, Connection),
- Connection:next_event(?FUNCTION_NAME, no_record, State#state{connection_states =
- ConnectionStates,
- expecting_finished = true});
+ Connection:next_event(?FUNCTION_NAME, no_record, State#state{handshake_env = HsEnv#handshake_env{expecting_finished = true},
+ connection_states = ConnectionStates});
cipher(Type, Msg, State, Connection) ->
handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
@@ -1085,10 +1215,9 @@ connection({call, RecvFrom}, {recv, N, Timeout},
#state{static_env = #static_env{protocol_cb = Connection},
socket_options =
#socket_options{active = false}} = State0, Connection) ->
- Timer = start_or_recv_cancel_timer(Timeout, RecvFrom),
passive_receive(State0#state{bytes_to_read = N,
- start_or_recv_from = RecvFrom,
- timer = Timer}, ?FUNCTION_NAME, Connection);
+ start_or_recv_from = RecvFrom}, ?FUNCTION_NAME, Connection,
+ [{{timeout, recv}, Timeout, timeout}]);
connection({call, From}, renegotiate, #state{static_env = #static_env{protocol_cb = Connection},
handshake_env = HsEnv} = State,
@@ -1104,10 +1233,10 @@ connection({call, From}, {connection_information, false}, State, _) ->
Info = connection_info(State),
hibernate_after(?FUNCTION_NAME, State, [{reply, From, {ok, Info}}]);
connection({call, From}, negotiated_protocol,
- #state{negotiated_protocol = undefined} = State, _) ->
+ #state{handshake_env = #handshake_env{negotiated_protocol = undefined}} = State, _) ->
hibernate_after(?FUNCTION_NAME, State, [{reply, From, {error, protocol_not_negotiated}}]);
connection({call, From}, negotiated_protocol,
- #state{negotiated_protocol = SelectedProtocol} = State, _) ->
+ #state{handshake_env = #handshake_env{negotiated_protocol = SelectedProtocol}} = State, _) ->
hibernate_after(?FUNCTION_NAME, State,
[{reply, From, {ok, SelectedProtocol}}]);
connection({call, From}, Msg, State, Connection) ->
@@ -1120,19 +1249,20 @@ connection(cast, {internal_renegotiate, WriteState}, #state{static_env = #static
connection_states = ConnectionStates#{current_write => WriteState}}, []);
connection(cast, {dist_handshake_complete, DHandle},
#state{ssl_options = #ssl_options{erl_dist = true},
+ connection_env = CEnv,
socket_options = SockOpts} = State0, Connection) ->
process_flag(priority, normal),
State1 =
State0#state{
socket_options = SockOpts#socket_options{active = true},
- erl_dist_handle = DHandle,
+ connection_env = CEnv#connection_env{erl_dist_handle = DHandle},
bytes_to_read = undefined},
{Record, State} = read_application_data(<<>>, State1),
Connection:next_event(connection, Record, State);
connection(info, Msg, State, _) ->
handle_info(Msg, ?FUNCTION_NAME, State);
-connection(internal, {recv, _}, State, Connection) ->
- passive_receive(State, ?FUNCTION_NAME, Connection);
+connection(internal, {recv, Timeout}, State, Connection) ->
+ passive_receive(State, ?FUNCTION_NAME, Connection, [{{timeout, recv}, Timeout, timeout}]);
connection(Type, Msg, State, Connection) ->
handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
@@ -1159,14 +1289,14 @@ handle_common_event(internal, {handshake, {#hello_request{}, _}}, StateName,
when StateName =/= connection ->
keep_state_and_data;
handle_common_event(internal, {handshake, {Handshake, Raw}}, StateName,
- #state{handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv} = State0,
+ #state{handshake_env = #handshake_env{tls_handshake_history = Hist0}} = State0,
Connection) ->
PossibleSNI = Connection:select_sni_extension(Handshake),
%% This function handles client SNI hello extension when Handshake is
%% a client_hello, which needs to be determined by the connection callback.
%% In other cases this is a noop
- State = handle_sni_extension(PossibleSNI, State0),
+ State = #state{handshake_env = HsEnv} = handle_sni_extension(PossibleSNI, State0),
Hist = ssl_handshake:update_handshake_history(Hist0, Raw),
{next_state, StateName, State#state{handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist}},
@@ -1176,35 +1306,47 @@ handle_common_event(internal, {protocol_record, TLSorDTLSRecord}, StateName, Sta
handle_common_event(timeout, hibernate, _, _, _) ->
{keep_state_and_data, [hibernate]};
handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName,
- #state{negotiated_version = Version} = State, _) ->
+ #state{connection_env = #connection_env{negotiated_version = Version}} = State, _) ->
handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Version,
StateName, State);
-handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State,
+handle_common_event({timeout, handshake}, close, _StateName, #state{start_or_recv_from = StartFrom} = State, _) ->
+ {stop_and_reply,
+ {shutdown, user_timeout},
+ {reply, StartFrom, {error, timeout}}, State#state{start_or_recv_from = undefined}};
+handle_common_event({timeout, recv}, timeout, StateName, #state{start_or_recv_from = RecvFrom} = State, _) ->
+ {next_state, StateName, State#state{start_or_recv_from = undefined,
+ bytes_to_read = undefined}, [{reply, RecvFrom, {error, timeout}}]};
+handle_common_event(Type, Msg, StateName, #state{connection_env =
+ #connection_env{negotiated_version = Version}} = State,
_) ->
- Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, {unexpected_msg, Msg}),
+ Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, {unexpected_msg, {Type,Msg}}),
handle_own_alert(Alert, Version, StateName, State).
handle_call({application_data, _Data}, _, _, _, _) ->
%% In renegotiation priorities handshake, send data when handshake is finished
{keep_state_and_data, [postpone]};
-handle_call({close, _} = Close, From, StateName, State, _Connection) ->
+handle_call({close, _} = Close, From, StateName, #state{connection_env = CEnv} = State, _Connection) ->
%% Run terminate before returning so that the reuseaddr
%% inet-option works properly
Result = terminate(Close, StateName, State),
{stop_and_reply,
{shutdown, normal},
- {reply, From, Result}, State#state{terminated = true}};
+ {reply, From, Result}, State#state{connection_env = CEnv#connection_env{terminated = true}}};
handle_call({shutdown, read_write = How}, From, StateName,
#state{static_env = #static_env{transport_cb = Transport,
- socket = Socket}} = State, _) ->
+ socket = Socket},
+ connection_env = CEnv} = State, _) ->
try send_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
StateName, State) of
_ ->
case Transport:shutdown(Socket, How) of
ok ->
- {next_state, StateName, State#state{terminated = true}, [{reply, From, ok}]};
+ {next_state, StateName, State#state{connection_env =
+ CEnv#connection_env{terminated = true}},
+ [{reply, From, ok}]};
Error ->
- {stop_and_reply, {shutdown, normal}, {reply, From, Error}, State#state{terminated = true}}
+ {stop_and_reply, {shutdown, normal}, {reply, From, Error},
+ State#state{connection_env = CEnv#connection_env{terminated = true}}}
end
catch
throw:Return ->
@@ -1226,15 +1368,13 @@ handle_call({recv, _N, _Timeout}, From, _,
handle_call({recv, N, Timeout}, RecvFrom, StateName, State, _) ->
%% Doing renegotiate wait with handling request until renegotiate is
%% finished.
- Timer = start_or_recv_cancel_timer(Timeout, RecvFrom),
- {next_state, StateName, State#state{bytes_to_read = N, start_or_recv_from = RecvFrom,
- timer = Timer},
- [{next_event, internal, {recv, RecvFrom}}]};
+ {next_state, StateName, State#state{bytes_to_read = N, start_or_recv_from = RecvFrom},
+ [{next_event, internal, {recv, RecvFrom}} , {{timeout, recv}, Timeout, timeout}]};
handle_call({new_user, User}, From, StateName,
- State =#state{user_application = {OldMon, _}}, _) ->
+ State = #state{connection_env = #connection_env{user_application = {OldMon, _}} = CEnv}, _) ->
NewMon = erlang:monitor(process, User),
erlang:demonitor(OldMon, [flush]),
- {next_state, StateName, State#state{user_application = {NewMon,User}},
+ {next_state, StateName, State#state{connection_env = CEnv#connection_env{user_application = {NewMon, User}}},
[{reply, From, ok}]};
handle_call({get_opts, OptTags}, From, _,
#state{static_env = #static_env{socket = Socket,
@@ -1244,23 +1384,31 @@ handle_call({get_opts, OptTags}, From, _,
{keep_state_and_data, [{reply, From, OptsReply}]};
handle_call({set_opts, Opts0}, From, StateName,
#state{static_env = #static_env{socket = Socket,
- transport_cb = Transport},
+ transport_cb = Transport,
+ tracker = Tracker},
+ connection_env =
+ #connection_env{user_application = {_Mon, Pid}},
socket_options = Opts1
} = State0, Connection) ->
{Reply, Opts} = set_socket_opts(Connection, Transport, Socket, Opts0, Opts1, []),
+ case {proplists:lookup(active, Opts0), Opts} of
+ {{_, N}, #socket_options{active=false}} when is_integer(N) ->
+ send_user(
+ Pid,
+ format_passive(
+ Connection:pids(State0), Transport, Socket, Tracker, Connection));
+ _ ->
+ ok
+ end,
State = State0#state{socket_options = Opts},
handle_active_option(Opts#socket_options.active, StateName, From, Reply, State);
handle_call(renegotiate, From, StateName, _, _) when StateName =/= connection ->
{keep_state_and_data, [{reply, From, {error, already_renegotiating}}]};
-handle_call(get_sslsocket, From, _StateName, State, Connection) ->
- SslSocket = Connection:socket(State),
- {keep_state_and_data, [{reply, From, SslSocket}]};
-
handle_call({prf, Secret, Label, Seed, WantedLength}, From, _,
#state{connection_states = ConnectionStates,
- negotiated_version = Version}, _) ->
+ connection_env = #connection_env{negotiated_version = Version}}, _) ->
#{security_parameters := SecParams} =
ssl_record:current_connection_state(ConnectionStates, read),
#security_parameters{master_secret = MasterSecret,
@@ -1308,14 +1456,14 @@ handle_info({ErrorTag, Socket, Reason}, StateName, #state{static_env = #static_e
{stop, {shutdown,normal}, State};
handle_info({'DOWN', MonitorRef, _, _, Reason}, _,
- #state{user_application = {MonitorRef, _Pid},
+ #state{connection_env = #connection_env{user_application = {MonitorRef, _Pid}},
ssl_options = #ssl_options{erl_dist = true}}) ->
{stop, {shutdown, Reason}};
handle_info({'DOWN', MonitorRef, _, _, _}, _,
- #state{user_application = {MonitorRef, _Pid}}) ->
+ #state{connection_env = #connection_env{user_application = {MonitorRef, _Pid}}}) ->
{stop, {shutdown, normal}};
handle_info({'EXIT', Pid, _Reason}, StateName,
- #state{user_application = {_MonitorRef, Pid}} = State) ->
+ #state{connection_env = #connection_env{user_application = {_MonitorRef, Pid}}} = State) ->
%% It seems the user application has linked to us
%% - ignore that and let the monitor handle this
{next_state, StateName, State};
@@ -1328,22 +1476,8 @@ handle_info({'EXIT', Socket, normal}, _StateName, #state{static_env = #static_en
handle_info({'EXIT', Socket, Reason}, _StateName, #state{static_env = #static_env{socket = Socket}} = State) ->
{stop,{shutdown, Reason}, State};
-handle_info(allow_renegotiate, StateName, State) ->
- {next_state, StateName, State#state{allow_renegotiate = true}};
-
-handle_info({cancel_start_or_recv, StartFrom}, StateName,
- #state{handshake_env = #handshake_env{renegotiation = {false, first}}} = State) when StateName =/= connection ->
- {stop_and_reply,
- {shutdown, user_timeout},
- {reply, StartFrom, {error, timeout}},
- State#state{timer = undefined}};
-handle_info({cancel_start_or_recv, RecvFrom}, StateName,
- #state{start_or_recv_from = RecvFrom} = State) when RecvFrom =/= undefined ->
- {next_state, StateName, State#state{start_or_recv_from = undefined,
- bytes_to_read = undefined,
- timer = undefined}, [{reply, RecvFrom, {error, timeout}}]};
-handle_info({cancel_start_or_recv, _RecvFrom}, StateName, State) ->
- {next_state, StateName, State#state{timer = undefined}};
+handle_info(allow_renegotiate, StateName, #state{handshake_env = HsEnv} = State) ->
+ {next_state, StateName, State#state{handshake_env = HsEnv#handshake_env{allow_renegotiate = true}}};
handle_info(Msg, StateName, #state{static_env = #static_env{socket = Socket, error_tag = Tag}} = State) ->
Report = io_lib:format("SSL: Got unexpected info: ~p ~n", [{Msg, Tag, Socket}]),
@@ -1353,7 +1487,7 @@ handle_info(Msg, StateName, #state{static_env = #static_env{socket = Socket, err
%%====================================================================
%% general gen_statem callbacks
%%====================================================================
-terminate(_, _, #state{terminated = true}) ->
+terminate(_, _, #state{connection_env = #connection_env{terminated = true}}) ->
%% Happens when user closes the connection using ssl:close/1
%% we want to guarantee that Transport:close has been called
%% when ssl:close/1 returns unless it is a downgrade where
@@ -1418,13 +1552,8 @@ format_status(terminate, [_, StateName, State]) ->
protocol_buffers = ?SECRET_PRINTOUT,
user_data_buffer = ?SECRET_PRINTOUT,
handshake_env = ?SECRET_PRINTOUT,
+ connection_env = ?SECRET_PRINTOUT,
session = ?SECRET_PRINTOUT,
- private_key = ?SECRET_PRINTOUT,
- diffie_hellman_params = ?SECRET_PRINTOUT,
- diffie_hellman_keys = ?SECRET_PRINTOUT,
- srp_params = ?SECRET_PRINTOUT,
- srp_keys = ?SECRET_PRINTOUT,
- premaster_secret = ?SECRET_PRINTOUT,
ssl_options = NewOptions,
flight_buffer = ?SECRET_PRINTOUT}
}}]}].
@@ -1438,10 +1567,10 @@ send_alert(Alert, _, #state{static_env = #static_env{protocol_cb = Connection}}
Connection:send_alert(Alert, State).
connection_info(#state{static_env = #static_env{protocol_cb = Connection},
- sni_hostname = SNIHostname,
+ handshake_env = #handshake_env{sni_hostname = SNIHostname},
session = #session{session_id = SessionId,
cipher_suite = CipherSuite, ecc = ECCCurve},
- negotiated_version = {_,_} = Version,
+ connection_env = #connection_env{negotiated_version = {_,_} = Version},
ssl_options = Opts}) ->
RecordCB = record_cb(Connection),
CipherSuiteDef = #{key_exchange := KexAlg} = ssl_cipher_format:suite_definition(CipherSuite),
@@ -1469,7 +1598,8 @@ security_info(#state{connection_states = ConnectionStates}) ->
do_server_hello(Type, #{next_protocol_negotiation := NextProtocols} =
ServerHelloExt,
- #state{negotiated_version = Version,
+ #state{connection_env = #connection_env{negotiated_version = Version},
+ handshake_env = HsEnv,
session = #session{session_id = SessId},
connection_states = ConnectionStates0,
ssl_options = #ssl_options{versions = [HighestVersion|_]}}
@@ -1482,8 +1612,8 @@ do_server_hello(Type, #{next_protocol_negotiation := NextProtocols} =
ssl_handshake:server_hello(SessId, ssl:tls_version(Version),
ConnectionStates1, ServerHelloExt),
State = server_hello(ServerHello,
- State1#state{expecting_next_protocol_negotiation =
- NextProtocols =/= undefined}, Connection),
+ State1#state{handshake_env = HsEnv#handshake_env{expecting_next_protocol_negotiation =
+ NextProtocols =/= undefined}}, Connection),
case Type of
new ->
new_server_hello(ServerHello, State, Connection);
@@ -1548,8 +1678,8 @@ override_server_random(Random, _, _) ->
new_server_hello(#server_hello{cipher_suite = CipherSuite,
compression_method = Compression,
session_id = SessionId},
- #state{session = Session0,
- negotiated_version = Version} = State0, Connection) ->
+ #state{session = Session0,
+ connection_env = #connection_env{negotiated_version = Version}} = State0, Connection) ->
try server_certify_and_key_exchange(State0, Connection) of
#state{} = State1 ->
{State, Actions} = server_hello_done(State1, Connection),
@@ -1565,7 +1695,7 @@ new_server_hello(#server_hello{cipher_suite = CipherSuite,
resumed_server_hello(#state{session = Session,
connection_states = ConnectionStates0,
- negotiated_version = Version} = State0, Connection) ->
+ connection_env = #connection_env{negotiated_version = Version}} = State0, Connection) ->
case ssl_handshake:master_secret(ssl:tls_version(Version), Session,
ConnectionStates0, server) of
@@ -1582,19 +1712,20 @@ resumed_server_hello(#state{session = Session,
server_hello(ServerHello, State0, Connection) ->
CipherSuite = ServerHello#server_hello.cipher_suite,
#{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_definition(CipherSuite),
- State = Connection:queue_handshake(ServerHello, State0),
- State#state{key_algorithm = KeyAlgorithm}.
+ #state{handshake_env = HsEnv} = State = Connection:queue_handshake(ServerHello, State0),
+ State#state{handshake_env = HsEnv#handshake_env{kex_algorithm = KeyAlgorithm}}.
server_hello_done(State, Connection) ->
HelloDone = ssl_handshake:server_hello_done(),
Connection:send_handshake(HelloDone, State).
handle_peer_cert(Role, PeerCert, PublicKeyInfo,
- #state{session = #session{cipher_suite = CipherSuite} = Session} = State0,
+ #state{handshake_env = HsEnv,
+ session = #session{cipher_suite = CipherSuite} = Session} = State0,
Connection) ->
- State1 = State0#state{session =
- Session#session{peer_certificate = PeerCert},
- public_key_info = PublicKeyInfo},
+ State1 = State0#state{handshake_env = HsEnv#handshake_env{public_key_info = PublicKeyInfo},
+ session =
+ Session#session{peer_certificate = PeerCert}},
#{key_exchange := KeyAlgorithm} = ssl_cipher_format:suite_definition(CipherSuite),
State = handle_peer_cert_key(Role, PeerCert, PublicKeyInfo, KeyAlgorithm, State1),
Connection:next_event(certify, no_record, State).
@@ -1602,21 +1733,13 @@ handle_peer_cert(Role, PeerCert, PublicKeyInfo,
handle_peer_cert_key(client, _,
{?'id-ecPublicKey', #'ECPoint'{point = _ECPoint} = PublicKey,
PublicKeyParams},
- KeyAlg, #state{session = Session} = State) when KeyAlg == ecdh_rsa;
+ KeyAlg, #state{handshake_env = HsEnv,
+ session = Session} = State) when KeyAlg == ecdh_rsa;
KeyAlg == ecdh_ecdsa ->
ECDHKey = public_key:generate_key(PublicKeyParams),
PremasterSecret = ssl_handshake:premaster_secret(PublicKey, ECDHKey),
- master_secret(PremasterSecret, State#state{diffie_hellman_keys = ECDHKey,
+ master_secret(PremasterSecret, State#state{handshake_env = HsEnv#handshake_env{kex_keys = ECDHKey},
session = Session#session{ecc = PublicKeyParams}});
-%% We do currently not support cipher suites that use fixed DH.
-%% If we want to implement that the following clause can be used
-%% to extract DH parameters form cert.
-%% handle_peer_cert_key(client, _PeerCert, {?dhpublicnumber, PublicKey, PublicKeyParams},
-%% {_,SignAlg},
-%% #state{diffie_hellman_keys = {_, MyPrivatKey}} = State) when
-%% SignAlg == dh_rsa;
-%% SignAlg == dh_dss ->
-%% dh_master_secret(PublicKeyParams, PublicKey, MyPrivatKey, State);
handle_peer_cert_key(_, _, _, _, State) ->
State.
@@ -1632,13 +1755,13 @@ certify_client(#state{client_certificate_requested = false} = State, _) ->
State.
verify_client_cert(#state{static_env = #static_env{role = client},
- handshake_env = #handshake_env{tls_handshake_history = Hist},
+ handshake_env = #handshake_env{tls_handshake_history = Hist,
+ cert_hashsign_algorithm = HashSign},
+ connection_env = #connection_env{negotiated_version = Version,
+ private_key = PrivateKey},
client_certificate_requested = true,
- negotiated_version = Version,
- private_key = PrivateKey,
session = #session{master_secret = MasterSecret,
- own_certificate = OwnCert},
- cert_hashsign_algorithm = HashSign} = State, Connection) ->
+ own_certificate = OwnCert}} = State, Connection) ->
case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret,
ssl:tls_version(Version), HashSign, PrivateKey, Hist) of
@@ -1652,7 +1775,7 @@ verify_client_cert(#state{static_env = #static_env{role = client},
verify_client_cert(#state{client_certificate_requested = false} = State, _) ->
State.
-client_certify_and_key_exchange(#state{negotiated_version = Version} =
+client_certify_and_key_exchange(#state{connection_env = #connection_env{negotiated_version = Version}} =
State0, Connection) ->
try do_client_certify_and_key_exchange(State0, Connection) of
State1 = #state{} ->
@@ -1677,7 +1800,7 @@ server_certify_and_key_exchange(State0, Connection) ->
request_client_cert(State2, Connection).
certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS},
- #state{private_key = Key,
+ #state{connection_env = #connection_env{private_key = Key},
handshake_env = #handshake_env{client_hello_version = {Major, Minor} = Version}}
= State, Connection) ->
FakeSecret = make_premaster_secret(Version, rsa),
@@ -1700,14 +1823,15 @@ certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS
end,
calculate_master_secret(PremasterSecret, State, Connection, certify, cipher);
certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPublicDhKey},
- #state{diffie_hellman_params = #'DHParameter'{} = Params,
- diffie_hellman_keys = {_, ServerDhPrivateKey}} = State,
+ #state{handshake_env = #handshake_env{diffie_hellman_params = #'DHParameter'{} = Params,
+ kex_keys = {_, ServerDhPrivateKey}}
+ } = State,
Connection) ->
PremasterSecret = ssl_handshake:premaster_secret(ClientPublicDhKey, ServerDhPrivateKey, Params),
calculate_master_secret(PremasterSecret, State, Connection, certify, cipher);
certify_client_key_exchange(#client_ec_diffie_hellman_public{dh_public = ClientPublicEcDhPoint},
- #state{diffie_hellman_keys = ECDHKey} = State, Connection) ->
+ #state{handshake_env = #handshake_env{kex_keys = ECDHKey}} = State, Connection) ->
PremasterSecret = ssl_handshake:premaster_secret(#'ECPoint'{point = ClientPublicEcDhPoint}, ECDHKey),
calculate_master_secret(PremasterSecret, State, Connection, certify, cipher);
certify_client_key_exchange(#client_psk_identity{} = ClientKey,
@@ -1717,8 +1841,8 @@ certify_client_key_exchange(#client_psk_identity{} = ClientKey,
PremasterSecret = ssl_handshake:premaster_secret(ClientKey, PSKLookup),
calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher);
certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey,
- #state{diffie_hellman_params = #'DHParameter'{} = Params,
- diffie_hellman_keys = {_, ServerDhPrivateKey},
+ #state{handshake_env = #handshake_env{diffie_hellman_params = #'DHParameter'{} = Params,
+ kex_keys = {_, ServerDhPrivateKey}},
ssl_options =
#ssl_options{user_lookup_fun = PSKLookup}} = State0,
Connection) ->
@@ -1726,7 +1850,7 @@ certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey,
ssl_handshake:premaster_secret(ClientKey, ServerDhPrivateKey, Params, PSKLookup),
calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher);
certify_client_key_exchange(#client_ecdhe_psk_identity{} = ClientKey,
- #state{diffie_hellman_keys = ServerEcDhPrivateKey,
+ #state{handshake_env = #handshake_env{kex_keys = ServerEcDhPrivateKey},
ssl_options =
#ssl_options{user_lookup_fun = PSKLookup}} = State,
Connection) ->
@@ -1734,25 +1858,26 @@ certify_client_key_exchange(#client_ecdhe_psk_identity{} = ClientKey,
ssl_handshake:premaster_secret(ClientKey, ServerEcDhPrivateKey, PSKLookup),
calculate_master_secret(PremasterSecret, State, Connection, certify, cipher);
certify_client_key_exchange(#client_rsa_psk_identity{} = ClientKey,
- #state{private_key = Key,
+ #state{connection_env = #connection_env{private_key = Key},
ssl_options =
#ssl_options{user_lookup_fun = PSKLookup}} = State0,
Connection) ->
PremasterSecret = ssl_handshake:premaster_secret(ClientKey, Key, PSKLookup),
calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher);
certify_client_key_exchange(#client_srp_public{} = ClientKey,
- #state{srp_params = Params,
- srp_keys = Key
+ #state{handshake_env = #handshake_env{srp_params = Params,
+ kex_keys = Key}
} = State0, Connection) ->
PremasterSecret = ssl_handshake:premaster_secret(ClientKey, Key, Params),
calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher).
-certify_server(#state{key_algorithm = Algo} = State, _) when Algo == dh_anon;
- Algo == ecdh_anon;
- Algo == psk;
- Algo == dhe_psk;
- Algo == ecdhe_psk;
- Algo == srp_anon ->
+certify_server(#state{handshake_env = #handshake_env{kex_algorithm = KexAlg}} =
+ State, _) when KexAlg == dh_anon;
+ KexAlg == ecdh_anon;
+ KexAlg == psk;
+ KexAlg == dhe_psk;
+ KexAlg == ecdhe_psk;
+ KexAlg == srp_anon ->
State;
certify_server(#state{static_env = #static_env{cert_db = CertDbHandle,
cert_db_ref = CertDbRef},
@@ -1764,18 +1889,19 @@ certify_server(#state{static_env = #static_env{cert_db = CertDbHandle,
throw(Alert)
end.
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = rsa} = State,_) ->
+key_exchange(#state{static_env = #static_env{role = server},
+ handshake_env = #handshake_env{kex_algorithm = rsa}} = State,_) ->
State;
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = Algo,
- hashsign_algorithm = HashSignAlgo,
- diffie_hellman_params = #'DHParameter'{} = Params,
- private_key = PrivateKey,
- connection_states = ConnectionStates0,
- negotiated_version = Version
- } = State0, Connection)
- when Algo == dhe_dss;
- Algo == dhe_rsa;
- Algo == dh_anon ->
+key_exchange(#state{static_env = #static_env{role = server},
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ diffie_hellman_params = #'DHParameter'{} = Params,
+ hashsign_algorithm = HashSignAlgo},
+ connection_env = #connection_env{negotiated_version = Version,
+ private_key = PrivateKey},
+ connection_states = ConnectionStates0} = State0, Connection)
+ when KexAlg == dhe_dss;
+ KexAlg == dhe_rsa;
+ KexAlg == dh_anon ->
DHKeys = public_key:generate_key(Params),
#{security_parameters := SecParams} =
ssl_record:pending_connection_state(ConnectionStates0, read),
@@ -1785,24 +1911,26 @@ key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = Alg
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
- State = Connection:queue_handshake(Msg, State0),
- State#state{diffie_hellman_keys = DHKeys};
+ #state{handshake_env = HsEnv} = State = Connection:queue_handshake(Msg, State0),
+ State#state{handshake_env = HsEnv#handshake_env{kex_keys = DHKeys}};
key_exchange(#state{static_env = #static_env{role = server},
- private_key = #'ECPrivateKey'{parameters = ECCurve} = Key,
- key_algorithm = Algo,
+ handshake_env = #handshake_env{kex_algorithm = KexAlg} = HsEnv,
+ connection_env = #connection_env{private_key = #'ECPrivateKey'{parameters = ECCurve} = Key},
session = Session} = State, _)
- when Algo == ecdh_ecdsa; Algo == ecdh_rsa ->
- State#state{diffie_hellman_keys = Key,
+ when KexAlg == ecdh_ecdsa;
+ KexAlg == ecdh_rsa ->
+ State#state{handshake_env = HsEnv#handshake_env{kex_keys = Key},
session = Session#session{ecc = ECCurve}};
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = Algo,
- hashsign_algorithm = HashSignAlgo,
- private_key = PrivateKey,
+key_exchange(#state{static_env = #static_env{role = server},
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ hashsign_algorithm = HashSignAlgo},
+ connection_env = #connection_env{negotiated_version = Version,
+ private_key = PrivateKey},
session = #session{ecc = ECCCurve},
- connection_states = ConnectionStates0,
- negotiated_version = Version
- } = State0, Connection)
- when Algo == ecdhe_ecdsa; Algo == ecdhe_rsa;
- Algo == ecdh_anon ->
+ connection_states = ConnectionStates0} = State0, Connection)
+ when KexAlg == ecdhe_ecdsa;
+ KexAlg == ecdhe_rsa;
+ KexAlg == ecdh_anon ->
ECDHKeys = public_key:generate_key(ECCCurve),
#{security_parameters := SecParams} =
@@ -1814,18 +1942,19 @@ key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = Alg
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
- State = Connection:queue_handshake(Msg, State0),
- State#state{diffie_hellman_keys = ECDHKeys};
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = psk,
+ #state{handshake_env = HsEnv} = State = Connection:queue_handshake(Msg, State0),
+ State#state{handshake_env = HsEnv#handshake_env{kex_keys = ECDHKeys}};
+key_exchange(#state{static_env = #static_env{role = server},
+ handshake_env = #handshake_env{kex_algorithm = psk},
ssl_options = #ssl_options{psk_identity = undefined}} = State, _) ->
State;
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = psk,
+key_exchange(#state{static_env = #static_env{role = server},
ssl_options = #ssl_options{psk_identity = PskIdentityHint},
- hashsign_algorithm = HashSignAlgo,
- private_key = PrivateKey,
- connection_states = ConnectionStates0,
- negotiated_version = Version
- } = State0, Connection) ->
+ handshake_env = #handshake_env{kex_algorithm = psk,
+ hashsign_algorithm = HashSignAlgo},
+ connection_env = #connection_env{negotiated_version = Version,
+ private_key = PrivateKey},
+ connection_states = ConnectionStates0} = State0, Connection) ->
#{security_parameters := SecParams} =
ssl_record:pending_connection_state(ConnectionStates0, read),
#security_parameters{client_random = ClientRandom,
@@ -1834,15 +1963,16 @@ key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = psk
{psk, PskIdentityHint,
HashSignAlgo, ClientRandom,
ServerRandom,
- PrivateKey}),
+ PrivateKey}),
Connection:queue_handshake(Msg, State0);
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = dhe_psk,
+key_exchange(#state{static_env = #static_env{role = server},
ssl_options = #ssl_options{psk_identity = PskIdentityHint},
- hashsign_algorithm = HashSignAlgo,
- diffie_hellman_params = #'DHParameter'{} = Params,
- private_key = PrivateKey,
- connection_states = ConnectionStates0,
- negotiated_version = Version
+ handshake_env = #handshake_env{kex_algorithm = dhe_psk,
+ diffie_hellman_params = #'DHParameter'{} = Params,
+ hashsign_algorithm = HashSignAlgo},
+ connection_env = #connection_env{negotiated_version = Version,
+ private_key = PrivateKey},
+ connection_states = ConnectionStates0
} = State0, Connection) ->
DHKeys = public_key:generate_key(Params),
#{security_parameters := SecParams} =
@@ -1855,15 +1985,16 @@ key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = dhe
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
- State = Connection:queue_handshake(Msg, State0),
- State#state{diffie_hellman_keys = DHKeys};
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = ecdhe_psk,
+ #state{handshake_env = HsEnv} = State = Connection:queue_handshake(Msg, State0),
+ State#state{handshake_env = HsEnv#handshake_env{kex_keys = DHKeys}};
+key_exchange(#state{static_env = #static_env{role = server},
ssl_options = #ssl_options{psk_identity = PskIdentityHint},
- hashsign_algorithm = HashSignAlgo,
- private_key = PrivateKey,
+ handshake_env = #handshake_env{kex_algorithm = ecdhe_psk,
+ hashsign_algorithm = HashSignAlgo},
+ connection_env = #connection_env{negotiated_version = Version,
+ private_key = PrivateKey},
session = #session{ecc = ECCCurve},
- connection_states = ConnectionStates0,
- negotiated_version = Version
+ connection_states = ConnectionStates0
} = State0, Connection) ->
ECDHKeys = public_key:generate_key(ECCCurve),
#{security_parameters := SecParams} =
@@ -1876,17 +2007,19 @@ key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = ecd
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
- State = Connection:queue_handshake(Msg, State0),
- State#state{diffie_hellman_keys = ECDHKeys};
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = rsa_psk,
+ #state{handshake_env = HsEnv} = State = Connection:queue_handshake(Msg, State0),
+ State#state{handshake_env = HsEnv#handshake_env{kex_keys = ECDHKeys}};
+key_exchange(#state{static_env = #static_env{role = server},
+ handshake_env = #handshake_env{kex_algorithm = rsa_psk},
ssl_options = #ssl_options{psk_identity = undefined}} = State, _) ->
State;
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = rsa_psk,
+key_exchange(#state{static_env = #static_env{role = server},
ssl_options = #ssl_options{psk_identity = PskIdentityHint},
- hashsign_algorithm = HashSignAlgo,
- private_key = PrivateKey,
- connection_states = ConnectionStates0,
- negotiated_version = Version
+ handshake_env = #handshake_env{kex_algorithm = rsa_psk,
+ hashsign_algorithm = HashSignAlgo},
+ connection_env = #connection_env{negotiated_version = Version,
+ private_key = PrivateKey},
+ connection_states = ConnectionStates0
} = State0, Connection) ->
#{security_parameters := SecParams} =
ssl_record:pending_connection_state(ConnectionStates0, read),
@@ -1898,17 +2031,18 @@ key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = rsa
ServerRandom,
PrivateKey}),
Connection:queue_handshake(Msg, State0);
-key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = Algo,
+key_exchange(#state{static_env = #static_env{role = server},
ssl_options = #ssl_options{user_lookup_fun = LookupFun},
- hashsign_algorithm = HashSignAlgo,
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ hashsign_algorithm = HashSignAlgo},
+ connection_env = #connection_env{negotiated_version = Version,
+ private_key = PrivateKey},
session = #session{srp_username = Username},
- private_key = PrivateKey,
- connection_states = ConnectionStates0,
- negotiated_version = Version
+ connection_states = ConnectionStates0
} = State0, Connection)
- when Algo == srp_dss;
- Algo == srp_rsa;
- Algo == srp_anon ->
+ when KexAlg == srp_dss;
+ KexAlg == srp_rsa;
+ KexAlg == srp_anon ->
SrpParams = handle_srp_identity(Username, LookupFun),
Keys = case generate_srp_server_keys(SrpParams, 0) of
Alert = #alert{} ->
@@ -1925,82 +2059,86 @@ key_exchange(#state{static_env = #static_env{role = server}, key_algorithm = Alg
HashSignAlgo, ClientRandom,
ServerRandom,
PrivateKey}),
- State = Connection:queue_handshake(Msg, State0),
- State#state{srp_params = SrpParams,
- srp_keys = Keys};
+ #state{handshake_env = HsEnv} = State = Connection:queue_handshake(Msg, State0),
+ State#state{handshake_env = HsEnv#handshake_env{srp_params = SrpParams,
+ kex_keys = Keys}};
key_exchange(#state{static_env = #static_env{role = client},
- key_algorithm = rsa,
- public_key_info = PublicKeyInfo,
- negotiated_version = Version,
- premaster_secret = PremasterSecret} = State0, Connection) ->
+ handshake_env = #handshake_env{kex_algorithm = rsa,
+ public_key_info = PublicKeyInfo,
+ premaster_secret = PremasterSecret},
+ connection_env = #connection_env{negotiated_version = Version}
+ } = State0, Connection) ->
Msg = rsa_key_exchange(ssl:tls_version(Version), PremasterSecret, PublicKeyInfo),
Connection:queue_handshake(Msg, State0);
key_exchange(#state{static_env = #static_env{role = client},
- key_algorithm = Algorithm,
- negotiated_version = Version,
- diffie_hellman_keys = {DhPubKey, _}
- } = State0, Connection)
- when Algorithm == dhe_dss;
- Algorithm == dhe_rsa;
- Algorithm == dh_anon ->
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ kex_keys = {DhPubKey, _}},
+ connection_env = #connection_env{negotiated_version = Version}
+ } = State0, Connection)
+ when KexAlg == dhe_dss;
+ KexAlg == dhe_rsa;
+ KexAlg == dh_anon ->
Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version), {dh, DhPubKey}),
Connection:queue_handshake(Msg, State0);
key_exchange(#state{static_env = #static_env{role = client},
- key_algorithm = Algorithm,
- negotiated_version = Version,
- session = Session,
- diffie_hellman_keys = #'ECPrivateKey'{parameters = ECCurve} = Key} = State0, Connection)
- when Algorithm == ecdhe_ecdsa; Algorithm == ecdhe_rsa;
- Algorithm == ecdh_ecdsa; Algorithm == ecdh_rsa;
- Algorithm == ecdh_anon ->
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ kex_keys = #'ECPrivateKey'{parameters = ECCurve} = Key},
+ connection_env = #connection_env{negotiated_version = Version},
+ session = Session
+ } = State0, Connection)
+ when KexAlg == ecdhe_ecdsa;
+ KexAlg == ecdhe_rsa;
+ KexAlg == ecdh_ecdsa;
+ KexAlg == ecdh_rsa;
+ KexAlg == ecdh_anon ->
Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version), {ecdh, Key}),
Connection:queue_handshake(Msg, State0#state{session = Session#session{ecc = ECCurve}});
key_exchange(#state{static_env = #static_env{role = client},
- ssl_options = SslOpts,
- key_algorithm = psk,
- negotiated_version = Version} = State0, Connection) ->
+ handshake_env = #handshake_env{kex_algorithm = psk},
+ connection_env = #connection_env{negotiated_version = Version},
+ ssl_options = SslOpts} = State0, Connection) ->
Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version),
{psk, SslOpts#ssl_options.psk_identity}),
Connection:queue_handshake(Msg, State0);
key_exchange(#state{static_env = #static_env{role = client},
- ssl_options = SslOpts,
- key_algorithm = dhe_psk,
- negotiated_version = Version,
- diffie_hellman_keys = {DhPubKey, _}} = State0, Connection) ->
+ handshake_env = #handshake_env{kex_algorithm = dhe_psk,
+ kex_keys = {DhPubKey, _}},
+ connection_env = #connection_env{negotiated_version = Version},
+ ssl_options = SslOpts} = State0, Connection) ->
Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version),
{dhe_psk,
SslOpts#ssl_options.psk_identity, DhPubKey}),
Connection:queue_handshake(Msg, State0);
key_exchange(#state{static_env = #static_env{role = client},
- ssl_options = SslOpts,
- key_algorithm = ecdhe_psk,
- negotiated_version = Version,
- diffie_hellman_keys = ECDHKeys} = State0, Connection) ->
+ handshake_env = #handshake_env{kex_algorithm = ecdhe_psk,
+ kex_keys = ECDHKeys},
+ connection_env = #connection_env{negotiated_version = Version},
+ ssl_options = SslOpts} = State0, Connection) ->
Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version),
{ecdhe_psk,
SslOpts#ssl_options.psk_identity, ECDHKeys}),
Connection:queue_handshake(Msg, State0);
key_exchange(#state{static_env = #static_env{role = client},
- ssl_options = SslOpts,
- key_algorithm = rsa_psk,
- public_key_info = PublicKeyInfo,
- negotiated_version = Version,
- premaster_secret = PremasterSecret}
+ handshake_env = #handshake_env{kex_algorithm = rsa_psk,
+ public_key_info = PublicKeyInfo,
+ premaster_secret = PremasterSecret},
+ connection_env = #connection_env{negotiated_version = Version},
+ ssl_options = SslOpts}
= State0, Connection) ->
Msg = rsa_psk_key_exchange(ssl:tls_version(Version), SslOpts#ssl_options.psk_identity,
PremasterSecret, PublicKeyInfo),
Connection:queue_handshake(Msg, State0);
key_exchange(#state{static_env = #static_env{role = client},
- key_algorithm = Algorithm,
- negotiated_version = Version,
- srp_keys = {ClientPubKey, _}}
+ handshake_env = #handshake_env{kex_algorithm = KexAlg,
+ kex_keys = {ClientPubKey, _}},
+ connection_env = #connection_env{negotiated_version = Version}}
= State0, Connection)
- when Algorithm == srp_dss;
- Algorithm == srp_rsa;
- Algorithm == srp_anon ->
+ when KexAlg == srp_dss;
+ KexAlg == srp_rsa;
+ KexAlg == srp_anon ->
Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version), {srp, ClientPubKey}),
Connection:queue_handshake(Msg, State0).
@@ -2037,18 +2175,24 @@ rsa_psk_key_exchange(Version, PskIdentity, PremasterSecret,
rsa_psk_key_exchange(_, _, _, _) ->
throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE, pub_key_is_not_rsa)).
-request_client_cert(#state{key_algorithm = Alg} = State, _)
- when Alg == dh_anon; Alg == ecdh_anon;
- Alg == psk; Alg == dhe_psk; Alg == ecdhe_psk; Alg == rsa_psk;
- Alg == srp_dss; Alg == srp_rsa; Alg == srp_anon ->
+request_client_cert(#state{handshake_env = #handshake_env{kex_algorithm = Alg}} = State, _)
+ when Alg == dh_anon;
+ Alg == ecdh_anon;
+ Alg == psk;
+ Alg == dhe_psk;
+ Alg == ecdhe_psk;
+ Alg == rsa_psk;
+ Alg == srp_dss;
+ Alg == srp_rsa;
+ Alg == srp_anon ->
State;
request_client_cert(#state{static_env = #static_env{cert_db = CertDbHandle,
cert_db_ref = CertDbRef},
+ connection_env = #connection_env{negotiated_version = Version},
ssl_options = #ssl_options{verify = verify_peer,
signature_algs = SupportedHashSigns},
- connection_states = ConnectionStates0,
- negotiated_version = Version} = State0, Connection) ->
+ connection_states = ConnectionStates0} = State0, Connection) ->
#{security_parameters :=
#security_parameters{cipher_suite = CipherSuite}} =
ssl_record:pending_connection_state(ConnectionStates0, read),
@@ -2065,7 +2209,7 @@ request_client_cert(#state{ssl_options = #ssl_options{verify = verify_none}} =
State.
calculate_master_secret(PremasterSecret,
- #state{negotiated_version = Version,
+ #state{connection_env = #connection_env{negotiated_version = Version},
connection_states = ConnectionStates0,
session = Session0} = State0, Connection,
_Current, Next) ->
@@ -2094,11 +2238,11 @@ finalize_handshake(State0, StateName, Connection) ->
next_protocol(#state{static_env = #static_env{role = server}} = State, _) ->
State;
-next_protocol(#state{negotiated_protocol = undefined} = State, _) ->
+next_protocol(#state{handshake_env = #handshake_env{negotiated_protocol = undefined}} = State, _) ->
State;
-next_protocol(#state{expecting_next_protocol_negotiation = false} = State, _) ->
+next_protocol(#state{handshake_env = #handshake_env{expecting_next_protocol_negotiation = false}} = State, _) ->
State;
-next_protocol(#state{negotiated_protocol = NextProtocol} = State0, Connection) ->
+next_protocol(#state{handshake_env = #handshake_env{negotiated_protocol = NextProtocol}} = State0, Connection) ->
NextProtocolMessage = ssl_handshake:next_protocol(NextProtocol),
Connection:queue_handshake(NextProtocolMessage, State0).
@@ -2107,7 +2251,7 @@ cipher_protocol(State, Connection) ->
finished(#state{static_env = #static_env{role = Role},
handshake_env = #handshake_env{tls_handshake_history = Hist},
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
session = Session,
connection_states = ConnectionStates0} = State0,
StateName, Connection) ->
@@ -2130,65 +2274,71 @@ save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, abbrev
calculate_secret(#server_dh_params{dh_p = Prime, dh_g = Base,
dh_y = ServerPublicDhKey} = Params,
- State, Connection) ->
+ #state{handshake_env = HsEnv} = State, Connection) ->
Keys = {_, PrivateDhKey} = crypto:generate_key(dh, [Prime, Base]),
PremasterSecret =
ssl_handshake:premaster_secret(ServerPublicDhKey, PrivateDhKey, Params),
calculate_master_secret(PremasterSecret,
- State#state{diffie_hellman_keys = Keys},
+ State#state{handshake_env = HsEnv#handshake_env{kex_keys = Keys}},
Connection, certify, certify);
calculate_secret(#server_ecdh_params{curve = ECCurve, public = ECServerPubKey},
- State=#state{session=Session}, Connection) ->
+ #state{handshake_env = HsEnv,
+ session = Session} = State, Connection) ->
ECDHKeys = public_key:generate_key(ECCurve),
PremasterSecret =
ssl_handshake:premaster_secret(#'ECPoint'{point = ECServerPubKey}, ECDHKeys),
calculate_master_secret(PremasterSecret,
- State#state{diffie_hellman_keys = ECDHKeys,
+ State#state{handshake_env = HsEnv#handshake_env{kex_keys = ECDHKeys},
session = Session#session{ecc = ECCurve}},
Connection, certify, certify);
calculate_secret(#server_psk_params{
hint = IdentityHint},
- State, Connection) ->
+ #state{handshake_env = HsEnv} = State, Connection) ->
%% store for later use
- Connection:next_event(certify, no_record, State#state{psk_identity = IdentityHint});
+ Connection:next_event(certify, no_record,
+ State#state{handshake_env =
+ HsEnv#handshake_env{server_psk_identity = IdentityHint}});
calculate_secret(#server_dhe_psk_params{
dh_params = #server_dh_params{dh_p = Prime, dh_g = Base}} = ServerKey,
- #state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} =
+ #state{handshake_env = HsEnv,
+ ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} =
State, Connection) ->
Keys = {_, PrivateDhKey} =
crypto:generate_key(dh, [Prime, Base]),
PremasterSecret = ssl_handshake:premaster_secret(ServerKey, PrivateDhKey, PSKLookup),
- calculate_master_secret(PremasterSecret, State#state{diffie_hellman_keys = Keys},
+ calculate_master_secret(PremasterSecret, State#state{handshake_env = HsEnv#handshake_env{kex_keys = Keys}},
Connection, certify, certify);
calculate_secret(#server_ecdhe_psk_params{
dh_params = #server_ecdh_params{curve = ECCurve}} = ServerKey,
#state{ssl_options = #ssl_options{user_lookup_fun = PSKLookup}} =
- State=#state{session=Session}, Connection) ->
+ #state{handshake_env = HsEnv,
+ session = Session} = State, Connection) ->
ECDHKeys = public_key:generate_key(ECCurve),
PremasterSecret = ssl_handshake:premaster_secret(ServerKey, ECDHKeys, PSKLookup),
calculate_master_secret(PremasterSecret,
- State#state{diffie_hellman_keys = ECDHKeys,
+ State#state{handshake_env = HsEnv#handshake_env{kex_keys = ECDHKeys},
session = Session#session{ecc = ECCurve}},
Connection, certify, certify);
calculate_secret(#server_srp_params{srp_n = Prime, srp_g = Generator} = ServerKey,
- #state{ssl_options = #ssl_options{srp_identity = SRPId}} = State,
+ #state{handshake_env = HsEnv,
+ ssl_options = #ssl_options{srp_identity = SRPId}} = State,
Connection) ->
Keys = generate_srp_client_keys(Generator, Prime, 0),
PremasterSecret = ssl_handshake:premaster_secret(ServerKey, Keys, SRPId),
- calculate_master_secret(PremasterSecret, State#state{srp_keys = Keys}, Connection,
+ calculate_master_secret(PremasterSecret, State#state{handshake_env = HsEnv#handshake_env{kex_keys = Keys}}, Connection,
certify, certify).
master_secret(#alert{} = Alert, _) ->
Alert;
master_secret(PremasterSecret, #state{static_env = #static_env{role = Role},
+ connection_env = #connection_env{negotiated_version = Version},
session = Session,
- negotiated_version = Version,
connection_states = ConnectionStates0} = State) ->
case ssl_handshake:master_secret(ssl:tls_version(Version), PremasterSecret,
ConnectionStates0, Role) of
@@ -2248,7 +2398,7 @@ cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0}
{Record, State} = prepare_connection(State0#state{session = Session,
connection_states = ConnectionStates},
Connection),
- Connection:next_event(connection, Record, State);
+ Connection:next_event(connection, Record, State, [{{timeout, handshake}, infinity, close}]);
cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0} = State0,
Connection) ->
ConnectionStates1 = ssl_record:set_client_verify_data(current_read, Data,
@@ -2257,15 +2407,15 @@ cipher_role(server, Data, Session, #state{connection_states = ConnectionStates0
finalize_handshake(State0#state{connection_states = ConnectionStates1,
session = Session}, cipher, Connection),
{Record, State} = prepare_connection(State1, Connection),
- Connection:next_event(connection, Record, State, Actions).
-
-is_anonymous(Algo) when Algo == dh_anon;
- Algo == ecdh_anon;
- Algo == psk;
- Algo == dhe_psk;
- Algo == ecdhe_psk;
- Algo == rsa_psk;
- Algo == srp_anon ->
+ Connection:next_event(connection, Record, State, [{{timeout, handshake}, infinity, close} | Actions]).
+
+is_anonymous(KexAlg) when KexAlg == dh_anon;
+ KexAlg == ecdh_anon;
+ KexAlg == psk;
+ KexAlg == dhe_psk;
+ KexAlg == ecdhe_psk;
+ KexAlg == rsa_psk;
+ KexAlg == srp_anon ->
true;
is_anonymous(_) ->
false.
@@ -2379,6 +2529,30 @@ set_socket_opts(ConnectionCb, Transport, Socket, [{active, Active}| Opts], SockO
Active == false ->
set_socket_opts(ConnectionCb, Transport, Socket, Opts,
SockOpts#socket_options{active = Active}, Other);
+set_socket_opts(ConnectionCb, Transport, Socket, [{active, Active1} = Opt| Opts],
+ SockOpts=#socket_options{active = Active0}, Other)
+ when Active1 >= -32768, Active1 =< 32767 ->
+ Active = if
+ is_integer(Active0), Active0 + Active1 < -32768 ->
+ error;
+ is_integer(Active0), Active0 + Active1 =< 0 ->
+ false;
+ is_integer(Active0), Active0 + Active1 > 32767 ->
+ error;
+ Active1 =< 0 ->
+ false;
+ is_integer(Active0) ->
+ Active0 + Active1;
+ true ->
+ Active1
+ end,
+ case Active of
+ error ->
+ {{error, {options, {socket_options, Opt}} }, SockOpts};
+ _ ->
+ set_socket_opts(ConnectionCb, Transport, Socket, Opts,
+ SockOpts#socket_options{active = Active}, Other)
+ end;
set_socket_opts(_,_, _, [{active, _} = Opt| _], SockOpts, _) ->
{{error, {options, {socket_options, Opt}} }, SockOpts};
set_socket_opts(ConnectionCb, Transport, Socket, [Opt | Opts], SockOpts, Other) ->
@@ -2443,21 +2617,13 @@ ack_connection(#state{handshake_env = #handshake_env{renegotiation = {true, From
gen_statem:reply(From, ok),
State#state{handshake_env = HsEnv#handshake_env{renegotiation = undefined}};
ack_connection(#state{handshake_env = #handshake_env{renegotiation = {false, first}} = HsEnv,
- start_or_recv_from = StartFrom,
- timer = Timer} = State) when StartFrom =/= undefined ->
+ start_or_recv_from = StartFrom} = State) when StartFrom =/= undefined ->
gen_statem:reply(StartFrom, connected),
- cancel_timer(Timer),
State#state{handshake_env = HsEnv#handshake_env{renegotiation = undefined},
- start_or_recv_from = undefined, timer = undefined};
+ start_or_recv_from = undefined};
ack_connection(State) ->
State.
-cancel_timer(undefined) ->
- ok;
-cancel_timer(Timer) ->
- erlang:cancel_timer(Timer),
- ok.
-
session_handle_params(#server_ecdh_params{curve = ECCurve}, Session) ->
Session#session{ecc = ECCurve};
session_handle_params(_, Session) ->
@@ -2513,9 +2679,8 @@ handle_resumed_session(SessId, #state{static_env = #static_env{host = Host,
protocol_cb = Connection,
session_cache = Cache,
session_cache_cb = CacheCb},
- connection_states = ConnectionStates0,
- negotiated_version = Version
- } = State) ->
+ connection_env = #connection_env{negotiated_version = Version},
+ connection_states = ConnectionStates0} = State) ->
Session = CacheCb:lookup(Cache, {{Host, Port}, SessId}),
case ssl_handshake:master_secret(ssl:tls_version(Version), Session,
ConnectionStates0, client) of
@@ -2572,8 +2737,13 @@ ssl_options_list([Key | Keys], [Value | Values], Acc) ->
handle_active_option(false, connection = StateName, To, Reply, State) ->
hibernate_after(StateName, State, [{reply, To, Reply}]);
+handle_active_option(_, connection = StateName, To, _Reply, #state{connection_env = #connection_env{terminated = true},
+ user_data_buffer = {_,0,_}} = State) ->
+ handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY, all_data_deliverd), StateName,
+ State#state{start_or_recv_from = To}),
+ {stop,{shutdown, peer_close}, State};
handle_active_option(_, connection = StateName0, To, Reply, #state{static_env = #static_env{protocol_cb = Connection},
- user_data_buffer = <<>>} = State0) ->
+ user_data_buffer = {_,0,_}} = State0) ->
case Connection:next_event(StateName0, no_record, State0) of
{next_state, StateName, State} ->
hibernate_after(StateName, State, [{reply, To, Reply}]);
@@ -2582,11 +2752,11 @@ handle_active_option(_, connection = StateName0, To, Reply, #state{static_env =
{stop, _, _} = Stop ->
Stop
end;
-handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = <<>>} = State) ->
+handle_active_option(_, StateName, To, Reply, #state{user_data_buffer = {_,0,_}} = State) ->
%% Active once already set
{next_state, StateName, State, [{reply, To, Reply}]};
-%% user_data_buffer =/= <<>>
+%% user_data_buffer nonempty
handle_active_option(_, StateName0, To, Reply,
#state{static_env = #static_env{protocol_cb = Connection}} = State0) ->
case read_application_data(<<>>, State0) of
@@ -2606,33 +2776,25 @@ handle_active_option(_, StateName0, To, Reply,
%% Picks ClientData
-get_data(_, _, <<>>) ->
- {more, <<>>};
-%% Recv timed out save buffer data until next recv
-get_data(#socket_options{active=false}, undefined, Buffer) ->
- {passive, Buffer};
-get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Buffer)
+get_data(#socket_options{active=false}, undefined, _Bin) ->
+ %% Recv timed out save buffer data until next recv
+ passive;
+get_data(#socket_options{active=Active, packet=Raw}, BytesToRead, Bin)
when Raw =:= raw; Raw =:= 0 -> %% Raw Mode
- if
- Active =/= false orelse BytesToRead =:= 0 ->
+ case Bin of
+ <<_/binary>> when Active =/= false orelse BytesToRead =:= 0 ->
%% Active true or once, or passive mode recv(0)
- {ok, Buffer, <<>>};
- byte_size(Buffer) >= BytesToRead ->
+ {ok, Bin, <<>>};
+ <<Data:BytesToRead/binary, Rest/binary>> ->
%% Passive Mode, recv(Bytes)
- <<Data:BytesToRead/binary, Rest/binary>> = Buffer,
- {ok, Data, Rest};
- true ->
+ {ok, Data, Rest};
+ <<_/binary>> ->
%% Passive Mode not enough data
- {more, Buffer}
+ {more, BytesToRead}
end;
-get_data(#socket_options{packet=Type, packet_size=Size}, _, Buffer) ->
+get_data(#socket_options{packet=Type, packet_size=Size}, _, Bin) ->
PacketOpts = [{packet_size, Size}],
- case decode_packet(Type, Buffer, PacketOpts) of
- {more, _} ->
- {more, Buffer};
- Decoded ->
- Decoded
- end.
+ decode_packet(Type, Bin, PacketOpts).
decode_packet({http, headers}, Buffer, PacketOpts) ->
decode_packet(httph, Buffer, PacketOpts);
@@ -2675,6 +2837,14 @@ deliver_app_data(
case Active of
once ->
SO#socket_options{active=false};
+ 1 ->
+ send_user(
+ Pid,
+ format_passive(
+ CPids, Transport, Socket, Tracker, Connection)),
+ SO#socket_options{active=false};
+ N when is_integer(N) ->
+ SO#socket_options{active=N - 1};
_ ->
SO
end.
@@ -2684,7 +2854,7 @@ format_reply(_, _, _,#socket_options{active = false, mode = Mode, packet = Packe
{ok, do_format_reply(Mode, Packet, Header, Data)};
format_reply(CPids, Transport, Socket, #socket_options{active = _, mode = Mode, packet = Packet,
header = Header}, Data, Tracker, Connection) ->
- {ssl, Connection:socket(CPids, Transport, Socket, Connection, Tracker),
+ {ssl, Connection:socket(CPids, Transport, Socket, Tracker),
do_format_reply(Mode, Packet, Header, Data)}.
deliver_packet_error(CPids, Transport, Socket,
@@ -2696,7 +2866,7 @@ format_packet_error(_, _, _,#socket_options{active = false, mode = Mode}, Data,
{error, {invalid_packet, do_format_reply(Mode, raw, 0, Data)}};
format_packet_error(CPids, Transport, Socket, #socket_options{active = _, mode = Mode},
Data, Tracker, Connection) ->
- {ssl_error, Connection:socket(CPids, Transport, Socket, Connection, Tracker),
+ {ssl_error, Connection:socket(CPids, Transport, Socket, Tracker),
{invalid_packet, do_format_reply(Mode, raw, 0, Data)}}.
do_format_reply(binary, _, N, Data) when N > 0 -> % Header mode
@@ -2711,6 +2881,9 @@ do_format_reply(list, Packet, _, Data)
do_format_reply(list, _,_, Data) ->
binary_to_list(Data).
+format_passive(CPids, Transport, Socket, Tracker, Connection) ->
+ {ssl_passive, Connection:socket(CPids, Transport, Socket, Tracker)}.
+
header(0, <<>>) ->
<<>>;
header(_, <<>>) ->
@@ -2752,12 +2925,10 @@ alert_user(Pids, Transport, Tracker, Socket, Active, Pid, From, Alert, Role, Con
case ssl_alert:reason_code(Alert, Role) of
closed ->
send_or_reply(Active, Pid, From,
- {ssl_closed, Connection:socket(Pids,
- Transport, Socket, Connection, Tracker)});
+ {ssl_closed, Connection:socket(Pids, Transport, Socket, Tracker)});
ReasonCode ->
send_or_reply(Active, Pid, From,
- {ssl_error, Connection:socket(Pids,
- Transport, Socket, Connection, Tracker), ReasonCode})
+ {ssl_error, Connection:socket(Pids, Transport, Socket, Tracker), ReasonCode})
end.
log_alert(Level, Role, ProtocolName, StateName, #alert{role = Role} = Alert) ->
@@ -2776,7 +2947,9 @@ invalidate_session(server, _, Port, Session) ->
handle_sni_extension(undefined, State) ->
State;
-handle_sni_extension(#sni{hostname = Hostname}, #state{static_env = #static_env{role = Role} = InitStatEnv0} = State0) ->
+handle_sni_extension(#sni{hostname = Hostname}, #state{static_env = #static_env{role = Role} = InitStatEnv0,
+ handshake_env = HsEnv,
+ connection_env = CEnv} = State0) ->
NewOptions = update_ssl_options_from_sni(State0#state.ssl_options, Hostname),
case NewOptions of
undefined ->
@@ -2799,12 +2972,12 @@ handle_sni_extension(#sni{hostname = Hostname}, #state{static_env = #static_env{
cert_db = CertDbHandle,
crl_db = CRLDbHandle,
session_cache = CacheHandle
- },
- private_key = Key,
- diffie_hellman_params = DHParams,
- ssl_options = NewOptions,
- sni_hostname = Hostname
- }
+ },
+ connection_env = CEnv#connection_env{private_key = Key},
+ ssl_options = NewOptions,
+ handshake_env = HsEnv#handshake_env{sni_hostname = Hostname,
+ diffie_hellman_params = DHParams}
+ }
end.
update_ssl_options_from_sni(OrigSSLOptions, SNIHostname) ->
@@ -2827,11 +3000,3 @@ new_emulated([], EmOpts) ->
EmOpts;
new_emulated(NewEmOpts, _) ->
NewEmOpts.
-
--compile({inline, [bincat/2]}).
-bincat(<<>>, B) ->
- B;
-bincat(A, <<>>) ->
- A;
-bincat(A, B) ->
- <<A/binary, B/binary>>.
diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl
index dd3bdd7478..201164949a 100644
--- a/lib/ssl/src/ssl_connection.hrl
+++ b/lib/ssl/src/ssl_connection.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -57,59 +57,64 @@
unprocessed_handshake_events = 0 :: integer(),
tls_handshake_history :: ssl_handshake:ssl_handshake_history() | secret_printout()
| 'undefined',
- renegotiation :: undefined | {boolean(), From::term() | internal | peer}
+ expecting_finished = false ::boolean(),
+ renegotiation :: undefined | {boolean(), From::term() | internal | peer},
+ allow_renegotiate = true ::boolean(),
+ %% Ext handling
+ hello, %%:: #client_hello{} | #server_hello{}
+ sni_hostname = undefined,
+ expecting_next_protocol_negotiation = false ::boolean(),
+ next_protocol = undefined :: undefined | binary(),
+ negotiated_protocol,
+ hashsign_algorithm = {undefined, undefined},
+ cert_hashsign_algorithm = {undefined, undefined},
+ %% key exchange
+ kex_algorithm :: ssl:kex_algo(),
+ kex_keys :: {PublicKey :: binary(), PrivateKey :: binary()} | #'ECPrivateKey'{} | undefined | secret_printout(),
+ diffie_hellman_params:: #'DHParameter'{} | undefined | secret_printout(),
+ srp_params :: #srp_user{} | secret_printout() | 'undefined',
+ public_key_info :: ssl_handshake:public_key_info() | 'undefined',
+ premaster_secret :: binary() | secret_printout() | 'undefined',
+ server_psk_identity :: binary() | 'undefined' % server psk identity hint
}).
+-record(connection_env, {
+ user_application :: {Monitor::reference(), User::pid()},
+ downgrade,
+ terminated = false ::boolean() | closed,
+ negotiated_version :: ssl_record:ssl_version() | 'undefined',
+ erl_dist_handle = undefined :: erlang:dist_handle() | 'undefined',
+ private_key :: public_key:private_key() | secret_printout() | 'undefined'
+ }).
+
-record(state, {
static_env :: #static_env{},
- handshake_env :: #handshake_env{} | secret_printout(),
- %% Change seldome
- user_application :: {Monitor::reference(), User::pid()},
+ connection_env :: #connection_env{} | secret_printout(),
ssl_options :: #ssl_options{},
socket_options :: #socket_options{},
- session :: #session{} | secret_printout(),
- allow_renegotiate = true ::boolean(),
- terminated = false ::boolean() | closed,
- negotiated_version :: ssl_record:ssl_version() | 'undefined',
- bytes_to_read :: undefined | integer(), %% bytes to read in passive mode
- downgrade,
- %% Changed often
+ %% Hanshake %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ handshake_env :: #handshake_env{} | secret_printout(),
+ %% Buffer of TLS/DTLS records, used during the TLS
+ %% handshake to when possible pack more than one TLS
+ %% record into the underlaying packet
+ %% format. Introduced by DTLS - RFC 4347. The
+ %% mecahnism is also usefull in TLS although we do not
+ %% need to worry about packet loss in TLS. In DTLS we
+ %% need to track DTLS handshake seqnr
+ flight_buffer = [] :: list() | map(),
+ client_certificate_requested = false :: boolean(),
+ protocol_specific = #{} :: map(),
+ session :: #session{} | secret_printout(),
+ key_share,
+ %% Data shuffling %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
connection_states :: ssl_record:connection_states() | secret_printout(),
protocol_buffers :: term() | secret_printout() , %% #protocol_buffers{} from tls_record.hrl or dtls_recor.hr
- user_data_buffer :: undefined | binary() | secret_printout(),
-
- %% Used only in HS
-
- client_certificate_requested = false :: boolean(),
- key_algorithm :: ssl_cipher_format:key_algo(),
- hashsign_algorithm = {undefined, undefined},
- cert_hashsign_algorithm = {undefined, undefined},
- public_key_info :: ssl_handshake:public_key_info() | 'undefined',
- private_key :: public_key:private_key() | secret_printout() | 'undefined',
- diffie_hellman_params:: #'DHParameter'{} | undefined | secret_printout(),
- diffie_hellman_keys :: {PublicKey :: binary(), PrivateKey :: binary()} | #'ECPrivateKey'{} | undefined | secret_printout(),
- psk_identity :: binary() | 'undefined', % server psk identity hint
- srp_params :: #srp_user{} | secret_printout() | 'undefined',
- srp_keys ::{PublicKey :: binary(), PrivateKey :: binary()} | secret_printout() | 'undefined',
- premaster_secret :: binary() | secret_printout() | 'undefined',
+ user_data_buffer :: undefined | {[binary()],non_neg_integer(),[binary()]} | secret_printout(),
+ bytes_to_read :: undefined | integer(), %% bytes to read in passive mode
+ %% recv and start handling
start_or_recv_from :: term(),
- timer :: undefined | reference(), % start_or_recive_timer
- hello, %%:: #client_hello{} | #server_hello{},
- expecting_next_protocol_negotiation = false ::boolean(),
- expecting_finished = false ::boolean(),
- next_protocol = undefined :: undefined | binary(),
- negotiated_protocol,
- sni_hostname = undefined,
- flight_buffer = [] :: list() | map(), %% Buffer of TLS/DTLS records, used during the TLS handshake
- %% to when possible pack more than one TLS record into the
- %% underlaying packet format. Introduced by DTLS - RFC 4347.
- %% The mecahnism is also usefull in TLS although we do not
- %% need to worry about packet loss in TLS. In DTLS we need to track DTLS handshake seqnr
- flight_state = reliable, %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp.
- erl_dist_handle = undefined :: erlang:dist_handle() | undefined,
- protocol_specific = #{} :: map(),
- key_share
+ log_level
}).
-define(DEFAULT_DIFFIE_HELLMAN_PARAMS,
diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl
index 9c1af86eeb..841620ce57 100644
--- a/lib/ssl/src/ssl_crl_cache.erl
+++ b/lib/ssl/src/ssl_crl_cache.erl
@@ -28,6 +28,10 @@
-behaviour(ssl_crl_cache_api).
+-export_type([crl_src/0, uri/0]).
+-type crl_src() :: {file, file:filename()} | {der, public_key:der_encoded()}.
+-type uri() :: uri_string:uri_string().
+
-export([lookup/3, select/2, fresh_crl/2]).
-export([insert/1, insert/2, delete/1]).
diff --git a/lib/ssl/src/ssl_crl_cache_api.erl b/lib/ssl/src/ssl_crl_cache_api.erl
index d5380583e7..8a750b3929 100644
--- a/lib/ssl/src/ssl_crl_cache_api.erl
+++ b/lib/ssl/src/ssl_crl_cache_api.erl
@@ -21,12 +21,15 @@
%%
-module(ssl_crl_cache_api).
-
-include_lib("public_key/include/public_key.hrl").
--type db_handle() :: term().
--type issuer_name() :: {rdnSequence, [#'AttributeTypeAndValue'{}]}.
+-export_type([dist_point/0, crl_cache_ref/0]).
+
+-type crl_cache_ref() :: any().
+-type issuer_name() :: {rdnSequence,[#'AttributeTypeAndValue'{}]}.
+-type dist_point() :: #'DistributionPoint'{}.
--callback lookup(#'DistributionPoint'{}, issuer_name(), db_handle()) -> not_available | [public_key:der_encoded()].
--callback select(issuer_name(), db_handle()) -> [public_key:der_encoded()].
--callback fresh_crl(#'DistributionPoint'{}, public_key:der_encoded()) -> public_key:der_encoded().
+
+-callback lookup(dist_point(), issuer_name(), crl_cache_ref()) -> not_available | [public_key:der_encoded()].
+-callback select(issuer_name(), crl_cache_ref()) -> [public_key:der_encoded()].
+-callback fresh_crl(dist_point(), public_key:der_encoded()) -> public_key:der_encoded().
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index 5e3c767c2c..6c95a7edf8 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -39,7 +39,7 @@
-type oid() :: tuple().
-type public_key_params() :: #'Dss-Parms'{} | {namedCurve, oid()} | #'ECParameters'{} | term().
-type public_key_info() :: {oid(), #'RSAPublicKey'{} | integer() | #'ECPoint'{}, public_key_params()}.
--type ssl_handshake_history() :: {[binary()], [binary()]}.
+-type ssl_handshake_history() :: {iodata(), iodata()}.
-type ssl_handshake() :: #server_hello{} | #server_hello_done{} | #certificate{} | #certificate_request{} |
#client_key_exchange{} | #finished{} | #certificate_verify{} |
@@ -76,10 +76,13 @@
handle_client_hello_extensions/9, %% Returns server hello extensions
handle_server_hello_extensions/9, select_curve/2, select_curve/3,
select_hashsign/4, select_hashsign/5,
- select_hashsign_algs/3, empty_extensions/2, add_server_share/2
+ select_hashsign_algs/3, empty_extensions/2, add_server_share/3
]).
--export([get_cert_params/1]).
+-export([get_cert_params/1,
+ server_name/3,
+ validation_fun_and_state/9,
+ handle_path_validation_error/7]).
%%====================================================================
%% Create handshake messages
@@ -592,7 +595,7 @@ encode_extensions(Exts) ->
encode_extensions(Exts, <<>>).
encode_extensions([], <<>>) ->
- <<>>;
+ <<?UINT16(0)>>;
encode_extensions([], Acc) ->
Size = byte_size(Acc),
<<?UINT16(Size), Acc/binary>>;
@@ -833,7 +836,7 @@ decode_extensions(Extensions, Version, MessageType) ->
decode_extensions(Extensions, Version, MessageType, empty_extensions()).
%%--------------------------------------------------------------------
--spec decode_server_key(binary(), ssl_cipher_format:key_algo(), ssl_record:ssl_version()) ->
+-spec decode_server_key(binary(), ssl:kex_algo(), ssl_record:ssl_version()) ->
#server_key_params{}.
%%
%% Description: Decode server_key data and return appropriate type
@@ -842,7 +845,7 @@ decode_server_key(ServerKey, Type, Version) ->
dec_server_key(ServerKey, key_exchange_alg(Type), Version).
%%--------------------------------------------------------------------
--spec decode_client_key(binary(), ssl_cipher_format:key_algo(), ssl_record:ssl_version()) ->
+-spec decode_client_key(binary(), ssl:kex_algo(), ssl_record:ssl_version()) ->
#encrypted_premaster_secret{}
| #client_diffie_hellman_public{}
| #client_ec_diffie_hellman_public{}
@@ -1150,12 +1153,18 @@ maybe_add_key_share(HelloExtensions, KeyShare) ->
HelloExtensions#{key_share => #key_share_client_hello{
client_shares = ClientShares}}.
-add_server_share(Extensions, KeyShare) ->
+add_server_share(server_hello, Extensions, KeyShare) ->
#key_share_server_hello{server_share = ServerShare0} = KeyShare,
%% Keep only public keys
ServerShare = kse_remove_private_key(ServerShare0),
Extensions#{key_share => #key_share_server_hello{
- server_share = ServerShare}}.
+ server_share = ServerShare}};
+add_server_share(hello_retry_request, Extensions,
+ #key_share_server_hello{
+ server_share = #key_share_entry{group = Group}}) ->
+ Extensions#{key_share => #key_share_hello_retry_request{
+ selected_group = Group}}.
+
kse_remove_private_key(#key_share_entry{
group = Group,
diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl
index d4233bea9b..b248edcaa9 100644
--- a/lib/ssl/src/ssl_handshake.hrl
+++ b/lib/ssl/src/ssl_handshake.hrl
@@ -47,7 +47,9 @@
srp_username,
is_resumable,
time_stamp,
- ecc
+ ecc, %% TLS 1.3 Group
+ sign_alg, %% TLS 1.3 Signature Algorithm
+ dh_public_value %% TLS 1.3 DH Public Value from peer
}).
-define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 57b72366d3..3d117a655f 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -32,8 +32,6 @@
-type reply() :: term().
-type msg() :: term().
-type from() :: term().
--type host() :: inet:ip_address() | inet:hostname().
--type session_id() :: 0 | binary().
-type certdb_ref() :: reference().
-type db_handle() :: term().
-type der_cert() :: binary().
@@ -124,7 +122,8 @@
cert :: public_key:der_encoded() | secret_printout() | 'undefined',
keyfile :: binary(),
key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo',
- public_key:der_encoded()} | key_map() | secret_printout() | 'undefined',
+ public_key:der_encoded()} | map() %%map() -> ssl:key() how to handle dialyzer?
+ | secret_printout() | 'undefined',
password :: string() | secret_printout() | 'undefined',
cacerts :: [public_key:der_encoded()] | secret_printout() | 'undefined',
cacertfile :: binary(),
@@ -198,15 +197,6 @@
connection_cb
}).
--type key_map() :: #{algorithm := rsa | dss | ecdsa,
- %% engine and key_id ought to
- %% be :=, but putting it in
- %% the spec gives dialyzer warning
- %% of correct code!
- engine => crypto:engine_ref(),
- key_id => crypto:key_id(),
- password => crypto:password()
- }.
-type state_name() :: hello | abbreviated | certify | cipher | connection.
-type gen_fsm_state_return() :: {next_state, state_name(), term()} |
{next_state, state_name(), term(), timeout()} |
diff --git a/lib/ssl/src/ssl_logger.erl b/lib/ssl/src/ssl_logger.erl
index ce8225bf72..f497315235 100644
--- a/lib/ssl/src/ssl_logger.erl
+++ b/lib/ssl/src/ssl_logger.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -20,7 +20,7 @@
-module(ssl_logger).
--export([debug/3,
+-export([debug/4,
format/2,
notice/2]).
@@ -35,6 +35,8 @@
-include("ssl_cipher.hrl").
-include("ssl_internal.hrl").
-include("tls_handshake.hrl").
+-include("dtls_handshake.hrl").
+-include("tls_handshake_1_3.hrl").
-include_lib("kernel/include/logger.hrl").
%%-------------------------------------------------------------------------
@@ -45,24 +47,38 @@
format(#{level:= _Level, msg:= {report, Msg}, meta:= _Meta}, _Config0) ->
#{direction := Direction,
protocol := Protocol,
- message := BinMsg0} = Msg,
+ message := Content} = Msg,
case Protocol of
- 'tls_record' ->
- BinMsg = lists:flatten(BinMsg0),
+ 'record' ->
+ BinMsg =
+ case Content of
+ #ssl_tls{} ->
+ [tls_record:build_tls_record(Content)];
+ _ when is_list(Content) ->
+ lists:flatten(Content)
+ end,
format_tls_record(Direction, BinMsg);
'handshake' ->
- format_handshake(Direction, BinMsg0);
+ format_handshake(Direction, Content);
_Other ->
[]
end.
%% Stateful logging
-debug(Level, Report, Meta) ->
+debug(Level, Direction, Protocol, Message)
+ when (Direction =:= inbound orelse Direction =:= outbound) andalso
+ (Protocol =:= 'record' orelse Protocol =:= 'handshake') ->
case logger:compare_levels(Level, debug) of
lt ->
- ?LOG_DEBUG(Report, Meta);
+ ?LOG_DEBUG(#{direction => Direction,
+ protocol => Protocol,
+ message => Message},
+ #{domain => [otp,ssl,Protocol]});
eq ->
- ?LOG_DEBUG(Report, Meta);
+ ?LOG_DEBUG(#{direction => Direction,
+ protocol => Protocol,
+ message => Message},
+ #{domain => [otp,ssl,Protocol]});
_ ->
ok
end.
@@ -115,6 +131,11 @@ parse_handshake(Direction, #server_hello{
[?rec_info(server_hello,
ServerHello#server_hello{cipher_suite = CipherSuite})]),
{Header, Message};
+parse_handshake(Direction, #hello_verify_request{} = HelloVerifyRequest) ->
+ Header = io_lib:format("~s Handshake, HelloVerifyRequest",
+ [header_prefix(Direction)]),
+ Message = io_lib:format("~p", [?rec_info(hello_verify_request, HelloVerifyRequest)]),
+ {Header, Message};
parse_handshake(Direction, #certificate{} = Certificate) ->
Header = io_lib:format("~s Handshake, Certificate",
[header_prefix(Direction)]),
@@ -159,8 +180,29 @@ parse_handshake(Direction, #hello_request{} = HelloRequest) ->
Header = io_lib:format("~s Handshake, HelloRequest",
[header_prefix(Direction)]),
Message = io_lib:format("~p", [?rec_info(hello_request, HelloRequest)]),
+ {Header, Message};
+parse_handshake(Direction, #certificate_request_1_3{} = CertificateRequest) ->
+ Header = io_lib:format("~s Handshake, CertificateRequest",
+ [header_prefix(Direction)]),
+ Message = io_lib:format("~p", [?rec_info(certificate_request_1_3, CertificateRequest)]),
+ {Header, Message};
+parse_handshake(Direction, #certificate_1_3{} = Certificate) ->
+ Header = io_lib:format("~s Handshake, Certificate",
+ [header_prefix(Direction)]),
+ Message = io_lib:format("~p", [?rec_info(certificate_1_3, Certificate)]),
+ {Header, Message};
+parse_handshake(Direction, #certificate_verify_1_3{} = CertificateVerify) ->
+ Header = io_lib:format("~s Handshake, CertificateVerify",
+ [header_prefix(Direction)]),
+ Message = io_lib:format("~p", [?rec_info(certificate_verify_1_3, CertificateVerify)]),
+ {Header, Message};
+parse_handshake(Direction, #encrypted_extensions{} = EncryptedExtensions) ->
+ Header = io_lib:format("~s Handshake, EncryptedExtensions",
+ [header_prefix(Direction)]),
+ Message = io_lib:format("~p", [?rec_info(encrypted_extensions, EncryptedExtensions)]),
{Header, Message}.
+
parse_cipher_suites([_|_] = Ciphers) ->
[format_cipher(C) || C <- Ciphers].
@@ -197,9 +239,12 @@ version({3,1}) ->
"TLS 1.0";
version({3,0}) ->
"SSL 3.0";
+version({254,253}) ->
+ "DTLS 1.2";
+version({254,255}) ->
+ "DTLS 1.0";
version({M,N}) ->
- io_lib:format("TLS [0x0~B0~B]", [M,N]).
-
+ io_lib:format("TLS/DTLS [0x0~B0~B]", [M,N]).
header_prefix(inbound) ->
"<<<";
@@ -233,8 +278,12 @@ tls_record_version([<<?BYTE(B),?BYTE(3),?BYTE(1),_/binary>>|_]) ->
io_lib:format("TLS 1.0 Record Protocol, ~s", [msg_type(B)]);
tls_record_version([<<?BYTE(B),?BYTE(3),?BYTE(0),_/binary>>|_]) ->
io_lib:format("SSL 3.0 Record Protocol, ~s", [msg_type(B)]);
+tls_record_version([<<?BYTE(B),?BYTE(254),?BYTE(253),_/binary>>|_]) ->
+ io_lib:format("DTLS 1.2 Record Protocol, ~s", [msg_type(B)]);
+tls_record_version([<<?BYTE(B),?BYTE(254),?BYTE(255),_/binary>>|_]) ->
+ io_lib:format("DTLS 1.0 Record Protocol, ~s", [msg_type(B)]);
tls_record_version([<<?BYTE(B),?BYTE(M),?BYTE(N),_/binary>>|_]) ->
- io_lib:format("TLS [0x0~B0~B] Record Protocol, ~s", [M, N, msg_type(B)]).
+ io_lib:format("TLS/DTLS [0x0~B0~B] Record Protocol, ~s", [M, N, msg_type(B)]).
msg_type(20) -> "change_cipher_spec";
@@ -315,12 +364,12 @@ convert_to_hex(P, [H|T], Row, Acc, C) when is_integer(H) ->
C + 1).
-row_prefix(tls_record, N) ->
+row_prefix(_ , N) ->
S = string:pad(string:to_lower(erlang:integer_to_list(N, 16)),4,leading,$0),
lists:reverse(lists:flatten(S ++ " - ")).
-end_row(tls_record, Row) ->
+end_row(_, Row) ->
Row ++ " ".
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index b1f080b0fe..456a560bf6 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -42,6 +42,8 @@
-include("ssl_handshake.hrl").
-include("ssl_internal.hrl").
+-include("ssl_api.hrl").
+
-include_lib("kernel/include/file.hrl").
-record(state, {
@@ -148,7 +150,7 @@ lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) ->
ssl_pkix_db:lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer).
%%--------------------------------------------------------------------
--spec new_session_id(integer()) -> session_id().
+-spec new_session_id(integer()) -> ssl:session_id().
%%
%% Description: Creates a session id for the server.
%%--------------------------------------------------------------------
@@ -170,7 +172,7 @@ clean_cert_db(Ref, File) ->
%%
%% Description: Make the session available for reuse.
%%--------------------------------------------------------------------
--spec register_session(host(), inet:port_number(), #session{}, unique | true) -> ok.
+-spec register_session(ssl:host(), inet:port_number(), #session{}, unique | true) -> ok.
register_session(Host, Port, Session, true) ->
call({register_session, Host, Port, Session});
register_session(Host, Port, Session, unique = Save) ->
@@ -185,7 +187,7 @@ register_session(Port, Session) ->
%% a the session has been marked "is_resumable = false" for some while
%% it will be safe to remove the data from the session database.
%%--------------------------------------------------------------------
--spec invalidate_session(host(), inet:port_number(), #session{}) -> ok.
+-spec invalidate_session(ssl:host(), inet:port_number(), #session{}) -> ok.
invalidate_session(Host, Port, Session) ->
load_mitigation(),
cast({invalidate_session, Host, Port, Session}).
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index 499ba108f2..91f1876980 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2013-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2013-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -25,6 +25,7 @@
-module(ssl_record).
-include("ssl_record.hrl").
+-include("ssl_connection.hrl").
-include("ssl_internal.hrl").
-include("ssl_cipher.hrl").
-include("ssl_alert.hrl").
@@ -46,14 +47,16 @@
-export([compress/3, uncompress/3, compressions/0]).
%% Payload encryption/decryption
--export([cipher/4, decipher/4, cipher_aead/4, decipher_aead/5, is_correct_mac/2, nonce_seed/3]).
+-export([cipher/4, cipher/5, decipher/4,
+ cipher_aead/4, cipher_aead/5, decipher_aead/5,
+ is_correct_mac/2, nonce_seed/3]).
-export_type([ssl_version/0, ssl_atom_version/0, connection_states/0, connection_state/0]).
-type ssl_version() :: {integer(), integer()}.
-type ssl_atom_version() :: tls_record:tls_atom_version().
--type connection_states() :: term(). %% Map
--type connection_state() :: term(). %% Map
+-type connection_states() :: map(). %% Map
+-type connection_state() :: map(). %% Map
%%====================================================================
%% Connection state handling
@@ -119,17 +122,19 @@ activate_pending_connection_state(#{current_write := Current,
}.
%%--------------------------------------------------------------------
--spec step_encryption_state(connection_states()) -> connection_states().
+-spec step_encryption_state(#state{}) -> #state{}.
%%
%% Description: Activates the next encyrption state (e.g. handshake
%% encryption).
%%--------------------------------------------------------------------
-step_encryption_state(#{pending_read := PendingRead,
- pending_write := PendingWrite} = States) ->
+step_encryption_state(#state{connection_states =
+ #{pending_read := PendingRead,
+ pending_write := PendingWrite} = ConnStates} = State) ->
NewRead = PendingRead#{sequence_number => 0},
NewWrite = PendingWrite#{sequence_number => 0},
- States#{current_read => NewRead,
- current_write => NewWrite}.
+ State#state{connection_states =
+ ConnStates#{current_read => NewRead,
+ current_write => NewWrite}}.
%%--------------------------------------------------------------------
@@ -316,27 +321,49 @@ cipher(Version, Fragment,
#security_parameters{bulk_cipher_algorithm =
BulkCipherAlgo}
} = WriteState0, MacHash) ->
-
+ %%
{CipherFragment, CipherS1} =
ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version),
{CipherFragment, WriteState0#{cipher_state => CipherS1}}.
+
+%%--------------------------------------------------------------------
+-spec cipher(ssl_version(), iodata(), #cipher_state{}, MacHash::binary(), #security_parameters{}) ->
+ {CipherFragment::binary(), #cipher_state{}}.
+%%
+%% Description: Payload encryption
+%%--------------------------------------------------------------------
+cipher(Version, Fragment, CipherS0, MacHash,
+ #security_parameters{bulk_cipher_algorithm = BulkCipherAlgo}) ->
+ %%
+ ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version).
+
%%--------------------------------------------------------------------
-spec cipher_aead(ssl_version(), iodata(), connection_state(), AAD::binary()) ->
{CipherFragment::binary(), connection_state()}.
%% Description: Payload encryption
%% %%--------------------------------------------------------------------
-cipher_aead(Version, Fragment,
+cipher_aead(_Version, Fragment,
#{cipher_state := CipherS0,
security_parameters :=
#security_parameters{bulk_cipher_algorithm =
BulkCipherAlgo}
} = WriteState0, AAD) ->
{CipherFragment, CipherS1} =
- cipher_aead(BulkCipherAlgo, CipherS0, AAD, Fragment, Version),
+ do_cipher_aead(BulkCipherAlgo, Fragment, CipherS0, AAD),
{CipherFragment, WriteState0#{cipher_state => CipherS1}}.
%%--------------------------------------------------------------------
+-spec cipher_aead(ssl_version(), iodata(), #cipher_state{}, AAD::binary(), #security_parameters{}) ->
+ {CipherFragment::binary(), #cipher_state{}}.
+
+%% Description: Payload encryption
+%% %%--------------------------------------------------------------------
+cipher_aead(_Version, Fragment, CipherS, AAD,
+ #security_parameters{bulk_cipher_algorithm = BulkCipherAlgo}) ->
+ do_cipher_aead(BulkCipherAlgo, Fragment, CipherS, AAD).
+
+%%--------------------------------------------------------------------
-spec decipher(ssl_version(), binary(), connection_state(), boolean()) ->
{binary(), binary(), connection_state()} | #alert{}.
%%
@@ -357,9 +384,8 @@ decipher(Version, CipherFragment,
Alert
end.
%%--------------------------------------------------------------------
--spec decipher_aead(ssl_cipher:cipher_enum(), #cipher_state{},
- binary(), binary(), ssl_record:ssl_version()) ->
- {binary(), #cipher_state{}} | #alert{}.
+-spec decipher_aead(ssl_cipher:cipher_enum(), #cipher_state{}, binary(), binary(), ssl_record:ssl_version()) ->
+ binary() | #alert{}.
%%
%% Description: Decrypts the data and checks the associated data (AAD) MAC using
%% cipher described by cipher_enum() and updating the cipher state.
@@ -371,7 +397,7 @@ decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment
{AAD, CipherText, CipherTag} = aead_ciphertext_split(Type, CipherState, CipherFragment, AAD0),
case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of
Content when is_binary(Content) ->
- {Content, CipherState};
+ Content;
_ ->
?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed)
end
@@ -413,11 +439,13 @@ random() ->
Random_28_bytes = ssl_cipher:random_bytes(28),
<<?UINT32(Secs_since_1970), Random_28_bytes/binary>>.
+-compile({inline, [is_correct_mac/2]}).
is_correct_mac(Mac, Mac) ->
true;
is_correct_mac(_M,_H) ->
false.
+-compile({inline, [record_protocol_role/1]}).
record_protocol_role(client) ->
?CLIENT;
record_protocol_role(server) ->
@@ -441,13 +469,15 @@ initial_security_params(ConnectionEnd) ->
compression_algorithm = ?NULL},
ssl_cipher:security_parameters(?TLS_NULL_WITH_NULL_NULL, SecParams).
-cipher_aead(?CHACHA20_POLY1305 = Type, #cipher_state{key=Key} = CipherState, AAD0, Fragment, _Version) ->
- AAD = end_additional_data(AAD0, erlang:iolist_size(Fragment)),
+-define(end_additional_data(AAD, Len), << (begin(AAD)end)/binary, ?UINT16(begin(Len)end) >>).
+
+do_cipher_aead(?CHACHA20_POLY1305 = Type, Fragment, #cipher_state{key=Key} = CipherState, AAD0) ->
+ AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)),
Nonce = encrypt_nonce(Type, CipherState),
{Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD),
{<<Content/binary, CipherTag/binary>>, CipherState};
-cipher_aead(Type, #cipher_state{key=Key, nonce = ExplicitNonce} = CipherState, AAD0, Fragment, _Version) ->
- AAD = end_additional_data(AAD0, erlang:iolist_size(Fragment)),
+do_cipher_aead(Type, Fragment, #cipher_state{key=Key, nonce = ExplicitNonce} = CipherState, AAD0) ->
+ AAD = ?end_additional_data(AAD0, erlang:iolist_size(Fragment)),
Nonce = encrypt_nonce(Type, CipherState),
{Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD),
{<<ExplicitNonce:64/integer, Content/binary, CipherTag/binary>>, CipherState#cipher_state{nonce = ExplicitNonce + 1}}.
@@ -463,15 +493,12 @@ decrypt_nonce(?CHACHA20_POLY1305, #cipher_state{nonce = Nonce, iv = IV}, _) ->
decrypt_nonce(?AES_GCM, #cipher_state{iv = <<Salt:4/bytes, _/binary>>}, <<ExplicitNonce:8/bytes, _/binary>>) ->
<<Salt/binary, ExplicitNonce/binary>>.
+-compile({inline, [aead_ciphertext_split/4]}).
aead_ciphertext_split(?CHACHA20_POLY1305, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) ->
- CipherLen = size(CipherTextFragment) - Len,
+ CipherLen = byte_size(CipherTextFragment) - Len,
<<CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment,
- {end_additional_data(AAD, CipherLen), CipherText, CipherTag};
+ {?end_additional_data(AAD, CipherLen), CipherText, CipherTag};
aead_ciphertext_split(?AES_GCM, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) ->
- CipherLen = size(CipherTextFragment) - (Len + 8), %% 8 is length of explicit Nonce
+ CipherLen = byte_size(CipherTextFragment) - (Len + 8), %% 8 is length of explicit Nonce
<< _:8/bytes, CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment,
- {end_additional_data(AAD, CipherLen), CipherText, CipherTag}.
-
-end_additional_data(AAD, Len) ->
- <<AAD/binary, ?UINT16(Len)>>.
-
+ {?end_additional_data(AAD, CipherLen), CipherText, CipherTag}.
diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl
index 4cb19d9d0d..eb718fd20c 100644
--- a/lib/ssl/src/ssl_record.hrl
+++ b/lib/ssl/src/ssl_record.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -141,6 +141,8 @@
-define(HANDSHAKE, 22).
-define(APPLICATION_DATA, 23).
-define(HEARTBEAT, 24).
+-define(KNOWN_RECORD_TYPE(Type),
+ (is_integer(Type) andalso (20 =< (Type)) andalso ((Type) =< 23))).
-define(MAX_PLAIN_TEXT_LENGTH, 16384).
-define(MAX_COMPRESSED_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+1024)).
-define(MAX_CIPHER_TEXT_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+2048)).
diff --git a/lib/ssl/src/ssl_session.erl b/lib/ssl/src/ssl_session.erl
index a9759c9b43..44305c65fe 100644
--- a/lib/ssl/src/ssl_session.erl
+++ b/lib/ssl/src/ssl_session.erl
@@ -27,6 +27,7 @@
-include("ssl_handshake.hrl").
-include("ssl_internal.hrl").
+-include("ssl_api.hrl").
%% Internal application API
-export([is_new/2, client_id/4, server_id/6, valid_session/2]).
@@ -34,7 +35,7 @@
-type seconds() :: integer().
%%--------------------------------------------------------------------
--spec is_new(session_id(), session_id()) -> boolean().
+-spec is_new(ssl:session_id(), ssl:session_id()) -> boolean().
%%
%% Description: Checks if the session id decided by the server is a
%% new or resumed sesion id.
@@ -47,7 +48,7 @@ is_new(_ClientSuggestion, _ServerDecision) ->
true.
%%--------------------------------------------------------------------
--spec client_id({host(), inet:port_number(), #ssl_options{}}, db_handle(), atom(),
+-spec client_id({ssl:host(), inet:port_number(), #ssl_options{}}, db_handle(), atom(),
undefined | binary()) -> binary().
%%
%% Description: Should be called by the client side to get an id
diff --git a/lib/ssl/src/ssl_session_cache_api.erl b/lib/ssl/src/ssl_session_cache_api.erl
index b68c75a09b..5f96f905b1 100644
--- a/lib/ssl/src/ssl_session_cache_api.erl
+++ b/lib/ssl/src/ssl_session_cache_api.erl
@@ -23,14 +23,20 @@
-module(ssl_session_cache_api).
-include("ssl_handshake.hrl").
-include("ssl_internal.hrl").
+-include("ssl_api.hrl").
--type key() :: {{host(), inet:port_number()}, session_id()} | {inet:port_number(), session_id()}.
+-export_type([session_cache_key/0, session/0, partial_key/0, session_cache_ref/0]).
--callback init(list()) -> db_handle().
--callback terminate(db_handle()) -> any().
--callback lookup(db_handle(), key()) -> #session{} | undefined.
--callback update(db_handle(), key(), #session{}) -> any().
--callback delete(db_handle(), key()) -> any().
--callback foldl(fun(), term(), db_handle()) -> term().
--callback select_session(db_handle(), {host(), inet:port_number()} | inet:port_number()) -> [#session{}].
--callback size(db_handle()) -> integer().
+-type session_cache_ref() :: any().
+-type session_cache_key() :: {partial_key(), ssl:session_id()}.
+-opaque session() :: #session{}.
+-opaque partial_key() :: {ssl:host(), inet:port_number()} | inet:port_number().
+
+-callback init(list()) -> session_cache_ref().
+-callback terminate(session_cache_ref()) -> any().
+-callback lookup(session_cache_ref(), session_cache_key()) -> #session{} | undefined.
+-callback update(session_cache_ref(), session_cache_key(), #session{}) -> any().
+-callback delete(session_cache_ref(), session_cache_key()) -> any().
+-callback foldl(fun(), term(), session_cache_ref()) -> term().
+-callback select_session(session_cache_ref(), {ssl:host(), inet:port_number()} | inet:port_number()) -> [#session{}].
+-callback size(session_cache_ref()) -> integer().
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 26f9fc99d3..39df2ad15b 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -50,7 +50,8 @@
handle_protocol_record/3]).
%% Handshake handling
--export([renegotiation/2, renegotiate/2, send_handshake/2,
+-export([renegotiation/2, renegotiate/2, send_handshake/2,
+ send_handshake_flight/1,
queue_handshake/2, queue_change_cipher/2,
reinit/1, reinit_handshake_data/1, select_sni_extension/1,
empty_connection_state/2]).
@@ -58,11 +59,10 @@
%% Alert and close handling
-export([send_alert/2, send_alert_in_connection/2,
send_sync_alert/2,
- encode_alert/3, close/5, protocol_name/0]).
+ close/5, protocol_name/0]).
%% Data handling
--export([encode_data/3, next_record/1,
- send/3, socket/5, setopts/3, getopts/3]).
+-export([next_record/1, socket/4, setopts/3, getopts/3]).
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
@@ -126,7 +126,7 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} =
end.
%%--------------------------------------------------------------------
--spec start_link(atom(), pid(), host(), inet:port_number(), port(), list(), pid(), tuple()) ->
+-spec start_link(atom(), pid(), ssl:host(), inet:port_number(), port(), list(), pid(), tuple()) ->
{ok, pid()} | ignore | {error, reason()}.
%%
%% Description: Creates a gen_statem process which calls Module:init/1 to
@@ -167,20 +167,11 @@ next_record(#state{handshake_env =
{no_record, State#state{handshake_env =
HsEnv#handshake_env{unprocessed_handshake_events = N-1}}};
next_record(#state{protocol_buffers =
- #protocol_buffers{tls_packets = [], tls_cipher_texts = [#ssl_tls{type = Type}| _] = CipherTexts0}
- = Buffers,
- connection_states = ConnectionStates0,
- negotiated_version = Version,
+ #protocol_buffers{tls_cipher_texts = [_|_] = CipherTexts},
+ connection_states = ConnectionStates,
ssl_options = #ssl_options{padding_check = Check}} = State) ->
- case decode_cipher_texts(Version, Type, CipherTexts0, ConnectionStates0, Check, <<>>) of
- {#ssl_tls{} = Record, ConnectionStates, CipherTexts} ->
- {Record, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts},
- connection_states = ConnectionStates}};
- {#alert{} = Alert, ConnectionStates, CipherTexts} ->
- {Alert, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts},
- connection_states = ConnectionStates}}
- end;
-next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []},
+ next_record(State, CipherTexts, ConnectionStates, Check);
+next_record(#state{protocol_buffers = #protocol_buffers{tls_cipher_texts = []},
protocol_specific = #{active_n_toggle := true, active_n := N} = ProtocolSpec,
static_env = #static_env{socket = Socket,
close_tag = CloseTag,
@@ -196,16 +187,56 @@ next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_ci
next_record(State) ->
{no_record, State}.
+%% Decipher next record and concatenate consecutive ?APPLICATION_DATA records into one
+%%
+next_record(State, CipherTexts, ConnectionStates, Check) ->
+ next_record(State, CipherTexts, ConnectionStates, Check, []).
+%%
+next_record(#state{connection_env = #connection_env{negotiated_version = Version}} = State,
+ [CT|CipherTexts], ConnectionStates0, Check, Acc) ->
+ case tls_record:decode_cipher_text(Version, CT, ConnectionStates0, Check) of
+ {#ssl_tls{type = ?APPLICATION_DATA, fragment = Fragment}, ConnectionStates} ->
+ case CipherTexts of
+ [] ->
+ %% End of cipher texts - build and deliver an ?APPLICATION_DATA record
+ %% from the accumulated fragments
+ next_record_done(State, [], ConnectionStates,
+ #ssl_tls{type = ?APPLICATION_DATA,
+ fragment = iolist_to_binary(lists:reverse(Acc, [Fragment]))});
+ [_|_] ->
+ next_record(State, CipherTexts, ConnectionStates, Check, [Fragment|Acc])
+ end;
+ {Record, ConnectionStates} when Acc =:= [] ->
+ %% Singelton non-?APPLICATION_DATA record - deliver
+ next_record_done(State, CipherTexts, ConnectionStates, Record);
+ {_Record, _ConnectionStates_to_forget} ->
+ %% Not ?APPLICATION_DATA but we have accumulated fragments
+ %% -> build an ?APPLICATION_DATA record with concatenated fragments
+ %% and forget about decrypting this record - we'll decrypt it again next time
+ next_record_done(State, [CT|CipherTexts], ConnectionStates0,
+ #ssl_tls{type = ?APPLICATION_DATA, fragment = iolist_to_binary(lists:reverse(Acc))});
+ #alert{} = Alert ->
+ Alert
+ end.
+
+next_record_done(#state{protocol_buffers = Buffers} = State, CipherTexts, ConnectionStates, Record) ->
+ {Record,
+ State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = CipherTexts},
+ connection_states = ConnectionStates}}.
+
+
next_event(StateName, Record, State) ->
next_event(StateName, Record, State, []).
+%%
next_event(StateName, no_record, State0, Actions) ->
case next_record(State0) of
{no_record, State} ->
{next_state, StateName, State, Actions};
{#ssl_tls{} = Record, State} ->
{next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
- {#alert{} = Alert, State} ->
- {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
+ #alert{} = Alert ->
+ Version = State0#state.connection_env#connection_env.negotiated_version,
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
end;
next_event(StateName, Record, State, Actions) ->
case Record of
@@ -214,40 +245,30 @@ next_event(StateName, Record, State, Actions) ->
#ssl_tls{} = Record ->
{next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
#alert{} = Alert ->
- {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
+ Version = State#state.connection_env#connection_env.negotiated_version,
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State)
end.
-decode_cipher_texts(_, Type, [] = CipherTexts, ConnectionStates, _, Acc) ->
- {#ssl_tls{type = Type, fragment = Acc}, ConnectionStates, CipherTexts};
-decode_cipher_texts(Version, Type,
- [#ssl_tls{type = Type} = CT | CipherTexts], ConnectionStates0, Check, Acc) ->
- case tls_record:decode_cipher_text(Version, CT, ConnectionStates0, Check) of
- {#ssl_tls{type = ?APPLICATION_DATA, fragment = Plain}, ConnectionStates} ->
- decode_cipher_texts(Version, Type, CipherTexts,
- ConnectionStates, Check, <<Acc/binary, Plain/binary>>);
- {#ssl_tls{type = Type, fragment = Plain}, ConnectionStates} ->
- {#ssl_tls{type = Type, fragment = Plain}, ConnectionStates, CipherTexts};
- #alert{} = Alert ->
- {Alert, ConnectionStates0, CipherTexts}
- end;
-decode_cipher_texts(_, Type, CipherTexts, ConnectionStates, _, Acc) ->
- {#ssl_tls{type = Type, fragment = Acc}, ConnectionStates, CipherTexts}.
%%% TLS record protocol level application data messages
-handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State0) ->
+handle_protocol_record(#ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName0, State0) ->
case ssl_connection:read_application_data(Data, State0) of
{stop, _, _} = Stop->
Stop;
{Record, State1} ->
- {next_state, StateName, State, Actions} = next_event(StateName, Record, State1),
- ssl_connection:hibernate_after(StateName, State, Actions)
+ case next_event(StateName0, Record, State1) of
+ {next_state, StateName, State, Actions} ->
+ ssl_connection:hibernate_after(StateName, State, Actions);
+ {stop, _, _} = Stop ->
+ Stop
+ end
end;
%%% TLS record protocol level handshake messages
handle_protocol_record(#ssl_tls{type = ?HANDSHAKE, fragment = Data},
StateName, #state{protocol_buffers =
#protocol_buffers{tls_handshake_buffer = Buf0} = Buffers,
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
ssl_options = Options} = State0) ->
try
EffectiveVersion = effective_version(Version, Options),
@@ -281,15 +302,13 @@ handle_protocol_record(#ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, St
{next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]};
%%% TLS record protocol level Alert messages
handle_protocol_record(#ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName,
- #state{negotiated_version = Version} = State) ->
+ #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try decode_alerts(EncAlerts) of
Alerts = [_|_] ->
handle_alerts(Alerts, {next_state, StateName, State});
[] ->
ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, empty_alert),
- Version, StateName, State);
- #alert{} = Alert ->
- ssl_connection:handle_own_alert(Alert, Version, StateName, State)
+ Version, StateName, State)
catch
_:_ ->
ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, alert_decode_error),
@@ -316,14 +335,14 @@ renegotiate(#state{static_env = #static_env{role = server,
socket = Socket,
transport_cb = Transport},
handshake_env = HsEnv,
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
connection_states = ConnectionStates0} = State0, Actions) ->
HelloRequest = ssl_handshake:hello_request(),
Frag = tls_handshake:encode_handshake(HelloRequest, Version),
Hs0 = ssl_handshake:init_handshake_history(),
{BinMsg, ConnectionStates} =
tls_record:encode_handshake(Frag, Version, ConnectionStates0),
- send(Transport, Socket, BinMsg),
+ tls_socket:send(Transport, Socket, BinMsg),
State = State0#state{connection_states =
ConnectionStates,
handshake_env = HsEnv#handshake_env{tls_handshake_history = Hs0}},
@@ -332,21 +351,16 @@ renegotiate(#state{static_env = #static_env{role = server,
send_handshake(Handshake, State) ->
send_handshake_flight(queue_handshake(Handshake, State)).
-queue_handshake(Handshake, #state{negotiated_version = Version,
- handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv,
- flight_buffer = Flight0,
- connection_states = ConnectionStates0,
- ssl_options = SslOpts} = State0) ->
+
+queue_handshake(Handshake, #state{handshake_env = #handshake_env{tls_handshake_history = Hist0} = HsEnv,
+ connection_env = #connection_env{negotiated_version = Version},
+ flight_buffer = Flight0,
+ ssl_options = SslOpts,
+ connection_states = ConnectionStates0} = State0) ->
{BinHandshake, ConnectionStates, Hist} =
encode_handshake(Handshake, Version, ConnectionStates0, Hist0),
- Report = #{direction => outbound,
- protocol => 'tls_record',
- message => BinHandshake},
- HandshakeMsg = #{direction => outbound,
- protocol => 'handshake',
- message => Handshake},
- ssl_logger:debug(SslOpts#ssl_options.log_level, HandshakeMsg, #{domain => [otp,ssl,handshake]}),
- ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Handshake),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'record', BinHandshake),
State0#state{connection_states = ConnectionStates,
handshake_env = HsEnv#handshake_env{tls_handshake_history = Hist},
@@ -355,24 +369,22 @@ queue_handshake(Handshake, #state{negotiated_version = Version,
send_handshake_flight(#state{static_env = #static_env{socket = Socket,
transport_cb = Transport},
flight_buffer = Flight} = State0) ->
- send(Transport, Socket, Flight),
+ tls_socket:send(Transport, Socket, Flight),
{State0#state{flight_buffer = []}, []}.
-queue_change_cipher(Msg, #state{negotiated_version = Version,
+
+queue_change_cipher(Msg, #state{connection_env = #connection_env{negotiated_version = Version},
flight_buffer = Flight0,
- connection_states = ConnectionStates0,
- ssl_options = SslOpts} = State0) ->
+ ssl_options = SslOpts,
+ connection_states = ConnectionStates0} = State0) ->
{BinChangeCipher, ConnectionStates} =
encode_change_cipher(Msg, Version, ConnectionStates0),
- Report = #{direction => outbound,
- protocol => 'tls_record',
- message => BinChangeCipher},
- ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'record', BinChangeCipher),
State0#state{connection_states = ConnectionStates,
flight_buffer = Flight0 ++ [BinChangeCipher]}.
reinit(#state{protocol_specific = #{sender := Sender},
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
connection_states = #{current_write := Write}} = State) ->
tls_sender:update_connection_state(Sender, Write, Version),
reinit_handshake_data(State).
@@ -382,9 +394,9 @@ reinit_handshake_data(#state{handshake_env = HsEnv} =State) ->
%% are only needed during the handshake phase.
%% To reduce memory foot print of a connection reinitialize them.
State#state{
- premaster_secret = undefined,
- public_key_info = undefined,
- handshake_env = HsEnv#handshake_env{tls_handshake_history = ssl_handshake:init_handshake_history()}
+ handshake_env = HsEnv#handshake_env{tls_handshake_history = ssl_handshake:init_handshake_history(),
+ public_key_info = undefined,
+ premaster_secret = undefined}
}.
select_sni_extension(#client_hello{extensions = #{sni := SNI}}) ->
@@ -408,18 +420,15 @@ empty_connection_state(ConnectionEnd, BeastMitigation) ->
encode_alert(#alert{} = Alert, Version, ConnectionStates) ->
tls_record:encode_alert_record(Alert, Version, ConnectionStates).
-send_alert(Alert, #state{negotiated_version = Version,
- static_env = #static_env{socket = Socket,
+send_alert(Alert, #state{static_env = #static_env{socket = Socket,
transport_cb = Transport},
+ connection_env = #connection_env{negotiated_version = Version},
ssl_options = SslOpts,
connection_states = ConnectionStates0} = StateData0) ->
{BinMsg, ConnectionStates} =
encode_alert(Alert, Version, ConnectionStates0),
- send(Transport, Socket, BinMsg),
- Report = #{direction => outbound,
- protocol => 'tls_record',
- message => BinMsg},
- ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}),
+ tls_socket:send(Transport, Socket, BinMsg),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'record', BinMsg),
StateData0#state{connection_states = ConnectionStates}.
%% If an ALERT sent in the connection state, should cause the TLS
@@ -473,14 +482,9 @@ protocol_name() ->
%%====================================================================
%% Data handling
%%====================================================================
-encode_data(Data, Version, ConnectionStates0)->
- tls_record:encode_data(Data, Version, ConnectionStates0).
-
-send(Transport, Socket, Data) ->
- tls_socket:send(Transport, Socket, Data).
-socket(Pids, Transport, Socket, Connection, Tracker) ->
- tls_socket:socket(Pids, Transport, Socket, Connection, Tracker).
+socket(Pids, Transport, Socket, Tracker) ->
+ tls_socket:socket(Pids, Transport, Socket, ?MODULE, Tracker).
setopts(Transport, Socket, Other) ->
tls_socket:setopts(Transport, Socket, Other).
@@ -506,12 +510,12 @@ init({call, From}, {start, Timeout},
session_cache = Cache,
session_cache_cb = CacheCb},
handshake_env = #handshake_env{renegotiation = {Renegotiation, _}} = HsEnv,
+ connection_env = CEnv,
ssl_options = SslOpts,
session = #session{own_certificate = Cert} = Session0,
connection_states = ConnectionStates0
} = State0) ->
KeyShare = maybe_generate_client_shares(SslOpts),
- Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From),
Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts,
Cache, CacheCb, Renegotiation, Cert, KeyShare),
@@ -519,24 +523,18 @@ init({call, From}, {start, Timeout},
Handshake0 = ssl_handshake:init_handshake_history(),
{BinMsg, ConnectionStates, Handshake} =
encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0),
- send(Transport, Socket, BinMsg),
- Report = #{direction => outbound,
- protocol => 'tls_record',
- message => BinMsg},
- HelloMsg = #{direction => outbound,
- protocol => 'handshake',
- message => Hello},
- ssl_logger:debug(SslOpts#ssl_options.log_level, HelloMsg, #{domain => [otp,ssl,handshake]}),
- ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}),
+ tls_socket:send(Transport, Socket, BinMsg),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'handshake', Hello),
+ ssl_logger:debug(SslOpts#ssl_options.log_level, outbound, 'record', BinMsg),
+
State = State0#state{connection_states = ConnectionStates,
- negotiated_version = HelloVersion, %% Requested version
+ connection_env = CEnv#connection_env{negotiated_version = HelloVersion}, %% Requested version
session =
Session0#session{session_id = Hello#client_hello.session_id},
handshake_env = HsEnv#handshake_env{tls_handshake_history = Handshake},
start_or_recv_from = From,
- timer = Timer,
- key_share = KeyShare},
- next_event(hello, no_record, State);
+ key_share = KeyShare},
+ next_event(hello, no_record, State, [{{timeout, handshake}, Timeout, close}]);
init(Type, Event, State) ->
gen_handshake(?FUNCTION_NAME, Type, Event, State).
@@ -564,26 +562,30 @@ error(_, _, _) ->
%%--------------------------------------------------------------------
hello(internal, #client_hello{extensions = Extensions} = Hello,
#state{ssl_options = #ssl_options{handshake = hello},
+ handshake_env = HsEnv,
start_or_recv_from = From} = State) ->
{next_state, user_hello, State#state{start_or_recv_from = undefined,
- hello = Hello},
+ handshake_env = HsEnv#handshake_env{hello = Hello}},
[{reply, From, {ok, Extensions}}]};
hello(internal, #server_hello{extensions = Extensions} = Hello,
#state{ssl_options = #ssl_options{handshake = hello},
+ handshake_env = HsEnv,
start_or_recv_from = From} = State) ->
{next_state, user_hello, State#state{start_or_recv_from = undefined,
- hello = Hello},
+ handshake_env = HsEnv#handshake_env{hello = Hello}},
[{reply, From, {ok, Extensions}}]};
+
hello(internal, #client_hello{client_version = ClientVersion} = Hello,
#state{connection_states = ConnectionStates0,
static_env = #static_env{
port = Port,
session_cache = Cache,
session_cache_cb = CacheCb},
- handshake_env = #handshake_env{renegotiation = {Renegotiation, _}} = HsEnv,
+ handshake_env = #handshake_env{kex_algorithm = KeyExAlg,
+ renegotiation = {Renegotiation, _},
+ negotiated_protocol = CurrentProtocol} = HsEnv,
+ connection_env = CEnv,
session = #session{own_certificate = Cert} = Session0,
- negotiated_protocol = CurrentProtocol,
- key_algorithm = KeyExAlg,
ssl_options = SslOpts} = State) ->
case choose_tls_version(SslOpts, Hello) of
@@ -598,8 +600,8 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello,
Renegotiation) of
#alert{} = Alert ->
ssl_connection:handle_own_alert(Alert, ClientVersion, hello,
- State#state{negotiated_version
- = ClientVersion});
+ State#state{connection_env = CEnv#connection_env{negotiated_version
+ = ClientVersion}});
{Version, {Type, Session},
ConnectionStates, Protocol0, ServerHelloExt, HashSign} ->
Protocol = case Protocol0 of
@@ -610,24 +612,26 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello,
internal,
{common_client_hello, Type, ServerHelloExt},
State#state{connection_states = ConnectionStates,
- negotiated_version = Version,
- hashsign_algorithm = HashSign,
- handshake_env = HsEnv#handshake_env{client_hello_version =
- ClientVersion},
- session = Session,
- negotiated_protocol = Protocol})
+ connection_env = CEnv#connection_env{negotiated_version = Version},
+ handshake_env = HsEnv#handshake_env{
+ hashsign_algorithm = HashSign,
+ client_hello_version = ClientVersion,
+ negotiated_protocol = Protocol},
+ session = Session
+ })
end
+
end;
hello(internal, #server_hello{} = Hello,
#state{connection_states = ConnectionStates0,
- negotiated_version = ReqVersion,
+ connection_env = #connection_env{negotiated_version = ReqVersion} = CEnv,
static_env = #static_env{role = client},
handshake_env = #handshake_env{renegotiation = {Renegotiation, _}},
ssl_options = SslOptions} = State) ->
case tls_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
- #alert{} = Alert ->
+ #alert{} = Alert -> %%TODO
ssl_connection:handle_own_alert(Alert, ReqVersion, hello,
- State#state{negotiated_version = ReqVersion});
+ State#state{connection_env = CEnv#connection_env{negotiated_version = ReqVersion}});
{Version, NewId, ConnectionStates, ProtoExt, Protocol} ->
ssl_connection:handle_session(Hello,
Version, NewId, ConnectionStates, ProtoExt, Protocol, State)
@@ -680,13 +684,16 @@ connection({call, From}, {user_renegotiate, WriteState},
[{next_event,{call, From}, renegotiate}]};
connection({call, From},
{close, {Pid, _Timeout}},
- #state{terminated = closed} = State) ->
- {next_state, downgrade, State#state{terminated = true, downgrade = {Pid, From}},
+ #state{connection_env = #connection_env{terminated = closed} =CEnv} = State) ->
+ {next_state, downgrade, State#state{connection_env =
+ CEnv#connection_env{terminated = true,
+ downgrade = {Pid, From}}},
[{next_event, internal, ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY)}]};
connection({call, From},
{close,{Pid, Timeout}},
#state{connection_states = ConnectionStates,
- protocol_specific = #{sender := Sender}
+ protocol_specific = #{sender := Sender},
+ connection_env = CEnv
} = State0) ->
case tls_sender:downgrade(Sender, Timeout) of
{ok, Write} ->
@@ -697,8 +704,10 @@ connection({call, From},
State = send_alert(?ALERT_REC(?WARNING, ?CLOSE_NOTIFY),
State0#state{connection_states =
ConnectionStates#{current_write => Write}}),
- {next_state, downgrade, State#state{downgrade = {Pid, From},
- terminated = true}, [{timeout, Timeout, downgrade}]};
+ {next_state, downgrade, State#state{connection_env =
+ CEnv#connection_env{downgrade = {Pid, From},
+ terminated = true}},
+ [{timeout, Timeout, downgrade}]};
{error, timeout} ->
{stop_and_reply, {shutdown, downgrade_fail}, [{reply, From, {error, timeout}}]}
end;
@@ -742,8 +751,7 @@ connection(internal, #hello_request{},
= Hello#client_hello.session_id}}, Actions);
connection(internal, #client_hello{} = Hello,
#state{static_env = #static_env{role = server},
- handshake_env = HsEnv,
- allow_renegotiate = true,
+ handshake_env = #handshake_env{allow_renegotiate = true}= HsEnv,
connection_states = CS,
protocol_specific = #{sender := Sender}
} = State) ->
@@ -755,17 +763,16 @@ connection(internal, #client_hello{} = Hello,
erlang:send_after(?WAIT_TO_ALLOW_RENEGOTIATION, self(), allow_renegotiate),
{ok, Write} = tls_sender:renegotiate(Sender),
next_event(hello, no_record, State#state{connection_states = CS#{current_write => Write},
- allow_renegotiate = false,
- handshake_env = HsEnv#handshake_env{renegotiation = {true, peer}}
+ handshake_env = HsEnv#handshake_env{renegotiation = {true, peer},
+ allow_renegotiate = false}
},
[{next_event, internal, Hello}]);
connection(internal, #client_hello{},
- #state{static_env = #static_env{role = server,
- protocol_cb = Connection},
- allow_renegotiate = false} = State0) ->
+ #state{static_env = #static_env{role = server},
+ handshake_env = #handshake_env{allow_renegotiate = false}} = State0) ->
Alert = ?ALERT_REC(?WARNING, ?NO_RENEGOTIATION),
send_alert_in_connection(Alert, State0),
- State = Connection:reinit_handshake_data(State0),
+ State = reinit_handshake_data(State0),
next_event(?FUNCTION_NAME, no_record, State);
connection(Type, Event, State) ->
@@ -778,15 +785,16 @@ connection(Type, Event, State) ->
downgrade(internal, #alert{description = ?CLOSE_NOTIFY},
#state{static_env = #static_env{transport_cb = Transport,
socket = Socket},
- downgrade = {Pid, From}} = State) ->
+ connection_env = #connection_env{downgrade = {Pid, From}}} = State) ->
tls_socket:setopts(Transport, Socket, [{active, false}, {packet, 0}, {mode, binary}]),
Transport:controlling_process(Socket, Pid),
{stop_and_reply, {shutdown, downgrade},[{reply, From, {ok, Socket}}], State};
-downgrade(timeout, downgrade, #state{downgrade = {_, From}} = State) ->
+downgrade(timeout, downgrade, #state{ connection_env = #connection_env{downgrade = {_, From}}} = State) ->
{stop_and_reply, {shutdown, normal},[{reply, From, {error, timeout}}], State};
downgrade(info, {CloseTag, Socket},
#state{static_env = #static_env{socket = Socket,
- close_tag = CloseTag}, downgrade = {_, From}} =
+ close_tag = CloseTag},
+ connection_env = #connection_env{downgrade = {_, From}}} =
State) ->
{stop_and_reply, {shutdown, normal},[{reply, From, {error, CloseTag}}], State};
downgrade(info, Info, State) ->
@@ -965,16 +973,16 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac
static_env = InitStatEnv,
handshake_env = #handshake_env{
tls_handshake_history = ssl_handshake:init_handshake_history(),
- renegotiation = {false, first}
+ renegotiation = {false, first},
+ allow_renegotiate = SSLOptions#ssl_options.client_renegotiation
},
+ connection_env = #connection_env{user_application = {UserMonitor, User}},
socket_options = SocketOptions,
ssl_options = SSLOptions,
session = #session{is_resumable = new},
connection_states = ConnectionStates,
protocol_buffers = #protocol_buffers{},
- user_application = {UserMonitor, User},
- user_data_buffer = <<>>,
- allow_renegotiate = SSLOptions#ssl_options.client_renegotiation,
+ user_data_buffer = {[],0,[]},
start_or_recv_from = undefined,
flight_buffer = [],
protocol_specific = #{sender => Sender,
@@ -986,12 +994,11 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac
initialize_tls_sender(#state{static_env = #static_env{
role = Role,
transport_cb = Transport,
- protocol_cb = Connection,
socket = Socket,
tracker = Tracker
},
- socket_options = SockOpts,
- negotiated_version = Version,
+ connection_env = #connection_env{negotiated_version = Version},
+ socket_options = SockOpts,
ssl_options = #ssl_options{renegotiate_at = RenegotiateAt,
log_level = LogLevel},
connection_states = #{current_write := ConnectionWriteState},
@@ -1001,20 +1008,29 @@ initialize_tls_sender(#state{static_env = #static_env{
socket => Socket,
socket_options => SockOpts,
tracker => Tracker,
- protocol_cb => Connection,
transport_cb => Transport,
negotiated_version => Version,
renegotiate_at => RenegotiateAt,
log_level => LogLevel},
tls_sender:initialize(Sender, Init).
-
-next_tls_record(Data, StateName, #state{protocol_buffers =
- #protocol_buffers{tls_record_buffer = Buf0,
- tls_cipher_texts = CT0} = Buffers,
- ssl_options = SslOpts} = State0) ->
- case tls_record:get_tls_records(Data,
- acceptable_record_versions(StateName, State0),
- Buf0, SslOpts) of
+
+next_tls_record(Data, StateName,
+ #state{protocol_buffers =
+ #protocol_buffers{tls_record_buffer = Buf0,
+ tls_cipher_texts = CT0} = Buffers,
+ ssl_options = SslOpts} = State0) ->
+ Versions =
+ %% TLS 1.3 Client/Server
+ %% - Ignore TLSPlaintext.legacy_record_version
+ %% - Verify that TLSCiphertext.legacy_record_version is set to 0x0303 for all records
+ %% other than an initial ClientHello, where it MAY also be 0x0301.
+ case StateName of
+ hello ->
+ [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS];
+ _ ->
+ State0#state.connection_env#connection_env.negotiated_version
+ end,
+ case tls_record:get_tls_records(Data, Versions, Buf0, SslOpts) of
{Records, Buf1} ->
CT1 = CT0 ++ Records,
next_record(State0#state{protocol_buffers =
@@ -1024,14 +1040,6 @@ next_tls_record(Data, StateName, #state{protocol_buffers =
handle_record_alert(Alert, State0)
end.
-%% TLS 1.3 Client/Server
-%% - Ignore TLSPlaintext.legacy_record_version
-%% - Verify that TLSCiphertext.legacy_record_version is set to 0x0303 for all records
-%% other than an initial ClientHello, where it MAY also be 0x0301.
-acceptable_record_versions(StateName, #state{negotiated_version = Version}) when StateName =/= hello->
- Version;
-acceptable_record_versions(hello, _) ->
- [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS].
handle_record_alert(Alert, _) ->
Alert.
@@ -1059,18 +1067,18 @@ handle_info({tcp_passive, Socket}, StateName,
State#state{protocol_specific = PS#{active_n_toggle => true}});
handle_info({CloseTag, Socket}, StateName,
#state{static_env = #static_env{socket = Socket, close_tag = CloseTag},
+ connection_env = #connection_env{negotiated_version = Version},
socket_options = #socket_options{active = Active},
protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs},
- user_data_buffer = Buffer,
- protocol_specific = PS,
- negotiated_version = Version} = State) ->
+ user_data_buffer = {_,BufferSize,_},
+ protocol_specific = PS} = State) ->
%% Note that as of TLS 1.1,
%% failure to properly close a connection no longer requires that a
%% session not be resumed. This is a change from TLS 1.0 to conform
%% with widespread implementation practice.
- case (Active == false) andalso ((CTs =/= []) or (Buffer =/= <<>>)) of
+ case (Active == false) andalso ((CTs =/= []) or (BufferSize =/= 0)) of
false ->
case Version of
{1, N} when N >= 1 ->
@@ -1103,11 +1111,13 @@ handle_alerts([], Result) ->
handle_alerts(_, {stop, _, _} = Stop) ->
Stop;
handle_alerts([#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} | _Alerts],
- {next_state, connection = StateName, #state{user_data_buffer = Buffer,
+ {next_state, connection = StateName, #state{connection_env = CEnv,
+ socket_options = #socket_options{active = false},
+ user_data_buffer = {_,BufferSize,_},
protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}} =
- State}) when (Buffer =/= <<>>) orelse
+ State}) when (BufferSize =/= 0) orelse
(CTs =/= []) ->
- {next_state, StateName, State#state{terminated = true}};
+ {next_state, StateName, State#state{connection_env = CEnv#connection_env{terminated = true}}};
handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State));
handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) ->
@@ -1123,11 +1133,12 @@ encode_handshake(Handshake, Version, ConnectionStates0, Hist0) ->
encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) ->
tls_record:encode_change_cipher_spec(Version, ConnectionStates).
+-spec decode_alerts(binary()) -> list().
decode_alerts(Bin) ->
ssl_alert:decode(Bin).
gen_handshake(StateName, Type, Event,
- #state{negotiated_version = Version} = State) ->
+ #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try ssl_connection:StateName(Type, Event, State, ?MODULE) of
Result ->
Result
@@ -1138,8 +1149,9 @@ gen_handshake(StateName, Type, Event,
Version, StateName, State)
end.
+
gen_handshake_1_3(StateName, Type, Event,
- #state{negotiated_version = Version} = State) ->
+ #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try tls_connection_1_3:StateName(Type, Event, State, ?MODULE) of
Result ->
Result
@@ -1150,18 +1162,19 @@ gen_handshake_1_3(StateName, Type, Event,
Version, StateName, State)
end.
-gen_info(Event, connection = StateName, #state{negotiated_version = Version} = State) ->
+
+gen_info(Event, connection = StateName, #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try handle_info(Event, StateName, State) of
Result ->
Result
catch
- _:_ ->
+ _:_ ->
ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR,
malformed_data),
Version, StateName, State)
end;
-gen_info(Event, StateName, #state{negotiated_version = Version} = State) ->
+gen_info(Event, StateName, #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try handle_info(Event, StateName, State) of
Result ->
Result
@@ -1172,18 +1185,18 @@ gen_info(Event, StateName, #state{negotiated_version = Version} = State) ->
Version, StateName, State)
end.
-gen_info_1_3(Event, connected = StateName, #state{negotiated_version = Version} = State) ->
+gen_info_1_3(Event, connected = StateName, #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try handle_info(Event, StateName, State) of
Result ->
Result
catch
- _:_ ->
+ _:_ ->
ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR,
malformed_data),
Version, StateName, State)
end;
-gen_info_1_3(Event, StateName, #state{negotiated_version = Version} = State) ->
+gen_info_1_3(Event, StateName, #state{connection_env = #connection_env{negotiated_version = Version}} = State) ->
try handle_info(Event, StateName, State) of
Result ->
Result
diff --git a/lib/ssl/src/tls_connection.hrl b/lib/ssl/src/tls_connection.hrl
index 0af2258932..9063b1b736 100644
--- a/lib/ssl/src/tls_connection.hrl
+++ b/lib/ssl/src/tls_connection.hrl
@@ -30,7 +30,6 @@
-include("tls_record.hrl").
-record(protocol_buffers, {
- tls_packets = [], %% :: [#ssl_tls{}], % Not yet handled decode SSL/TLS packets.
tls_record_buffer = <<>>, %% :: binary(), % Buffer of incomplete records
tls_handshake_buffer = <<>>, %% :: binary(), % Buffer of incomplete handshakes
tls_cipher_texts = [] %%:: [binary()]
diff --git a/lib/ssl/src/tls_connection_1_3.erl b/lib/ssl/src/tls_connection_1_3.erl
index a20499972b..701a5860c2 100644
--- a/lib/ssl/src/tls_connection_1_3.erl
+++ b/lib/ssl/src/tls_connection_1_3.erl
@@ -109,82 +109,84 @@
%% gen_statem helper functions
-export([start/4,
- negotiated/4
+ negotiated/4,
+ wait_cert/4,
+ wait_cv/4,
+ wait_finished/4
]).
-start(internal,
- #client_hello{} = Hello,
- #state{connection_states = _ConnectionStates0,
- ssl_options = #ssl_options{ciphers = _ServerCiphers,
- signature_algs = _ServerSignAlgs,
- signature_algs_cert = _SignatureSchemes, %% TODO: Check??
- supported_groups = _ServerGroups0,
- versions = _Versions} = SslOpts,
- session = #session{own_certificate = Cert}} = State0,
- _Module) ->
- Env = #{cert => Cert},
- case tls_handshake_1_3:handle_client_hello(Hello, SslOpts, Env) of
+start(internal, #change_cipher_spec{}, State0, _Module) ->
+ {Record, State} = tls_connection:next_record(State0),
+ tls_connection:next_event(?FUNCTION_NAME, Record, State);
+start(internal, #client_hello{} = Hello, State0, _Module) ->
+ case tls_handshake_1_3:do_start(Hello, State0) of
#alert{} = Alert ->
ssl_connection:handle_own_alert(Alert, {3,4}, start, State0);
- M ->
- %% update connection_states with cipher
- State = update_state(State0, M),
- {next_state, negotiated, State, [{next_event, internal, M}]}
-
- end.
+ {State, start} ->
+ {next_state, start, State, []};
+ {State, negotiated} ->
+ {next_state, negotiated, State, [{next_event, internal, start_handshake}]}
+ end;
+start(Type, Msg, State, Connection) ->
+ ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
-negotiated(internal,
- Map,
- #state{connection_states = ConnectionStates0,
- session = #session{session_id = SessionId,
- own_certificate = OwnCert},
- ssl_options = #ssl_options{} = SslOpts,
- key_share = KeyShare,
- handshake_env = #handshake_env{tls_handshake_history = HHistory0},
- private_key = CertPrivateKey,
- static_env = #static_env{
- cert_db = CertDbHandle,
- cert_db_ref = CertDbRef,
- socket = Socket,
- transport_cb = Transport}} = State0, _Module) ->
- Env = #{connection_states => ConnectionStates0,
- session_id => SessionId,
- own_certificate => OwnCert,
- cert_db => CertDbHandle,
- cert_db_ref => CertDbRef,
- ssl_options => SslOpts,
- key_share => KeyShare,
- tls_handshake_history => HHistory0,
- transport_cb => Transport,
- socket => Socket,
- private_key => CertPrivateKey},
- case tls_handshake_1_3:do_negotiated(Map, Env) of
+negotiated(internal, #change_cipher_spec{}, State0, _Module) ->
+ {Record, State} = tls_connection:next_record(State0),
+ tls_connection:next_event(?FUNCTION_NAME, Record, State);
+negotiated(internal, Message, State0, _Module) ->
+ case tls_handshake_1_3:do_negotiated(Message, State0) of
#alert{} = Alert ->
ssl_connection:handle_own_alert(Alert, {3,4}, negotiated, State0);
- M ->
- %% TODO: implement update_state
- %% State = update_state(State0, M),
- {next_state, wait_flight2, State0, [{next_event, internal, M}]}
-
+ {State, NextState} ->
+ {next_state, NextState, State, []}
end.
-update_state(#state{connection_states = ConnectionStates0,
- session = Session} = State,
- #{cipher := Cipher,
- key_share := KeyShare,
- session_id := SessionId}) ->
- #{security_parameters := SecParamsR0} = PendingRead =
- maps:get(pending_read, ConnectionStates0),
- #{security_parameters := SecParamsW0} = PendingWrite =
- maps:get(pending_write, ConnectionStates0),
- SecParamsR = ssl_cipher:security_parameters_1_3(SecParamsR0, Cipher),
- SecParamsW = ssl_cipher:security_parameters_1_3(SecParamsW0, Cipher),
- ConnectionStates =
- ConnectionStates0#{pending_read => PendingRead#{security_parameters => SecParamsR},
- pending_write => PendingWrite#{security_parameters => SecParamsW}},
- State#state{connection_states = ConnectionStates,
- key_share = KeyShare,
- session = Session#session{session_id = SessionId}}.
+wait_cert(internal, #change_cipher_spec{}, State0, _Module) ->
+ {Record, State} = tls_connection:next_record(State0),
+ tls_connection:next_event(?FUNCTION_NAME, Record, State);
+wait_cert(internal,
+ #certificate_1_3{} = Certificate, State0, _Module) ->
+ case tls_handshake_1_3:do_wait_cert(Certificate, State0) of
+ {#alert{} = Alert, State} ->
+ ssl_connection:handle_own_alert(Alert, {3,4}, wait_cert, State);
+ {State1, NextState} ->
+ {Record, State} = tls_connection:next_record(State1),
+ tls_connection:next_event(NextState, Record, State)
+ end;
+wait_cert(Type, Msg, State, Connection) ->
+ ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
+
+
+wait_cv(internal, #change_cipher_spec{}, State0, _Module) ->
+ {Record, State} = tls_connection:next_record(State0),
+ tls_connection:next_event(?FUNCTION_NAME, Record, State);
+wait_cv(internal,
+ #certificate_verify_1_3{} = CertificateVerify, State0, _Module) ->
+ case tls_handshake_1_3:do_wait_cv(CertificateVerify, State0) of
+ {#alert{} = Alert, State} ->
+ ssl_connection:handle_own_alert(Alert, {3,4}, wait_cv, State);
+ {State1, NextState} ->
+ {Record, State} = tls_connection:next_record(State1),
+ tls_connection:next_event(NextState, Record, State)
+ end;
+wait_cv(Type, Msg, State, Connection) ->
+ ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
+
+
+wait_finished(internal, #change_cipher_spec{}, State0, _Module) ->
+ {Record, State} = tls_connection:next_record(State0),
+ tls_connection:next_event(?FUNCTION_NAME, Record, State);
+wait_finished(internal,
+ #finished{} = Finished, State0, Module) ->
+ case tls_handshake_1_3:do_wait_finished(Finished, State0) of
+ #alert{} = Alert ->
+ ssl_connection:handle_own_alert(Alert, {3,4}, finished, State0);
+ State1 ->
+ {Record, State} = ssl_connection:prepare_connection(State1, Module),
+ tls_connection:next_event(connection, Record, State)
+ end;
+wait_finished(Type, Msg, State, Connection) ->
+ ssl_connection:handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl
index f0bbd0f94f..e7cee1956b 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -31,6 +31,7 @@
-include("ssl_alert.hrl").
-include("ssl_internal.hrl").
-include("ssl_cipher.hrl").
+-include("ssl_api.hrl").
-include_lib("public_key/include/public_key.hrl").
-include_lib("kernel/include/logger.hrl").
@@ -49,7 +50,7 @@
%% Handshake handling
%%====================================================================
%%--------------------------------------------------------------------
--spec client_hello(host(), inet:port_number(), ssl_record:connection_states(),
+-spec client_hello(ssl:host(), inet:port_number(), ssl_record:connection_states(),
#ssl_options{}, integer(), atom(), boolean(), der_cert(),
#key_share_client_hello{} | undefined) ->
#client_hello{}.
@@ -97,13 +98,13 @@ client_hello(Host, Port, ConnectionStates,
-spec hello(#server_hello{} | #client_hello{}, #ssl_options{},
ssl_record:connection_states() | {inet:port_number(), #session{}, db_handle(),
atom(), ssl_record:connection_states(),
- binary() | undefined, ssl_cipher_format:key_algo()},
+ binary() | undefined, ssl:kex_algo()},
boolean()) ->
- {tls_record:tls_version(), session_id(),
+ {tls_record:tls_version(), ssl:session_id(),
ssl_record:connection_states(), alpn | npn, binary() | undefined}|
{tls_record:tls_version(), {resumed | new, #session{}},
ssl_record:connection_states(), binary() | undefined,
- HelloExt::map(), {ssl_cipher_format:hash(), ssl_cipher_format:sign_algo()} |
+ HelloExt::map(), {ssl:hash(), ssl:sign_algo()} |
undefined} | #alert{}.
%%
%% Description: Handles a received hello message
@@ -388,10 +389,7 @@ get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length),
Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>,
try decode_handshake(Version, Type, Body) of
Handshake ->
- Report = #{direction => inbound,
- protocol => 'handshake',
- message => Handshake},
- ssl_logger:debug(Opts#ssl_options.log_level, Report, #{domain => [otp,ssl,handshake]}),
+ ssl_logger:debug(Opts#ssl_options.log_level, inbound, 'handshake', Handshake),
get_tls_handshake_aux(Version, Rest, Opts, [{Handshake,Raw} | Acc])
catch
_:_ ->
diff --git a/lib/ssl/src/tls_handshake.hrl b/lib/ssl/src/tls_handshake.hrl
index f6644f64af..fc67bb61fd 100644
--- a/lib/ssl/src/tls_handshake.hrl
+++ b/lib/ssl/src/tls_handshake.hrl
@@ -32,6 +32,7 @@
client_version,
random,
session_id, % opaque SessionID<0..32>
+ cookie, % opaque<2..2^16-1>
cipher_suites, % cipher_suites<2..2^16-1>
compression_methods, % compression_methods<1..2^8-1>,
%% Extensions
diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl
index 670c4d424d..1e8b046c1e 100644
--- a/lib/ssl/src/tls_handshake_1_3.erl
+++ b/lib/ssl/src/tls_handshake_1_3.erl
@@ -28,6 +28,7 @@
-include("tls_handshake_1_3.hrl").
-include("ssl_alert.hrl").
-include("ssl_cipher.hrl").
+-include("ssl_connection.hrl").
-include("ssl_internal.hrl").
-include("ssl_record.hrl").
-include_lib("public_key/include/public_key.hrl").
@@ -35,39 +36,112 @@
%% Encode
-export([encode_handshake/1, decode_handshake/2]).
-%% Handshake
--export([handle_client_hello/3]).
-
%% Create handshake messages
-export([certificate/5,
- certificate_verify/5,
+ certificate_verify/4,
+ encrypted_extensions/0,
server_hello/4]).
--export([do_negotiated/2]).
+-export([do_start/2,
+ do_negotiated/2,
+ do_wait_cert/2,
+ do_wait_cv/2,
+ do_wait_finished/2]).
%%====================================================================
%% Create handshake messages
%%====================================================================
-server_hello(SessionId, KeyShare, ConnectionStates, _Map) ->
+server_hello(MsgType, SessionId, KeyShare, ConnectionStates) ->
#{security_parameters := SecParams} =
ssl_record:pending_connection_state(ConnectionStates, read),
- Extensions = server_hello_extensions(KeyShare),
+ Extensions = server_hello_extensions(MsgType, KeyShare),
#server_hello{server_version = {3,3}, %% legacy_version
cipher_suite = SecParams#security_parameters.cipher_suite,
compression_method = 0, %% legacy attribute
- random = SecParams#security_parameters.server_random,
+ random = server_hello_random(MsgType, SecParams),
session_id = SessionId,
extensions = Extensions
}.
-server_hello_extensions(KeyShare) ->
+server_hello_extensions(MsgType, KeyShare) ->
SupportedVersions = #server_hello_selected_version{selected_version = {3,4}},
Extensions = #{server_hello_selected_version => SupportedVersions},
- ssl_handshake:add_server_share(Extensions, KeyShare).
+ ssl_handshake:add_server_share(MsgType, Extensions, KeyShare).
+
+server_hello_random(server_hello, #security_parameters{server_random = Random}) ->
+ Random;
+%% For reasons of backward compatibility with middleboxes (see
+%% Appendix D.4), the HelloRetryRequest message uses the same structure
+%% as the ServerHello, but with Random set to the special value of the
+%% SHA-256 of "HelloRetryRequest":
+%%
+%% CF 21 AD 74 E5 9A 61 11 BE 1D 8C 02 1E 65 B8 91
+%% C2 A2 11 16 7A BB 8C 5E 07 9E 09 E2 C8 A8 33 9C
+server_hello_random(hello_retry_request, _) ->
+ crypto:hash(sha256, "HelloRetryRequest").
+
+
+%% TODO: implement support for encrypted_extensions
+encrypted_extensions() ->
+ #encrypted_extensions{
+ extensions = #{}
+ }.
+
+
+certificate_request(SignAlgs0, SignAlgsCert0) ->
+ %% Input arguments contain TLS 1.2 algorithms due to backward compatibility
+ %% reasons. These {Hash, Algo} tuples must be filtered before creating the
+ %% the extensions.
+ SignAlgs = filter_tls13_algs(SignAlgs0),
+ SignAlgsCert = filter_tls13_algs(SignAlgsCert0),
+ Extensions0 = add_signature_algorithms(#{}, SignAlgs),
+ Extensions = add_signature_algorithms_cert(Extensions0, SignAlgsCert),
+ #certificate_request_1_3{
+ certificate_request_context = <<>>,
+ extensions = Extensions}.
+
+
+add_signature_algorithms(Extensions, SignAlgs) ->
+ Extensions#{signature_algorithms =>
+ #signature_algorithms{signature_scheme_list = SignAlgs}}.
+
+
+add_signature_algorithms_cert(Extensions, undefined) ->
+ Extensions;
+add_signature_algorithms_cert(Extensions, SignAlgsCert) ->
+ Extensions#{signature_algorithms_cert =>
+ #signature_algorithms{signature_scheme_list = SignAlgsCert}}.
+
+
+filter_tls13_algs(undefined) -> undefined;
+filter_tls13_algs(Algo) ->
+ lists:filter(fun is_atom/1, Algo).
%% TODO: use maybe monad for error handling!
+%% enum {
+%% X509(0),
+%% RawPublicKey(2),
+%% (255)
+%% } CertificateType;
+%%
+%% struct {
+%% select (certificate_type) {
+%% case RawPublicKey:
+%% /* From RFC 7250 ASN.1_subjectPublicKeyInfo */
+%% opaque ASN1_subjectPublicKeyInfo<1..2^24-1>;
+%%
+%% case X509:
+%% opaque cert_data<1..2^24-1>;
+%% };
+%% Extension extensions<0..2^16-1>;
+%% } CertificateEntry;
+%%
+%% struct {
+%% opaque certificate_request_context<0..2^8-1>;
+%% CertificateEntry certificate_list<0..2^24-1>;
+%% } Certificate;
certificate(OwnCert, CertDbHandle, CertDbRef, _CRContext, server) ->
case ssl_certificate:certificate_chain(OwnCert, CertDbHandle, CertDbRef) of
{ok, _, Chain} ->
@@ -82,23 +156,55 @@ certificate(OwnCert, CertDbHandle, CertDbRef, _CRContext, server) ->
?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {server_has_no_suitable_certificates, Error})
end.
-%% TODO: use maybe monad for error handling!
-certificate_verify(OwnCert, PrivateKey, SignatureScheme, Messages, server) ->
+
+certificate_verify(PrivateKey, SignatureScheme,
+ #state{connection_states = ConnectionStates,
+ handshake_env =
+ #handshake_env{
+ tls_handshake_history = {Messages, _}}}, server) ->
+ #{security_parameters := SecParamsR} =
+ ssl_record:pending_connection_state(ConnectionStates, write),
+ #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR,
+
{HashAlgo, _, _} =
ssl_cipher:scheme_to_components(SignatureScheme),
- %% Transcript-Hash(Handshake Context, Certificate)
- Context = [Messages, OwnCert],
- THash = tls_v1:transcript_hash(Context, HashAlgo),
+ Context = lists:reverse(Messages),
- Signature = digitally_sign(THash, <<"TLS 1.3, server CertificateVerify">>,
- HashAlgo, PrivateKey),
+ %% Transcript-Hash uses the HKDF hash function defined by the cipher suite.
+ THash = tls_v1:transcript_hash(Context, HKDFAlgo),
- #certificate_verify_1_3{
- algorithm = SignatureScheme,
- signature = Signature
+ %% Digital signatures use the hash function defined by the selected signature
+ %% scheme.
+ case sign(THash, <<"TLS 1.3, server CertificateVerify">>,
+ HashAlgo, PrivateKey) of
+ {ok, Signature} ->
+ {ok, #certificate_verify_1_3{
+ algorithm = SignatureScheme,
+ signature = Signature
+ }};
+ {error, badarg} ->
+ {error, badarg}
+
+ end.
+
+
+finished(#state{connection_states = ConnectionStates,
+ handshake_env =
+ #handshake_env{
+ tls_handshake_history = {Messages, _}}}) ->
+ #{security_parameters := SecParamsR,
+ cipher_state := #cipher_state{finished_key = FinishedKey}} =
+ ssl_record:current_connection_state(ConnectionStates, write),
+ #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR,
+
+ VerifyData = tls_v1:finished_verify_data(FinishedKey, HKDFAlgo, Messages),
+
+ #finished{
+ verify_data = VerifyData
}.
+
%%====================================================================
%% Encode handshake
%%====================================================================
@@ -115,6 +221,12 @@ encode_handshake(#certificate_1_3{
EncContext = encode_cert_req_context(Context),
EncEntries = encode_cert_entries(Entries),
{?CERTIFICATE, <<EncContext/binary, EncEntries/binary>>};
+encode_handshake(#certificate_verify_1_3{
+ algorithm = Algorithm,
+ signature = Signature}) ->
+ EncAlgo = encode_algorithm(Algorithm),
+ EncSign = encode_signature(Signature),
+ {?CERTIFICATE_VERIFY, <<EncAlgo/binary, EncSign/binary>>};
encode_handshake(#encrypted_extensions{extensions = Exts})->
{?ENCRYPTED_EXTENSIONS, encode_extensions(Exts)};
encode_handshake(#new_session_ticket{
@@ -164,6 +276,11 @@ decode_handshake(?CERTIFICATE, <<?BYTE(CSize), Context:CSize/binary,
certificate_request_context = Context,
certificate_list = CertList
};
+decode_handshake(?CERTIFICATE_VERIFY, <<?UINT16(EncAlgo), ?UINT16(Size), Signature:Size/binary>>) ->
+ Algorithm = ssl_cipher:signature_scheme(EncAlgo),
+ #certificate_verify_1_3{
+ algorithm = Algorithm,
+ signature = Signature};
decode_handshake(?ENCRYPTED_EXTENSIONS, <<?UINT16(Size), EncExts:Size/binary>>) ->
#encrypted_extensions{
extensions = decode_extensions(EncExts, encrypted_extensions)
@@ -204,9 +321,16 @@ encode_cert_entries([#certificate_entry{data = Data,
extensions = Exts} | Rest], Acc) ->
DSize = byte_size(Data),
BinExts = encode_extensions(Exts),
- ExtSize = byte_size(BinExts),
encode_cert_entries(Rest,
- [<<?UINT24(DSize), Data/binary, ?UINT16(ExtSize), BinExts/binary>> | Acc]).
+ [<<?UINT24(DSize), Data/binary, BinExts/binary>> | Acc]).
+
+encode_algorithm(Algo) ->
+ Scheme = ssl_cipher:signature_scheme(Algo),
+ <<?UINT16(Scheme)>>.
+
+encode_signature(Signature) ->
+ Size = byte_size(Signature),
+ <<?UINT16(Size), Signature/binary>>.
decode_cert_entries(Entries) ->
decode_cert_entries(Entries, []).
@@ -260,37 +384,58 @@ certificate_entry(DER) ->
%% 79
%% 00
%% 0101010101010101010101010101010101010101010101010101010101010101
-digitally_sign(THash, Context, HashAlgo, PrivateKey = #'RSAPrivateKey'{}) ->
+sign(THash, Context, HashAlgo, PrivateKey) ->
Content = build_content(Context, THash),
%% The length of the Salt MUST be equal to the length of the output
- %% of the digest algorithm.
- PadLen = ssl_cipher:hash_size(HashAlgo),
+ %% of the digest algorithm: rsa_pss_saltlen = -1
+ try public_key:sign(Content, HashAlgo, PrivateKey,
+ [{rsa_padding, rsa_pkcs1_pss_padding},
+ {rsa_pss_saltlen, -1},
+ {rsa_mgf1_md, HashAlgo}]) of
+ Signature ->
+ {ok, Signature}
+ catch
+ error:badarg ->
+ {error, badarg}
+ end.
+
+
+verify(THash, Context, HashAlgo, Signature, PublicKey) ->
+ Content = build_content(Context, THash),
- public_key:sign(Content, HashAlgo, PrivateKey,
+ %% The length of the Salt MUST be equal to the length of the output
+ %% of the digest algorithm: rsa_pss_saltlen = -1
+ try public_key:verify(Content, HashAlgo, Signature, PublicKey,
[{rsa_padding, rsa_pkcs1_pss_padding},
- {rsa_pss_saltlen, PadLen}]).
+ {rsa_pss_saltlen, -1},
+ {rsa_mgf1_md, HashAlgo}]) of
+ Result ->
+ {ok, Result}
+ catch
+ error:badarg ->
+ {error, badarg}
+ end.
build_content(Context, THash) ->
- <<" ",
- " ",
- Context/binary,?BYTE(0),THash/binary>>.
+ Prefix = binary:copy(<<32>>, 64),
+ <<Prefix/binary,Context/binary,?BYTE(0),THash/binary>>.
+
%%====================================================================
%% Handle handshake messages
%%====================================================================
-handle_client_hello(#client_hello{cipher_suites = ClientCiphers,
- session_id = SessionId,
- extensions = Extensions} = _Hello,
- #ssl_options{ciphers = ServerCiphers,
- signature_algs = ServerSignAlgs,
- signature_algs_cert = _SignatureSchemes, %% TODO: Check??
- supported_groups = ServerGroups0} = _SslOpts,
- Env) ->
- Cert = maps:get(cert, Env, undefined),
+do_start(#client_hello{cipher_suites = ClientCiphers,
+ session_id = SessionId,
+ extensions = Extensions} = _Hello,
+ #state{connection_states = _ConnectionStates0,
+ ssl_options = #ssl_options{ciphers = ServerCiphers,
+ signature_algs = ServerSignAlgs,
+ supported_groups = ServerGroups0},
+ session = #session{own_certificate = Cert}} = State0) ->
ClientGroups0 = maps:get(elliptic_curves, Extensions, undefined),
ClientGroups = get_supported_groups(ClientGroups0),
@@ -314,11 +459,9 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers,
%% and a signature algorithm/certificate pair to authenticate itself to
%% the client.
Cipher = Maybe(select_cipher_suite(ClientCiphers, ServerCiphers)),
- Group = Maybe(select_server_group(ServerGroups, ClientGroups)),
+ Groups = Maybe(select_common_groups(ServerGroups, ClientGroups)),
Maybe(validate_key_share(ClientGroups, ClientShares)),
- ClientPubKey = Maybe(get_client_public_key(Group, ClientShares)),
-
{PublicKeyAlgo, SignAlgo, SignHash} = get_certificate_params(Cert),
%% Check if client supports signature algorithm of server certificate
@@ -327,14 +470,25 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers,
%% Select signature algorithm (used in CertificateVerify message).
SelectedSignAlg = Maybe(select_sign_algo(PublicKeyAlgo, ClientSignAlgs, ServerSignAlgs)),
+ %% Select client public key. If no public key found in ClientShares or
+ %% ClientShares is empty, trigger HelloRetryRequest as we were able
+ %% to find an acceptable set of parameters but the ClientHello does not
+ %% contain sufficient information.
+ {Group, ClientPubKey} = get_client_public_key(Groups, ClientShares),
+
%% Generate server_share
KeyShare = ssl_cipher:generate_server_share(Group),
- _Ret = #{cipher => Cipher,
- group => Group,
- sign_alg => SelectedSignAlg,
- client_share => ClientPubKey,
- key_share => KeyShare,
- session_id => SessionId}
+
+ State1 = update_start_state(State0, Cipher, KeyShare, SessionId,
+ Group, SelectedSignAlg, ClientPubKey),
+
+ %% 4.1.4. Hello Retry Request
+ %%
+ %% The server will send this message in response to a ClientHello
+ %% message if it is able to find an acceptable set of parameters but the
+ %% ClientHello does not contain sufficient information to proceed with
+ %% the handshake.
+ Maybe(send_hello_retry_request(State1, ClientPubKey, KeyShare, SessionId))
%% TODO:
%% - session handling
@@ -346,122 +500,380 @@ handle_client_hello(#client_hello{cipher_suites = ClientCiphers,
?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_groups);
{Ref, illegal_parameter} ->
?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER);
- {Ref, {hello_retry_request, _Group0}} ->
- %% TODO
- ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, "hello_retry_request not implemented");
{Ref, no_suitable_cipher} ->
?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_cipher);
{Ref, {insufficient_security, no_suitable_signature_algorithm}} ->
- ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm);
+ ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, "No suitable signature algorithm");
{Ref, {insufficient_security, no_suitable_public_key}} ->
?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_public_key)
end.
-do_negotiated(#{client_share := ClientKey,
- group := SelectedGroup,
- sign_alg := SignatureScheme
- } = Map,
- #{connection_states := ConnectionStates0,
- session_id := SessionId,
- own_certificate := OwnCert,
- cert_db := CertDbHandle,
- cert_db_ref := CertDbRef,
- ssl_options := SslOpts,
- key_share := KeyShare,
- tls_handshake_history := HHistory0,
- transport_cb := Transport,
- socket := Socket,
- private_key := CertPrivateKey}) ->
+do_negotiated(start_handshake,
+ #state{connection_states = ConnectionStates0,
+ session = #session{session_id = SessionId,
+ own_certificate = OwnCert,
+ ecc = SelectedGroup,
+ sign_alg = SignatureScheme,
+ dh_public_value = ClientKey},
+ ssl_options = #ssl_options{} = SslOpts,
+ key_share = KeyShare,
+ handshake_env = #handshake_env{tls_handshake_history = _HHistory0},
+ connection_env = #connection_env{private_key = CertPrivateKey},
+ static_env = #static_env{
+ cert_db = CertDbHandle,
+ cert_db_ref = CertDbRef,
+ socket = _Socket,
+ transport_cb = _Transport}
+ } = State0) ->
{Ref,Maybe} = maybe(),
try
%% Create server_hello
%% Extensions: supported_versions, key_share, (pre_shared_key)
- ServerHello = server_hello(SessionId, KeyShare, ConnectionStates0, Map),
-
- %% Update handshake_history (done in encode!)
- %% Encode handshake
- {BinMsg, ConnectionStates1, HHistory1} =
- tls_connection:encode_handshake(ServerHello, {3,4}, ConnectionStates0, HHistory0),
- %% Send server_hello
- tls_connection:send(Transport, Socket, BinMsg),
- log_handshake(SslOpts, ServerHello),
- log_tls_record(SslOpts, BinMsg),
-
- %% ConnectionStates2 = calculate_security_parameters(ClientKey, SelectedGroup, KeyShare,
- %% HHistory1, ConnectionStates1),
- {HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV} =
- calculate_security_parameters(ClientKey, SelectedGroup, KeyShare,
- HHistory1, ConnectionStates1),
- ConnectionStates2 =
- update_pending_connection_states(ConnectionStates1, HandshakeSecret,
- ReadKey, ReadIV, WriteKey, WriteIV),
- ConnectionStates3 =
- ssl_record:step_encryption_state(ConnectionStates2),
+ ServerHello = server_hello(server_hello, SessionId, KeyShare, ConnectionStates0),
+
+ {State1, _} = tls_connection:send_handshake(ServerHello, State0),
+
+ State2 =
+ calculate_handshake_secrets(ClientKey, SelectedGroup, KeyShare, State1),
+
+ State3 = ssl_record:step_encryption_state(State2),
+
+ %% Create EncryptedExtensions
+ EncryptedExtensions = encrypted_extensions(),
+
+ %% Encode EncryptedExtensions
+ State4 = tls_connection:queue_handshake(EncryptedExtensions, State3),
+
+ %% Create and send CertificateRequest ({verify, verify_peer})
+ {State5, NextState} = maybe_send_certificate_request(State4, SslOpts),
%% Create Certificate
Certificate = certificate(OwnCert, CertDbHandle, CertDbRef, <<>>, server),
%% Encode Certificate
- {_, _ConnectionStates4, HHistory2} =
- tls_connection:encode_handshake(Certificate, {3,4}, ConnectionStates3, HHistory1),
- %% log_handshake(SslOpts, Certificate),
+ State6 = tls_connection:queue_handshake(Certificate, State5),
%% Create CertificateVerify
- {Messages, _} = HHistory2,
+ CertificateVerify = Maybe(certificate_verify(CertPrivateKey, SignatureScheme,
+ State6, server)),
+ %% Encode CertificateVerify
+ State7 = tls_connection:queue_handshake(CertificateVerify, State6),
- %% Use selected signature_alg from here, HKDF only used for key_schedule
- CertificateVerify =
- tls_handshake_1_3:certificate_verify(OwnCert, CertPrivateKey, SignatureScheme,
- Messages, server),
- io:format("### CertificateVerify: ~p~n", [CertificateVerify]),
+ %% Create Finished
+ Finished = finished(State7),
- %% Encode CertificateVerify
+ %% Encode Finished
+ State8 = tls_connection:queue_handshake(Finished, State7),
+
+ %% Send first flight
+ {State9, _} = tls_connection:send_handshake_flight(State8),
+
+ {State9, NextState}
+
+ catch
+ {Ref, badarg} ->
+ ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {digitally_sign, badarg})
+ end.
+
+
+do_wait_cert(#certificate_1_3{} = Certificate, State0) ->
+ {Ref,Maybe} = maybe(),
+ try
+ Maybe(process_client_certificate(Certificate, State0))
+ catch
+ {Ref, {certificate_required, State}} ->
+ {?ALERT_REC(?FATAL, ?CERTIFICATE_REQUIRED, certificate_required), State};
+ {Ref, {{certificate_unknown, Reason}, State}} ->
+ {?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, Reason), State};
+ {Ref, {{internal_error, Reason}, State}} ->
+ {?ALERT_REC(?FATAL, ?INTERNAL_ERROR, Reason), State};
+ {Ref, {{handshake_failure, Reason}, State}} ->
+ {?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason), State};
+ {#alert{} = Alert, State} ->
+ {Alert, State}
+ end.
+
+
+do_wait_cv(#certificate_verify_1_3{} = CertificateVerify, State0) ->
+ {Ref,Maybe} = maybe(),
+ try
+ Maybe(verify_signature_algorithm(State0, CertificateVerify)),
+ Maybe(verify_certificate_verify(State0, CertificateVerify))
+ catch
+ {Ref, {{bad_certificate, Reason}, State}} ->
+ {?ALERT_REC(?FATAL, ?BAD_CERTIFICATE, {bad_certificate, Reason}), State};
+ {Ref, {badarg, State}} ->
+ {?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {verify, badarg}), State};
+ {Ref, {{handshake_failure, Reason}, State}} ->
+ {?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {handshake_failure, Reason}), State}
+ end.
- %% Send Certificate, CertifricateVerify
- %% Send finished
+do_wait_finished(#finished{verify_data = VerifyData},
+ #state{connection_states = _ConnectionStates0,
+ session = #session{session_id = _SessionId,
+ own_certificate = _OwnCert},
+ ssl_options = #ssl_options{} = _SslOpts,
+ key_share = _KeyShare,
+ handshake_env = #handshake_env{tls_handshake_history = _HHistory0},
+ static_env = #static_env{
+ cert_db = _CertDbHandle,
+ cert_db_ref = _CertDbRef,
+ socket = _Socket,
+ transport_cb = _Transport}
+ } = State0) ->
- %% Next record/Next event
+ {Ref,Maybe} = maybe(),
- Maybe(not_implemented(negotiated))
+ try
+ Maybe(validate_client_finished(State0, VerifyData)),
+
+ State1 = calculate_traffic_secrets(State0),
+
+ %% Configure traffic keys
+ ssl_record:step_encryption_state(State1)
catch
- {Ref, {state_not_implemented, State}} ->
- %% TODO
- ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {state_not_implemented, State})
+ {Ref, decrypt_error} ->
+ ?ALERT_REC(?FATAL, ?DECRYPT_ERROR, decrypt_error)
end.
%% TODO: Remove this function!
-not_implemented(State) ->
- {error, {state_not_implemented, State}}.
+%% not_implemented(State, Reason) ->
+%% {error, {not_implemented, State, Reason}}.
+%%
+%% not_implemented(update_secrets, State0, Reason) ->
+%% State1 = calculate_traffic_secrets(State0),
+%% State = ssl_record:step_encryption_state(State1),
+%% {error, {not_implemented, State, Reason}}.
+
+
+
+%% Recipients of Finished messages MUST verify that the contents are
+%% correct and if incorrect MUST terminate the connection with a
+%% "decrypt_error" alert.
+validate_client_finished(#state{connection_states = ConnectionStates,
+ handshake_env =
+ #handshake_env{
+ tls_handshake_history = {Messages0, _}}}, VerifyData) ->
+ #{security_parameters := SecParamsR,
+ cipher_state := #cipher_state{finished_key = FinishedKey}} =
+ ssl_record:current_connection_state(ConnectionStates, read),
+ #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR,
+
+ %% Drop the client's finished message, it is not part of the handshake context
+ %% when the client calculates its finished message.
+ [_|Messages] = Messages0,
+
+ ControlData = tls_v1:finished_verify_data(FinishedKey, HKDFAlgo, Messages),
+ compare_verify_data(ControlData, VerifyData).
+
+
+compare_verify_data(Data, Data) ->
+ ok;
+compare_verify_data(_, _) ->
+ {error, decrypt_error}.
+
+
+send_hello_retry_request(#state{connection_states = ConnectionStates0} = State0,
+ no_suitable_key, KeyShare, SessionId) ->
+ ServerHello = server_hello(hello_retry_request, SessionId, KeyShare, ConnectionStates0),
+ {State1, _} = tls_connection:send_handshake(ServerHello, State0),
+
+ %% TODO: Fix handshake history!
+ State2 = replace_ch1_with_message_hash(State1),
+
+ {ok, {State2, start}};
+send_hello_retry_request(State0, _, _, _) ->
+ %% Suitable key found.
+ {ok, {State0, negotiated}}.
+
+
+maybe_send_certificate_request(State, #ssl_options{verify = verify_none}) ->
+ {State, wait_finished};
+maybe_send_certificate_request(State, #ssl_options{
+ verify = verify_peer,
+ signature_algs = SignAlgs,
+ signature_algs_cert = SignAlgsCert}) ->
+ CertificateRequest = certificate_request(SignAlgs, SignAlgsCert),
+ {tls_connection:queue_handshake(CertificateRequest, State), wait_cert}.
+
+
+process_client_certificate(#certificate_1_3{
+ certificate_request_context = <<>>,
+ certificate_list = []},
+ #state{ssl_options =
+ #ssl_options{
+ fail_if_no_peer_cert = false}} = State) ->
+ {ok, {State, wait_finished}};
+process_client_certificate(#certificate_1_3{
+ certificate_request_context = <<>>,
+ certificate_list = []},
+ #state{ssl_options =
+ #ssl_options{
+ fail_if_no_peer_cert = true}} = State0) ->
+
+ %% At this point the client believes that the connection is up and starts using
+ %% its traffic secrets. In order to be able send an proper Alert to the client
+ %% the server should also change its connection state and use the traffic
+ %% secrets.
+ State1 = calculate_traffic_secrets(State0),
+ State = ssl_record:step_encryption_state(State1),
+ {error, {certificate_required, State}};
+process_client_certificate(#certificate_1_3{certificate_list = Certs0},
+ #state{ssl_options =
+ #ssl_options{signature_algs = SignAlgs,
+ signature_algs_cert = SignAlgsCert} = SslOptions,
+ static_env =
+ #static_env{
+ role = Role,
+ host = Host,
+ cert_db = CertDbHandle,
+ cert_db_ref = CertDbRef,
+ crl_db = CRLDbHandle}} = State0) ->
+ %% TODO: handle extensions!
+
+ %% Remove extensions from list of certificates!
+ Certs = convert_certificate_chain(Certs0),
+ case is_supported_signature_algorithm(Certs, SignAlgs, SignAlgsCert) of
+ true ->
+ case validate_certificate_chain(Certs, CertDbHandle, CertDbRef,
+ SslOptions, CRLDbHandle, Role, Host) of
+ {ok, {PeerCert, PublicKeyInfo}} ->
+ State = store_peer_cert(State0, PeerCert, PublicKeyInfo),
+ {ok, {State, wait_cv}};
+ {error, Reason} ->
+ State1 = calculate_traffic_secrets(State0),
+ State = ssl_record:step_encryption_state(State1),
+ {error, {Reason, State}};
+ #alert{} = Alert ->
+ State1 = calculate_traffic_secrets(State0),
+ State = ssl_record:step_encryption_state(State1),
+ {Alert, State}
+ end;
+ false ->
+ State1 = calculate_traffic_secrets(State0),
+ State = ssl_record:step_encryption_state(State1),
+ {error, {{handshake_failure,
+ "Client certificate uses unsupported signature algorithm"}, State}}
+ end.
-log_handshake(SslOpts, Message) ->
- Msg = #{direction => outbound,
- protocol => 'handshake',
- message => Message},
- ssl_logger:debug(SslOpts#ssl_options.log_level, Msg, #{domain => [otp,ssl,handshake]}).
+%% TODO: check whole chain!
+is_supported_signature_algorithm(Certs, SignAlgs, undefined) ->
+ is_supported_signature_algorithm(Certs, SignAlgs);
+is_supported_signature_algorithm(Certs, _, SignAlgsCert) ->
+ is_supported_signature_algorithm(Certs, SignAlgsCert).
+%%
+is_supported_signature_algorithm([BinCert|_], SignAlgs0) ->
+ #'OTPCertificate'{signatureAlgorithm = SignAlg} =
+ public_key:pkix_decode_cert(BinCert, otp),
+ SignAlgs = filter_tls13_algs(SignAlgs0),
+ Scheme = ssl_cipher:signature_algorithm_to_scheme(SignAlg),
+ lists:member(Scheme, SignAlgs).
+
+
+validate_certificate_chain(Certs, CertDbHandle, CertDbRef, SslOptions, CRLDbHandle, Role, Host) ->
+ ServerName = ssl_handshake:server_name(SslOptions#ssl_options.server_name_indication, Host, Role),
+ [PeerCert | ChainCerts ] = Certs,
+ try
+ {TrustedCert, CertPath} =
+ ssl_certificate:trusted_cert_and_path(Certs, CertDbHandle, CertDbRef,
+ SslOptions#ssl_options.partial_chain),
+ ValidationFunAndState =
+ ssl_handshake:validation_fun_and_state(SslOptions#ssl_options.verify_fun, Role,
+ CertDbHandle, CertDbRef, ServerName,
+ SslOptions#ssl_options.customize_hostname_check,
+ SslOptions#ssl_options.crl_check, CRLDbHandle, CertPath),
+ Options = [{max_path_length, SslOptions#ssl_options.depth},
+ {verify_fun, ValidationFunAndState}],
+ %% TODO: Validate if Certificate is using a supported signature algorithm
+ %% (signature_algs_cert)!
+ case public_key:pkix_path_validation(TrustedCert, CertPath, Options) of
+ {ok, {PublicKeyInfo,_}} ->
+ {ok, {PeerCert, PublicKeyInfo}};
+ {error, Reason} ->
+ ssl_handshake:handle_path_validation_error(Reason, PeerCert, ChainCerts,
+ SslOptions, Options,
+ CertDbHandle, CertDbRef)
+ end
+ catch
+ error:{badmatch,{asn1, Asn1Reason}} ->
+ %% ASN-1 decode of certificate somehow failed
+ {error, {certificate_unknown, {failed_to_decode_certificate, Asn1Reason}}};
+ error:OtherReason ->
+ {error, {internal_error, {unexpected_error, OtherReason}}}
+ end.
+
+
+store_peer_cert(#state{session = Session,
+ handshake_env = HsEnv} = State, PeerCert, PublicKeyInfo) ->
+ State#state{session = Session#session{peer_certificate = PeerCert},
+ handshake_env = HsEnv#handshake_env{public_key_info = PublicKeyInfo}}.
+
+
+convert_certificate_chain(Certs) ->
+ Fun = fun(#certificate_entry{data = Data}) ->
+ {true, Data};
+ (_) ->
+ false
+ end,
+ lists:filtermap(Fun, Certs).
+
+
+%% 4.4.1. The Transcript Hash
+%%
+%% As an exception to this general rule, when the server responds to a
+%% ClientHello with a HelloRetryRequest, the value of ClientHello1 is
+%% replaced with a special synthetic handshake message of handshake type
+%% "message_hash" containing Hash(ClientHello1). I.e.,
+%%
+%% Transcript-Hash(ClientHello1, HelloRetryRequest, ... Mn) =
+%% Hash(message_hash || /* Handshake type */
+%% 00 00 Hash.length || /* Handshake message length (bytes) */
+%% Hash(ClientHello1) || /* Hash of ClientHello1 */
+%% HelloRetryRequest || ... || Mn)
+%%
+%% NOTE: Hash.length is used in practice (openssl) and not message length!
+%% It is most probably a fault in the RFC.
+replace_ch1_with_message_hash(#state{connection_states = ConnectionStates,
+ handshake_env =
+ #handshake_env{
+ tls_handshake_history =
+ {[HRR,CH1|HHistory], LM}} = HSEnv} = State0) ->
+ #{security_parameters := SecParamsR} =
+ ssl_record:pending_connection_state(ConnectionStates, read),
+ #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR,
+ MessageHash = message_hash(CH1, HKDFAlgo),
+ State0#state{handshake_env =
+ HSEnv#handshake_env{
+ tls_handshake_history =
+ {[HRR,MessageHash|HHistory], LM}}}.
-log_tls_record(SslOpts, BinMsg) ->
- Report = #{direction => outbound,
- protocol => 'tls_record',
- message => BinMsg},
- ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}).
+message_hash(ClientHello1, HKDFAlgo) ->
+ [?MESSAGE_HASH,
+ 0,0,ssl_cipher:hash_size(HKDFAlgo),
+ crypto:hash(HKDFAlgo, ClientHello1)].
-calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, HHistory, ConnectionStates) ->
+calculate_handshake_secrets(ClientKey, SelectedGroup, KeyShare,
+ #state{connection_states = ConnectionStates,
+ handshake_env =
+ #handshake_env{
+ tls_handshake_history = HHistory}} = State0) ->
#{security_parameters := SecParamsR} =
ssl_record:pending_connection_state(ConnectionStates, read),
#security_parameters{prf_algorithm = HKDFAlgo,
cipher_suite = CipherSuite} = SecParamsR,
%% Calculate handshake_secret
- EarlySecret = tls_v1:key_schedule(early_secret, HKDFAlgo , {psk, <<>>}),
+ PSK = binary:copy(<<0>>, ssl_cipher:hash_size(HKDFAlgo)),
+ EarlySecret = tls_v1:key_schedule(early_secret, HKDFAlgo , {psk, PSK}),
PrivateKey = get_server_private_key(KeyShare), %% #'ECPrivateKey'{}
IKM = calculate_shared_secret(ClientKey, PrivateKey, SelectedGroup),
@@ -479,22 +891,44 @@ calculate_security_parameters(ClientKey, SelectedGroup, KeyShare, HHistory, Conn
{ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientHSTrafficSecret),
{WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerHSTrafficSecret),
- {HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV}.
+ %% Calculate Finished Keys
+ ReadFinishedKey = tls_v1:finished_key(ClientHSTrafficSecret, HKDFAlgo),
+ WriteFinishedKey = tls_v1:finished_key(ServerHSTrafficSecret, HKDFAlgo),
- %% %% Update pending connection state
- %% PendingRead0 = ssl_record:pending_connection_state(ConnectionStates, read),
- %% PendingWrite0 = ssl_record:pending_connection_state(ConnectionStates, write),
+ update_pending_connection_states(State0, HandshakeSecret,
+ ReadKey, ReadIV, ReadFinishedKey,
+ WriteKey, WriteIV, WriteFinishedKey).
- %% PendingRead = update_conn_state(PendingRead0, HandshakeSecret, ReadKey, ReadIV),
- %% PendingWrite = update_conn_state(PendingWrite0, HandshakeSecret, WriteKey, WriteIV),
+calculate_traffic_secrets(#state{connection_states = ConnectionStates,
+ handshake_env =
+ #handshake_env{
+ tls_handshake_history = HHistory}} = State0) ->
+ #{security_parameters := SecParamsR} =
+ ssl_record:pending_connection_state(ConnectionStates, read),
+ #security_parameters{prf_algorithm = HKDFAlgo,
+ cipher_suite = CipherSuite,
+ master_secret = HandshakeSecret} = SecParamsR,
+
+ MasterSecret =
+ tls_v1:key_schedule(master_secret, HKDFAlgo, HandshakeSecret),
- %% %% Update pending and copy to current (activate)
- %% %% All subsequent handshake messages are encrypted
- %% %% ([sender]_handshake_traffic_secret)
- %% #{current_read => PendingRead,
- %% current_write => PendingWrite,
- %% pending_read => PendingRead,
- %% pending_write => PendingWrite}.
+ %% Get the correct list messages for the handshake context.
+ Messages = get_handshake_context(HHistory),
+
+ %% Calculate [sender]_application_traffic_secret_0
+ ClientAppTrafficSecret0 =
+ tls_v1:client_application_traffic_secret_0(HKDFAlgo, MasterSecret, lists:reverse(Messages)),
+ ServerAppTrafficSecret0 =
+ tls_v1:server_application_traffic_secret_0(HKDFAlgo, MasterSecret, lists:reverse(Messages)),
+
+ %% Calculate traffic keys
+ #{cipher := Cipher} = ssl_cipher_format:suite_definition(CipherSuite),
+ {ReadKey, ReadIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ClientAppTrafficSecret0),
+ {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, ServerAppTrafficSecret0),
+
+ update_pending_connection_states(State0, MasterSecret,
+ ReadKey, ReadIV, undefined,
+ WriteKey, WriteIV, undefined).
get_server_private_key(#key_share_server_hello{server_share = ServerShare}) ->
@@ -508,6 +942,11 @@ get_private_key(#key_share_entry{
{_, PrivateKey}}) ->
PrivateKey.
+%% TODO: implement EC keys
+get_public_key({?'rsaEncryption', PublicKey, _}) ->
+ PublicKey.
+
+
%% X25519, X448
calculate_shared_secret(OthersKey, MyKey, Group)
when is_binary(OthersKey) andalso is_binary(MyKey) andalso
@@ -527,40 +966,191 @@ calculate_shared_secret(OthersKey, MyKey = #'ECPrivateKey'{}, _Group)
public_key:compute_key(Point, MyKey).
-update_pending_connection_states(CS = #{pending_read := PendingRead0,
- pending_write := PendingWrite0},
- HandshakeSecret, ReadKey, ReadIV, WriteKey, WriteIV) ->
- PendingRead = update_connection_state(PendingRead0, HandshakeSecret, ReadKey, ReadIV),
- PendingWrite = update_connection_state(PendingWrite0, HandshakeSecret, WriteKey, WriteIV),
- CS#{pending_read => PendingRead,
- pending_write => PendingWrite}.
+update_pending_connection_states(#state{connection_states =
+ CS = #{pending_read := PendingRead0,
+ pending_write := PendingWrite0}} = State,
+ HandshakeSecret,
+ ReadKey, ReadIV, ReadFinishedKey,
+ WriteKey, WriteIV, WriteFinishedKey) ->
+ PendingRead = update_connection_state(PendingRead0, HandshakeSecret,
+ ReadKey, ReadIV, ReadFinishedKey),
+ PendingWrite = update_connection_state(PendingWrite0, HandshakeSecret,
+ WriteKey, WriteIV, WriteFinishedKey),
+ State#state{connection_states = CS#{pending_read => PendingRead,
+ pending_write => PendingWrite}}.
update_connection_state(ConnectionState = #{security_parameters := SecurityParameters0},
- HandshakeSecret, Key, IV) ->
+ HandshakeSecret, Key, IV, FinishedKey) ->
%% Store secret
SecurityParameters = SecurityParameters0#security_parameters{
master_secret = HandshakeSecret},
ConnectionState#{security_parameters => SecurityParameters,
- cipher_state => cipher_init(Key, IV)}.
+ cipher_state => cipher_init(Key, IV, FinishedKey)}.
+
+
+update_start_state(#state{connection_states = ConnectionStates0,
+ connection_env = CEnv,
+ session = Session} = State,
+ Cipher, KeyShare, SessionId,
+ Group, SelectedSignAlg, ClientPubKey) ->
+ #{security_parameters := SecParamsR0} = PendingRead =
+ maps:get(pending_read, ConnectionStates0),
+ #{security_parameters := SecParamsW0} = PendingWrite =
+ maps:get(pending_write, ConnectionStates0),
+ SecParamsR = ssl_cipher:security_parameters_1_3(SecParamsR0, Cipher),
+ SecParamsW = ssl_cipher:security_parameters_1_3(SecParamsW0, Cipher),
+ ConnectionStates =
+ ConnectionStates0#{pending_read => PendingRead#{security_parameters => SecParamsR},
+ pending_write => PendingWrite#{security_parameters => SecParamsW}},
+ State#state{connection_states = ConnectionStates,
+ key_share = KeyShare,
+ session = Session#session{session_id = SessionId,
+ ecc = Group,
+ sign_alg = SelectedSignAlg,
+ dh_public_value = ClientPubKey},
+ connection_env = CEnv#connection_env{negotiated_version = {3,4}}}.
+
+
+cipher_init(Key, IV, FinishedKey) ->
+ #cipher_state{key = Key,
+ iv = IV,
+ finished_key = FinishedKey,
+ tag_len = 16}.
+
+
+%% Get handshake context for verification of CertificateVerify.
+%%
+%% Verify CertificateVerify:
+%% ClientHello (client) (1)
+%% ServerHello (server) (2)
+%% EncryptedExtensions (server) (8)
+%% CertificateRequest (server) (13)
+%% Certificate (server) (11)
+%% CertificateVerify (server) (15)
+%% Finished (server) (20)
+%% Certificate (client) (11)
+%% CertificateVerify (client) (15) - Drop! Not included in calculations!
+get_handshake_context_cv({[<<15,_/binary>>|Messages], _}) ->
+ Messages.
+
+
+%% Get handshake context for traffic key calculation.
+%%
+%% Client is authenticated with certificate:
+%% ClientHello (client) (1)
+%% ServerHello (server) (2)
+%% EncryptedExtensions (server) (8)
+%% CertificateRequest (server) (13)
+%% Certificate (server) (11)
+%% CertificateVerify (server) (15)
+%% Finished (server) (20)
+%% Certificate (client) (11) - Drop! Not included in calculations!
+%% CertificateVerify (client) (15) - Drop! Not included in calculations!
+%% Finished (client) (20) - Drop! Not included in calculations!
+%%
+%% Client is authenticated but sends empty certificate:
+%% ClientHello (client) (1)
+%% ServerHello (server) (2)
+%% EncryptedExtensions (server) (8)
+%% CertificateRequest (server) (13)
+%% Certificate (server) (11)
+%% CertificateVerify (server) (15)
+%% Finished (server) (20)
+%% Certificate (client) (11) - Drop! Not included in calculations!
+%% Finished (client) (20) - Drop! Not included in calculations!
+%%
+%% Client is not authenticated:
+%% ClientHello (client) (1)
+%% ServerHello (server) (2)
+%% EncryptedExtensions (server) (8)
+%% Certificate (server) (11)
+%% CertificateVerify (server) (15)
+%% Finished (server) (20)
+%% Finished (client) (20) - Drop! Not included in calculations!
+%%
+%% Drop all client messages from the front of the iolist using the property that
+%% incoming messages are binaries.
+get_handshake_context({Messages, _}) ->
+ get_handshake_context(Messages);
+get_handshake_context([H|T]) when is_binary(H) ->
+ get_handshake_context(T);
+get_handshake_context(L) ->
+ L.
+
+
+%% If sent by a client, the signature algorithm used in the signature
+%% MUST be one of those present in the supported_signature_algorithms
+%% field of the "signature_algorithms" extension in the
+%% CertificateRequest message.
+verify_signature_algorithm(#state{ssl_options =
+ #ssl_options{
+ signature_algs = ServerSignAlgs}} = State0,
+ #certificate_verify_1_3{algorithm = ClientSignAlg}) ->
+ case lists:member(ClientSignAlg, ServerSignAlgs) of
+ true ->
+ ok;
+ false ->
+ State1 = calculate_traffic_secrets(State0),
+ State = ssl_record:step_encryption_state(State1),
+ {error, {{handshake_failure,
+ "CertificateVerify uses unsupported signature algorithm"}, State}}
+ end.
+verify_certificate_verify(#state{connection_states = ConnectionStates,
+ handshake_env =
+ #handshake_env{
+ public_key_info = PublicKeyInfo,
+ tls_handshake_history = HHistory}} = State0,
+ #certificate_verify_1_3{
+ algorithm = SignatureScheme,
+ signature = Signature}) ->
+ #{security_parameters := SecParamsR} =
+ ssl_record:pending_connection_state(ConnectionStates, write),
+ #security_parameters{prf_algorithm = HKDFAlgo} = SecParamsR,
-cipher_init(Key, IV) ->
- #cipher_state{key = Key, iv = IV, tag_len = 16}.
+ {HashAlgo, _, _} =
+ ssl_cipher:scheme_to_components(SignatureScheme),
+
+ Messages = get_handshake_context_cv(HHistory),
+
+ Context = lists:reverse(Messages),
+
+ %% Transcript-Hash uses the HKDF hash function defined by the cipher suite.
+ THash = tls_v1:transcript_hash(Context, HKDFAlgo),
+
+ PublicKey = get_public_key(PublicKeyInfo),
+
+ %% Digital signatures use the hash function defined by the selected signature
+ %% scheme.
+ case verify(THash, <<"TLS 1.3, client CertificateVerify">>,
+ HashAlgo, Signature, PublicKey) of
+ {ok, true} ->
+ {ok, {State0, wait_finished}};
+ {ok, false} ->
+ State1 = calculate_traffic_secrets(State0),
+ State = ssl_record:step_encryption_state(State1),
+ {error, {{handshake_failure, "Failed to verify CertificateVerify"}, State}};
+ {error, badarg} ->
+ State1 = calculate_traffic_secrets(State0),
+ State = ssl_record:step_encryption_state(State1),
+ {error, {badarg, State}}
+ end.
%% If there is no overlap between the received
%% "supported_groups" and the groups supported by the server, then the
%% server MUST abort the handshake with a "handshake_failure" or an
%% "insufficient_security" alert.
-select_server_group(_, []) ->
+select_common_groups(_, []) ->
{error, {insufficient_security, no_suitable_groups}};
-select_server_group(ServerGroups, [C|ClientGroups]) ->
- case lists:member(C, ServerGroups) of
- true ->
- {ok, C};
- false ->
- select_server_group(ServerGroups, ClientGroups)
+select_common_groups(ServerGroups, ClientGroups) ->
+ Fun = fun(E) -> lists:member(E, ClientGroups) end,
+ case lists:filter(Fun, ServerGroups) of
+ [] ->
+ {error, {insufficient_security, no_suitable_groups}};
+ L ->
+ {ok, L}
end.
@@ -591,20 +1181,36 @@ validate_key_share([_|ClientGroups], [_|_] = ClientShares) ->
validate_key_share(ClientGroups, ClientShares).
-get_client_public_key(Group, ClientShares) ->
+get_client_public_key([Group|_] = Groups, ClientShares) ->
+ get_client_public_key(Groups, ClientShares, Group).
+%%
+get_client_public_key(_, [], PreferredGroup) ->
+ {PreferredGroup, no_suitable_key};
+get_client_public_key([], _, PreferredGroup) ->
+ {PreferredGroup, no_suitable_key};
+get_client_public_key([Group|Groups], ClientShares, PreferredGroup) ->
case lists:keysearch(Group, 2, ClientShares) of
{value, {_, _, ClientPublicKey}} ->
- {ok, ClientPublicKey};
+ {Group, ClientPublicKey};
false ->
- %% 4.1.4. Hello Retry Request
- %%
- %% The server will send this message in response to a ClientHello
- %% message if it is able to find an acceptable set of parameters but the
- %% ClientHello does not contain sufficient information to proceed with
- %% the handshake.
- {error, {hello_retry_request, Group}}
+ get_client_public_key(Groups, ClientShares, PreferredGroup)
end.
+
+%% get_client_public_key(Group, ClientShares) ->
+%% case lists:keysearch(Group, 2, ClientShares) of
+%% {value, {_, _, ClientPublicKey}} ->
+%% ClientPublicKey;
+%% false ->
+%% %% 4.1.4. Hello Retry Request
+%% %%
+%% %% The server will send this message in response to a ClientHello
+%% %% message if it is able to find an acceptable set of parameters but the
+%% %% ClientHello does not contain sufficient information to proceed with
+%% %% the handshake.
+%% no_suitable_key
+%% end.
+
select_cipher_suite([], _) ->
{error, no_suitable_cipher};
select_cipher_suite([Cipher|ClientCiphers], ServerCiphers) ->
diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl
index b8bf4603dd..9f0c588cb6 100644
--- a/lib/ssl/src/tls_record.erl
+++ b/lib/ssl/src/tls_record.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -43,6 +43,9 @@
%% Decoding
-export([decode_cipher_text/4]).
+%% Logging helper
+-export([build_tls_record/1]).
+
%% Protocol version handling
-export([protocol_version/1, lowest_protocol_version/1, lowest_protocol_version/2,
highest_protocol_version/1, highest_protocol_version/2,
@@ -76,15 +79,23 @@ init_connection_states(Role, BeastMitigation) ->
pending_write => Pending}.
%%--------------------------------------------------------------------
--spec get_tls_records(binary(), [tls_version()] | tls_version(), binary(),
- #ssl_options{}) -> {[binary()], binary()} | #alert{}.
+-spec get_tls_records(
+ binary(),
+ [tls_version()] | tls_version(),
+ Buffer0 :: binary() | {'undefined' | #ssl_tls{}, {[binary()],non_neg_integer(),[binary()]}},
+ #ssl_options{}) ->
+ {Records :: [#ssl_tls{}],
+ Buffer :: {'undefined' | #ssl_tls{}, {[binary()],non_neg_integer(),[binary()]}}} |
+ #alert{}.
%%
%% and returns it as a list of tls_compressed binaries also returns leftover
%% Description: Given old buffer and new data from TCP, packs up a records
%% data
%%--------------------------------------------------------------------
-get_tls_records(Data, Version, Buffer, SslOpts) ->
- get_tls_records_aux(Version, <<Buffer/binary, Data/binary>>, [], SslOpts).
+get_tls_records(Data, Versions, Buffer, SslOpts) when is_binary(Buffer) ->
+ parse_tls_records(Versions, {[Data],byte_size(Data),[]}, SslOpts, undefined);
+get_tls_records(Data, Versions, {Hdr, {Front,Size,Rear}}, SslOpts) ->
+ parse_tls_records(Versions, {Front,Size + byte_size(Data),[Data|Rear]}, SslOpts, Hdr).
%%====================================================================
%% Encoding
@@ -106,8 +117,8 @@ encode_handshake(Frag, Version,
ConnectionStates) ->
case iolist_size(Frag) of
N when N > ?MAX_PLAIN_TEXT_LENGTH ->
- Data = split_bin(iolist_to_binary(Frag), Version, BCA, BeastMitigation),
- encode_iolist(?HANDSHAKE, Data, Version, ConnectionStates);
+ Data = split_iovec(erlang:iolist_to_iovec(Frag), Version, BCA, BeastMitigation),
+ encode_fragments(?HANDSHAKE, Version, Data, ConnectionStates);
_ ->
encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates)
end.
@@ -119,7 +130,7 @@ encode_handshake(Frag, Version,
%% Description: Encodes an alert message to send on the ssl-socket.
%%--------------------------------------------------------------------
encode_alert_record(Alert, {3, 4}, ConnectionStates) ->
- tls_record_1_3:encode_handshake(Alert, ConnectionStates);
+ tls_record_1_3:encode_alert_record(Alert, ConnectionStates);
encode_alert_record(#alert{level = Level, description = Description},
Version, ConnectionStates) ->
encode_plain_text(?ALERT, Version, <<?BYTE(Level), ?BYTE(Description)>>,
@@ -135,20 +146,20 @@ encode_change_cipher_spec(Version, ConnectionStates) ->
encode_plain_text(?CHANGE_CIPHER_SPEC, Version, ?byte(?CHANGE_CIPHER_SPEC_PROTO), ConnectionStates).
%%--------------------------------------------------------------------
--spec encode_data(binary(), tls_version(), ssl_record:connection_states()) ->
- {iolist(), ssl_record:connection_states()}.
+-spec encode_data([binary()], tls_version(), ssl_record:connection_states()) ->
+ {[[binary()]], ssl_record:connection_states()}.
%%
%% Description: Encodes data to send on the ssl-socket.
%%--------------------------------------------------------------------
encode_data(Data, {3, 4}, ConnectionStates) ->
tls_record_1_3:encode_data(Data, ConnectionStates);
-encode_data(Frag, Version,
+encode_data(Data, Version,
#{current_write := #{beast_mitigation := BeastMitigation,
security_parameters :=
#security_parameters{bulk_cipher_algorithm = BCA}}} =
ConnectionStates) ->
- Data = split_bin(Frag, Version, BCA, BeastMitigation),
- encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates).
+ Fragments = split_iovec(Data, Version, BCA, BeastMitigation),
+ encode_fragments(?APPLICATION_DATA, Version, Fragments, ConnectionStates).
%%====================================================================
%% Decoding
@@ -162,57 +173,59 @@ encode_data(Frag, Version,
%%--------------------------------------------------------------------
decode_cipher_text({3,4}, CipherTextRecord, ConnectionStates, _) ->
tls_record_1_3:decode_cipher_text(CipherTextRecord, ConnectionStates);
-decode_cipher_text(_, #ssl_tls{type = Type, version = Version,
- fragment = CipherFragment} = CipherText,
+decode_cipher_text(_, CipherTextRecord,
#{current_read :=
- #{compression_state := CompressionS0,
- sequence_number := Seq,
- cipher_state := CipherS0,
+ #{sequence_number := Seq,
security_parameters :=
- #security_parameters{
- cipher_type = ?AEAD,
- bulk_cipher_algorithm =
- BulkCipherAlgo,
- compression_algorithm = CompAlg}
- } = ReadState0} = ConnnectionStates0, _) ->
- AAD = start_additional_data(Type, Version, ReadState0),
- CipherS1 = ssl_record:nonce_seed(BulkCipherAlgo, <<?UINT64(Seq)>>, CipherS0),
- case ssl_record:decipher_aead(BulkCipherAlgo, CipherS1, AAD, CipherFragment, Version) of
- {PlainFragment, CipherState} ->
- {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
- PlainFragment, CompressionS0),
- ConnnectionStates = ConnnectionStates0#{
+ #security_parameters{cipher_type = ?AEAD,
+ bulk_cipher_algorithm = BulkCipherAlgo},
+ cipher_state := CipherS0
+ }
+ } = ConnectionStates0, _) ->
+ SeqBin = <<?UINT64(Seq)>>,
+ #ssl_tls{type = Type, version = {MajVer,MinVer} = Version, fragment = Fragment} = CipherTextRecord,
+ StartAdditionalData = <<SeqBin/binary, ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>,
+ CipherS = ssl_record:nonce_seed(BulkCipherAlgo, SeqBin, CipherS0),
+ case ssl_record:decipher_aead(
+ BulkCipherAlgo, CipherS, StartAdditionalData, Fragment, Version)
+ of
+ PlainFragment when is_binary(PlainFragment) ->
+ #{current_read :=
+ #{security_parameters := SecParams,
+ compression_state := CompressionS0} = ReadState0} = ConnectionStates0,
+ {Plain, CompressionS} = ssl_record:uncompress(SecParams#security_parameters.compression_algorithm,
+ PlainFragment, CompressionS0),
+ ConnectionStates = ConnectionStates0#{
current_read => ReadState0#{
- cipher_state => CipherState,
+ cipher_state => CipherS,
sequence_number => Seq + 1,
- compression_state => CompressionS1}},
- {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
+ compression_state => CompressionS}},
+ {CipherTextRecord#ssl_tls{fragment = Plain}, ConnectionStates};
#alert{} = Alert ->
Alert
end;
-decode_cipher_text(_, #ssl_tls{type = Type, version = Version,
- fragment = CipherFragment} = CipherText,
- #{current_read :=
- #{compression_state := CompressionS0,
- sequence_number := Seq,
- security_parameters :=
- #security_parameters{compression_algorithm = CompAlg}
- } = ReadState0} = ConnnectionStates0, PaddingCheck) ->
+decode_cipher_text(_, #ssl_tls{version = Version,
+ fragment = CipherFragment} = CipherTextRecord,
+ #{current_read := ReadState0} = ConnnectionStates0, PaddingCheck) ->
case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of
{PlainFragment, Mac, ReadState1} ->
- MacHash = ssl_cipher:calc_mac_hash(Type, Version, PlainFragment, ReadState1),
+ MacHash = ssl_cipher:calc_mac_hash(CipherTextRecord#ssl_tls.type, Version, PlainFragment, ReadState1),
case ssl_record:is_correct_mac(Mac, MacHash) of
true ->
+ #{sequence_number := Seq,
+ compression_state := CompressionS0,
+ security_parameters :=
+ #security_parameters{compression_algorithm = CompAlg}} = ReadState0,
{Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
PlainFragment, CompressionS0),
- ConnnectionStates = ConnnectionStates0#{
- current_read => ReadState1#{
- sequence_number => Seq + 1,
- compression_state => CompressionS1}},
- {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
+ ConnnectionStates =
+ ConnnectionStates0#{current_read =>
+ ReadState1#{sequence_number => Seq + 1,
+ compression_state => CompressionS1}},
+ {CipherTextRecord#ssl_tls{fragment = Plain}, ConnnectionStates};
false ->
- ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
+ ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
end;
#alert{} = Alert ->
Alert
@@ -398,132 +411,230 @@ initial_connection_state(ConnectionEnd, BeastMitigation) ->
server_verify_data => undefined
}.
-get_tls_records_aux({MajVer, MinVer} = Version, <<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer),
- ?UINT16(Length), Data:Length/binary, Rest/binary>> = RawTLSRecord,
- Acc, SslOpts) when Type == ?APPLICATION_DATA;
- Type == ?HANDSHAKE;
- Type == ?ALERT;
- Type == ?CHANGE_CIPHER_SPEC ->
- Report = #{direction => inbound,
- protocol => 'tls_record',
- message => [RawTLSRecord]},
- ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}),
- get_tls_records_aux(Version, Rest, [#ssl_tls{type = Type,
- version = Version,
- fragment = Data} | Acc], SslOpts);
-get_tls_records_aux(Versions, <<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer),
- ?UINT16(Length), Data:Length/binary, Rest/binary>> = RawTLSRecord,
- Acc, SslOpts) when is_list(Versions) andalso
- ((Type == ?APPLICATION_DATA)
- orelse
- (Type == ?HANDSHAKE)
- orelse
- (Type == ?ALERT)
- orelse
- (Type == ?CHANGE_CIPHER_SPEC)) ->
- case is_acceptable_version({MajVer, MinVer}, Versions) of
+%% Used by logging to recreate the received bytes
+build_tls_record(#ssl_tls{type = Type, version = {MajVer, MinVer}, fragment = Fragment}) ->
+ Length = byte_size(Fragment),
+ <<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer),?UINT16(Length), Fragment/binary>>.
+
+
+parse_tls_records(Versions, Q, SslOpts, undefined) ->
+ decode_tls_records(Versions, Q, SslOpts, [], undefined, undefined, undefined);
+parse_tls_records(Versions, Q, SslOpts, #ssl_tls{type = Type, version = Version, fragment = Length}) ->
+ decode_tls_records(Versions, Q, SslOpts, [], Type, Version, Length).
+
+%% Generic code path
+decode_tls_records(Versions, {_,Size,_} = Q0, SslOpts, Acc, undefined, _Version, _Length) ->
+ if
+ 5 =< Size ->
+ {<<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Length)>>, Q} = binary_from_front(5, Q0),
+ validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, {MajVer,MinVer}, Length);
+ 3 =< Size ->
+ {<<?BYTE(Type),?BYTE(MajVer),?BYTE(MinVer)>>, Q} = binary_from_front(3, Q0),
+ validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, {MajVer,MinVer}, undefined);
+ 1 =< Size ->
+ {<<?BYTE(Type)>>, Q} = binary_from_front(1, Q0),
+ validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, undefined, undefined);
+ true ->
+ validate_tls_records_type(Versions, Q0, SslOpts, Acc, undefined, undefined, undefined)
+ end;
+decode_tls_records(Versions, {_,Size,_} = Q0, SslOpts, Acc, Type, undefined, _Length) ->
+ if
+ 4 =< Size ->
+ {<<?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Length)>>, Q} = binary_from_front(4, Q0),
+ validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, {MajVer,MinVer}, Length);
+ 2 =< Size ->
+ {<<?BYTE(MajVer),?BYTE(MinVer)>>, Q} = binary_from_front(2, Q0),
+ validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, {MajVer,MinVer}, undefined);
+ true ->
+ validate_tls_record_version(Versions, Q0, SslOpts, Acc, Type, undefined, undefined)
+ end;
+decode_tls_records(Versions, {_,Size,_} = Q0, SslOpts, Acc, Type, Version, undefined) ->
+ if
+ 2 =< Size ->
+ {<<?UINT16(Length)>>, Q} = binary_from_front(2, Q0),
+ validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length);
true ->
- Report = #{direction => inbound,
- protocol => 'tls_record',
- message => [RawTLSRecord]},
- ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}),
- get_tls_records_aux(Versions, Rest, [#ssl_tls{type = Type,
- version = {MajVer, MinVer},
- fragment = Data} | Acc], SslOpts);
- false ->
+ validate_tls_record_length(Versions, Q0, SslOpts, Acc, Type, Version, undefined)
+ end;
+decode_tls_records(Versions, Q, SslOpts, Acc, Type, Version, Length) ->
+ validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length).
+
+validate_tls_records_type(_Versions, Q, _SslOpts, Acc, undefined, _Version, _Length) ->
+ {lists:reverse(Acc),
+ {undefined, Q}};
+validate_tls_records_type(Versions, Q, SslOpts, Acc, Type, Version, Length) ->
+ if
+ ?KNOWN_RECORD_TYPE(Type) ->
+ validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, Version, Length);
+ true ->
+ %% Not ?KNOWN_RECORD_TYPE(Type)
+ ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE)
+ end.
+
+validate_tls_record_version(_Versions, Q, _SslOpts, Acc, Type, undefined, _Length) ->
+ {lists:reverse(Acc),
+ {#ssl_tls{type = Type, version = undefined, fragment = undefined}, Q}};
+validate_tls_record_version(Versions, Q, SslOpts, Acc, Type, Version, Length) ->
+ case Versions of
+ _ when is_list(Versions) ->
+ case is_acceptable_version(Version, Versions) of
+ true ->
+ validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length);
+ false ->
+ ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
+ end;
+ {3, 4} when Version =:= {3, 3} ->
+ validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length);
+ Version ->
+ %% Exact version match
+ validate_tls_record_length(Versions, Q, SslOpts, Acc, Type, Version, Length);
+ _ ->
?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
+ end.
+
+validate_tls_record_length(_Versions, Q, _SslOpts, Acc, Type, Version, undefined) ->
+ {lists:reverse(Acc),
+ {#ssl_tls{type = Type, version = Version, fragment = undefined}, Q}};
+validate_tls_record_length(Versions, {_,Size0,_} = Q0, SslOpts, Acc, Type, Version, Length) ->
+ if
+ Length =< ?MAX_CIPHER_TEXT_LENGTH ->
+ if
+ Length =< Size0 ->
+ %% Complete record
+ {Fragment, Q} = binary_from_front(Length, Q0),
+ Record = #ssl_tls{type = Type, version = Version, fragment = Fragment},
+ ssl_logger:debug(SslOpts#ssl_options.log_level, inbound, 'record', Record),
+ decode_tls_records(Versions, Q, SslOpts, [Record|Acc], undefined, undefined, undefined);
+ true ->
+ {lists:reverse(Acc),
+ {#ssl_tls{type = Type, version = Version, fragment = Length}, Q0}}
+ end;
+ true ->
+ ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW)
+ end.
+
+
+binary_from_front(SplitSize, {Front,Size,Rear}) ->
+ binary_from_front(SplitSize, Front, Size, Rear, []).
+%%
+binary_from_front(SplitSize, [], Size, [_] = Rear, Acc) ->
+ %% Optimize a simple case
+ binary_from_front(SplitSize, Rear, Size, [], Acc);
+binary_from_front(SplitSize, [], Size, Rear, Acc) ->
+ binary_from_front(SplitSize, lists:reverse(Rear), Size, [], Acc);
+binary_from_front(SplitSize, [Bin|Front], Size, Rear, []) ->
+ %% Optimize a frequent case
+ BinSize = byte_size(Bin),
+ if
+ SplitSize < BinSize ->
+ {RetBin, Rest} = erlang:split_binary(Bin, SplitSize),
+ {RetBin, {[Rest|Front],Size - SplitSize,Rear}};
+ BinSize < SplitSize ->
+ binary_from_front(SplitSize - BinSize, Front, Size, Rear, [Bin]);
+ true -> % Perfect fit
+ {Bin, {Front,Size - SplitSize,Rear}}
end;
-get_tls_records_aux(_, <<?BYTE(Type),?BYTE(_MajVer),?BYTE(_MinVer),
- ?UINT16(Length), _:Length/binary, _Rest/binary>>,
- _, _) when Type == ?APPLICATION_DATA;
- Type == ?HANDSHAKE;
- Type == ?ALERT;
- Type == ?CHANGE_CIPHER_SPEC ->
- ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC);
-get_tls_records_aux(_, <<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer),
- ?UINT16(Length), _/binary>>,
- _Acc, _) when Length > ?MAX_CIPHER_TEXT_LENGTH ->
- ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW);
-get_tls_records_aux(_, Data, Acc, _) ->
- case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of
- true ->
- {lists:reverse(Acc), Data};
- false ->
- ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE)
+binary_from_front(SplitSize, [Bin|Front], Size, Rear, Acc) ->
+ BinSize = byte_size(Bin),
+ if
+ SplitSize < BinSize ->
+ {Last, Rest} = erlang:split_binary(Bin, SplitSize),
+ RetBin = iolist_to_binary(lists:reverse(Acc, [Last])),
+ {RetBin, {[Rest|Front],Size - byte_size(RetBin),Rear}};
+ BinSize < SplitSize ->
+ binary_from_front(SplitSize - BinSize, Front, Size, Rear, [Bin|Acc]);
+ true -> % Perfect fit
+ RetBin = iolist_to_binary(lists:reverse(Acc, [Bin])),
+ {RetBin, {Front,Size - byte_size(RetBin),Rear}}
end.
+
%%--------------------------------------------------------------------
-encode_plain_text(Type, Version, Data, #{current_write := Write0} = ConnectionStates) ->
- {CipherFragment, Write1} = do_encode_plain_text(Type, Version, Data, Write0),
- {CipherText, Write} = encode_tls_cipher_text(Type, Version, CipherFragment, Write1),
- {CipherText, ConnectionStates#{current_write => Write}}.
-
-encode_tls_cipher_text(Type, {MajVer, MinVer}, Fragment, #{sequence_number := Seq} = Write) ->
- Length = erlang:iolist_size(Fragment),
- {[<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Fragment],
- Write#{sequence_number => Seq +1}}.
-
-encode_iolist(Type, Data, Version, ConnectionStates0) ->
- {ConnectionStates, EncodedMsg} =
- lists:foldl(fun(Text, {CS0, Encoded}) ->
- {Enc, CS1} =
- encode_plain_text(Type, Version, Text, CS0),
- {CS1, [Enc | Encoded]}
- end, {ConnectionStates0, []}, Data),
- {lists:reverse(EncodedMsg), ConnectionStates}.
-%%--------------------------------------------------------------------
-do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0,
- cipher_state := CipherS0,
- sequence_number := Seq,
- security_parameters :=
- #security_parameters{
- cipher_type = ?AEAD,
- bulk_cipher_algorithm = BCAlg,
- compression_algorithm = CompAlg}
- } = WriteState0) ->
- {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
- CipherS = ssl_record:nonce_seed(BCAlg, <<?UINT64(Seq)>>, CipherS0),
- WriteState = WriteState0#{compression_state => CompS1,
- cipher_state => CipherS},
- AAD = start_additional_data(Type, Version, WriteState),
- ssl_record:cipher_aead(Version, Comp, WriteState, AAD);
-do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0,
- security_parameters :=
- #security_parameters{compression_algorithm = CompAlg}
- }= WriteState0) ->
- {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
- WriteState1 = WriteState0#{compression_state => CompS1},
- MacHash = ssl_cipher:calc_mac_hash(Type, Version, Comp, WriteState1),
- ssl_record:cipher(Version, Comp, WriteState1, MacHash);
-do_encode_plain_text(_,_,_,CS) ->
+encode_plain_text(Type, Version, Data, ConnectionStates0) ->
+ {[CipherText],ConnectionStates} = encode_fragments(Type, Version, [Data], ConnectionStates0),
+ {CipherText,ConnectionStates}.
+%%--------------------------------------------------------------------
+encode_fragments(Type, Version, Data,
+ #{current_write := #{compression_state := CompS,
+ cipher_state := CipherS,
+ sequence_number := Seq}} = ConnectionStates) ->
+ encode_fragments(Type, Version, Data, ConnectionStates, CompS, CipherS, Seq, []).
+%%
+encode_fragments(_Type, _Version, [], #{current_write := WriteS} = CS,
+ CompS, CipherS, Seq, CipherFragments) ->
+ {lists:reverse(CipherFragments),
+ CS#{current_write := WriteS#{compression_state := CompS,
+ cipher_state := CipherS,
+ sequence_number := Seq}}};
+encode_fragments(Type, Version, [Text|Data],
+ #{current_write := #{security_parameters :=
+ #security_parameters{cipher_type = ?AEAD,
+ bulk_cipher_algorithm = BCAlg,
+ compression_algorithm = CompAlg} = SecPars}} = CS,
+ CompS0, CipherS0, Seq, CipherFragments) ->
+ {CompText, CompS} = ssl_record:compress(CompAlg, Text, CompS0),
+ SeqBin = <<?UINT64(Seq)>>,
+ CipherS1 = ssl_record:nonce_seed(BCAlg, SeqBin, CipherS0),
+ {MajVer, MinVer} = Version,
+ VersionBin = <<?BYTE(MajVer), ?BYTE(MinVer)>>,
+ StartAdditionalData = <<SeqBin/binary, ?BYTE(Type), VersionBin/binary>>,
+ {CipherFragment,CipherS} = ssl_record:cipher_aead(Version, CompText, CipherS1, StartAdditionalData, SecPars),
+ Length = byte_size(CipherFragment),
+ CipherHeader = <<?BYTE(Type), VersionBin/binary, ?UINT16(Length)>>,
+ encode_fragments(Type, Version, Data, CS, CompS, CipherS, Seq + 1,
+ [[CipherHeader, CipherFragment] | CipherFragments]);
+encode_fragments(Type, Version, [Text|Data],
+ #{current_write := #{security_parameters :=
+ #security_parameters{compression_algorithm = CompAlg,
+ mac_algorithm = MacAlgorithm} = SecPars,
+ mac_secret := MacSecret}} = CS,
+ CompS0, CipherS0, Seq, CipherFragments) ->
+ {CompText, CompS} = ssl_record:compress(CompAlg, Text, CompS0),
+ MacHash = ssl_cipher:calc_mac_hash(Type, Version, CompText, MacAlgorithm, MacSecret, Seq),
+ {CipherFragment,CipherS} = ssl_record:cipher(Version, CompText, CipherS0, MacHash, SecPars),
+ Length = byte_size(CipherFragment),
+ {MajVer, MinVer} = Version,
+ CipherHeader = <<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>,
+ encode_fragments(Type, Version, Data, CS, CompS, CipherS, Seq + 1,
+ [[CipherHeader, CipherFragment] | CipherFragments]);
+encode_fragments(_Type, _Version, _Data, CS, _CompS, _CipherS, _Seq, _CipherFragments) ->
exit({cs, CS}).
%%--------------------------------------------------------------------
-start_additional_data(Type, {MajVer, MinVer},
- #{sequence_number := SeqNo}) ->
- <<?UINT64(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>.
%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are
%% not vulnerable to this attack.
-split_bin(<<FirstByte:8, Rest/binary>>, Version, BCA, one_n_minus_one) when
- BCA =/= ?RC4 andalso ({3, 1} == Version orelse
- {3, 0} == Version) ->
- [[FirstByte]|do_split_bin(Rest)];
+split_iovec([<<FirstByte:8, Rest/binary>>|Data], Version, BCA, one_n_minus_one)
+ when (BCA =/= ?RC4) andalso ({3, 1} == Version orelse
+ {3, 0} == Version) ->
+ [[FirstByte]|split_iovec([Rest|Data])];
%% 0/n splitting countermeasure for clients that are incompatible with 1/n-1
%% splitting.
-split_bin(Bin, Version, BCA, zero_n) when
- BCA =/= ?RC4 andalso ({3, 1} == Version orelse
- {3, 0} == Version) ->
- [<<>>|do_split_bin(Bin)];
-split_bin(Bin, _, _, _) ->
- do_split_bin(Bin).
-
-do_split_bin(<<>>) -> [];
-do_split_bin(Bin) ->
- case Bin of
- <<Chunk:?MAX_PLAIN_TEXT_LENGTH/binary, Rest/binary>> ->
- [Chunk|do_split_bin(Rest)];
- _ ->
- [Bin]
- end.
+split_iovec(Data, Version, BCA, zero_n)
+ when (BCA =/= ?RC4) andalso ({3, 1} == Version orelse
+ {3, 0} == Version) ->
+ [<<>>|split_iovec(Data)];
+split_iovec(Data, _Version, _BCA, _BeatMitigation) ->
+ split_iovec(Data).
+
+split_iovec([]) ->
+ [];
+split_iovec(Data) ->
+ {Part,Rest} = split_iovec(Data, ?MAX_PLAIN_TEXT_LENGTH, []),
+ [Part|split_iovec(Rest)].
+%%
+split_iovec([Bin|Data], SplitSize, Acc) ->
+ BinSize = byte_size(Bin),
+ if
+ SplitSize < BinSize ->
+ {Last, Rest} = erlang:split_binary(Bin, SplitSize),
+ {lists:reverse(Acc, [Last]), [Rest|Data]};
+ BinSize < SplitSize ->
+ split_iovec(Data, SplitSize - BinSize, [Bin|Acc]);
+ true -> % Perfect match
+ {lists:reverse(Acc, [Bin]), Data}
+ end;
+split_iovec([], _SplitSize, Acc) ->
+ {lists:reverse(Acc),[]}.
+
%%--------------------------------------------------------------------
lowest_list_protocol_version(Ver, []) ->
Ver;
diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl
index 1681babed9..97331e1510 100644
--- a/lib/ssl/src/tls_record_1_3.erl
+++ b/lib/ssl/src/tls_record_1_3.erl
@@ -123,6 +123,36 @@ decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE,
ReadState0#{sequence_number => Seq + 1}},
{decode_inner_plaintext(PlainFragment), ConnectionStates}
end;
+
+
+%% RFC8446 - TLS 1.3 (OpenSSL compatibility)
+%% Handle unencrypted Alerts from openssl s_client when server's
+%% connection states are already stepped into traffic encryption.
+%% (E.g. openssl s_client receives a CertificateRequest with
+%% a signature_algorithms_cert extension that does not contain
+%% the signature algorithm of the client's certificate.)
+decode_cipher_text(#ssl_tls{type = ?ALERT,
+ version = ?LEGACY_VERSION,
+ fragment = <<2,47>>},
+ ConnectionStates0) ->
+ {#ssl_tls{type = ?ALERT,
+ version = {3,4}, %% Internally use real version
+ fragment = <<2,47>>}, ConnectionStates0};
+%% RFC8446 - TLS 1.3
+%% D.4. Middlebox Compatibility Mode
+%% - If not offering early data, the client sends a dummy
+%% change_cipher_spec record (see the third paragraph of Section 5)
+%% immediately before its second flight. This may either be before
+%% its second ClientHello or before its encrypted handshake flight.
+%% If offering early data, the record is placed immediately after the
+%% first ClientHello.
+decode_cipher_text(#ssl_tls{type = ?CHANGE_CIPHER_SPEC,
+ version = ?LEGACY_VERSION,
+ fragment = <<1>>},
+ ConnectionStates0) ->
+ {#ssl_tls{type = ?CHANGE_CIPHER_SPEC,
+ version = {3,4}, %% Internally use real version
+ fragment = <<1>>}, ConnectionStates0};
decode_cipher_text(#ssl_tls{type = Type,
version = ?LEGACY_VERSION,
fragment = CipherFragment},
diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl
index 1559fcbb37..d0604565e3 100644
--- a/lib/ssl/src/tls_sender.erl
+++ b/lib/ssl/src/tls_sender.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2018-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2018-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -38,20 +38,24 @@
-define(SERVER, ?MODULE).
--record(data, {connection_pid,
- connection_states = #{},
- role,
- socket,
- socket_options,
- tracker,
- protocol_cb,
- transport_cb,
- negotiated_version,
- renegotiate_at,
- connection_monitor,
- dist_handle,
- log_level
- }).
+-record(static,
+ {connection_pid,
+ role,
+ socket,
+ socket_options,
+ tracker,
+ transport_cb,
+ negotiated_version,
+ renegotiate_at,
+ connection_monitor,
+ dist_handle,
+ log_level
+ }).
+
+-record(data,
+ {static = #static{},
+ connection_states = #{}
+ }).
%%%===================================================================
%%% API
@@ -172,6 +176,10 @@ dist_tls_socket(Pid) ->
callback_mode() ->
state_functions.
+
+-define(HANDLE_COMMON,
+ ?FUNCTION_NAME(Type, Msg, StateData) ->
+ handle_common(Type, Msg, StateData)).
%%--------------------------------------------------------------------
-spec init(Args :: term()) ->
gen_statem:init_result(atom()).
@@ -193,41 +201,37 @@ init({call, From}, {Pid, #{current_write := WriteState,
socket := Socket,
socket_options := SockOpts,
tracker := Tracker,
- protocol_cb := Connection,
transport_cb := Transport,
negotiated_version := Version,
renegotiate_at := RenegotiateAt,
log_level := LogLevel}},
- #data{connection_states = ConnectionStates} = StateData0) ->
+ #data{connection_states = ConnectionStates, static = Static0} = StateData0) ->
Monitor = erlang:monitor(process, Pid),
StateData =
- StateData0#data{connection_pid = Pid,
- connection_monitor = Monitor,
- connection_states =
- ConnectionStates#{current_write => WriteState},
- role = Role,
- socket = Socket,
- socket_options = SockOpts,
- tracker = Tracker,
- protocol_cb = Connection,
- transport_cb = Transport,
- negotiated_version = Version,
- renegotiate_at = RenegotiateAt,
- log_level = LogLevel},
+ StateData0#data{connection_states = ConnectionStates#{current_write => WriteState},
+ static = Static0#static{connection_pid = Pid,
+ connection_monitor = Monitor,
+ role = Role,
+ socket = Socket,
+ socket_options = SockOpts,
+ tracker = Tracker,
+ transport_cb = Transport,
+ negotiated_version = Version,
+ renegotiate_at = RenegotiateAt,
+ log_level = LogLevel}},
{next_state, handshake, StateData, [{reply, From, ok}]};
-init(info, Msg, StateData) ->
- handle_info(Msg, ?FUNCTION_NAME, StateData).
+init(_, _, _) ->
+ %% Just in case anything else sneeks through
+ {keep_state_and_data, [postpone]}.
+
%%--------------------------------------------------------------------
-spec connection(gen_statem:event_type(),
Msg :: term(),
StateData :: term()) ->
gen_statem:event_handler_result(atom()).
%%--------------------------------------------------------------------
-connection({call, From}, renegotiate,
- #data{connection_states = #{current_write := Write}} = StateData) ->
- {next_state, handshake, StateData, [{reply, From, {ok, Write}}]};
connection({call, From}, {application_data, AppData},
- #data{socket_options = #socket_options{packet = Packet}} =
+ #data{static = #static{socket_options = #socket_options{packet = Packet}}} =
StateData) ->
case encode_packet(Packet, AppData) of
{error, _} = Error ->
@@ -235,40 +239,40 @@ connection({call, From}, {application_data, AppData},
Data ->
send_application_data(Data, From, ?FUNCTION_NAME, StateData)
end;
-connection({call, From}, {set_opts, _} = Call, StateData) ->
- handle_call(From, Call, ?FUNCTION_NAME, StateData);
+connection({call, From}, {ack_alert, #alert{} = Alert}, StateData0) ->
+ StateData = send_tls_alert(Alert, StateData0),
+ {next_state, ?FUNCTION_NAME, StateData,
+ [{reply,From,ok}]};
+connection({call, From}, renegotiate,
+ #data{connection_states = #{current_write := Write}} = StateData) ->
+ {next_state, handshake, StateData, [{reply, From, {ok, Write}}]};
+connection({call, From}, downgrade, #data{connection_states =
+ #{current_write := Write}} = StateData) ->
+ {next_state, death_row, StateData, [{reply,From, {ok, Write}}]};
+connection({call, From}, {set_opts, Opts}, StateData) ->
+ handle_set_opts(From, Opts, StateData);
connection({call, From}, dist_get_tls_socket,
- #data{protocol_cb = Connection,
- transport_cb = Transport,
- socket = Socket,
- connection_pid = Pid,
- tracker = Tracker} = StateData) ->
- TLSSocket = Connection:socket([Pid, self()], Transport, Socket, Connection, Tracker),
+ #data{static = #static{transport_cb = Transport,
+ socket = Socket,
+ connection_pid = Pid,
+ tracker = Tracker}} = StateData) ->
+ TLSSocket = tls_connection:socket([Pid, self()], Transport, Socket, Tracker),
{next_state, ?FUNCTION_NAME, StateData, [{reply, From, {ok, TLSSocket}}]};
connection({call, From}, {dist_handshake_complete, _Node, DHandle},
- #data{connection_pid = Pid,
- socket_options = #socket_options{packet = Packet}} =
- StateData) ->
+ #data{static = #static{connection_pid = Pid} = Static} = StateData) ->
ok = erlang:dist_ctrl_input_handler(DHandle, Pid),
ok = ssl_connection:dist_handshake_complete(Pid, DHandle),
%% From now on we execute on normal priority
process_flag(priority, normal),
- {next_state, ?FUNCTION_NAME, StateData#data{dist_handle = DHandle},
- [{reply, From, ok}
- | case dist_data(DHandle, Packet) of
- [] ->
- [];
- Data ->
- [{next_event, internal,
- {application_packets,{self(),undefined},Data}}]
- end]};
-connection({call, From}, {ack_alert, #alert{} = Alert}, StateData0) ->
- StateData = send_tls_alert(Alert, StateData0),
- {next_state, ?FUNCTION_NAME, StateData,
- [{reply,From,ok}]};
-connection({call, From}, downgrade, #data{connection_states =
- #{current_write := Write}} = StateData) ->
- {next_state, death_row, StateData, [{reply,From, {ok, Write}}]};
+ {keep_state, StateData#data{static = Static#static{dist_handle = DHandle}},
+ [{reply,From,ok}|
+ case dist_data(DHandle) of
+ [] ->
+ [];
+ Data ->
+ [{next_event, internal,
+ {application_packets,{self(),undefined},erlang:iolist_to_iovec(Data)}}]
+ end]};
connection(internal, {application_packets, From, Data}, StateData) ->
send_application_data(Data, From, ?FUNCTION_NAME, StateData);
%%
@@ -276,29 +280,26 @@ connection(cast, #alert{} = Alert, StateData0) ->
StateData = send_tls_alert(Alert, StateData0),
{next_state, ?FUNCTION_NAME, StateData};
connection(cast, {new_write, WritesState, Version},
- #data{connection_states = ConnectionStates0} = StateData) ->
+ #data{connection_states = ConnectionStates, static = Static} = StateData) ->
{next_state, connection,
StateData#data{connection_states =
- ConnectionStates0#{current_write => WritesState},
- negotiated_version = Version}};
+ ConnectionStates#{current_write => WritesState},
+ static = Static#static{negotiated_version = Version}}};
%%
-connection(info, dist_data,
- #data{dist_handle = DHandle,
- socket_options = #socket_options{packet = Packet}} =
- StateData) ->
- {next_state, ?FUNCTION_NAME, StateData,
- case dist_data(DHandle, Packet) of
+connection(info, dist_data, #data{static = #static{dist_handle = DHandle}}) ->
+ {keep_state_and_data,
+ case dist_data(DHandle) of
[] ->
[];
Data ->
[{next_event, internal,
- {application_packets,{self(),undefined},Data}}]
+ {application_packets,{self(),undefined},erlang:iolist_to_iovec(Data)}}]
end};
connection(info, tick, StateData) ->
consume_ticks(),
- {next_state, ?FUNCTION_NAME, StateData,
- [{next_event, {call, {self(), undefined}},
- {application_data, <<>>}}]};
+ Data = [<<0:32>>], % encode_packet(4, <<>>)
+ From = {self(), undefined},
+ send_application_data(Data, From, ?FUNCTION_NAME, StateData);
connection(info, {send, From, Ref, Data}, _StateData) ->
%% This is for testing only!
%%
@@ -307,29 +308,37 @@ connection(info, {send, From, Ref, Data}, _StateData) ->
From ! {Ref, ok},
{keep_state_and_data,
[{next_event, {call, {self(), undefined}},
- {application_data, iolist_to_binary(Data)}}]};
-connection(info, Msg, StateData) ->
- handle_info(Msg, ?FUNCTION_NAME, StateData).
+ {application_data, erlang:iolist_to_iovec(Data)}}]};
+?HANDLE_COMMON.
+
%%--------------------------------------------------------------------
-spec handshake(gen_statem:event_type(),
Msg :: term(),
StateData :: term()) ->
gen_statem:event_handler_result(atom()).
%%--------------------------------------------------------------------
-handshake({call, From}, {set_opts, _} = Call, StateData) ->
- handle_call(From, Call, ?FUNCTION_NAME, StateData);
+handshake({call, From}, {set_opts, Opts}, StateData) ->
+ handle_set_opts(From, Opts, StateData);
handshake({call, _}, _, _) ->
+ %% Postpone all calls to the connection state
+ {keep_state_and_data, [postpone]};
+handshake(internal, {application_packets,_,_}, _) ->
{keep_state_and_data, [postpone]};
handshake(cast, {new_write, WritesState, Version},
- #data{connection_states = ConnectionStates0} = StateData) ->
+ #data{connection_states = ConnectionStates, static = Static} = StateData) ->
{next_state, connection,
- StateData#data{connection_states =
- ConnectionStates0#{current_write => WritesState},
- negotiated_version = Version}};
-handshake(internal, {application_packets,_,_}, _) ->
+ StateData#data{connection_states = ConnectionStates#{current_write => WritesState},
+ static = Static#static{negotiated_version = Version}}};
+handshake(info, dist_data, _) ->
{keep_state_and_data, [postpone]};
-handshake(info, Msg, StateData) ->
- handle_info(Msg, ?FUNCTION_NAME, StateData).
+handshake(info, tick, _) ->
+ %% Ignore - data is sent anyway during handshake
+ consume_ticks(),
+ keep_state_and_data;
+handshake(info, {send, _, _, _}, _) ->
+ %% Testing only, OTP distribution test suites...
+ {keep_state_and_data, [postpone]};
+?HANDLE_COMMON.
%%--------------------------------------------------------------------
-spec death_row(gen_statem:event_type(),
@@ -364,68 +373,76 @@ code_change(_OldVsn, State, Data, _Extra) ->
%%%===================================================================
%%% Internal functions
%%%===================================================================
-handle_call(From, {set_opts, Opts}, StateName, #data{socket_options = SockOpts} = StateData) ->
- {next_state, StateName, StateData#data{socket_options = set_opts(SockOpts, Opts)}, [{reply, From, ok}]}.
-
-handle_info({'DOWN', Monitor, _, _, Reason}, _,
- #data{connection_monitor = Monitor,
- dist_handle = Handle} = StateData) when Handle =/= undefined->
- {next_state, death_row, StateData, [{state_timeout, 5000, Reason}]};
-handle_info({'DOWN', Monitor, _, _, _}, _,
- #data{connection_monitor = Monitor} = StateData) ->
+
+handle_set_opts(
+ From, Opts, #data{static = #static{socket_options = SockOpts} = Static} = StateData) ->
+ {keep_state, StateData#data{static = Static#static{socket_options = set_opts(SockOpts, Opts)}},
+ [{reply, From, ok}]}.
+
+handle_common(
+ {call, From}, {set_opts, Opts},
+ #data{static = #static{socket_options = SockOpts} = Static} = StateData) ->
+ {keep_state, StateData#data{static = Static#static{socket_options = set_opts(SockOpts, Opts)}},
+ [{reply, From, ok}]};
+handle_common(
+ info, {'DOWN', Monitor, _, _, Reason},
+ #data{static = #static{connection_monitor = Monitor,
+ dist_handle = Handle}} = StateData) when Handle =/= undefined ->
+ {next_state, death_row, StateData,
+ [{state_timeout, 5000, Reason}]};
+handle_common(
+ info, {'DOWN', Monitor, _, _, _},
+ #data{static = #static{connection_monitor = Monitor}} = StateData) ->
{stop, normal, StateData};
-handle_info(_,_,_) ->
+handle_common(info, Msg, _) ->
+ Report =
+ io_lib:format("TLS sender: Got unexpected info: ~p ~n", [Msg]),
+ error_logger:info_report(Report),
+ keep_state_and_data;
+handle_common(Type, Msg, _) ->
+ Report =
+ io_lib:format(
+ "TLS sender: Got unexpected event: ~p ~n", [{Type,Msg}]),
+ error_logger:error_report(Report),
keep_state_and_data.
-send_tls_alert(Alert, #data{negotiated_version = Version,
- socket = Socket,
- protocol_cb = Connection,
- transport_cb = Transport,
- connection_states = ConnectionStates0,
- log_level = LogLevel} = StateData0) ->
+send_tls_alert(#alert{} = Alert,
+ #data{static = #static{negotiated_version = Version,
+ socket = Socket,
+ transport_cb = Transport,
+ log_level = LogLevel},
+ connection_states = ConnectionStates0} = StateData0) ->
{BinMsg, ConnectionStates} =
- Connection:encode_alert(Alert, Version, ConnectionStates0),
- Connection:send(Transport, Socket, BinMsg),
- Report = #{direction => outbound,
- protocol => 'tls_record',
- message => BinMsg},
- ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}),
+ tls_record:encode_alert_record(Alert, Version, ConnectionStates0),
+ tls_socket:send(Transport, Socket, BinMsg),
+ ssl_logger:debug(LogLevel, outbound, 'record', BinMsg),
StateData0#data{connection_states = ConnectionStates}.
send_application_data(Data, From, StateName,
- #data{connection_pid = Pid,
- socket = Socket,
- dist_handle = DistHandle,
- negotiated_version = Version,
- protocol_cb = Connection,
- transport_cb = Transport,
- connection_states = ConnectionStates0,
- renegotiate_at = RenegotiateAt,
- log_level = LogLevel} = StateData0) ->
+ #data{static = #static{connection_pid = Pid,
+ socket = Socket,
+ dist_handle = DistHandle,
+ negotiated_version = Version,
+ transport_cb = Transport,
+ renegotiate_at = RenegotiateAt,
+ log_level = LogLevel},
+ connection_states = ConnectionStates0} = StateData0) ->
case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of
true ->
ssl_connection:internal_renegotiation(Pid, ConnectionStates0),
{next_state, handshake, StateData0,
[{next_event, internal, {application_packets, From, Data}}]};
false ->
- {Msgs, ConnectionStates} =
- Connection:encode_data(
- iolist_to_binary(Data), Version, ConnectionStates0),
+ {Msgs, ConnectionStates} = tls_record:encode_data(Data, Version, ConnectionStates0),
StateData = StateData0#data{connection_states = ConnectionStates},
- case Connection:send(Transport, Socket, Msgs) of
+ case tls_socket:send(Transport, Socket, Msgs) of
ok when DistHandle =/= undefined ->
- Report = #{direction => outbound,
- protocol => 'tls_record',
- message => Msgs},
- ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}),
+ ssl_logger:debug(LogLevel, outbound, 'record', Msgs),
{next_state, StateName, StateData, []};
Reason when DistHandle =/= undefined ->
{next_state, death_row, StateData, [{state_timeout, 5000, Reason}]};
ok ->
- Report = #{direction => outbound,
- protocol => 'tls_record',
- message => Msgs},
- ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}),
+ ssl_logger:debug(LogLevel, outbound, 'record', Msgs),
{next_state, StateName, StateData, [{reply, From, ok}]};
Result ->
{next_state, StateName, StateData, [{reply, From, Result}]}
@@ -436,9 +453,9 @@ send_application_data(Data, From, StateName,
encode_packet(Packet, Data) ->
Len = iolist_size(Data),
case Packet of
- 1 when Len < (1 bsl 8) -> [<<Len:8>>,Data];
- 2 when Len < (1 bsl 16) -> [<<Len:16>>,Data];
- 4 when Len < (1 bsl 32) -> [<<Len:32>>,Data];
+ 1 when Len < (1 bsl 8) -> [<<Len:8>>|Data];
+ 2 when Len < (1 bsl 16) -> [<<Len:16>>|Data];
+ 4 when Len < (1 bsl 32) -> [<<Len:32>>|Data];
N when N =:= 1; N =:= 2; N =:= 4 ->
{error,
{badarg, {packet_to_large, Len, (1 bsl (Packet bsl 3)) - 1}}};
@@ -475,22 +492,30 @@ call(FsmPid, Event) ->
{error, closed}
end.
-%%---------------Erlang distribution --------------------------------------
+%%-------------- Erlang distribution helpers ------------------------------
-dist_data(DHandle, Packet) ->
+dist_data(DHandle) ->
case erlang:dist_ctrl_get_data(DHandle) of
none ->
erlang:dist_ctrl_get_data_notification(DHandle),
[];
- Data ->
- %% This is encode_packet(4, Data) without Len check
- %% since the emulator will always deliver a Data
- %% smaller than 4 GB, and the distribution will
- %% therefore always have to use {packet,4}
+ %% This is encode_packet(4, Data) without Len check
+ %% since the emulator will always deliver a Data
+ %% smaller than 4 GB, and the distribution will
+ %% therefore always have to use {packet,4}
+ Data when is_binary(Data) ->
+ Len = byte_size(Data),
+ [[<<Len:32>>,Data]|dist_data(DHandle)];
+ [BA,BB] = Data ->
+ Len = byte_size(BA) + byte_size(BB),
+ [[<<Len:32>>|Data]|dist_data(DHandle)];
+ Data when is_list(Data) ->
Len = iolist_size(Data),
- [<<Len:32>>,Data|dist_data(DHandle, Packet)]
+ [[<<Len:32>>|Data]|dist_data(DHandle)]
end.
+
+%% Empty the inbox from distribution ticks - do not let them accumulate
consume_ticks() ->
receive tick ->
consume_ticks()
diff --git a/lib/ssl/src/tls_socket.erl b/lib/ssl/src/tls_socket.erl
index a391bc53de..c3c41d3e12 100644
--- a/lib/ssl/src/tls_socket.erl
+++ b/lib/ssl/src/tls_socket.erl
@@ -32,6 +32,7 @@
emulated_socket_options/2, get_emulated_opts/1,
set_emulated_opts/2, get_all_opts/1, handle_call/3, handle_cast/2,
handle_info/2, code_change/3]).
+-export([update_active_n/2]).
-record(state, {
emulated_opts,
@@ -51,7 +52,9 @@ listen(Transport, Port, #config{transport_info = {Transport, _, _, _},
case Transport:listen(Port, Options ++ internal_inet_values()) of
{ok, ListenSocket} ->
{ok, Tracker} = inherit_tracker(ListenSocket, EmOpts, SslOpts),
- {ok, #sslsocket{pid = {ListenSocket, Config#config{emulated = Tracker}}}};
+ Socket = #sslsocket{pid = {ListenSocket, Config#config{emulated = Tracker}}},
+ check_active_n(EmOpts, Socket),
+ {ok, Socket};
Err = {error, _} ->
Err
end.
@@ -117,14 +120,16 @@ socket(Pids, Transport, Socket, ConnectionCb, Tracker) ->
#sslsocket{pid = Pids,
%% "The name "fd" is keept for backwards compatibility
fd = {Transport, Socket, ConnectionCb, Tracker}}.
-setopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
+setopts(gen_tcp, Socket = #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
{SockOpts, EmulatedOpts} = split_options(Options),
ok = set_emulated_opts(Tracker, EmulatedOpts),
+ check_active_n(EmulatedOpts, Socket),
inet:setopts(ListenSocket, SockOpts);
-setopts(_, #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_},
+setopts(_, Socket = #sslsocket{pid = {ListenSocket, #config{transport_info = {Transport,_,_,_},
emulated = Tracker}}}, Options) ->
{SockOpts, EmulatedOpts} = split_options(Options),
ok = set_emulated_opts(Tracker, EmulatedOpts),
+ check_active_n(EmulatedOpts, Socket),
Transport:setopts(ListenSocket, SockOpts);
%%% Following clauses will not be called for emulated options, they are handled in the connection process
setopts(gen_tcp, Socket, Options) ->
@@ -132,6 +137,31 @@ setopts(gen_tcp, Socket, Options) ->
setopts(Transport, Socket, Options) ->
Transport:setopts(Socket, Options).
+check_active_n(EmulatedOpts, Socket = #sslsocket{pid = {_, #config{emulated = Tracker}}}) ->
+ %% We check the resulting options to send an ssl_passive message if necessary.
+ case proplists:lookup(active, EmulatedOpts) of
+ %% The provided value is out of bound.
+ {_, N} when is_integer(N), N < -32768 ->
+ throw(einval);
+ {_, N} when is_integer(N), N > 32767 ->
+ throw(einval);
+ {_, N} when is_integer(N) ->
+ case get_emulated_opts(Tracker, [active]) of
+ [{_, false}] ->
+ self() ! {ssl_passive, Socket},
+ ok;
+ %% The result of the addition is out of bound.
+ [{_, A}] when is_integer(A), A < -32768 ->
+ throw(einval);
+ [{_, A}] when is_integer(A), A > 32767 ->
+ throw(einval);
+ _ ->
+ ok
+ end;
+ _ ->
+ ok
+ end.
+
getopts(gen_tcp, #sslsocket{pid = {ListenSocket, #config{emulated = Tracker}}}, Options) ->
{SockOptNames, EmulatedOptNames} = split_options(Options),
EmulatedOpts = get_emulated_opts(Tracker, EmulatedOptNames),
@@ -209,7 +239,7 @@ start_link(Port, SockOpts, SslOpts) ->
init([Port, Opts, SslOpts]) ->
process_flag(trap_exit, true),
true = link(Port),
- {ok, #state{emulated_opts = Opts, port = Port, ssl_opts = SslOpts}}.
+ {ok, #state{emulated_opts = do_set_emulated_opts(Opts, []), port = Port, ssl_opts = SslOpts}}.
%%--------------------------------------------------------------------
-spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}.
@@ -304,9 +334,24 @@ split_options([Name | Opts], Emu, SocketOptNames, EmuOptNames) ->
do_set_emulated_opts([], Opts) ->
Opts;
+do_set_emulated_opts([{active, N0} | Rest], Opts) when is_integer(N0) ->
+ N = update_active_n(N0, proplists:get_value(active, Opts, false)),
+ do_set_emulated_opts(Rest, [{active, N} | proplists:delete(active, Opts)]);
do_set_emulated_opts([{Name,_} = Opt | Rest], Opts) ->
do_set_emulated_opts(Rest, [Opt | proplists:delete(Name, Opts)]).
+update_active_n(New, Current) ->
+ if
+ is_integer(Current), New + Current =< 0 ->
+ false;
+ is_integer(Current) ->
+ New + Current;
+ New =< 0 ->
+ false;
+ true ->
+ New
+ end.
+
get_socket_opts(_, [], _) ->
[];
get_socket_opts(ListenSocket, SockOptNames, Cb) ->
@@ -366,6 +411,9 @@ validate_inet_option(header, Value)
when not is_integer(Value) ->
throw({error, {options, {header,Value}}});
validate_inet_option(active, Value)
+ when Value >= -32768, Value =< 32767 ->
+ ok;
+validate_inet_option(active, Value)
when Value =/= true, Value =/= false, Value =/= once ->
throw({error, {options, {active,Value}}});
validate_inet_option(_, _) ->
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index df2a421bce..f103f3218b 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -37,14 +37,14 @@
groups/1, groups/2, group_to_enum/1, enum_to_group/1, default_groups/1]).
-export([derive_secret/4, hkdf_expand_label/5, hkdf_extract/3, hkdf_expand/4,
- key_schedule/3, key_schedule/4,
+ key_schedule/3, key_schedule/4, create_info/3,
external_binder_key/2, resumption_binder_key/2,
client_early_traffic_secret/3, early_exporter_master_secret/3,
client_handshake_traffic_secret/3, server_handshake_traffic_secret/3,
client_application_traffic_secret_0/3, server_application_traffic_secret_0/3,
exporter_master_secret/3, resumption_master_secret/3,
update_traffic_secret/2, calculate_traffic_keys/3,
- transcript_hash/2]).
+ transcript_hash/2, finished_key/2, finished_verify_data/3]).
-type named_curve() :: sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 |
sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 |
@@ -64,7 +64,7 @@
%% TLS 1.3 ---------------------------------------------------
-spec derive_secret(Secret::binary(), Label::binary(),
- Messages::iodata(), Algo::ssl_cipher_format:hash()) -> Key::binary().
+ Messages::iodata(), Algo::ssl:hash()) -> Key::binary().
derive_secret(Secret, Label, Messages, Algo) ->
Hash = crypto:hash(mac_algo(Algo), Messages),
hkdf_expand_label(Secret, Label,
@@ -72,22 +72,28 @@ derive_secret(Secret, Label, Messages, Algo) ->
-spec hkdf_expand_label(Secret::binary(), Label0::binary(),
Context::binary(), Length::integer(),
- Algo::ssl_cipher_format:hash()) -> KeyingMaterial::binary().
+ Algo::ssl:hash()) -> KeyingMaterial::binary().
hkdf_expand_label(Secret, Label0, Context, Length, Algo) ->
+ HkdfLabel = create_info(Label0, Context, Length),
+ hkdf_expand(Secret, HkdfLabel, Length, Algo).
+
+%% Create info parameter for HKDF-Expand:
+%% HKDF-Expand(PRK, info, L) -> OKM
+create_info(Label0, Context0, Length) ->
%% struct {
%% uint16 length = Length;
%% opaque label<7..255> = "tls13 " + Label;
%% opaque context<0..255> = Context;
%% } HkdfLabel;
Label1 = << <<"tls13 ">>/binary, Label0/binary>>,
- LLen = size(Label1),
- Label = <<?BYTE(LLen), Label1/binary>>,
+ LabelLen = size(Label1),
+ Label = <<?BYTE(LabelLen), Label1/binary>>,
+ ContextLen = size(Context0),
+ Context = <<?BYTE(ContextLen),Context0/binary>>,
Content = <<Label/binary, Context/binary>>,
- Len = size(Content),
- HkdfLabel = <<?UINT16(Len), Content/binary>>,
- hkdf_expand(Secret, HkdfLabel, Length, Algo).
+ <<?UINT16(Length), Content/binary>>.
--spec hkdf_extract(MacAlg::ssl_cipher_format:hash(), Salt::binary(),
+-spec hkdf_extract(MacAlg::ssl:hash(), Salt::binary(),
KeyingMaterial::binary()) -> PseudoRandKey::binary().
hkdf_extract(MacAlg, Salt, KeyingMaterial) ->
@@ -95,14 +101,14 @@ hkdf_extract(MacAlg, Salt, KeyingMaterial) ->
-spec hkdf_expand(PseudoRandKey::binary(), ContextInfo::binary(),
- Length::integer(), Algo::ssl_cipher_format:hash()) -> KeyingMaterial::binary().
+ Length::integer(), Algo::ssl:hash()) -> KeyingMaterial::binary().
hkdf_expand(PseudoRandKey, ContextInfo, Length, Algo) ->
Iterations = erlang:ceil(Length / ssl_cipher:hash_size(Algo)),
hkdf_expand(Algo, PseudoRandKey, ContextInfo, Length, 1, Iterations, <<>>, <<>>).
--spec transcript_hash(Messages::iodata(), Algo::ssl_cipher_format:hash()) -> Hash::binary().
+-spec transcript_hash(Messages::iodata(), Algo::ssl:hash()) -> Hash::binary().
transcript_hash(Messages, Algo) ->
crypto:hash(mac_algo(Algo), Messages).
@@ -368,6 +374,25 @@ exporter_master_secret(Algo, {master_secret, Secret}, M) ->
resumption_master_secret(Algo, {master_secret, Secret}, M) ->
derive_secret(Secret, <<"res master">>, M, Algo).
+-spec finished_key(binary(), atom()) -> binary().
+finished_key(BaseKey, Algo) ->
+ %% finished_key =
+ %% HKDF-Expand-Label(BaseKey, "finished", "", Hash.length)
+ ssl_cipher:hash_size(Algo),
+ hkdf_expand_label(BaseKey, <<"finished">>, <<>>, ssl_cipher:hash_size(Algo), Algo).
+
+-spec finished_verify_data(binary(), atom(), iodata()) -> binary().
+finished_verify_data(FinishedKey, HKDFAlgo, Messages) ->
+ %% The verify_data value is computed as follows:
+ %%
+ %% verify_data =
+ %% HMAC(finished_key,
+ %% Transcript-Hash(Handshake Context,
+ %% Certificate*, CertificateVerify*))
+ Context = lists:reverse(Messages),
+ THash = tls_v1:transcript_hash(Context, HKDFAlgo),
+ tls_v1:hmac_hash(HKDFAlgo, FinishedKey, THash).
+
%% The next-generation application_traffic_secret is computed as:
%%
%% application_traffic_secret_N+1 =
@@ -394,7 +419,8 @@ update_traffic_secret(Algo, Secret) ->
-spec calculate_traffic_keys(atom(), atom(), binary()) -> {binary(), binary()}.
calculate_traffic_keys(HKDFAlgo, Cipher, Secret) ->
Key = hkdf_expand_label(Secret, <<"key">>, <<>>, ssl_cipher:key_material(Cipher), HKDFAlgo),
- IV = hkdf_expand_label(Secret, <<"iv">>, <<>>, ssl_cipher:key_material(Cipher), HKDFAlgo),
+ %% TODO: remove hard coded IV size
+ IV = hkdf_expand_label(Secret, <<"iv">>, <<>>, 12, HKDFAlgo),
{Key, IV}.
%% TLS v1.3 ---------------------------------------------------
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index a4adc7561b..57b74115ed 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -29,7 +29,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
# Application version
# ----------------------------------------------------
include ../vsn.mk
-VSN=$(GS_VSN)
+VSN=$(SSL_VSN)
# ----------------------------------------------------
# Target Specs
diff --git a/lib/ssl/test/property_test/ssl_eqc_handshake.erl b/lib/ssl/test/property_test/ssl_eqc_handshake.erl
index e4c4c89021..38a4b7fb11 100644
--- a/lib/ssl/test/property_test/ssl_eqc_handshake.erl
+++ b/lib/ssl/test/property_test/ssl_eqc_handshake.erl
@@ -96,7 +96,7 @@ tls_msg(?'TLS_v1.3'= Version) ->
encrypted_extensions(),
certificate_1_3(),
%%certificate_request_1_3,
- %%certificate_verify()
+ certificate_verify_1_3(),
finished(),
key_update()
]);
@@ -163,6 +163,13 @@ certificate_1_3() ->
certificate_list = certificate_entries(Certs, [])
}).
+certificate_verify_1_3() ->
+ ?LET(Certs, certificate_chain(),
+ #certificate_verify_1_3{
+ algorithm = sig_scheme(),
+ signature = signature()
+ }).
+
finished() ->
?LET(Size, digest_size(),
#finished{verify_data = crypto:strong_rand_bytes(Size)}).
@@ -511,6 +518,42 @@ sig_scheme_list() ->
ecdsa_sha1]
]).
+sig_scheme() ->
+ oneof([rsa_pkcs1_sha256,
+ rsa_pkcs1_sha384,
+ rsa_pkcs1_sha512,
+ ecdsa_secp256r1_sha256,
+ ecdsa_secp384r1_sha384,
+ ecdsa_secp521r1_sha512,
+ rsa_pss_rsae_sha256,
+ rsa_pss_rsae_sha384,
+ rsa_pss_rsae_sha512,
+ rsa_pss_pss_sha256,
+ rsa_pss_pss_sha384,
+ rsa_pss_pss_sha512,
+ rsa_pkcs1_sha1,
+ ecdsa_sha1]).
+
+signature() ->
+ <<44,119,215,137,54,84,156,26,121,212,64,173,189,226,
+ 191,46,76,89,204,2,78,79,163,228,90,21,89,179,4,198,
+ 109,14,52,26,230,22,56,8,170,129,86,0,7,132,245,81,
+ 181,131,62,70,79,167,112,85,14,171,175,162,110,29,
+ 212,198,45,188,83,176,251,197,224,104,95,74,89,59,
+ 26,60,63,79,238,196,137,65,23,199,127,145,176,184,
+ 216,3,48,116,172,106,97,83,227,172,246,137,91,79,
+ 173,119,169,60,67,1,177,117,9,93,38,86,232,253,73,
+ 140,17,147,130,110,136,245,73,10,91,70,105,53,225,
+ 158,107,60,190,30,14,26,92,147,221,60,117,104,53,70,
+ 142,204,7,131,11,183,192,120,246,243,68,99,147,183,
+ 49,149,48,188,8,218,17,150,220,121,2,99,194,140,35,
+ 13,249,201,37,216,68,45,87,58,18,10,106,11,132,241,
+ 71,170,225,216,197,212,29,107,36,80,189,184,202,56,
+ 86,213,45,70,34,74,71,48,137,79,212,194,172,151,57,
+ 57,30,126,24,157,198,101,220,84,162,89,105,185,245,
+ 76,105,212,176,25,6,148,49,194,106,253,241,212,200,
+ 37,154,227,53,49,216,72,82,163>>.
+
client_hello_versions(?'TLS_v1.3') ->
?LET(SupportedVersions,
oneof([[{3,4}],
@@ -739,10 +782,13 @@ key_share_entry_list(N, Pool, Acc) ->
key_exchange = P},
key_share_entry_list(N - 1, Pool -- [G], [KeyShareEntry|Acc]).
+%% TODO: fix curve generation
generate_public_key(Group)
when Group =:= secp256r1 orelse
Group =:= secp384r1 orelse
- Group =:= secp521r1 ->
+ Group =:= secp521r1 orelse
+ Group =:= x448 orelse
+ Group =:= x25519 ->
#'ECPrivateKey'{publicKey = PublicKey} =
public_key:generate_key({namedCurve, secp256r1}),
PublicKey;
diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl
index a5309e866b..ca8d0ec70c 100644
--- a/lib/ssl/test/ssl_ECC_SUITE.erl
+++ b/lib/ssl/test/ssl_ECC_SUITE.erl
@@ -212,53 +212,61 @@ client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) ->
ecc_default_order(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
- ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ ecdhe_ecdsa, ecdhe_ecdsa,
+ Config, DefaultCurve),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [],
- case ssl_test_lib:supported_eccs([{eccs, [sect571r1]}]) of
- true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs([{eccs, [DefaultCurve]}]) of
+ true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
ecc_default_order_custom_curves(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
- ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ ecdhe_ecdsa, ecdhe_ecdsa,
+ Config, DefaultCurve),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
- true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
+ true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
ecc_client_order(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
- ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ ecdhe_ecdsa, ecdhe_ecdsa,
+ Config, DefaultCurve),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
ECCOpts = [{honor_ecc_order, false}],
- case ssl_test_lib:supported_eccs([{eccs, [sect571r1]}]) of
- true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
+ case ssl_test_lib:supported_eccs([{eccs, [DefaultCurve]}]) of
+ true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
ecc_client_order_custom_curves(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
- ecdhe_ecdsa, ecdhe_ecdsa, Config),
+ ecdhe_ecdsa, ecdhe_ecdsa,
+ Config, DefaultCurve),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
- true -> ssl_test_lib:ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config);
+ true -> ssl_test_lib:ecc_test(DefaultCurve, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
@@ -274,12 +282,13 @@ ecc_unknown_curve(Config) ->
client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdh_rsa, ecdhe_ecdsa, Config),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
@@ -287,12 +296,13 @@ client_ecdh_rsa_server_ecdhe_ecdsa_server_custom(Config) ->
client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdh_rsa, ecdhe_rsa, Config),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
@@ -301,12 +311,13 @@ client_ecdh_rsa_server_ecdhe_rsa_server_custom(Config) ->
client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_rsa, ecdhe_ecdsa, Config),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
@@ -314,19 +325,21 @@ client_ecdhe_rsa_server_ecdhe_ecdsa_server_custom(Config) ->
client_ecdhe_rsa_server_ecdhe_rsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_rsa, ecdhe_rsa, Config),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
end.
client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
Ext = x509_test:extensions([{key_usage, [keyEncipherment]}]),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, [[], [], [{extensions, Ext}]]},
{client_chain, Default}],
@@ -334,8 +347,8 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) ->
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
- Expected = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))), %% The certificate curve
+ ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}],
+ Expected = secp256r1, %% The certificate curve
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(Expected, COpts, SOpts, [], ECCOpts, Config);
@@ -344,12 +357,13 @@ client_ecdhe_rsa_server_ecdh_rsa_server_custom(Config) ->
client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_ecdsa, ecdhe_ecdsa, Config),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
@@ -357,12 +371,13 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_server_custom(Config) ->
client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_ecdsa, ecdhe_rsa, Config),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config);
false -> {skip, "unsupported named curves"}
@@ -370,12 +385,13 @@ client_ecdhe_ecdsa_server_ecdhe_rsa_server_custom(Config) ->
client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_ecdsa, ecdhe_ecdsa, Config),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config);
false -> {skip, "unsupported named curves"}
@@ -383,12 +399,13 @@ client_ecdhe_ecdsa_server_ecdhe_ecdsa_client_custom(Config) ->
client_ecdhe_rsa_server_ecdhe_ecdsa_client_custom(Config) ->
Default = ssl_test_lib:default_cert_chain_conf(),
+ DefaultCurve = pubkey_cert_records:namedCurves(hd(tls_v1:ecc_curves(0))),
{COpts0, SOpts0} = ssl_test_lib:make_ec_cert_chains([{server_chain, Default},
{client_chain, Default}],
ecdhe_rsa, ecdhe_ecdsa, Config),
COpts = ssl_test_lib:ssl_options(COpts0, Config),
SOpts = ssl_test_lib:ssl_options(SOpts0, Config),
- ECCOpts = [{eccs, [secp256r1, sect571r1]}],
+ ECCOpts = [{eccs, [secp256r1, DefaultCurve]}],
case ssl_test_lib:supported_eccs(ECCOpts) of
true -> ssl_test_lib:ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config);
false -> {skip, "unsupported named curves"}
diff --git a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl
index 7f7c3da5ab..dfc780479e 100644
--- a/lib/ssl/test/ssl_alpn_handshake_SUITE.erl
+++ b/lib/ssl/test/ssl_alpn_handshake_SUITE.erl
@@ -153,41 +153,41 @@ protocols_must_be_a_binary_list(Config) when is_list(Config) ->
empty_client(Config) when is_list(Config) ->
run_failing_handshake(Config,
- [{alpn_advertised_protocols, []}],
- [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}],
- {error,{tls_alert,"no application protocol"}}).
+ [{alpn_advertised_protocols, []}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}],
+ no_application_protocol).
%--------------------------------------------------------------------------------
empty_server(Config) when is_list(Config) ->
run_failing_handshake(Config,
- [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
- [{alpn_preferred_protocols, []}],
- {error,{tls_alert,"no application protocol"}}).
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
+ [{alpn_preferred_protocols, []}],
+ no_application_protocol).
%--------------------------------------------------------------------------------
empty_client_empty_server(Config) when is_list(Config) ->
run_failing_handshake(Config,
- [{alpn_advertised_protocols, []}],
- [{alpn_preferred_protocols, []}],
- {error,{tls_alert,"no application protocol"}}).
+ [{alpn_advertised_protocols, []}],
+ [{alpn_preferred_protocols, []}],
+ no_application_protocol).
%--------------------------------------------------------------------------------
no_matching_protocol(Config) when is_list(Config) ->
run_failing_handshake(Config,
- [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
- [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}],
- {error,{tls_alert,"no application protocol"}}).
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"spdy/3">>, <<"http/2">>]}],
+ no_application_protocol).
%--------------------------------------------------------------------------------
client_alpn_and_server_alpn(Config) when is_list(Config) ->
run_handshake(Config,
- [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
- [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}],
- {ok, <<"http/1.1">>}).
+ [{alpn_advertised_protocols, [<<"http/1.0">>, <<"http/1.1">>]}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>, <<"http/1.1">>, <<"http/1.0">>]}],
+ {ok, <<"http/1.1">>}).
%--------------------------------------------------------------------------------
@@ -297,7 +297,7 @@ alpn_not_supported_server(Config) when is_list(Config)->
%% Internal functions ------------------------------------------------
%%--------------------------------------------------------------------
-run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult) ->
+run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedAlert) ->
ClientOpts = ClientExtraOpts ++ ssl_test_lib:ssl_options(client_rsa_opts, Config),
ServerOpts = ServerExtraOpts ++ ssl_test_lib:ssl_options(server_rsa_opts, Config),
@@ -313,8 +313,7 @@ run_failing_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedResult)
{from, self()},
{mfa, {?MODULE, placeholder, []}},
{options, ClientOpts}]),
- ssl_test_lib:check_result(Server, ExpectedResult,
- Client, ExpectedResult).
+ ssl_test_lib:check_client_alert(Server, Client, ExpectedAlert).
run_handshake(Config, ClientExtraOpts, ServerExtraOpts, ExpectedProtocol) ->
Data = "hello world",
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 0727505dde..b566e817f7 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,6 +29,7 @@
-include_lib("public_key/include/public_key.hrl").
-include("ssl_api.hrl").
+-include("ssl_cipher.hrl").
-include("ssl_internal.hrl").
-include("ssl_alert.hrl").
-include("ssl_internal.hrl").
@@ -166,8 +167,10 @@ api_tests() ->
accept_pool,
prf,
socket_options,
+ active_n,
cipher_suites,
handshake_continue,
+ handshake_continue_timeout,
hello_client_cancel,
hello_server_cancel
].
@@ -244,6 +247,7 @@ error_handling_tests()->
[close_transport_accept,
recv_active,
recv_active_once,
+ recv_active_n,
recv_error_handling,
call_in_error_state,
close_in_error_state,
@@ -272,7 +276,20 @@ rizzo_tests() ->
tls13_test_group() ->
[tls13_enable_client_side,
tls13_enable_server_side,
- tls_record_1_3_encode_decode].
+ tls_record_1_3_encode_decode,
+ tls13_finished_verify_data,
+ tls13_1_RTT_handshake,
+ tls13_basic_ssl_server_openssl_client,
+ tls13_custom_groups_ssl_server_openssl_client,
+ tls13_hello_retry_request_ssl_server_openssl_client,
+ tls13_client_auth_empty_cert_alert_ssl_server_openssl_client,
+ tls13_client_auth_empty_cert_ssl_server_openssl_client,
+ tls13_client_auth_ssl_server_openssl_client,
+ tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client,
+ tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client,
+ tls13_hrr_client_auth_ssl_server_openssl_client,
+ tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client,
+ tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client].
%%--------------------------------------------------------------------
init_per_suite(Config0) ->
@@ -690,6 +707,34 @@ handshake_continue(Config) when is_list(Config) ->
ssl_test_lib:close(Server),
ssl_test_lib:close(Client).
+%%------------------------------------------------------------------
+handshake_continue_timeout() ->
+ [{doc, "Test API function ssl:handshake_continue/3 with short timeout"}].
+handshake_continue_timeout(Config) when is_list(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_verification_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_verification_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {timeout, 1},
+ {options, ssl_test_lib:ssl_options([{reuseaddr, true}, {handshake, hello}],
+ Config)},
+ {continue_options, proplists:delete(reuseaddr, ServerOpts)}
+ ]),
+
+ Port = ssl_test_lib:inet_port(Server),
+
+
+ {connect_failed, _} = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Server, {error,timeout}),
+ ssl_test_lib:close(Server).
+
+
%%--------------------------------------------------------------------
hello_client_cancel() ->
[{doc, "Test API function ssl:handshake_cancel/1 on the client side"}].
@@ -711,14 +756,7 @@ hello_client_cancel(Config) when is_list(Config) ->
{from, self()},
{options, ssl_test_lib:ssl_options([{handshake, hello}], Config)},
{continue_options, cancel}]),
- receive
- {Server, {error, {tls_alert, "user canceled"}}} ->
- ok;
- {Server, {error, closed}} ->
- ct:pal("Did not receive the ALERT"),
- ok
- end.
-
+ ssl_test_lib:check_server_alert(Server, user_canceled).
%%--------------------------------------------------------------------
hello_server_cancel() ->
[{doc, "Test API function ssl:handshake_cancel/1 on the server side"}].
@@ -1192,9 +1230,8 @@ fallback(Config) when is_list(Config) ->
[{fallback, true},
{versions, ['tlsv1']}
| ClientOpts]}]),
-
- ssl_test_lib:check_result(Server, {error,{tls_alert,"inappropriate fallback"}},
- Client, {error,{tls_alert,"inappropriate fallback"}}).
+ ssl_test_lib:check_server_alert(Server, Client, inappropriate_fallback).
+
%%--------------------------------------------------------------------
cipher_format() ->
@@ -1966,7 +2003,7 @@ recv_active(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
recv_active_once() ->
- [{doc,"Test recv on active socket"}].
+ [{doc,"Test recv on active (once) socket"}].
recv_active_once(Config) when is_list(Config) ->
ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
@@ -1991,6 +2028,178 @@ recv_active_once(Config) when is_list(Config) ->
ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
+recv_active_n() ->
+ [{doc,"Test recv on active (n) socket"}].
+
+recv_active_n(Config) when is_list(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ Server =
+ ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active_once, []}},
+ {options, [{active, 1} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client =
+ ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE, try_recv_active_once, []}},
+ {options, [{active, 1} | ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
+%% Test case adapted from gen_tcp_misc_SUITE.
+active_n() ->
+ [{doc,"Test {active,N} option"}].
+
+active_n(Config) when is_list(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_opts, Config),
+ ServerOpts = ssl_test_lib:ssl_options(server_opts, Config),
+ Port = ssl_test_lib:inet_port(node()),
+ N = 3,
+ LS = ok(ssl:listen(Port, [{active,N}|ServerOpts])),
+ [{active,N}] = ok(ssl:getopts(LS, [active])),
+ active_n_common(LS, N),
+ Self = self(),
+ spawn_link(fun() ->
+ S0 = ok(ssl:transport_accept(LS)),
+ {ok, S} = ssl:handshake(S0),
+ ok = ssl:setopts(S, [{active,N}]),
+ [{active,N}] = ok(ssl:getopts(S, [active])),
+ ssl:controlling_process(S, Self),
+ Self ! {server, S}
+ end),
+ C = ok(ssl:connect("localhost", Port, [{active,N}|ClientOpts])),
+ [{active,N}] = ok(ssl:getopts(C, [active])),
+ S = receive
+ {server, S0} -> S0
+ after
+ 1000 ->
+ exit({error, connect})
+ end,
+ active_n_common(C, N),
+ active_n_common(S, N),
+ ok = ssl:setopts(C, [{active,N}]),
+ ok = ssl:setopts(S, [{active,N}]),
+ ReceiveMsg = fun(Socket, Msg) ->
+ receive
+ {ssl,Socket,Msg} ->
+ ok;
+ {ssl,Socket,Begin} ->
+ receive
+ {ssl,Socket,End} ->
+ Msg = Begin ++ End,
+ ok
+ after 1000 ->
+ exit(timeout)
+ end
+ after 1000 ->
+ exit(timeout)
+ end
+ end,
+ repeat(3, fun(I) ->
+ Msg = "message "++integer_to_list(I),
+ ok = ssl:send(C, Msg),
+ ReceiveMsg(S, Msg),
+ ok = ssl:send(S, Msg),
+ ReceiveMsg(C, Msg)
+ end),
+ receive
+ {ssl_passive,S} ->
+ [{active,false}] = ok(ssl:getopts(S, [active]))
+ after
+ 1000 ->
+ exit({error,ssl_passive})
+ end,
+ receive
+ {ssl_passive,C} ->
+ [{active,false}] = ok(ssl:getopts(C, [active]))
+ after
+ 1000 ->
+ exit({error,ssl_passive})
+ end,
+ LS2 = ok(ssl:listen(0, [{active,0}])),
+ receive
+ {ssl_passive,LS2} ->
+ [{active,false}] = ok(ssl:getopts(LS2, [active]))
+ after
+ 1000 ->
+ exit({error,ssl_passive})
+ end,
+ ok = ssl:close(LS2),
+ ok = ssl:close(C),
+ ok = ssl:close(S),
+ ok = ssl:close(LS),
+ ok.
+
+active_n_common(S, N) ->
+ ok = ssl:setopts(S, [{active,-N}]),
+ receive
+ {ssl_passive, S} -> ok
+ after
+ 1000 ->
+ error({error,ssl_passive_failure})
+ end,
+ [{active,false}] = ok(ssl:getopts(S, [active])),
+ ok = ssl:setopts(S, [{active,0}]),
+ receive
+ {ssl_passive, S} -> ok
+ after
+ 1000 ->
+ error({error,ssl_passive_failure})
+ end,
+ ok = ssl:setopts(S, [{active,32767}]),
+ {error,{options,_}} = ssl:setopts(S, [{active,1}]),
+ {error,{options,_}} = ssl:setopts(S, [{active,-32769}]),
+ ok = ssl:setopts(S, [{active,-32768}]),
+ receive
+ {ssl_passive, S} -> ok
+ after
+ 1000 ->
+ error({error,ssl_passive_failure})
+ end,
+ [{active,false}] = ok(ssl:getopts(S, [active])),
+ ok = ssl:setopts(S, [{active,N}]),
+ ok = ssl:setopts(S, [{active,true}]),
+ [{active,true}] = ok(ssl:getopts(S, [active])),
+ receive
+ _ -> error({error,active_n})
+ after
+ 0 ->
+ ok
+ end,
+ ok = ssl:setopts(S, [{active,N}]),
+ ok = ssl:setopts(S, [{active,once}]),
+ [{active,once}] = ok(ssl:getopts(S, [active])),
+ receive
+ _ -> error({error,active_n})
+ after
+ 0 ->
+ ok
+ end,
+ {error,{options,_}} = ssl:setopts(S, [{active,32768}]),
+ ok = ssl:setopts(S, [{active,false}]),
+ [{active,false}] = ok(ssl:getopts(S, [active])),
+ ok.
+
+ok({ok,V}) -> V.
+
+repeat(N, Fun) ->
+ repeat(N, N, Fun).
+
+repeat(N, T, Fun) when is_integer(N), N > 0 ->
+ Fun(T-N),
+ repeat(N-1, T, Fun);
+repeat(_, _, _) ->
+ ok.
+
+%%--------------------------------------------------------------------
dh_params() ->
[{doc,"Test to specify DH-params file in server."}].
@@ -2660,8 +2869,7 @@ default_reject_anonymous(Config) when is_list(Config) ->
[{ciphers,[CipherSuite]} |
ClientOpts]}]),
- ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}},
- Client, {error, {tls_alert, "insufficient security"}}).
+ ssl_test_lib:check_server_alert(Server, Client, insufficient_security).
%%--------------------------------------------------------------------
ciphers_ecdsa_signed_certs() ->
@@ -3513,8 +3721,7 @@ no_common_signature_algs(Config) when is_list(Config) ->
{options, [{signature_algs, [{sha384, rsa}]}
| ClientOpts]}]),
- ssl_test_lib:check_result(Server, {error, {tls_alert, "insufficient security"}},
- Client, {error, {tls_alert, "insufficient security"}}).
+ ssl_test_lib:check_server_alert(Server, Client, insufficient_security).
%%--------------------------------------------------------------------
@@ -3545,7 +3752,7 @@ tls_dont_crash_on_handshake_garbage(Config) ->
<<22, 3,3, 5:16, 92,64,37,228,209>> % garbage
]),
% Send unexpected change_cipher_spec
- ok = gen_tcp:send(Socket, <<20, 0,0,12, 111,40,244,7,137,224,16,109,197,110,249,152>>),
+ ok = gen_tcp:send(Socket, <<20, 3,3, 12:16, 111,40,244,7,137,224,16,109,197,110,249,152>>),
% Ensure we receive an alert, not sudden disconnect
{ok, <<21, _/binary>>} = drop_handshakes(Socket, 1000).
@@ -4073,6 +4280,9 @@ rizzo_one_n_minus_one(Config) when is_list(Config) ->
{cipher,
fun(rc4_128) ->
false;
+ %% TODO: remove this clause when chacha is fixed!
+ (chacha20_poly1305) ->
+ false;
(_) ->
true
end}]),
@@ -4214,8 +4424,7 @@ tls_versions_option(Config) when is_list(Config) ->
{Server, _} ->
ok
end,
-
- ssl_test_lib:check_result(ErrClient, {error, {tls_alert, "protocol version"}}).
+ ssl_test_lib:check_client_alert(ErrClient, protocol_version).
%%--------------------------------------------------------------------
@@ -4443,7 +4652,7 @@ tls_record_1_3_encode_decode(_Config) ->
15,117,155,48,24,112,61,15,113,208,127,51,179,227,194,232>>,
<<197,54,168,218,54,91,157,58,30,201,197,142,51,58,53,231,228,
131,57,122,170,78,82,196,30,48,23,16,95,255,185,236>>,
- undefined,undefined,16},
+ undefined,undefined,undefined,16},
client_verify_data => undefined,compression_state => undefined,
mac_secret => undefined,secure_renegotiation => undefined,
security_parameters =>
@@ -4469,7 +4678,7 @@ tls_record_1_3_encode_decode(_Config) ->
15,117,155,48,24,112,61,15,113,208,127,51,179,227,194,232>>,
<<197,54,168,218,54,91,157,58,30,201,197,142,51,58,53,231,228,
131,57,122,170,78,82,196,30,48,23,16,95,255,185,236>>,
- undefined,undefined,16},
+ undefined,undefined,undefined,16},
client_verify_data => undefined,compression_state => undefined,
mac_secret => undefined,secure_renegotiation => undefined,
security_parameters =>
@@ -4533,6 +4742,1112 @@ tls_record_1_3_encode_decode(_Config) ->
ct:log("Decoded: ~p ~n", [DecodedText]),
ok.
+tls13_1_RTT_handshake() ->
+ [{doc,"Test TLS 1.3 1-RTT Handshake"}].
+
+tls13_1_RTT_handshake(_Config) ->
+ %% ConnectionStates with NULL cipher
+ ConnStatesNull =
+ #{current_write =>
+ #{security_parameters =>
+ #security_parameters{cipher_suite = ?TLS_NULL_WITH_NULL_NULL},
+ sequence_number => 0
+ }
+ },
+
+ %% {client} construct a ClientHello handshake message:
+ %%
+ %% ClientHello (196 octets): 01 00 00 c0 03 03 cb 34 ec b1 e7 81 63
+ %% ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83
+ %% 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b
+ %% 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00
+ %% 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23
+ %% 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2
+ %% 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a
+ %% af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03
+ %% 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06
+ %% 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01
+ %%
+ %% {client} send handshake record:
+ %%
+ %% payload (196 octets): 01 00 00 c0 03 03 cb 34 ec b1 e7 81 63 ba
+ %% 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83 02
+ %% 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b 00
+ %% 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00 12
+ %% 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23 00
+ %% 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2 3d
+ %% 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af
+ %% 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03 02
+ %% 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06 02
+ %% 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01
+ %%
+ %% complete record (201 octets): 16 03 01 00 c4 01 00 00 c0 03 03 cb
+ %% 34 ec b1 e7 81 63 ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12
+ %% ec 18 a2 ef 62 83 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00
+ %% 00 91 00 00 00 0b 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01
+ %% 00 00 0a 00 14 00 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02
+ %% 01 03 01 04 00 23 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d
+ %% e5 60 e4 bd 43 d2 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d
+ %% 54 13 69 1e 52 9a af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e
+ %% 04 03 05 03 06 03 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02
+ %% 01 04 02 05 02 06 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01
+ ClientHello =
+ hexstr2bin("01 00 00 c0 03 03 cb 34 ec b1 e7 81 63
+ ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12 ec 18 a2 ef 62 83
+ 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00 00 91 00 00 00 0b
+ 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01 00 00 0a 00 14 00
+ 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 23
+ 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d e5 60 e4 bd 43 d2
+ 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a
+ af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e 04 03 05 03 06 03
+ 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02 01 04 02 05 02 06
+ 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01"),
+
+ ClientHelloRecord =
+ %% Current implementation always sets
+ %% legacy_record_version to Ox0303
+ hexstr2bin("16 03 03 00 c4 01 00 00 c0 03 03 cb
+ 34 ec b1 e7 81 63 ba 1c 38 c6 da cb 19 6a 6d ff a2 1a 8d 99 12
+ ec 18 a2 ef 62 83 02 4d ec e7 00 00 06 13 01 13 03 13 02 01 00
+ 00 91 00 00 00 0b 00 09 00 00 06 73 65 72 76 65 72 ff 01 00 01
+ 00 00 0a 00 14 00 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02
+ 01 03 01 04 00 23 00 00 00 33 00 26 00 24 00 1d 00 20 99 38 1d
+ e5 60 e4 bd 43 d2 3d 8e 43 5a 7d ba fe b3 c0 6e 51 c1 3c ae 4d
+ 54 13 69 1e 52 9a af 2c 00 2b 00 03 02 03 04 00 0d 00 20 00 1e
+ 04 03 05 03 06 03 02 03 08 04 08 05 08 06 04 01 05 01 06 01 02
+ 01 04 02 05 02 06 02 02 02 00 2d 00 02 01 01 00 1c 00 02 40 01"),
+
+ {CHEncrypted, _} =
+ tls_record:encode_handshake(ClientHello, {3,4}, ConnStatesNull),
+ ClientHelloRecord = iolist_to_binary(CHEncrypted),
+
+ %% {server} extract secret "early":
+ %%
+ %% salt: 0 (all zero octets)
+ %%
+ %% IKM (32 octets): 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
+ %% 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
+ %%
+ %% secret (32 octets): 33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c
+ %% e2 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a
+ HKDFAlgo = sha256,
+ Salt = binary:copy(<<?BYTE(0)>>, 32),
+ IKM = binary:copy(<<?BYTE(0)>>, 32),
+ EarlySecret =
+ hexstr2bin("33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c
+ e2 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a"),
+
+ {early_secret, EarlySecret} = tls_v1:key_schedule(early_secret, HKDFAlgo, {psk, Salt}),
+
+ %% {client} create an ephemeral x25519 key pair:
+ %%
+ %% private key (32 octets): 49 af 42 ba 7f 79 94 85 2d 71 3e f2 78
+ %% 4b cb ca a7 91 1d e2 6a dc 56 42 cb 63 45 40 e7 ea 50 05
+ %%
+ %% public key (32 octets): 99 38 1d e5 60 e4 bd 43 d2 3d 8e 43 5a 7d
+ %% ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af 2c
+ CPublicKey =
+ hexstr2bin("99 38 1d e5 60 e4 bd 43 d2 3d 8e 43 5a 7d
+ ba fe b3 c0 6e 51 c1 3c ae 4d 54 13 69 1e 52 9a af 2c"),
+
+ %% {server} create an ephemeral x25519 key pair:
+ %%
+ %% private key (32 octets): b1 58 0e ea df 6d d5 89 b8 ef 4f 2d 56
+ %% 52 57 8c c8 10 e9 98 01 91 ec 8d 05 83 08 ce a2 16 a2 1e
+ %%
+ %% public key (32 octets): c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6
+ %% 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f
+ SPrivateKey =
+ hexstr2bin("b1 58 0e ea df 6d d5 89 b8 ef 4f 2d 56
+ 52 57 8c c8 10 e9 98 01 91 ec 8d 05 83 08 ce a2 16 a2 1e"),
+
+ SPublicKey =
+ hexstr2bin("c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6
+ 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f"),
+
+ %% {server} construct a ServerHello handshake message:
+ %%
+ %% ServerHello (90 octets): 02 00 00 56 03 03 a6 af 06 a4 12 18 60
+ %% dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e
+ %% d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88
+ %% 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1
+ %% dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04
+ ServerHello =
+ hexstr2bin("02 00 00 56 03 03 a6 af 06 a4 12 18 60
+ dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e
+ d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88
+ 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1
+ dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04"),
+
+ %% {server} derive secret for handshake "tls13 derived":
+ %%
+ %% PRK (32 octets): 33 ad 0a 1c 60 7e c0 3b 09 e6 cd 98 93 68 0c e2
+ %% 10 ad f3 00 aa 1f 26 60 e1 b2 2e 10 f1 70 f9 2a
+ %%
+ %% hash (32 octets): e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24
+ %% 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55
+ %%
+ %% info (49 octets): 00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64
+ %% 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4
+ %% 64 9b 93 4c a4 95 99 1b 78 52 b8 55
+ %%
+ %% expanded (32 octets): 6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba
+ %% b6 97 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba
+ Hash =
+ hexstr2bin("e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24
+ 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55"),
+
+ Hash = crypto:hash(HKDFAlgo, <<>>),
+
+ Info =
+ hexstr2bin("00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64
+ 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4
+ 64 9b 93 4c a4 95 99 1b 78 52 b8 55"),
+
+ Info = tls_v1:create_info(<<"derived">>, Hash, ssl_cipher:hash_size(HKDFAlgo)),
+
+ Expanded =
+ hexstr2bin("6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba
+ b6 97 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba"),
+
+ Expanded = tls_v1:derive_secret(EarlySecret, <<"derived">>, <<>>, HKDFAlgo),
+
+ %% {server} extract secret "handshake":
+ %%
+ %% salt (32 octets): 6f 26 15 a1 08 c7 02 c5 67 8f 54 fc 9d ba b6 97
+ %% 16 c0 76 18 9c 48 25 0c eb ea c3 57 6c 36 11 ba
+ %%
+ %% IKM (32 octets): 8b d4 05 4f b5 5b 9d 63 fd fb ac f9 f0 4b 9f 0d
+ %% 35 e6 d6 3f 53 75 63 ef d4 62 72 90 0f 89 49 2d
+ %%
+ %% secret (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b
+ %% 01 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac
+
+ %% salt = Expanded
+ HandshakeIKM =
+ hexstr2bin("8b d4 05 4f b5 5b 9d 63 fd fb ac f9 f0 4b 9f 0d
+ 35 e6 d6 3f 53 75 63 ef d4 62 72 90 0f 89 49 2d"),
+
+ HandshakeSecret =
+ hexstr2bin("1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b
+ 01 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac"),
+
+ HandshakeIKM = crypto:compute_key(ecdh, CPublicKey, SPrivateKey, x25519),
+
+ {handshake_secret, HandshakeSecret} =
+ tls_v1:key_schedule(handshake_secret, HKDFAlgo, HandshakeIKM,
+ {early_secret, EarlySecret}),
+
+ %% {server} derive secret "tls13 c hs traffic":
+ %%
+ %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01
+ %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac
+ %%
+ %% hash (32 octets): 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed
+ %% d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8
+ %%
+ %% info (54 octets): 00 20 12 74 6c 73 31 33 20 63 20 68 73 20 74 72
+ %% 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58
+ %% ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8
+ %%
+ %% expanded (32 octets): b3 ed db 12 6e 06 7f 35 a7 80 b3 ab f4 5e
+ %% 2d 8f 3b 1a 95 07 38 f5 2e 96 00 74 6a 0e 27 a5 5a 21
+
+ %% PRK = HandshakeSecret
+ CHSTHash =
+ hexstr2bin("86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed
+ d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"),
+
+ CHSTInfo =
+ hexstr2bin("00 20 12 74 6c 73 31 33 20 63 20 68 73 20 74 72
+ 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58
+ ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"),
+
+ CHSTrafficSecret =
+ hexstr2bin(" b3 ed db 12 6e 06 7f 35 a7 80 b3 ab f4 5e
+ 2d 8f 3b 1a 95 07 38 f5 2e 96 00 74 6a 0e 27 a5 5a 21"),
+
+ CHSH = <<ClientHello/binary,ServerHello/binary>>,
+ CHSTHash = crypto:hash(HKDFAlgo, CHSH),
+ CHSTInfo = tls_v1:create_info(<<"c hs traffic">>, CHSTHash, ssl_cipher:hash_size(HKDFAlgo)),
+
+ CHSTrafficSecret =
+ tls_v1:client_handshake_traffic_secret(HKDFAlgo, {handshake_secret, HandshakeSecret}, CHSH),
+
+ %% {server} derive secret "tls13 s hs traffic":
+ %%
+ %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01
+ %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac
+ %%
+ %% hash (32 octets): 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58 ed
+ %% d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8
+ %%
+ %% info (54 octets): 00 20 12 74 6c 73 31 33 20 73 20 68 73 20 74 72
+ %% 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58
+ %% ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8
+ %%
+ %% expanded (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d
+ %% 37 b4 e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38
+
+ %% PRK = HandshakeSecret
+ %% hash = CHSTHash
+ SHSTInfo =
+ hexstr2bin("00 20 12 74 6c 73 31 33 20 73 20 68 73 20 74 72
+ 61 66 66 69 63 20 86 0c 06 ed c0 78 58 ee 8e 78 f0 e7 42 8c 58
+ ed d6 b4 3f 2c a3 e6 e9 5f 02 ed 06 3c f0 e1 ca d8"),
+
+ SHSTrafficSecret =
+ hexstr2bin("b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d
+ 37 b4 e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38"),
+
+ SHSTInfo = tls_v1:create_info(<<"s hs traffic">>, CHSTHash, ssl_cipher:hash_size(HKDFAlgo)),
+
+ SHSTrafficSecret =
+ tls_v1:server_handshake_traffic_secret(HKDFAlgo, {handshake_secret, HandshakeSecret}, CHSH),
+
+
+ %% {server} derive secret for master "tls13 derived":
+ %%
+ %% PRK (32 octets): 1d c8 26 e9 36 06 aa 6f dc 0a ad c1 2f 74 1b 01
+ %% 04 6a a6 b9 9f 69 1e d2 21 a9 f0 ca 04 3f be ac
+ %%
+ %% hash (32 octets): e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24
+ %% 27 ae 41 e4 64 9b 93 4c a4 95 99 1b 78 52 b8 55
+ %%
+ %% info (49 octets): 00 20 0d 74 6c 73 31 33 20 64 65 72 69 76 65 64
+ %% 20 e3 b0 c4 42 98 fc 1c 14 9a fb f4 c8 99 6f b9 24 27 ae 41 e4
+ %% 64 9b 93 4c a4 95 99 1b 78 52 b8 55
+ %%
+ %% expanded (32 octets): 43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25
+ %% 90 b5 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4
+
+ %% PRK = HandshakeSecret
+ %% hash = Hash
+ %% info = Info
+ MasterDeriveSecret =
+ hexstr2bin("43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25
+ 90 b5 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4"),
+
+ MasterDeriveSecret = tls_v1:derive_secret(HandshakeSecret, <<"derived">>, <<>>, HKDFAlgo),
+
+ %% {server} extract secret "master":
+ %%
+ %% salt (32 octets): 43 de 77 e0 c7 77 13 85 9a 94 4d b9 db 25 90 b5
+ %% 31 90 a6 5b 3e e2 e4 f1 2d d7 a0 bb 7c e2 54 b4
+ %%
+ %% IKM (32 octets): 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
+ %% 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
+ %%
+ %% secret (32 octets): 18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a
+ %% 47 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19
+
+ %% salt = MasterDeriveSecret
+ %% IKM = IKM
+ MasterSecret =
+ hexstr2bin("18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a
+ 47 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19"),
+
+ {master_secret, MasterSecret} =
+ tls_v1:key_schedule(master_secret, HKDFAlgo, {handshake_secret, HandshakeSecret}),
+
+ %% {server} send handshake record:
+ %%
+ %% payload (90 octets): 02 00 00 56 03 03 a6 af 06 a4 12 18 60 dc 5e
+ %% 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14 34 da c1 55 77 2e d3 e2
+ %% 69 28 00 13 01 00 00 2e 00 33 00 24 00 1d 00 20 c9 82 88 76 11
+ %% 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6 cc 25 3b 83 3d f1 dd 69
+ %% b1 b0 4e 75 1f 0f 00 2b 00 02 03 04
+ %%
+ %% complete record (95 octets): 16 03 03 00 5a 02 00 00 56 03 03 a6
+ %% af 06 a4 12 18 60 dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14
+ %% 34 da c1 55 77 2e d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00
+ %% 1d 00 20 c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6
+ %% cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04
+
+ %% payload = ServerHello
+ ServerHelloRecord =
+ hexstr2bin("16 03 03 00 5a 02 00 00 56 03 03 a6
+ af 06 a4 12 18 60 dc 5e 6e 60 24 9c d3 4c 95 93 0c 8a c5 cb 14
+ 34 da c1 55 77 2e d3 e2 69 28 00 13 01 00 00 2e 00 33 00 24 00
+ 1d 00 20 c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 56 d6
+ cc 25 3b 83 3d f1 dd 69 b1 b0 4e 75 1f 0f 00 2b 00 02 03 04"),
+
+ {SHEncrypted, _} =
+ tls_record:encode_handshake(ServerHello, {3,4}, ConnStatesNull),
+ ServerHelloRecord = iolist_to_binary(SHEncrypted),
+
+ %% {server} derive write traffic keys for handshake data:
+ %%
+ %% PRK (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d 37 b4
+ %% e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38
+ %%
+ %% key info (13 octets): 00 10 09 74 6c 73 31 33 20 6b 65 79 00
+ %%
+ %% key expanded (16 octets): 3f ce 51 60 09 c2 17 27 d0 f2 e4 e8 6e
+ %% e4 03 bc
+ %%
+ %% iv info (12 octets): 00 0c 08 74 6c 73 31 33 20 69 76 00
+ %%
+ %% iv expanded (12 octets): 5d 31 3e b2 67 12 76 ee 13 00 0b 30
+
+ %% PRK = SHSTrafficSecret
+ WriteKeyInfo =
+ hexstr2bin("00 10 09 74 6c 73 31 33 20 6b 65 79 00"),
+
+ WriteKey =
+ hexstr2bin("3f ce 51 60 09 c2 17 27 d0 f2 e4 e8 6e e4 03 bc"),
+
+ WriteIVInfo =
+ hexstr2bin("00 0c 08 74 6c 73 31 33 20 69 76 00"),
+
+ WriteIV =
+ hexstr2bin(" 5d 31 3e b2 67 12 76 ee 13 00 0b 30"),
+
+ Cipher = aes_128_gcm, %% TODO: get from ServerHello
+
+ WriteKeyInfo = tls_v1:create_info(<<"key">>, <<>>, ssl_cipher:key_material(Cipher)),
+ %% TODO: remove hardcoded IV size
+ WriteIVInfo = tls_v1:create_info(<<"iv">>, <<>>, 12),
+
+ {WriteKey, WriteIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, SHSTrafficSecret),
+
+ %% {server} construct an EncryptedExtensions handshake message:
+ %%
+ %% EncryptedExtensions (40 octets): 08 00 00 24 00 22 00 0a 00 14 00
+ %% 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 1c
+ %% 00 02 40 01 00 00 00 00
+ %%
+ %% {server} construct a Certificate handshake message:
+ %%
+ %% Certificate (445 octets): 0b 00 01 b9 00 00 01 b5 00 01 b0 30 82
+ %% 01 ac 30 82 01 15 a0 03 02 01 02 02 01 02 30 0d 06 09 2a 86 48
+ %% 86 f7 0d 01 01 0b 05 00 30 0e 31 0c 30 0a 06 03 55 04 03 13 03
+ %% 72 73 61 30 1e 17 0d 31 36 30 37 33 30 30 31 32 33 35 39 5a 17
+ %% 0d 32 36 30 37 33 30 30 31 32 33 35 39 5a 30 0e 31 0c 30 0a 06
+ %% 03 55 04 03 13 03 72 73 61 30 81 9f 30 0d 06 09 2a 86 48 86 f7
+ %% 0d 01 01 01 05 00 03 81 8d 00 30 81 89 02 81 81 00 b4 bb 49 8f
+ %% 82 79 30 3d 98 08 36 39 9b 36 c6 98 8c 0c 68 de 55 e1 bd b8 26
+ %% d3 90 1a 24 61 ea fd 2d e4 9a 91 d0 15 ab bc 9a 95 13 7a ce 6c
+ %% 1a f1 9e aa 6a f9 8c 7c ed 43 12 09 98 e1 87 a8 0e e0 cc b0 52
+ %% 4b 1b 01 8c 3e 0b 63 26 4d 44 9a 6d 38 e2 2a 5f da 43 08 46 74
+ %% 80 30 53 0e f0 46 1c 8c a9 d9 ef bf ae 8e a6 d1 d0 3e 2b d1 93
+ %% ef f0 ab 9a 80 02 c4 74 28 a6 d3 5a 8d 88 d7 9f 7f 1e 3f 02 03
+ %% 01 00 01 a3 1a 30 18 30 09 06 03 55 1d 13 04 02 30 00 30 0b 06
+ %% 03 55 1d 0f 04 04 03 02 05 a0 30 0d 06 09 2a 86 48 86 f7 0d 01
+ %% 01 0b 05 00 03 81 81 00 85 aa d2 a0 e5 b9 27 6b 90 8c 65 f7 3a
+ %% 72 67 17 06 18 a5 4c 5f 8a 7b 33 7d 2d f7 a5 94 36 54 17 f2 ea
+ %% e8 f8 a5 8c 8f 81 72 f9 31 9c f3 6b 7f d6 c5 5b 80 f2 1a 03 01
+ %% 51 56 72 60 96 fd 33 5e 5e 67 f2 db f1 02 70 2e 60 8c ca e6 be
+ %% c1 fc 63 a4 2a 99 be 5c 3e b7 10 7c 3c 54 e9 b9 eb 2b d5 20 3b
+ %% 1c 3b 84 e0 a8 b2 f7 59 40 9b a3 ea c9 d9 1d 40 2d cc 0c c8 f8
+ %% 96 12 29 ac 91 87 b4 2b 4d e1 00 00
+ %%
+ %% {server} construct a CertificateVerify handshake message:
+ %%
+ %% CertificateVerify (136 octets): 0f 00 00 84 08 04 00 80 5a 74 7c
+ %% 5d 88 fa 9b d2 e5 5a b0 85 a6 10 15 b7 21 1f 82 4c d4 84 14 5a
+ %% b3 ff 52 f1 fd a8 47 7b 0b 7a bc 90 db 78 e2 d3 3a 5c 14 1a 07
+ %% 86 53 fa 6b ef 78 0c 5e a2 48 ee aa a7 85 c4 f3 94 ca b6 d3 0b
+ %% be 8d 48 59 ee 51 1f 60 29 57 b1 54 11 ac 02 76 71 45 9e 46 44
+ %% 5c 9e a5 8c 18 1e 81 8e 95 b8 c3 fb 0b f3 27 84 09 d3 be 15 2a
+ %% 3d a5 04 3e 06 3d da 65 cd f5 ae a2 0d 53 df ac d4 2f 74 f3
+ EncryptedExtensions =
+ hexstr2bin("08 00 00 24 00 22 00 0a 00 14 00
+ 12 00 1d 00 17 00 18 00 19 01 00 01 01 01 02 01 03 01 04 00 1c
+ 00 02 40 01 00 00 00 00"),
+
+ Certificate =
+ hexstr2bin("0b 00 01 b9 00 00 01 b5 00 01 b0 30 82
+ 01 ac 30 82 01 15 a0 03 02 01 02 02 01 02 30 0d 06 09 2a 86 48
+ 86 f7 0d 01 01 0b 05 00 30 0e 31 0c 30 0a 06 03 55 04 03 13 03
+ 72 73 61 30 1e 17 0d 31 36 30 37 33 30 30 31 32 33 35 39 5a 17
+ 0d 32 36 30 37 33 30 30 31 32 33 35 39 5a 30 0e 31 0c 30 0a 06
+ 03 55 04 03 13 03 72 73 61 30 81 9f 30 0d 06 09 2a 86 48 86 f7
+ 0d 01 01 01 05 00 03 81 8d 00 30 81 89 02 81 81 00 b4 bb 49 8f
+ 82 79 30 3d 98 08 36 39 9b 36 c6 98 8c 0c 68 de 55 e1 bd b8 26
+ d3 90 1a 24 61 ea fd 2d e4 9a 91 d0 15 ab bc 9a 95 13 7a ce 6c
+ 1a f1 9e aa 6a f9 8c 7c ed 43 12 09 98 e1 87 a8 0e e0 cc b0 52
+ 4b 1b 01 8c 3e 0b 63 26 4d 44 9a 6d 38 e2 2a 5f da 43 08 46 74
+ 80 30 53 0e f0 46 1c 8c a9 d9 ef bf ae 8e a6 d1 d0 3e 2b d1 93
+ ef f0 ab 9a 80 02 c4 74 28 a6 d3 5a 8d 88 d7 9f 7f 1e 3f 02 03
+ 01 00 01 a3 1a 30 18 30 09 06 03 55 1d 13 04 02 30 00 30 0b 06
+ 03 55 1d 0f 04 04 03 02 05 a0 30 0d 06 09 2a 86 48 86 f7 0d 01
+ 01 0b 05 00 03 81 81 00 85 aa d2 a0 e5 b9 27 6b 90 8c 65 f7 3a
+ 72 67 17 06 18 a5 4c 5f 8a 7b 33 7d 2d f7 a5 94 36 54 17 f2 ea
+ e8 f8 a5 8c 8f 81 72 f9 31 9c f3 6b 7f d6 c5 5b 80 f2 1a 03 01
+ 51 56 72 60 96 fd 33 5e 5e 67 f2 db f1 02 70 2e 60 8c ca e6 be
+ c1 fc 63 a4 2a 99 be 5c 3e b7 10 7c 3c 54 e9 b9 eb 2b d5 20 3b
+ 1c 3b 84 e0 a8 b2 f7 59 40 9b a3 ea c9 d9 1d 40 2d cc 0c c8 f8
+ 96 12 29 ac 91 87 b4 2b 4d e1 00 00"),
+
+ CertificateVerify =
+ hexstr2bin("0f 00 00 84 08 04 00 80 5a 74 7c
+ 5d 88 fa 9b d2 e5 5a b0 85 a6 10 15 b7 21 1f 82 4c d4 84 14 5a
+ b3 ff 52 f1 fd a8 47 7b 0b 7a bc 90 db 78 e2 d3 3a 5c 14 1a 07
+ 86 53 fa 6b ef 78 0c 5e a2 48 ee aa a7 85 c4 f3 94 ca b6 d3 0b
+ be 8d 48 59 ee 51 1f 60 29 57 b1 54 11 ac 02 76 71 45 9e 46 44
+ 5c 9e a5 8c 18 1e 81 8e 95 b8 c3 fb 0b f3 27 84 09 d3 be 15 2a
+ 3d a5 04 3e 06 3d da 65 cd f5 ae a2 0d 53 df ac d4 2f 74 f3"),
+
+ %% {server} calculate finished "tls13 finished":
+ %%
+ %% PRK (32 octets): b6 7b 7d 69 0c c1 6c 4e 75 e5 42 13 cb 2d 37 b4
+ %% e9 c9 12 bc de d9 10 5d 42 be fd 59 d3 91 ad 38
+ %%
+ %% hash (0 octets): (empty)
+ %%
+ %% info (18 octets): 00 20 0e 74 6c 73 31 33 20 66 69 6e 69 73 68 65
+ %% 64 00
+ %%
+ %% expanded (32 octets): 00 8d 3b 66 f8 16 ea 55 9f 96 b5 37 e8 85
+ %% c3 1f c0 68 bf 49 2c 65 2f 01 f2 88 a1 d8 cd c1 9f c8
+ %%
+ %% finished (32 octets): 9b 9b 14 1d 90 63 37 fb d2 cb dc e7 1d f4
+ %% de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 18
+
+ %% PRK = SHSTrafficSecret
+ FInfo =
+ hexstr2bin("00 20 0e 74 6c 73 31 33 20 66 69 6e 69 73 68 65
+ 64 00"),
+
+ FExpanded =
+ hexstr2bin("00 8d 3b 66 f8 16 ea 55 9f 96 b5 37 e8 85
+ c3 1f c0 68 bf 49 2c 65 2f 01 f2 88 a1 d8 cd c1 9f c8"),
+
+ FinishedVerifyData =
+ hexstr2bin("9b 9b 14 1d 90 63 37 fb d2 cb dc e7 1d f4
+ de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07 18"),
+
+ FInfo = tls_v1:create_info(<<"finished">>, <<>>, ssl_cipher:hash_size(HKDFAlgo)),
+
+ FExpanded = tls_v1:finished_key(SHSTrafficSecret, HKDFAlgo),
+
+ MessageHistory0 = [CertificateVerify,
+ Certificate,
+ EncryptedExtensions,
+ ServerHello,
+ ClientHello],
+
+ FinishedVerifyData = tls_v1:finished_verify_data(FExpanded, HKDFAlgo, MessageHistory0),
+
+ %% {server} construct a Finished handshake message:
+ %%
+ %% Finished (36 octets): 14 00 00 20 9b 9b 14 1d 90 63 37 fb d2 cb
+ %% dc e7 1d f4 de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07
+ %% 18
+ FinishedHSBin =
+ hexstr2bin("14 00 00 20 9b 9b 14 1d 90 63 37 fb d2 cb
+ dc e7 1d f4 de da 4a b4 2c 30 95 72 cb 7f ff ee 54 54 b7 8f 07
+ 18"),
+
+ FinishedHS = #finished{verify_data = FinishedVerifyData},
+
+ FinishedIOList = tls_handshake:encode_handshake(FinishedHS, {3,4}),
+ FinishedHSBin = iolist_to_binary(FinishedIOList),
+
+ %% {server} derive secret "tls13 c ap traffic":
+ %%
+ %% PRK (32 octets): 18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a 47
+ %% 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19
+ %%
+ %% hash (32 octets): 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b 1a
+ %% 00 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13
+ %%
+ %% info (54 octets): 00 20 12 74 6c 73 31 33 20 63 20 61 70 20 74 72
+ %% 61 66 66 69 63 20 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b
+ %% 1a 00 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13
+ %%
+ %% expanded (32 octets): 9e 40 64 6c e7 9a 7f 9d c0 5a f8 88 9b ce
+ %% 65 52 87 5a fa 0b 06 df 00 87 f7 92 eb b7 c1 75 04 a5
+
+ %% PRK = MasterSecret
+ CAPTHash =
+ hexstr2bin("96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b 1a
+ 00 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13"),
+ CAPTInfo =
+ hexstr2bin("00 20 12 74 6c 73 31 33 20 63 20 61 70 20 74 72
+ 61 66 66 69 63 20 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b
+ 1a 00 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13"),
+
+ CAPTrafficSecret =
+ hexstr2bin("9e 40 64 6c e7 9a 7f 9d c0 5a f8 88 9b ce
+ 65 52 87 5a fa 0b 06 df 00 87 f7 92 eb b7 c1 75 04 a5"),
+
+ CHSF = <<ClientHello/binary,
+ ServerHello/binary,
+ EncryptedExtensions/binary,
+ Certificate/binary,
+ CertificateVerify/binary,
+ FinishedHSBin/binary>>,
+
+ CAPTHash = crypto:hash(HKDFAlgo, CHSF),
+
+ CAPTInfo =
+ tls_v1:create_info(<<"c ap traffic">>, CAPTHash, ssl_cipher:hash_size(HKDFAlgo)),
+
+ CAPTrafficSecret =
+ tls_v1:client_application_traffic_secret_0(HKDFAlgo, {master_secret, MasterSecret}, CHSF),
+
+ %% {server} derive secret "tls13 s ap traffic":
+ %%
+ %% PRK (32 octets): 18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a 47
+ %% 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19
+ %%
+ %% hash (32 octets): 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b 1a
+ %% 00 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13
+ %%
+ %% info (54 octets): 00 20 12 74 6c 73 31 33 20 73 20 61 70 20 74 72
+ %% 61 66 66 69 63 20 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b
+ %% 1a 00 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13
+ %%
+ %% expanded (32 octets): a1 1a f9 f0 55 31 f8 56 ad 47 11 6b 45 a9
+ %% 50 32 82 04 b4 f4 4b fb 6b 3a 4b 4f 1f 3f cb 63 16 43
+
+ %% PRK = MasterSecret
+ %% hash = CAPTHash
+ SAPTInfo =
+ hexstr2bin(" 00 20 12 74 6c 73 31 33 20 73 20 61 70 20 74 72
+ 61 66 66 69 63 20 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b
+ 1a 00 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13"),
+
+ SAPTrafficSecret =
+ hexstr2bin("a1 1a f9 f0 55 31 f8 56 ad 47 11 6b 45 a9
+ 50 32 82 04 b4 f4 4b fb 6b 3a 4b 4f 1f 3f cb 63 16 43"),
+
+ SAPTInfo =
+ tls_v1:create_info(<<"s ap traffic">>, CAPTHash, ssl_cipher:hash_size(HKDFAlgo)),
+
+ SAPTrafficSecret =
+ tls_v1:server_application_traffic_secret_0(HKDFAlgo, {master_secret, MasterSecret}, CHSF),
+
+ %% {server} derive secret "tls13 exp master":
+ %%
+ %% PRK (32 octets): 18 df 06 84 3d 13 a0 8b f2 a4 49 84 4c 5f 8a 47
+ %% 80 01 bc 4d 4c 62 79 84 d5 a4 1d a8 d0 40 29 19
+ %%
+ %% hash (32 octets): 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b 1a
+ %% 00 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13
+ %%
+ %% info (52 octets): 00 20 10 74 6c 73 31 33 20 65 78 70 20 6d 61 73
+ %% 74 65 72 20 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b 1a 00
+ %% 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13
+ %%
+ %% expanded (32 octets): fe 22 f8 81 17 6e da 18 eb 8f 44 52 9e 67
+ %% 92 c5 0c 9a 3f 89 45 2f 68 d8 ae 31 1b 43 09 d3 cf 50
+
+ %% PRK = MasterSecret
+ %% hash = CAPTHash
+ ExporterInfo =
+ hexstr2bin("00 20 10 74 6c 73 31 33 20 65 78 70 20 6d 61 73
+ 74 65 72 20 96 08 10 2a 0f 1c cc 6d b6 25 0b 7b 7e 41 7b 1a 00
+ 0e aa da 3d aa e4 77 7a 76 86 c9 ff 83 df 13"),
+
+ ExporterMasterSecret =
+ hexstr2bin("fe 22 f8 81 17 6e da 18 eb 8f 44 52 9e 67
+ 92 c5 0c 9a 3f 89 45 2f 68 d8 ae 31 1b 43 09 d3 cf 50"),
+
+ ExporterInfo =
+ tls_v1:create_info(<<"exp master">>, CAPTHash, ssl_cipher:hash_size(HKDFAlgo)),
+
+ ExporterMasterSecret =
+ tls_v1:exporter_master_secret(HKDFAlgo, {master_secret, MasterSecret}, CHSF),
+
+ %% {server} derive write traffic keys for application data:
+ %%
+ %% PRK (32 octets): a1 1a f9 f0 55 31 f8 56 ad 47 11 6b 45 a9 50 32
+ %% 82 04 b4 f4 4b fb 6b 3a 4b 4f 1f 3f cb 63 16 43
+ %%
+ %% key info (13 octets): 00 10 09 74 6c 73 31 33 20 6b 65 79 00
+ %%
+ %% key expanded (16 octets): 9f 02 28 3b 6c 9c 07 ef c2 6b b9 f2 ac
+ %% 92 e3 56
+ %%
+ %% iv info (12 octets): 00 0c 08 74 6c 73 31 33 20 69 76 00
+ %%
+ %% iv expanded (12 octets): cf 78 2b 88 dd 83 54 9a ad f1 e9 84
+
+ %% PRK = SAPTrafficsecret
+ %% key info = WriteKeyInfo
+ %% iv info = WrtieIVInfo
+ SWKey =
+ hexstr2bin("9f 02 28 3b 6c 9c 07 ef c2 6b b9 f2 ac 92 e3 56"),
+
+ SWIV =
+ hexstr2bin("cf 78 2b 88 dd 83 54 9a ad f1 e9 84"),
+
+ {SWKey, SWIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, SAPTrafficSecret),
+
+ %% {server} derive read traffic keys for handshake data:
+ %%
+ %% PRK (32 octets): b3 ed db 12 6e 06 7f 35 a7 80 b3 ab f4 5e 2d 8f
+ %% 3b 1a 95 07 38 f5 2e 96 00 74 6a 0e 27 a5 5a 21
+ %%
+ %% key info (13 octets): 00 10 09 74 6c 73 31 33 20 6b 65 79 00
+ %%
+ %% key expanded (16 octets): db fa a6 93 d1 76 2c 5b 66 6a f5 d9 50
+ %% 25 8d 01
+ %%
+ %% iv info (12 octets): 00 0c 08 74 6c 73 31 33 20 69 76 00
+ %%
+ %% iv expanded (12 octets): 5b d3 c7 1b 83 6e 0b 76 bb 73 26 5f
+
+ %% PRK = CHSTrafficsecret
+ %% key info = WriteKeyInfo
+ %% iv info = WrtieIVInfo
+ SRKey =
+ hexstr2bin("db fa a6 93 d1 76 2c 5b 66 6a f5 d9 50 25 8d 01"),
+
+ SRIV =
+ hexstr2bin("5b d3 c7 1b 83 6e 0b 76 bb 73 26 5f"),
+
+ {SRKey, SRIV} = tls_v1:calculate_traffic_keys(HKDFAlgo, Cipher, CHSTrafficSecret).
+
+
+tls13_finished_verify_data() ->
+ [{doc,"Test TLS 1.3 Finished message handling"}].
+
+tls13_finished_verify_data(_Config) ->
+ ClientHello =
+ hexstr2bin("01 00 00 c6 03 03 00 01 02 03 04 05 06 07 08 09
+ 0a 0b 0c 0d 0e 0f 10 11 12 13 14 15 16 17 18 19
+ 1a 1b 1c 1d 1e 1f 20 e0 e1 e2 e3 e4 e5 e6 e7 e8
+ e9 ea eb ec ed ee ef f0 f1 f2 f3 f4 f5 f6 f7 f8
+ f9 fa fb fc fd fe ff 00 06 13 01 13 02 13 03 01
+ 00 00 77 00 00 00 18 00 16 00 00 13 65 78 61 6d
+ 70 6c 65 2e 75 6c 66 68 65 69 6d 2e 6e 65 74 00
+ 0a 00 08 00 06 00 1d 00 17 00 18 00 0d 00 14 00
+ 12 04 03 08 04 04 01 05 03 08 05 05 01 08 06 06
+ 01 02 01 00 33 00 26 00 24 00 1d 00 20 35 80 72
+ d6 36 58 80 d1 ae ea 32 9a df 91 21 38 38 51 ed
+ 21 a2 8e 3b 75 e9 65 d0 d2 cd 16 62 54 00 2d 00
+ 02 01 01 00 2b 00 03 02 03 04"),
+
+ ServerHello =
+ hexstr2bin("02 00 00 76 03 03 70 71 72 73 74 75 76 77 78 79
+ 7a 7b 7c 7d 7e 7f 80 81 82 83 84 85 86 87 88 89
+ 8a 8b 8c 8d 8e 8f 20 e0 e1 e2 e3 e4 e5 e6 e7 e8
+ e9 ea eb ec ed ee ef f0 f1 f2 f3 f4 f5 f6 f7 f8
+ f9 fa fb fc fd fe ff 13 01 00 00 2e 00 33 00 24
+ 00 1d 00 20 9f d7 ad 6d cf f4 29 8d d3 f9 6d 5b
+ 1b 2a f9 10 a0 53 5b 14 88 d7 f8 fa bb 34 9a 98
+ 28 80 b6 15 00 2b 00 02 03 04"),
+
+ EncryptedExtensions =
+ hexstr2bin("08 00 00 02 00 00"),
+
+ Certificate =
+ hexstr2bin("0b 00 03 2e 00 00 03 2a 00 03 25 30 82 03 21 30
+ 82 02 09 a0 03 02 01 02 02 08 15 5a 92 ad c2 04
+ 8f 90 30 0d 06 09 2a 86 48 86 f7 0d 01 01 0b 05
+ 00 30 22 31 0b 30 09 06 03 55 04 06 13 02 55 53
+ 31 13 30 11 06 03 55 04 0a 13 0a 45 78 61 6d 70
+ 6c 65 20 43 41 30 1e 17 0d 31 38 31 30 30 35 30
+ 31 33 38 31 37 5a 17 0d 31 39 31 30 30 35 30 31
+ 33 38 31 37 5a 30 2b 31 0b 30 09 06 03 55 04 06
+ 13 02 55 53 31 1c 30 1a 06 03 55 04 03 13 13 65
+ 78 61 6d 70 6c 65 2e 75 6c 66 68 65 69 6d 2e 6e
+ 65 74 30 82 01 22 30 0d 06 09 2a 86 48 86 f7 0d
+ 01 01 01 05 00 03 82 01 0f 00 30 82 01 0a 02 82
+ 01 01 00 c4 80 36 06 ba e7 47 6b 08 94 04 ec a7
+ b6 91 04 3f f7 92 bc 19 ee fb 7d 74 d7 a8 0d 00
+ 1e 7b 4b 3a 4a e6 0f e8 c0 71 fc 73 e7 02 4c 0d
+ bc f4 bd d1 1d 39 6b ba 70 46 4a 13 e9 4a f8 3d
+ f3 e1 09 59 54 7b c9 55 fb 41 2d a3 76 52 11 e1
+ f3 dc 77 6c aa 53 37 6e ca 3a ec be c3 aa b7 3b
+ 31 d5 6c b6 52 9c 80 98 bc c9 e0 28 18 e2 0b f7
+ f8 a0 3a fd 17 04 50 9e ce 79 bd 9f 39 f1 ea 69
+ ec 47 97 2e 83 0f b5 ca 95 de 95 a1 e6 04 22 d5
+ ee be 52 79 54 a1 e7 bf 8a 86 f6 46 6d 0d 9f 16
+ 95 1a 4c f7 a0 46 92 59 5c 13 52 f2 54 9e 5a fb
+ 4e bf d7 7a 37 95 01 44 e4 c0 26 87 4c 65 3e 40
+ 7d 7d 23 07 44 01 f4 84 ff d0 8f 7a 1f a0 52 10
+ d1 f4 f0 d5 ce 79 70 29 32 e2 ca be 70 1f df ad
+ 6b 4b b7 11 01 f4 4b ad 66 6a 11 13 0f e2 ee 82
+ 9e 4d 02 9d c9 1c dd 67 16 db b9 06 18 86 ed c1
+ ba 94 21 02 03 01 00 01 a3 52 30 50 30 0e 06 03
+ 55 1d 0f 01 01 ff 04 04 03 02 05 a0 30 1d 06 03
+ 55 1d 25 04 16 30 14 06 08 2b 06 01 05 05 07 03
+ 02 06 08 2b 06 01 05 05 07 03 01 30 1f 06 03 55
+ 1d 23 04 18 30 16 80 14 89 4f de 5b cc 69 e2 52
+ cf 3e a3 00 df b1 97 b8 1d e1 c1 46 30 0d 06 09
+ 2a 86 48 86 f7 0d 01 01 0b 05 00 03 82 01 01 00
+ 59 16 45 a6 9a 2e 37 79 e4 f6 dd 27 1a ba 1c 0b
+ fd 6c d7 55 99 b5 e7 c3 6e 53 3e ff 36 59 08 43
+ 24 c9 e7 a5 04 07 9d 39 e0 d4 29 87 ff e3 eb dd
+ 09 c1 cf 1d 91 44 55 87 0b 57 1d d1 9b df 1d 24
+ f8 bb 9a 11 fe 80 fd 59 2b a0 39 8c de 11 e2 65
+ 1e 61 8c e5 98 fa 96 e5 37 2e ef 3d 24 8a fd e1
+ 74 63 eb bf ab b8 e4 d1 ab 50 2a 54 ec 00 64 e9
+ 2f 78 19 66 0d 3f 27 cf 20 9e 66 7f ce 5a e2 e4
+ ac 99 c7 c9 38 18 f8 b2 51 07 22 df ed 97 f3 2e
+ 3e 93 49 d4 c6 6c 9e a6 39 6d 74 44 62 a0 6b 42
+ c6 d5 ba 68 8e ac 3a 01 7b dd fc 8e 2c fc ad 27
+ cb 69 d3 cc dc a2 80 41 44 65 d3 ae 34 8c e0 f3
+ 4a b2 fb 9c 61 83 71 31 2b 19 10 41 64 1c 23 7f
+ 11 a5 d6 5c 84 4f 04 04 84 99 38 71 2b 95 9e d6
+ 85 bc 5c 5d d6 45 ed 19 90 94 73 40 29 26 dc b4
+ 0e 34 69 a1 59 41 e8 e2 cc a8 4b b6 08 46 36 a0
+ 00 00"),
+
+ CertificateVerify =
+ hexstr2bin("0f 00 01 04 08 04 01 00 17 fe b5 33 ca 6d 00 7d
+ 00 58 25 79 68 42 4b bc 3a a6 90 9e 9d 49 55 75
+ 76 a5 20 e0 4a 5e f0 5f 0e 86 d2 4f f4 3f 8e b8
+ 61 ee f5 95 22 8d 70 32 aa 36 0f 71 4e 66 74 13
+ 92 6e f4 f8 b5 80 3b 69 e3 55 19 e3 b2 3f 43 73
+ df ac 67 87 06 6d cb 47 56 b5 45 60 e0 88 6e 9b
+ 96 2c 4a d2 8d ab 26 ba d1 ab c2 59 16 b0 9a f2
+ 86 53 7f 68 4f 80 8a ef ee 73 04 6c b7 df 0a 84
+ fb b5 96 7a ca 13 1f 4b 1c f3 89 79 94 03 a3 0c
+ 02 d2 9c bd ad b7 25 12 db 9c ec 2e 5e 1d 00 e5
+ 0c af cf 6f 21 09 1e bc 4f 25 3c 5e ab 01 a6 79
+ ba ea be ed b9 c9 61 8f 66 00 6b 82 44 d6 62 2a
+ aa 56 88 7c cf c6 6a 0f 38 51 df a1 3a 78 cf f7
+ 99 1e 03 cb 2c 3a 0e d8 7d 73 67 36 2e b7 80 5b
+ 00 b2 52 4f f2 98 a4 da 48 7c ac de af 8a 23 36
+ c5 63 1b 3e fa 93 5b b4 11 e7 53 ca 13 b0 15 fe
+ c7 e4 a7 30 f1 36 9f 9e"),
+
+ BaseKey =
+ hexstr2bin("a2 06 72 65 e7 f0 65 2a 92 3d 5d 72 ab 04 67 c4
+ 61 32 ee b9 68 b6 a3 2d 31 1c 80 58 68 54 88 14"),
+
+ VerifyData =
+ hexstr2bin("ea 6e e1 76 dc cc 4a f1 85 9e 9e 4e 93 f7 97 ea
+ c9 a7 8c e4 39 30 1e 35 27 5a d4 3f 3c dd bd e3"),
+
+ Messages = [CertificateVerify,
+ Certificate,
+ EncryptedExtensions,
+ ServerHello,
+ ClientHello],
+
+ FinishedKey = tls_v1:finished_key(BaseKey, sha256),
+ VerifyData = tls_v1:finished_verify_data(FinishedKey, sha256, Messages).
+
+tls13_basic_ssl_server_openssl_client() ->
+ [{doc,"Test TLS 1.3 basic connection between ssl server and openssl s_client"}].
+
+tls13_basic_ssl_server_openssl_client(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+tls13_custom_groups_ssl_server_openssl_client() ->
+ [{doc,"Test that ssl server can select a common group for key-exchange"}].
+
+tls13_custom_groups_ssl_server_openssl_client(Config) ->
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {supported_groups, [x448, secp256r1, secp384r1]}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ ClientOpts = [{groups,"P-384:P-256:X25519"}|ClientOpts0],
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+tls13_hello_retry_request_ssl_server_openssl_client() ->
+ [{doc,"Test that ssl server can request a new group when the client's first key share"
+ "is not supported"}].
+
+tls13_hello_retry_request_ssl_server_openssl_client(Config) ->
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {supported_groups, [x448, x25519]}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ ClientOpts = [{groups,"P-256:X25519"}|ClientOpts0],
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+tls13_client_auth_empty_cert_alert_ssl_server_openssl_client() ->
+ [{doc,"TLS 1.3: Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to true."}].
+
+tls13_client_auth_empty_cert_alert_ssl_server_openssl_client(Config) ->
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ %% Delete Client Cert and Key
+ ClientOpts1 = proplists:delete(certfile, ClientOpts0),
+ ClientOpts = proplists:delete(keyfile, ClientOpts1),
+
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {verify, verify_peer},
+ {fail_if_no_peer_cert, true}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server,
+ {error,
+ {tls_alert,
+ {certificate_required,
+ "received SERVER ALERT: Fatal - Certificate required - certificate_required"}}}),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+tls13_client_auth_empty_cert_ssl_server_openssl_client() ->
+ [{doc,"TLS 1.3: Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to false."}].
+
+tls13_client_auth_empty_cert_ssl_server_openssl_client(Config) ->
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ %% Delete Client Cert and Key
+ ClientOpts1 = proplists:delete(certfile, ClientOpts0),
+ ClientOpts = proplists:delete(keyfile, ClientOpts1),
+
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {verify, verify_peer},
+ {fail_if_no_peer_cert, false}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+
+tls13_client_auth_ssl_server_openssl_client() ->
+ [{doc,"TLS 1.3: Test client authentication."}].
+
+tls13_client_auth_ssl_server_openssl_client(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {verify, verify_peer},
+ {fail_if_no_peer_cert, true}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+
+tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client() ->
+ [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to true."}].
+
+tls13_hrr_client_auth_empty_cert_alert_ssl_server_openssl_client(Config) ->
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ %% Delete Client Cert and Key
+ ClientOpts1 = proplists:delete(certfile, ClientOpts0),
+ ClientOpts2 = proplists:delete(keyfile, ClientOpts1),
+ ClientOpts = [{groups,"P-256:X25519"}|ClientOpts2],
+
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {verify, verify_peer},
+ {fail_if_no_peer_cert, true},
+ {supported_groups, [x448, x25519]}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server,
+ {error,
+ {tls_alert,
+ {certificate_required,
+ "received SERVER ALERT: Fatal - Certificate required - certificate_required"}}}),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+
+tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client() ->
+ [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication when client sends an empty certificate and fail_if_no_peer_cert is set to false."}].
+
+tls13_hrr_client_auth_empty_cert_ssl_server_openssl_client(Config) ->
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ %% Delete Client Cert and Key
+ ClientOpts1 = proplists:delete(certfile, ClientOpts0),
+ ClientOpts2 = proplists:delete(keyfile, ClientOpts1),
+ ClientOpts = [{groups,"P-256:X25519"}|ClientOpts2],
+
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {verify, verify_peer},
+ {fail_if_no_peer_cert, false},
+ {supported_groups, [x448, x25519]}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+
+tls13_hrr_client_auth_ssl_server_openssl_client() ->
+ [{doc,"TLS 1.3 (HelloRetryRequest): Test client authentication."}].
+
+tls13_hrr_client_auth_ssl_server_openssl_client(Config) ->
+ ClientOpts0 = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+ ClientOpts = [{groups,"P-256:X25519"}|ClientOpts0],
+
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {verify, verify_peer},
+ {fail_if_no_peer_cert, true},
+ {supported_groups, [x448, x25519]}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+
+tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client() ->
+ [{doc,"TLS 1.3: Test client authentication with unsupported signature_algorithm"}].
+
+tls13_unsupported_sign_algo_client_auth_ssl_server_openssl_client(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {verify, verify_peer},
+ %% Skip rsa_pkcs1_sha256!
+ {signature_algs, [rsa_pkcs1_sha384, rsa_pkcs1_sha512]},
+ {fail_if_no_peer_cert, true}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(
+ Server,
+ {error,
+ {tls_alert,
+ {insufficient_security,
+ "received SERVER ALERT: Fatal - Insufficient Security - "
+ "\"No suitable signature algorithm\""}}}),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
+
+%% Triggers Client Alert as openssl s_client does not have a certificate with a
+%% signature algorithm supported by the server (signature_algorithms_cert extension
+%% of CertificateRequest does not contain the algorithm of the client certificate).
+tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client() ->
+ [{doc,"TLS 1.3: Test client authentication with unsupported signature_algorithm_cert"}].
+
+tls13_unsupported_sign_algo_cert_client_auth_ssl_server_openssl_client(Config) ->
+ ClientOpts = ssl_test_lib:ssl_options(client_rsa_opts, Config),
+
+ ServerOpts0 = ssl_test_lib:ssl_options(server_rsa_opts, Config),
+ %% Set versions
+ ServerOpts = [{versions, ['tlsv1.2','tlsv1.3']},
+ {log_level, debug},
+ {verify, verify_peer},
+ {signature_algs, [rsa_pkcs1_sha256, rsa_pkcs1_sha384, rsa_pss_rsae_sha256]},
+ %% Skip rsa_pkcs1_sha256!
+ {signature_algs_cert, [rsa_pkcs1_sha384, rsa_pkcs1_sha512]},
+ {fail_if_no_peer_cert, true}|ServerOpts0],
+ {_ClientNode, ServerNode, _Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_basic_client(openssl, 'tlsv1.3', Port, ClientOpts),
+
+ ssl_test_lib:check_result(
+ Server,
+ {error,
+ {tls_alert,
+ {illegal_parameter,
+ "received CLIENT ALERT: Fatal - Illegal Parameter"}}}),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close_port(Client).
+
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
@@ -5321,3 +6636,31 @@ tls_or_dtls('dtlsv1.2') ->
dtls;
tls_or_dtls(_) ->
tls.
+
+hexstr2int(S) ->
+ B = hexstr2bin(S),
+ Bits = size(B) * 8,
+ <<Integer:Bits/integer>> = B,
+ Integer.
+
+hexstr2bin(S) when is_binary(S) ->
+ hexstr2bin(S, <<>>);
+hexstr2bin(S) ->
+ hexstr2bin(list_to_binary(S), <<>>).
+%%
+hexstr2bin(<<>>, Acc) ->
+ Acc;
+hexstr2bin(<<C,T/binary>>, Acc) when C =:= 32; %% SPACE
+ C =:= 10; %% LF
+ C =:= 13 -> %% CR
+ hexstr2bin(T, Acc);
+hexstr2bin(<<X,Y,T/binary>>, Acc) ->
+ I = hex2int(X) * 16 + hex2int(Y),
+ hexstr2bin(T, <<Acc/binary,I>>).
+
+hex2int(C) when $0 =< C, C =< $9 ->
+ C - $0;
+hex2int(C) when $A =< C, C =< $F ->
+ C - $A + 10;
+hex2int(C) when $a =< C, C =< $f ->
+ C - $a + 10.
diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl
index 0b2011a627..35efa2b8a3 100644
--- a/lib/ssl/test/ssl_bench_SUITE.erl
+++ b/lib/ssl/test/ssl_bench_SUITE.erl
@@ -41,6 +41,7 @@ end_per_group(_GroupName, _Config) ->
ok.
init_per_suite(Config) ->
+ ct:timetrap({minutes, 1}),
case node() of
nonode@nohost ->
{skipped, "Node not distributed"};
@@ -163,7 +164,7 @@ do_test(Type, TC, Loop, ParallellConnections, Server) ->
end
end,
Spawn = fun(Id) ->
- Pid = spawn(fun() -> Test(Id) end),
+ Pid = spawn_link(fun() -> Test(Id) end),
receive {Pid, init} -> Pid end
end,
Pids = [Spawn(Id) || Id <- lists:seq(ParallellConnections, 1, -1)],
@@ -180,42 +181,42 @@ do_test(Type, TC, Loop, ParallellConnections, Server) ->
{ok, TestPerSecond}.
server_init(ssl, setup_connection, _, _, Server) ->
- {ok, Socket} = ssl:listen(0, ssl_opts(listen)),
- {ok, {_Host, Port}} = ssl:sockname(Socket),
+ {ok, LSocket} = ssl:listen(0, ssl_opts(listen)),
+ {ok, {_Host, Port}} = ssl:sockname(LSocket),
{ok, Host} = inet:gethostname(),
?FPROF_SERVER andalso start_profile(fprof, [whereis(ssl_manager), new]),
%%?EPROF_SERVER andalso start_profile(eprof, [ssl_connection_sup, ssl_manager]),
?EPROF_SERVER andalso start_profile(eprof, [ssl_manager]),
Server ! {self(), {init, Host, Port}},
Test = fun(TSocket) ->
- ok = ssl:ssl_accept(TSocket),
- ssl:close(TSocket)
+ {ok, Socket} = ssl:handshake(TSocket),
+ ssl:close(Socket)
end,
- setup_server_connection(Socket, Test);
+ setup_server_connection(LSocket, Test);
server_init(ssl, payload, Loop, _, Server) ->
- {ok, Socket} = ssl:listen(0, ssl_opts(listen)),
- {ok, {_Host, Port}} = ssl:sockname(Socket),
+ {ok, LSocket} = ssl:listen(0, ssl_opts(listen)),
+ {ok, {_Host, Port}} = ssl:sockname(LSocket),
{ok, Host} = inet:gethostname(),
Server ! {self(), {init, Host, Port}},
Test = fun(TSocket) ->
- ok = ssl:ssl_accept(TSocket),
+ {ok, Socket} = ssl:handshake(TSocket),
Size = byte_size(msg()),
- server_echo(TSocket, Size, Loop),
- ssl:close(TSocket)
+ server_echo(Socket, Size, Loop),
+ ssl:close(Socket)
end,
- setup_server_connection(Socket, Test);
+ setup_server_connection(LSocket, Test);
server_init(ssl, pem_cache, Loop, _, Server) ->
- {ok, Socket} = ssl:listen(0, ssl_opts(listen_der)),
- {ok, {_Host, Port}} = ssl:sockname(Socket),
+ {ok, LSocket} = ssl:listen(0, ssl_opts(listen_der)),
+ {ok, {_Host, Port}} = ssl:sockname(LSocket),
{ok, Host} = inet:gethostname(),
Server ! {self(), {init, Host, Port}},
Test = fun(TSocket) ->
- ok = ssl:ssl_accept(TSocket),
+ {ok, Socket} = ssl:handshake(TSocket),
Size = byte_size(msg()),
- server_echo(TSocket, Size, Loop),
- ssl:close(TSocket)
+ server_echo(Socket, Size, Loop),
+ ssl:close(Socket)
end,
- setup_server_connection(Socket, Test);
+ setup_server_connection(LSocket, Test);
server_init(Type, Tc, _, _, Server) ->
io:format("No server init code for ~p ~p~n",[Type, Tc]),
diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl
index bddcc2514d..8690faed54 100644
--- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl
+++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl
@@ -298,15 +298,8 @@ server_require_peer_cert_fail(Config) when is_list(Config) ->
{host, Hostname},
{from, self()},
{options, [{active, Active} | BadClientOpts]}]),
- receive
- {Server, {error, {tls_alert, "handshake failure"}}} ->
- receive
- {Client, {error, {tls_alert, "handshake failure"}}} ->
- ok;
- {Client, {error, closed}} ->
- ok
- end
- end.
+
+ ssl_test_lib:check_server_alert(Server, Client, handshake_failure).
%%--------------------------------------------------------------------
server_require_peer_cert_empty_ok() ->
@@ -365,15 +358,8 @@ server_require_peer_cert_partial_chain(Config) when is_list(Config) ->
{options, [{active, Active},
{cacerts, [RootCA]} |
proplists:delete(cacertfile, ClientOpts)]}]),
- receive
- {Server, {error, {tls_alert, "unknown ca"}}} ->
- receive
- {Client, {error, {tls_alert, "unknown ca"}}} ->
- ok;
- {Client, {error, closed}} ->
- ok
- end
- end.
+ ssl_test_lib:check_server_alert(Server, Client, unknown_ca).
+
%%--------------------------------------------------------------------
server_require_peer_cert_allow_partial_chain() ->
[{doc, "Server trusts intermediat CA and accepts a partial chain. (partial_chain option)"}].
@@ -446,17 +432,7 @@ server_require_peer_cert_do_not_allow_partial_chain(Config) when is_list(Config)
{from, self()},
{mfa, {ssl_test_lib, no_result, []}},
{options, ClientOpts}]),
-
- receive
- {Server, {error, {tls_alert, "unknown ca"}}} ->
- receive
- {Client, {error, {tls_alert, "unknown ca"}}} ->
- ok;
- {Client, {error, closed}} ->
- ok
- end
- end.
-
+ ssl_test_lib:check_server_alert(Server, Client, unknown_ca).
%%--------------------------------------------------------------------
server_require_peer_cert_partial_chain_fun_fail() ->
[{doc, "If parial_chain fun crashes, treat it as if it returned unkown_ca"}].
@@ -487,16 +463,7 @@ server_require_peer_cert_partial_chain_fun_fail(Config) when is_list(Config) ->
{from, self()},
{mfa, {ssl_test_lib, no_result, []}},
{options, ClientOpts}]),
-
- receive
- {Server, {error, {tls_alert, "unknown ca"}}} ->
- receive
- {Client, {error, {tls_alert, "unknown ca"}}} ->
- ok;
- {Client, {error, closed}} ->
- ok
- end
- end.
+ ssl_test_lib:check_server_alert(Server, Client, unknown_ca).
%%--------------------------------------------------------------------
verify_fun_always_run_client() ->
@@ -535,14 +502,8 @@ verify_fun_always_run_client(Config) when is_list(Config) ->
[{verify, verify_peer},
{verify_fun, FunAndState}
| ClientOpts]}]),
- %% Server error may be {tls_alert,"handshake failure"} or closed depending on timing
- %% this is not a bug it is a circumstance of how tcp works!
- receive
- {Server, ServerError} ->
- ct:log("Server Error ~p~n", [ServerError])
- end,
- ssl_test_lib:check_result(Client, {error, {tls_alert, "handshake failure"}}).
+ ssl_test_lib:check_client_alert(Server, Client, handshake_failure).
%%--------------------------------------------------------------------
verify_fun_always_run_server() ->
@@ -581,16 +542,8 @@ verify_fun_always_run_server(Config) when is_list(Config) ->
{mfa, {ssl_test_lib,
no_result, []}},
{options, ClientOpts}]),
-
- %% Client error may be {tls_alert, "handshake failure" } or closed depending on timing
- %% this is not a bug it is a circumstance of how tcp works!
- receive
- {Client, ClientError} ->
- ct:log("Client Error ~p~n", [ClientError])
- end,
-
- ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}).
-
+
+ ssl_test_lib:check_client_alert(Server, Client, handshake_failure).
%%--------------------------------------------------------------------
cert_expired() ->
@@ -620,8 +573,7 @@ cert_expired(Config) when is_list(Config) ->
{from, self()},
{options, [{verify, verify_peer}, {active, Active} | ClientOpts]}]),
- ssl_test_lib:check_result(Server, {error, {tls_alert, "certificate expired"}},
- Client, {error, {tls_alert, "certificate expired"}}).
+ ssl_test_lib:check_client_alert(Server, Client, certificate_expired).
two_digits_str(N) when N < 10 ->
lists:flatten(io_lib:format("0~p", [N]));
@@ -727,12 +679,8 @@ critical_extension_verify_server(Config) when is_list(Config) ->
{options, [{verify, verify_none}, {active, Active} | ClientOpts]}]),
%% This certificate has a critical extension that we don't
- %% understand. Therefore, verification should fail.
-
- ssl_test_lib:check_result(Server, {error, {tls_alert, "unsupported certificate"}},
- Client, {error, {tls_alert, "unsupported certificate"}}),
-
- ssl_test_lib:close(Server).
+ %% understand. Therefore, verification should fail.
+ ssl_test_lib:check_server_alert(Server, Client, unsupported_certificate).
%%--------------------------------------------------------------------
critical_extension_verify_client() ->
@@ -763,12 +711,7 @@ critical_extension_verify_client(Config) when is_list(Config) ->
{mfa, {ssl_test_lib, ReceiveFunction, []}},
{options, [{verify, verify_peer}, {active, Active} | ClientOpts]}]),
- %% This certificate has a critical extension that we don't
- %% understand. Therefore, verification should fail.
- ssl_test_lib:check_result(Server, {error, {tls_alert, "unsupported certificate"}},
- Client, {error, {tls_alert, "unsupported certificate"}}),
-
- ssl_test_lib:close(Server).
+ ssl_test_lib:check_client_alert(Server, Client, unsupported_certificate).
%%--------------------------------------------------------------------
critical_extension_verify_none() ->
@@ -908,10 +851,7 @@ invalid_signature_server(Config) when is_list(Config) ->
{host, Hostname},
{from, self()},
{options, [{verify, verify_peer} | ClientOpts]}]),
-
- ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}},
- Client, {error, {tls_alert, "unknown ca"}}).
-
+ ssl_test_lib:check_server_alert(Server, Client, unknown_ca).
%%--------------------------------------------------------------------
invalid_signature_client() ->
@@ -946,9 +886,7 @@ invalid_signature_client(Config) when is_list(Config) ->
{from, self()},
{options, NewClientOpts}]),
- ssl_test_lib:check_result(Server, {error, {tls_alert, "unknown ca"}},
- Client, {error, {tls_alert, "unknown ca"}}).
-
+ ssl_test_lib:check_client_alert(Server, Client, unknown_ca).
%%--------------------------------------------------------------------
@@ -1034,16 +972,7 @@ unknown_server_ca_fail(Config) when is_list(Config) ->
[{verify, verify_peer},
{verify_fun, FunAndState}
| ClientOpts]}]),
- receive
- {Client, {error, {tls_alert, "unknown ca"}}} ->
- receive
- {Server, {error, {tls_alert, "unknown ca"}}} ->
- ok;
- {Server, {error, closed}} ->
- ok
- end
- end.
-
+ ssl_test_lib:check_client_alert(Server, Client, unknown_ca).
%%--------------------------------------------------------------------
unknown_server_ca_accept_verify_none() ->
@@ -1193,11 +1122,7 @@ customize_hostname_check(Config) when is_list(Config) ->
{mfa, {ssl_test_lib, no_result, []}},
{options, ClientOpts}
]),
- ssl_test_lib:check_result(Client1, {error, {tls_alert, "handshake failure"}},
- Server, {error, {tls_alert, "handshake failure"}}),
-
- ssl_test_lib:close(Server),
- ssl_test_lib:close(Client).
+ ssl_test_lib:check_client_alert(Server, Client1, handshake_failure).
incomplete_chain() ->
[{doc,"Test option verify_peer"}].
diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl
index c61039b5da..b2fd3874a8 100644
--- a/lib/ssl/test/ssl_crl_SUITE.erl
+++ b/lib/ssl/test/ssl_crl_SUITE.erl
@@ -238,7 +238,7 @@ crl_verify_revoked(Config) when is_list(Config) ->
end,
crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts,
- "certificate revoked").
+ certificate_revoked).
crl_verify_no_crl() ->
[{doc,"Verify a simple CRL chain when the CRL is missing"}].
@@ -277,10 +277,10 @@ crl_verify_no_crl(Config) when is_list(Config) ->
%% The error "revocation status undetermined" gets turned
%% into "bad certificate".
crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts,
- "bad certificate");
+ bad_certificate);
peer ->
crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts,
- "bad certificate");
+ bad_certificate);
best_effort ->
%% In "best effort" mode, we consider the certificate not
%% to be revoked if we can't find the appropriate CRL.
@@ -341,7 +341,7 @@ crl_hash_dir_collision(Config) when is_list(Config) ->
%% First certificate revoked; first fails, second succeeds.
crl_verify_error(Hostname, ServerNode, ServerOpts1, ClientNode, ClientOpts,
- "certificate revoked"),
+ certificate_revoked),
crl_verify_valid(Hostname, ServerNode, ServerOpts2, ClientNode, ClientOpts),
make_certs:revoke(PrivDir, CA2, "collision-client-2", CertsConfig),
@@ -352,9 +352,9 @@ crl_hash_dir_collision(Config) when is_list(Config) ->
%% Second certificate revoked; both fail.
crl_verify_error(Hostname, ServerNode, ServerOpts1, ClientNode, ClientOpts,
- "certificate revoked"),
+ certificate_revoked),
crl_verify_error(Hostname, ServerNode, ServerOpts2, ClientNode, ClientOpts,
- "certificate revoked"),
+ certificate_revoked),
ok.
@@ -400,10 +400,10 @@ crl_hash_dir_expired(Config) when is_list(Config) ->
%% The error "revocation status undetermined" gets turned
%% into "bad certificate".
crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts,
- "bad certificate");
+ bad_certificate);
peer ->
crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts,
- "bad certificate");
+ bad_certificate);
best_effort ->
%% In "best effort" mode, we consider the certificate not
%% to be revoked if we can't find the appropriate CRL.
@@ -451,11 +451,8 @@ crl_verify_error(Hostname, ServerNode, ServerOpts, ClientNode, ClientOpts, Expec
{host, Hostname},
{from, self()},
{options, ClientOpts}]),
- receive
- {Server, AlertOrClose} ->
- ct:pal("Server Alert or Close ~p", [AlertOrClose])
- end,
- ssl_test_lib:check_result(Client, {error, {tls_alert, ExpectedAlert}}).
+
+ ssl_test_lib:check_client_alert(Server, Client, ExpectedAlert).
%%--------------------------------------------------------------------
%% Internal functions ------------------------------------------------
diff --git a/lib/ssl/test/ssl_dist_bench_SUITE.erl b/lib/ssl/test/ssl_dist_bench_SUITE.erl
index d9d9c4e473..7e7de5c9bf 100644
--- a/lib/ssl/test/ssl_dist_bench_SUITE.erl
+++ b/lib/ssl/test/ssl_dist_bench_SUITE.erl
@@ -1,7 +1,7 @@
%%%-------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2017-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2017-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -43,7 +43,7 @@
throughput_1048576/1]).
%% Debug
--export([payload/1]).
+-export([payload/1, roundtrip_runner/3, setup_runner/3, throughput_runner/4]).
%%%-------------------------------------------------------------------
@@ -504,17 +504,19 @@ throughput(A, B, Prefix, HA, HB, Packets, Size) ->
[] = ssl_apply(HA, erlang, nodes, []),
[] = ssl_apply(HB, erlang, nodes, []),
#{time := Time,
- dist_stats := DistStats,
+ client_dist_stats := ClientDistStats,
client_msacc_stats := ClientMsaccStats,
client_prof := ClientProf,
server_msacc_stats := ServerMsaccStats,
- server_prof := ServerProf} =
+ server_prof := ServerProf,
+ server_gc_before := Server_GC_Before,
+ server_gc_after := Server_GC_After} =
ssl_apply(HA, fun () -> throughput_runner(A, B, Packets, Size) end),
[B] = ssl_apply(HA, erlang, nodes, []),
[A] = ssl_apply(HB, erlang, nodes, []),
ClientMsaccStats =:= undefined orelse
msacc:print(ClientMsaccStats),
- io:format("DistStats: ~p~n", [DistStats]),
+ io:format("ClientDistStats: ~p~n", [ClientDistStats]),
Overhead =
50 % Distribution protocol headers (empirical) (TLS+=54)
+ byte_size(erlang:term_to_binary([0|<<>>])), % Benchmark overhead
@@ -533,6 +535,8 @@ throughput(A, B, Prefix, HA, HB, Packets, Size) ->
end,
io:format("******* ClientProf:~n", []), prof_print(ClientProf),
io:format("******* ServerProf:~n", []), prof_print(ServerProf),
+ io:format("******* Server GC Before:~n~p~n", [Server_GC_Before]),
+ io:format("******* Server GC After:~n~p~n", [Server_GC_After]),
Speed = round((Bytes * 1000000) / (1024 * Time)),
report(Prefix++" Throughput_"++integer_to_list(Size), Speed, "kB/s").
@@ -554,10 +558,10 @@ throughput_runner(A, B, Rounds, Size) ->
ok
end,
prof_start(),
- {Time,ServerMsaccStats,ServerProf} =
+ #{time := Time} = Result =
throughput_client(ServerPid, ServerMon, Payload, Rounds),
prof_stop(),
- ClientMsaccStats =
+ MsaccStats =
case msacc:available() of
true ->
MStats = msacc:stats(),
@@ -566,15 +570,13 @@ throughput_runner(A, B, Rounds, Size) ->
false ->
undefined
end,
- ClientProf = prof_end(),
+ Prof = prof_end(),
[{_Node,Socket}] = dig_dist_node_sockets(),
DistStats = inet:getstat(Socket),
- #{time => microseconds(Time),
- dist_stats => DistStats,
- client_msacc_stats => ClientMsaccStats,
- client_prof => ClientProf,
- server_msacc_stats => ServerMsaccStats,
- server_prof => ServerProf}.
+ Result#{time := microseconds(Time),
+ client_dist_stats => DistStats,
+ client_msacc_stats => MsaccStats,
+ client_prof => Prof}.
dig_dist_node_sockets() ->
[case DistCtrl of
@@ -597,6 +599,9 @@ dig_dist_node_sockets() ->
throughput_server(Pid, N) ->
+ GC_Before = get_server_gc_info(),
+ %% dbg:tracer(port, dbg:trace_port(file, "throughput_server_gc.log")),
+ %% dbg:p(TLSDistReceiver, garbage_collection),
msacc:available() andalso
begin
msacc:stop(),
@@ -605,9 +610,9 @@ throughput_server(Pid, N) ->
ok
end,
prof_start(),
- throughput_server_loop(Pid, N).
+ throughput_server_loop(Pid, GC_Before, N).
-throughput_server_loop(_Pid, 0) ->
+throughput_server_loop(_Pid, GC_Before, 0) ->
prof_stop(),
MsaccStats =
case msacc:available() of
@@ -620,11 +625,26 @@ throughput_server_loop(_Pid, 0) ->
undefined
end,
Prof = prof_end(),
- exit({ok,MsaccStats,Prof});
-throughput_server_loop(Pid, N) ->
+ %% dbg:flush_trace_port(),
+ exit(#{server_msacc_stats => MsaccStats,
+ server_prof => Prof,
+ server_gc_before => GC_Before,
+ server_gc_after => get_server_gc_info()});
+throughput_server_loop(Pid, GC_Before, N) ->
receive
{Pid, N, _} ->
- throughput_server_loop(Pid, N-1)
+ throughput_server_loop(Pid, GC_Before, N-1)
+ end.
+
+get_server_gc_info() ->
+ case whereis(ssl_connection_sup_dist) of
+ undefined ->
+ undefined;
+ SupPid ->
+ [{_Id,TLSDistReceiver,_Type,_Modules}|_] =
+ supervisor:which_children(SupPid),
+ erlang:process_info(
+ TLSDistReceiver, [garbage_collection,garbage_collection_info])
end.
throughput_client(Pid, Mon, Payload, N) ->
@@ -632,8 +652,8 @@ throughput_client(Pid, Mon, Payload, N) ->
throughput_client_loop(_Pid, Mon, _Payload, 0, StartTime) ->
receive
- {'DOWN', Mon, _, _, {ok,MsaccStats,Prof}} ->
- {elapsed_time(StartTime),MsaccStats,Prof};
+ {'DOWN', Mon, _, _, #{} = Result} ->
+ Result#{time => elapsed_time(StartTime)};
{'DOWN', Mon, _, _, Other} ->
exit(Other)
end;
@@ -651,6 +671,7 @@ prof_start() ->
ok.
-elif(?prof =:= eprof).
prof_start() ->
+ catch eprof:stop(),
{ok,_} = eprof:start(),
profiling = eprof:start_profiling(processes()),
ok.
diff --git a/lib/ssl/test/ssl_sni_SUITE.erl b/lib/ssl/test/ssl_sni_SUITE.erl
index 251b6a2639..7629d75100 100644
--- a/lib/ssl/test/ssl_sni_SUITE.erl
+++ b/lib/ssl/test/ssl_sni_SUITE.erl
@@ -236,8 +236,8 @@ dns_name_reuse(Config) ->
{mfa, {ssl_test_lib, session_info_result, []}},
{from, self()}, {options, [{verify, verify_peer} | ClientConf]}]),
- ssl_test_lib:check_result(Client1, {error, {tls_alert, "handshake failure"}}),
- ssl_test_lib:close(Client0).
+ ssl_test_lib:check_client_alert(Client1, handshake_failure).
+
%%--------------------------------------------------------------------
%% Internal Functions ------------------------------------------------
%%--------------------------------------------------------------------
@@ -370,8 +370,8 @@ unsuccessfull_connect(ServerOptions, ClientOptions, Hostname0, Config) ->
{from, self()},
{options, ClientOptions}]),
- ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}},
- Client, {error, {tls_alert, "handshake failure"}}).
+ ssl_test_lib:check_server_alert(Server, Client, handshake_failure).
+
host_name(undefined, Hostname) ->
Hostname;
host_name(Hostname, _) ->
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 0173b98e1a..7f8e81dbd8 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -30,6 +30,7 @@
-record(sslsocket, { fd = nil, pid = nil}).
-define(SLEEP, 1000).
+-define(DEFAULT_CURVE, secp256r1).
%% For now always run locally
run_where(_) ->
@@ -437,6 +438,37 @@ check_result(Pid, Msg) ->
{got, Unexpected}},
ct:fail(Reason)
end.
+check_server_alert(Pid, Alert) ->
+ receive
+ {Pid, {error, {tls_alert, {Alert, _}}}} ->
+ ok
+ end.
+check_server_alert(Server, Client, Alert) ->
+ receive
+ {Server, {error, {tls_alert, {Alert, _}}}} ->
+ receive
+ {Client, {error, {tls_alert, {Alert, _}}}} ->
+ ok;
+ {Client, {error, closed}} ->
+ ok
+ end
+ end.
+check_client_alert(Pid, Alert) ->
+ receive
+ {Pid, {error, {tls_alert, {Alert, _}}}} ->
+ ok
+ end.
+check_client_alert(Server, Client, Alert) ->
+ receive
+ {Client, {error, {tls_alert, {Alert, _}}}} ->
+ receive
+ {Server, {error, {tls_alert, {Alert, _}}}} ->
+ ok;
+ {Server, {error, closed}} ->
+ ok
+ end
+ end.
+
wait_for_result(Server, ServerMsg, Client, ClientMsg) ->
receive
@@ -618,9 +650,12 @@ make_rsa_cert_chains(UserConf, Config, Suffix) ->
}.
make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config) ->
+ make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config, ?DEFAULT_CURVE).
+%%
+make_ec_cert_chains(UserConf, ClientChainType, ServerChainType, Config, Curve) ->
ClientChain = proplists:get_value(client_chain, UserConf, default_cert_chain_conf()),
ServerChain = proplists:get_value(server_chain, UserConf, default_cert_chain_conf()),
- CertChainConf = gen_conf(ClientChainType, ServerChainType, ClientChain, ServerChain),
+ CertChainConf = gen_conf(ClientChainType, ServerChainType, ClientChain, ServerChain, Curve),
ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), atom_to_list(ClientChainType)]),
ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), atom_to_list(ServerChainType)]),
GenCertData = public_key:pkix_test_data(CertChainConf),
@@ -635,7 +670,11 @@ default_cert_chain_conf() ->
%% Use only default options
[[],[],[]].
-gen_conf(mix, mix, UserClient, UserServer) ->
+
+gen_conf(ClientChainType, ServerChainType, UserClient, UserServer) ->
+ gen_conf(ClientChainType, ServerChainType, UserClient, UserServer, ?DEFAULT_CURVE).
+%%
+gen_conf(mix, mix, UserClient, UserServer, _) ->
ClientTag = conf_tag("client"),
ServerTag = conf_tag("server"),
@@ -646,12 +685,12 @@ gen_conf(mix, mix, UserClient, UserServer) ->
ServerConf = merge_chain_spec(UserServer, DefaultServer, []),
new_format([{ClientTag, ClientConf}, {ServerTag, ServerConf}]);
-gen_conf(ClientChainType, ServerChainType, UserClient, UserServer) ->
+gen_conf(ClientChainType, ServerChainType, UserClient, UserServer, Curve) ->
ClientTag = conf_tag("client"),
ServerTag = conf_tag("server"),
- DefaultClient = chain_spec(client, ClientChainType),
- DefaultServer = chain_spec(server, ServerChainType),
+ DefaultClient = chain_spec(client, ClientChainType, Curve),
+ DefaultServer = chain_spec(server, ServerChainType, Curve),
ClientConf = merge_chain_spec(UserClient, DefaultClient, []),
ServerConf = merge_chain_spec(UserServer, DefaultServer, []),
@@ -673,43 +712,43 @@ proplist_to_map([Head | Rest]) ->
conf_tag(Role) ->
list_to_atom(Role ++ "_chain").
-chain_spec(_Role, ecdh_rsa) ->
+chain_spec(_Role, ecdh_rsa, Curve) ->
Digest = {digest, appropriate_sha(crypto:supports())},
- CurveOid = hd(tls_v1:ecc_curves(0)),
+ CurveOid = pubkey_cert_records:namedCurves(Curve),
[[Digest, {key, {namedCurve, CurveOid}}],
[Digest, {key, hardcode_rsa_key(1)}],
[Digest, {key, {namedCurve, CurveOid}}]];
-chain_spec(_Role, ecdhe_ecdsa) ->
+chain_spec(_Role, ecdhe_ecdsa, Curve) ->
Digest = {digest, appropriate_sha(crypto:supports())},
- CurveOid = hd(tls_v1:ecc_curves(0)),
+ CurveOid = pubkey_cert_records:namedCurves(Curve),
[[Digest, {key, {namedCurve, CurveOid}}],
[Digest, {key, {namedCurve, CurveOid}}],
[Digest, {key, {namedCurve, CurveOid}}]];
-chain_spec(_Role, ecdh_ecdsa) ->
+chain_spec(_Role, ecdh_ecdsa, Curve) ->
Digest = {digest, appropriate_sha(crypto:supports())},
- CurveOid = hd(tls_v1:ecc_curves(0)),
+ CurveOid = pubkey_cert_records:namedCurves(Curve),
[[Digest, {key, {namedCurve, CurveOid}}],
[Digest, {key, {namedCurve, CurveOid}}],
[Digest, {key, {namedCurve, CurveOid}}]];
-chain_spec(_Role, ecdhe_rsa) ->
+chain_spec(_Role, ecdhe_rsa, _) ->
Digest = {digest, appropriate_sha(crypto:supports())},
[[Digest, {key, hardcode_rsa_key(1)}],
[Digest, {key, hardcode_rsa_key(2)}],
[Digest, {key, hardcode_rsa_key(3)}]];
-chain_spec(_Role, ecdsa) ->
+chain_spec(_Role, ecdsa, Curve) ->
Digest = {digest, appropriate_sha(crypto:supports())},
- CurveOid = hd(tls_v1:ecc_curves(0)),
+ CurveOid = pubkey_cert_records:namedCurves(Curve),
[[Digest, {key, {namedCurve, CurveOid}}],
[Digest, {key, {namedCurve, CurveOid}}],
[Digest, {key, {namedCurve, CurveOid}}]];
-chain_spec(_Role, rsa) ->
+chain_spec(_Role, rsa, _) ->
Digest = {digest, appropriate_sha(crypto:supports())},
[[Digest, {key, hardcode_rsa_key(1)}],
[Digest, {key, hardcode_rsa_key(2)}],
[Digest, {key, hardcode_rsa_key(3)}]];
-chain_spec(_Role, dsa) ->
+chain_spec(_Role, dsa, _) ->
Digest = {digest, appropriate_sha(crypto:supports())},
[[Digest, {key, hardcode_dsa_key(1)}],
[Digest, {key, hardcode_dsa_key(2)}],
@@ -742,7 +781,7 @@ merge_spec(User, Default, [Conf | Rest], Acc) ->
make_mix_cert(Config) ->
Ext = x509_test:extensions([{key_usage, [digitalSignature]}]),
Digest = {digest, appropriate_sha(crypto:supports())},
- CurveOid = hd(tls_v1:ecc_curves(0)),
+ CurveOid = pubkey_cert_records:namedCurves(?DEFAULT_CURVE),
Mix = proplists:get_value(mix, Config, peer_ecc),
ClientChainType =ServerChainType = mix,
{ClientChain, ServerChain} = mix(Mix, Digest, CurveOid, Ext),
@@ -825,7 +864,8 @@ make_rsa_cert(Config) ->
Config
end.
appropriate_sha(CryptoSupport) ->
- case proplists:get_bool(sha256, CryptoSupport) of
+ Hashes = proplists:get_value(hashs, CryptoSupport),
+ case lists:member(sha256, Hashes) of
true ->
sha256;
false ->
@@ -1064,8 +1104,36 @@ ecc_test(Expect, COpts, SOpts, CECCOpts, SECCOpts, Config) ->
ecc_test_error(COpts, SOpts, CECCOpts, SECCOpts, Config) ->
{Server, Port} = start_server_ecc_error(erlang, SOpts, SECCOpts, Config),
Client = start_client_ecc_error(erlang, Port, COpts, CECCOpts, Config),
- Error = {error, {tls_alert, "insufficient security"}},
- check_result(Server, Error, Client, Error).
+ check_server_alert(Server, Client, insufficient_security).
+
+start_basic_client(openssl, Version, Port, ClientOpts) ->
+ Cert = proplists:get_value(certfile, ClientOpts),
+ Key = proplists:get_value(keyfile, ClientOpts),
+ CA = proplists:get_value(cacertfile, ClientOpts),
+ Groups0 = proplists:get_value(groups, ClientOpts),
+ Exe = "openssl",
+ Args0 = ["s_client", "-verify", "2", "-port", integer_to_list(Port),
+ ssl_test_lib:version_flag(Version),
+ "-CAfile", CA, "-host", "localhost", "-msg", "-debug"],
+ Args1 =
+ case Groups0 of
+ undefined ->
+ Args0;
+ G ->
+ Args0 ++ ["-groups", G]
+ end,
+ Args =
+ case {Cert, Key} of
+ {C, K} when C =:= undefined orelse
+ K =:= undefined ->
+ Args1;
+ {C, K} ->
+ Args1 ++ ["-cert", C, "-key", K]
+ end,
+
+ OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
+ true = port_command(OpenSslPort, "Hello world"),
+ OpenSslPort.
start_client(openssl, Port, ClientOpts, Config) ->
Cert = proplists:get_value(certfile, ClientOpts),
@@ -1073,11 +1141,11 @@ start_client(openssl, Port, ClientOpts, Config) ->
CA = proplists:get_value(cacertfile, ClientOpts),
Version = ssl_test_lib:protocol_version(Config),
Exe = "openssl",
- Args = ["s_client", "-verify", "2", "-port", integer_to_list(Port),
+ Args0 = ["s_client", "-verify", "2", "-port", integer_to_list(Port),
ssl_test_lib:version_flag(Version),
"-cert", Cert, "-CAfile", CA,
"-key", Key, "-host","localhost", "-msg", "-debug"],
-
+ Args = maybe_force_ipv4(Args0),
OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args),
true = port_command(OpenSslPort, "Hello world"),
OpenSslPort;
@@ -1091,6 +1159,18 @@ start_client(erlang, Port, ClientOpts, Config) ->
{mfa, {ssl_test_lib, check_key_exchange_send_active, [KeyEx]}},
{options, [{verify, verify_peer} | ClientOpts]}]).
+%% Workaround for running tests on machines where openssl
+%% s_client would use an IPv6 address with localhost. As
+%% this test suite and the ssl application is not prepared
+%% for that we have to force s_client to use IPv4 if
+%% OpenSSL supports IPv6.
+maybe_force_ipv4(Args0) ->
+ case is_ipv6_supported() of
+ true ->
+ Args0 ++ ["-4"];
+ false ->
+ Args0
+ end.
start_client_ecc(erlang, Port, ClientOpts, Expect, ECCOpts, Config) ->
{ClientNode, _, Hostname} = ssl_test_lib:run_where(Config),
@@ -1654,6 +1734,17 @@ active_once_disregard(Socket, N) ->
ssl:setopts(Socket, [{active, once}]),
active_once_disregard(Socket, N-byte_size(Bytes))
end.
+
+is_ipv6_supported() ->
+ case os:cmd("openssl version") of
+ "OpenSSL 0.9.8" ++ _ -> % Does not support IPv6
+ false;
+ "OpenSSL 1.0" ++ _ -> % Does not support IPv6
+ false;
+ _ ->
+ true
+ end.
+
is_sane_ecc(openssl) ->
case os:cmd("openssl version") of
"OpenSSL 1.0.0a" ++ _ -> % Known bug in openssl
@@ -1849,6 +1940,8 @@ version_flag('tlsv1.1') ->
"-tls1_1";
version_flag('tlsv1.2') ->
"-tls1_2";
+version_flag('tlsv1.3') ->
+ "-tls1_3";
version_flag(sslv3) ->
"-ssl3";
version_flag(sslv2) ->
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index d180021439..df84411b6d 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -1249,7 +1249,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]),
ssl_test_lib:consume_port_exit(OpenSslPort),
- ssl_test_lib:check_result(Server, {error, {tls_alert, "bad record mac"}}),
+ ssl_test_lib:check_server_alert(Server, bad_record_mac),
process_flag(trap_exit, false).
%%--------------------------------------------------------------------
@@ -1946,6 +1946,11 @@ erlang_ssl_receive(Socket, Data) ->
ct:log("Connection info: ~p~n",
[ssl:connection_information(Socket)]),
receive
+ {ssl, Socket, "R\n"} ->
+ %% Swallow s_client renegotiation command.
+ %% openssl s_client connected commands can appear on
+ %% server side with some openssl versions.
+ erlang_ssl_receive(Socket,Data);
{ssl, Socket, Data} ->
io:format("Received ~p~n",[Data]),
%% open_ssl server sometimes hangs waiting in blocking read
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index 3527062a8a..0d9f907d5c 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 9.1.2
+SSL_VSN = 9.2
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index e67397c6fd..2cb677785d 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -188,6 +188,46 @@
is used to keep the table fixated during the entire traversal.</p>
</item>
</list>
+ <note>
+ <p>Even though the access of a single object is always guaranteed to be
+ <seealso marker="#concurrency">atomic and isolated</seealso>, each traversal
+ through a table to find the next key is not done with such guarantees. This is often
+ not a problem, but may cause rare subtle "unexpected" effects if a concurrent
+ process inserts objects during a traversal. For example, consider one
+ process doing</p>
+<pre>
+ets:new(t, [ordered_set, named_table]),
+ets:insert(t, {1}),
+ets:insert(t, {2}),
+ets:insert(t, {3}),
+</pre>
+ <p>A concurrent call to <c>ets:first(t)</c>, done by another
+ process, may then in rare cases return <c>2</c> even though
+ <c>2</c> has never existed in the table ordered as the first key. In
+ the same way, a concurrent call to <c>ets:next(t, 1)</c> may return
+ <c>3</c> even though <c>3</c> never existed in the table
+ ordered directly after <c>1</c>.</p>
+ <p>Effects like this are improbable but possible. The probability will
+ further be reduced (if not vanish) if table option
+ <seealso marker="#new_2_write_concurrency"><c>write_concurrency</c></seealso>
+ is not enabled. This can also only be a potential concern for
+ <c>ordered_set</c> where the traversal order is defined.</p>
+ </note>
+ <p>Traversals using <c>match</c> and <c>select</c> functions may not need to
+ scan the entire table depending on how the key is specified. A match
+ pattern with a <em>fully bound key</em> (without any match variables) will
+ optimize the operation to a single key lookup without any table traversal
+ at all. For <c>ordered_set</c> a <em>partially bound key</em> will limit the
+ traversal to only scan a subset of the table based on term order. A
+ partially bound key is either a list or a tuple with a prefix that is fully
+ bound. Example:</p>
+<pre>
+1> <input>T = ets:new(t,[ordered_set]), ets:insert(T, {"555-1234", "John Smith"}).</input>
+true
+2> <input>%% Efficient search of all with area code 555</input>
+2> <input>ets:match(T,{[$5,$5,$5,$- |'$1'],'$2'}).</input>
+[["1234","John Smith"]]
+</pre>
</section>
<section>
@@ -602,12 +642,11 @@ Error: fun containing local Erlang function calls
<p><marker id="info_2_safe_fixed_monotonic_time"/></p>
<p><c>Item=safe_fixed|safe_fixed_monotonic_time,
Value={FixationTime,Info}|false</c></p>
- <p>If the table has been fixed using
+ <p>If the table is fixed using
<seealso marker="#safe_fixtable/2">
<c>safe_fixtable/2</c></seealso>,
the call returns a tuple where <c>FixationTime</c> is the
- time when the table was first fixed by a process, which either
- is or is not one of the processes it is fixed by now.</p>
+ last time when the table changed from unfixed to fixed.</p>
<p>The format and value of <c>FixationTime</c> depends on
<c>Item</c>:</p>
<taglist>
@@ -639,8 +678,15 @@ Error: fun containing local Erlang function calls
table is fixed by now. <c>RefCount</c> is the value
of the reference counter and it keeps track of how many times
the table has been fixed by the process.</p>
- <p>If the table never has been fixed, the call returns
- <c>false</c>.</p>
+ <p>Table fixations are not limited to <seealso marker="#safe_fixtable/2">
+ <c>safe_fixtable/2</c></seealso>. Temporary fixations may also
+ be done by for example <seealso marker="#traversal">traversing
+ functions</seealso> like <c>select</c> and <c>match</c>. Such
+ table fixations are automatically released before the
+ corresponding functions returns, but they may be seen by a
+ concurrent call to
+ <c>ets:info(T,safe_fixed|safe_fixed_monotonic_time)</c>.</p>
+ <p>If the table is not fixed at all, the call returns <c>false</c>.</p>
</item>
<item>
<p><c>Item=stats, Value=tuple()</c></p>
@@ -1998,9 +2044,8 @@ true</pre>
<p>This function provides an efficient way to update one or more
counters, without the trouble of having to look up an object, update
the object by incrementing an element, and insert the resulting
- object into the table again. (The update is done atomically,
- that is, no process
- can access the ETS table in the middle of the operation.)</p>
+ object into the table again. The operation is guaranteed to be
+ <seealso marker="#concurrency">atomic and isolated</seealso>.</p>
<p>This function destructively update the object with key
<c><anno>Key</anno></c> in table <c><anno>Tab</anno></c> by adding
<c><anno>Incr</anno></c> to the element at position
diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml
index ae42846c6b..60b7eb3436 100644
--- a/lib/stdlib/doc/src/filename.xml
+++ b/lib/stdlib/doc/src/filename.xml
@@ -546,7 +546,7 @@ true
<p><em>Examples:</em></p>
<pre>
20> <input>filename:rootname("/beam.src/kalle").</input>
-/beam.src/kalle"
+"/beam.src/kalle"
21> <input>filename:rootname("/beam.src/foo.erl").</input>
"/beam.src/foo"
22> <input>filename:rootname("/beam.src/foo.erl", ".erl").</input>
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index d678d0436b..d4a4ba268b 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2016</year><year>2018</year>
+ <year>2016</year><year>2019</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -320,12 +320,13 @@ erlang:'!' -----> Module:StateName/3
</p>
<p>
There is also a server start option
- <seealso marker="#type-hibernate_after_opt">
+ <seealso marker="#type-enter_loop_opt">
<c>{hibernate_after, Timeout}</c>
</seealso>
for
- <seealso marker="#start/3"><c>start/3,4</c></seealso> or
- <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>
+ <seealso marker="#start/3"><c>start/3,4</c></seealso>,
+ <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso> or
+ <seealso marker="#enter_loop/4"><c>enter_loop/4,5,6</c></seealso>,
that may be used to automatically hibernate the server.
</p>
</description>
@@ -514,36 +515,6 @@ handle_event(_, _, State, Data) ->
</desc>
</datatype>
<datatype>
- <name name="debug_opt"/>
- <desc>
- <p>
- Debug option that can be used when starting
- a <c>gen_statem</c> server through,
- <seealso marker="#enter_loop/4"><c>enter_loop/4-6</c></seealso>.
- </p>
- <p>
- For every entry in <c><anno>Dbgs</anno></c>,
- the corresponding function in
- <seealso marker="sys"><c>sys</c></seealso> is called.
- </p>
- </desc>
- </datatype>
- <datatype>
- <name name="hibernate_after_opt"/>
- <desc>
- <p>
- hibernate_after option that can be used when starting
- a <c>gen_statem</c> server through,
- <seealso marker="#enter_loop/4"><c>enter_loop/4-6</c></seealso>.
- </p>
- <p>If option<seealso marker="#type-hibernate_after_opt"><c>{hibernate_after,HibernateAfterTimeout}</c></seealso> is present, the <c>gen_statem</c>
- process awaits any message for <c>HibernateAfterTimeout</c> milliseconds and
- if no message is received, the process goes into hibernation automatically
- (by calling <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>).
- </p>
- </desc>
- </datatype>
- <datatype>
<name name="start_opt"/>
<desc>
<p>
@@ -563,6 +534,37 @@ handle_event(_, _, State, Data) ->
</desc>
</datatype>
<datatype>
+ <name name="enter_loop_opt"/>
+ <desc>
+ <p>
+ Options that can be used when starting
+ a <c>gen_statem</c> server through,
+ <seealso marker="#enter_loop/4"><c>enter_loop/4-6</c></seealso>.
+ </p>
+ <taglist>
+ <tag><c>hibernate_after</c></tag>
+ <item>
+ <p>
+ <c>HibernateAfterTimeout</c>
+ specifies that the <c>gen_statem</c> process awaits
+ any message for <c>HibernateAfterTimeout</c> milliseconds and
+ if no message is received, the process goes into hibernation
+ automatically (by calling
+ <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>).
+ </p>
+ </item>
+ <tag><c>debug</c></tag>
+ <item>
+ <p>
+ For every entry in <c><anno>Dbgs</anno></c>,
+ the corresponding function in
+ <seealso marker="sys"><c>sys</c></seealso> is called.
+ </p>
+ </item>
+ </taglist>
+ </desc>
+ </datatype>
+ <datatype>
<name name="from"/>
<desc>
<p>
@@ -1701,7 +1703,11 @@ handle_event(_, _, State, Data) ->
<list type="bulleted">
<item>
<p>
- If option <c>{timeout,Time}</c> is present in
+ If option
+ <seealso marker="#type-start_opt">
+ <c>{timeout,Time}</c>
+ </seealso>
+ is present in
<c><anno>Opts</anno></c>, the <c>gen_statem</c>
is allowed to spend <c>Time</c> milliseconds initializing
or it terminates and the start function returns
@@ -1709,23 +1715,33 @@ handle_event(_, _, State, Data) ->
</p>
</item>
<item>
- <p>If option<seealso marker="#type-hibernate_after_opt"><c>{hibernate_after,HibernateAfterTimeout}</c></seealso> is present, the <c>gen_statem</c>
- process awaits any message for <c>HibernateAfterTimeout</c> milliseconds and
- if no message is received, the process goes into hibernation automatically
- (by calling <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>).
+ <p>If option
+ <seealso marker="#type-enter_loop_opt">
+ <c>{hibernate_after,HibernateAfterTimeout}</c>
+ </seealso>
+ is present, the <c>gen_statem</c>
+ process awaits any message for <c>HibernateAfterTimeout</c> milliseconds and
+ if no message is received, the process goes into hibernation automatically
+ (by calling <seealso marker="proc_lib#hibernate/3"><c>proc_lib:hibernate/3</c></seealso>).
</p>
</item>
<item>
<p>
If option
- <seealso marker="#type-debug_opt"><c>{debug,Dbgs}</c></seealso>
+ <seealso marker="#type-enter_loop_opt">
+ <c>{debug,Dbgs}</c>
+ </seealso>
is present in <c><anno>Opts</anno></c>, debugging through
<seealso marker="sys"><c>sys</c></seealso> is activated.
</p>
</item>
<item>
<p>
- If option <c>{spawn_opt,SpawnOpts}</c> is present in
+ If option
+ <seealso marker="#type-start_opt">
+ <c>{spawn_opt,SpawnOpts}</c>
+ </seealso>
+ is present in
<c><anno>Opts</anno></c>, <c>SpawnOpts</c> is passed
as option list to
<seealso marker="erts:erlang#spawn_opt/2"><c>erlang:spawn_opt/2</c></seealso>,
diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml
index a682811c6d..23c3f6e981 100644
--- a/lib/stdlib/doc/src/notes.xml
+++ b/lib/stdlib/doc/src/notes.xml
@@ -31,6 +31,72 @@
</header>
<p>This document describes the changes made to the STDLIB application.</p>
+<section><title>STDLIB 3.8</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> Fix a bug in the Erlang Pretty Printer: long atom
+ names in combination with <c>&lt;&lt;&gt;&gt;</c> could
+ cause a crash. </p>
+ <p>
+ Own Id: OTP-15592 Aux Id: ERL-818 </p>
+ </item>
+ <item>
+ <p> Fix bugs that could cause wrong results or bad
+ performance when formatting lists of characters using the
+ control sequences <c>p</c> or <c>P</c> and limiting the
+ output with the option <c>chars_limit</c>. </p>
+ <p>
+ Own Id: OTP-15639</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Improved ETS documentation about safe table traversal and
+ the partially bound key optimization for
+ <c>ordered_set</c>.</p>
+ <p>
+ Own Id: OTP-15545 Aux Id: PR-2103, PR-2139 </p>
+ </item>
+ <item>
+ <p> Optimize <c>calendar:gregorian_days_to_date/1</c>.
+ </p>
+ <p>
+ Own Id: OTP-15572 Aux Id: PR-2121 </p>
+ </item>
+ <item>
+ <p> Optimize functions
+ <c>calendar:rfc3339_to_system_time()</c> and
+ <c>calendar:system_time_to_rfc3339()</c>. </p>
+ <p>
+ Own Id: OTP-15630</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>STDLIB 3.7.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> Optimize pretty printing of terms. The slower
+ behaviour was introduced in Erlang/OTP 20. </p>
+ <p>
+ Own Id: OTP-15573 Aux Id: ERIERL-306 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>STDLIB 3.7</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/stdlib/doc/src/proplists.xml b/lib/stdlib/doc/src/proplists.xml
index 9d7eb55a7e..4465103469 100644
--- a/lib/stdlib/doc/src/proplists.xml
+++ b/lib/stdlib/doc/src/proplists.xml
@@ -57,6 +57,11 @@
<datatype>
<name name="property"/>
</datatype>
+
+ <datatype>
+ <name name="proplist"/>
+ </datatype>
+
</datatypes>
<funcs>
diff --git a/lib/stdlib/doc/src/slave.xml b/lib/stdlib/doc/src/slave.xml
index 80fb28b548..778c5f66e5 100644
--- a/lib/stdlib/doc/src/slave.xml
+++ b/lib/stdlib/doc/src/slave.xml
@@ -39,23 +39,30 @@
done through the master.</p>
<p>Slave nodes on other hosts than the current one are started with
- the <c>rsh</c> program. The user must be allowed to <c>rsh</c> to
+ the <c>ssh</c> program. The user must be allowed to <c>ssh</c> to
the remote hosts without being prompted for a password. This can
- be arranged in a number of ways (for details, see the <c>rsh</c>
+ be arranged in a number of ways (for details, see the <c>ssh</c>
documentation). A slave node started on the same host
as the master inherits certain environment values from the master,
such as the current directory and the environment variables. For
what can be assumed about the environment when a slave is started
- on another host, see the documentation for the <c>rsh</c>
+ on another host, see the documentation for the <c>ssh</c>
program.</p>
- <p>An alternative to the <c>rsh</c> program can be specified on
+ <p>An alternative to the <c>ssh</c> program can be specified on
the command line to
<seealso marker="erts:erl#erl"><c>erl(1)</c></seealso> as follows:</p>
<pre>
-rsh Program</pre>
+ <p>Note that the command specified with the <c>-rsh</c> flag is
+ treated as a file name which may contain spaces. It is thus not
+ possible to include any command line options. The remote node will
+ be launched as <c>"$RSH" "$REMOTE_HOSTNAME" erl -detached -noinput
+ ...</c>, so the
+ <c>erl</c> command must be found in the path on the remote host.</p>
+
<p>The slave node is to use the same file system at the master. At
least, Erlang/OTP is to be installed in the same place on both
computers and the same version of Erlang is to be used.</p>
@@ -166,7 +173,9 @@ slave:start(H, Name, Arg).</code>
</item>
<tag><c>no_rsh</c></tag>
<item>
- <p>There is no <c>rsh</c> program on the computer.</p>
+ <p>No remote shell program was found on the computer. Note
+ that <c>ssh</c> is used by default, but this can be overridden
+ with the <c>-rsh</c> flag.</p>
</item>
<tag><c>{already_running, <anno>Node</anno>}</c></tag>
<item>
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index c5075f31c5..e22ca89ef5 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2018</year>
+ <year>1996</year><year>2019</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -271,6 +271,9 @@
<name name="dbg_fun"/>
</datatype>
<datatype>
+ <name name="debug_option"/>
+ </datatype>
+ <datatype>
<name name="format_fun"/>
</datatype>
</datatypes>
diff --git a/lib/stdlib/src/calendar.erl b/lib/stdlib/src/calendar.erl
index bb5d450cd6..3a8fe2211b 100644
--- a/lib/stdlib/src/calendar.erl
+++ b/lib/stdlib/src/calendar.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -357,13 +357,17 @@ rfc3339_to_system_time(DateTimeString) ->
rfc3339_to_system_time(DateTimeString, Options) ->
Unit = proplists:get_value(unit, Options, second),
%% _T is the character separating the date and the time:
- {DateStr, [_T|TimeStr]} = lists:split(10, DateTimeString),
- {TimeStr2, TimeStr3} = lists:split(8, TimeStr),
- {ok, [Hour, Min, Sec], []} = io_lib:fread("~d:~d:~d", TimeStr2),
- {ok, [Year, Month, Day], []} = io_lib:fread("~d-~d-~d", DateStr),
+ [Y1, Y2, Y3, Y4, $-, Mon1, Mon2, $-, D1, D2, _T,
+ H1, H2, $:, Min1, Min2, $:, S1, S2 | TimeStr] = DateTimeString,
+ Hour = list_to_integer([H1, H2]),
+ Min = list_to_integer([Min1, Min2]),
+ Sec = list_to_integer([S1, S2]),
+ Year = list_to_integer([Y1, Y2, Y3, Y4]),
+ Month = list_to_integer([Mon1, Mon2]),
+ Day = list_to_integer([D1, D2]),
DateTime = {{Year, Month, Day}, {Hour, Min, Sec}},
IsFractionChar = fun(C) -> C >= $0 andalso C =< $9 orelse C =:= $. end,
- {FractionStr, UtcOffset} = lists:splitwith(IsFractionChar, TimeStr3),
+ {FractionStr, UtcOffset} = lists:splitwith(IsFractionChar, TimeStr),
Time = datetime_to_system_time(DateTime),
Secs = Time - offset_adjustment(Time, second, UtcOffset),
check(DateTimeString, Options, Secs),
@@ -451,8 +455,9 @@ system_time_to_rfc3339(Time, Options) ->
DateTime = system_time_to_datetime(Secs),
{{Year, Month, Day}, {Hour, Min, Sec}} = DateTime,
FractionStr = fraction_str(Factor, AdjustedTime),
- flat_fwrite("~4.10.0B-~2.10.0B-~2.10.0B~c~2.10.0B:~2.10.0B:~2.10.0B~s~s",
- [Year, Month, Day, T, Hour, Min, Sec, FractionStr, Offset]).
+ L = [pad4(Year), "-", pad2(Month), "-", pad2(Day), [T],
+ pad2(Hour), ":", pad2(Min), ":", pad2(Sec), FractionStr, Offset],
+ lists:append(L).
%% time_difference(T1, T2) = Tdiff
%%
@@ -529,24 +534,41 @@ valid_date({Y, M, D}) ->
%% day_to_year(DayOfEpoch) = {Year, DayOfYear}
%%
-%% The idea here is to first guess a year, and then adjust. Although
-%% the implementation is recursive, at most 1 or 2 recursive steps
+%% The idea here is to first set the upper and lower bounds for a year,
+%% and then adjust a range by interpolation search. Although complexity
+%% of the algorithm is log(log(n)), at most 1 or 2 recursive steps
%% are taken.
-%% If DayOfEpoch is very large, we need far more than 1 or 2 iterations,
-%% since we just subtract a yearful of days at a time until we're there.
%%
-spec day_to_year(non_neg_integer()) -> {year(), day_of_year()}.
day_to_year(DayOfEpoch) when DayOfEpoch >= 0 ->
- Y0 = DayOfEpoch div ?DAYS_PER_YEAR,
- {Y1, D1} = dty(Y0, DayOfEpoch, dy(Y0)),
+ YMax = DayOfEpoch div ?DAYS_PER_YEAR,
+ YMin = DayOfEpoch div ?DAYS_PER_LEAP_YEAR,
+ {Y1, D1} = dty(YMin, YMax, DayOfEpoch, dy(YMin), dy(YMax)),
{Y1, DayOfEpoch - D1}.
--spec dty(year(), non_neg_integer(), non_neg_integer()) ->
+-spec dty(year(), year(), non_neg_integer(), non_neg_integer(),
+ non_neg_integer()) ->
{year(), non_neg_integer()}.
-dty(Y, D1, D2) when D1 < D2 ->
- dty(Y-1, D1, dy(Y-1));
-dty(Y, _D1, D2) ->
- {Y, D2}.
+dty(Min, Max, _D1, DMin, _DMax) when Min == Max ->
+ {Min, DMin};
+dty(Min, Max, D1, DMin, DMax) ->
+ Diff = Max - Min,
+ Mid = Min + (Diff * (D1 - DMin)) div (DMax - DMin),
+ MidLength =
+ case is_leap_year(Mid) of
+ true -> ?DAYS_PER_LEAP_YEAR;
+ false -> ?DAYS_PER_YEAR
+ end,
+ case dy(Mid) of
+ D2 when D1 < D2 ->
+ NewMax = Mid - 1,
+ dty(Min, NewMax, D1, DMin, dy(NewMax));
+ D2 when D1 - D2 >= MidLength ->
+ NewMin = Mid + 1,
+ dty(NewMin, Max, D1, dy(NewMin), DMax);
+ D2 ->
+ {Mid, D2}
+ end.
%%
%% The Gregorian days of the iso week 01 day 1 for a given year.
@@ -663,7 +685,7 @@ offset(OffsetOption, Secs0) when OffsetOption =:= "";
Secs = abs(Secs0),
Hour = Secs div 3600,
Min = (Secs rem 3600) div 60,
- io_lib:fwrite("~c~2.10.0B:~2.10.0B", [Sign, Hour, Min]);
+ [Sign | lists:append([pad2(Hour), ":", pad2(Min)])];
offset(OffsetOption, _Secs) ->
OffsetOption.
@@ -678,8 +700,10 @@ offset_string_adjustment(_Time, _Unit, "Z") ->
0;
offset_string_adjustment(_Time, _Unit, "z") ->
0;
-offset_string_adjustment(_Time, _Unit, [Sign|Tz]) ->
- {ok, [Hour, Min], []} = io_lib:fread("~d:~d", Tz),
+offset_string_adjustment(_Time, _Unit, Tz) ->
+ [Sign, H1, H2, $:, M1, M2] = Tz,
+ Hour = list_to_integer([H1, H2]),
+ Min = list_to_integer([M1, M2]),
Adjustment = 3600 * Hour + 60 * Min,
case Sign of
$- -> -Adjustment;
@@ -687,8 +711,9 @@ offset_string_adjustment(_Time, _Unit, [Sign|Tz]) ->
end.
local_offset(SystemTime, Unit) ->
- LocalTime = system_time_to_local_time(SystemTime, Unit),
+ %% Not optimized for special cases.
UniversalTime = system_time_to_universal_time(SystemTime, Unit),
+ LocalTime = erlang:universaltime_to_localtime(UniversalTime),
LocalSecs = datetime_to_gregorian_seconds(LocalTime),
UniversalSecs = datetime_to_gregorian_seconds(UniversalTime),
LocalSecs - UniversalSecs.
@@ -697,7 +722,8 @@ fraction_str(1, _Time) ->
"";
fraction_str(Factor, Time) ->
Fraction = Time rem Factor,
- io_lib:fwrite(".~*..0B", [log10(Factor), abs(Fraction)]).
+ S = integer_to_list(abs(Fraction)),
+ [$. | pad(log10(Factor) - length(S), S)].
fraction(second, _) ->
0;
@@ -718,5 +744,21 @@ log10(1000) -> 3;
log10(1000000) -> 6;
log10(1000000000) -> 9.
-flat_fwrite(F, S) ->
- lists:flatten(io_lib:fwrite(F, S)).
+pad(0, S) ->
+ S;
+pad(I, S) ->
+ [$0 | pad(I - 1, S)].
+
+pad2(N) when N < 10 ->
+ [$0 | integer_to_list(N)];
+pad2(N) ->
+ integer_to_list(N).
+
+pad4(N) when N < 10 ->
+ [$0, $0, $0 | integer_to_list(N)];
+pad4(N) when N < 100 ->
+ [$0, $0 | integer_to_list(N)];
+pad4(N) when N < 1000 ->
+ [$0 | integer_to_list(N)];
+pad4(N) ->
+ integer_to_list(N).
diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl
index dd302a2880..ada3ff5de3 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -697,6 +697,8 @@ fun_info(Extra) ->
%% BITS:
+bit_grp([], _Opts) ->
+ leaf("<<>>");
bit_grp(Fs, Opts) ->
append([['<<'], [bit_elems(Fs, Opts)], ['>>']]).
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 513118a874..49911eac2c 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -67,6 +67,14 @@
%% Type that is exported just to be documented
-export_type([transition_option/0]).
+%% Type exports for start_link & friends
+-export_type(
+ [server_name/0,
+ server_ref/0,
+ start_opt/0,
+ start_ret/0,
+ enter_loop_opt/0]).
+
%%%==========================================================================
%%% Interface functions.
%%%==========================================================================
@@ -424,28 +432,26 @@ timeout_event_type(Type) ->
%%% API
-type server_name() ::
- {'global', GlobalName :: term()}
+ {'global', GlobalName :: term()}
| {'via', RegMod :: module(), Name :: term()}
| {'local', atom()}.
-type server_ref() ::
- pid()
+ pid()
| (LocalName :: atom())
| {Name :: atom(), Node :: atom()}
| {'global', GlobalName :: term()}
| {'via', RegMod :: module(), ViaName :: term()}.
--type debug_opt() ::
- {'debug',
- Dbgs ::
- ['trace' | 'log' | 'statistics' | 'debug'
- | {'logfile', string()}]}.
--type hibernate_after_opt() ::
- {'hibernate_after', HibernateAfterTimeout :: timeout()}.
-type start_opt() ::
- debug_opt()
- | {'timeout', Time :: timeout()}
- | hibernate_after_opt()
- | {'spawn_opt', [proc_lib:spawn_option()]}.
--type start_ret() :: {'ok', pid()} | 'ignore' | {'error', term()}.
+ {'timeout', Time :: timeout()}
+ | {'spawn_opt', [proc_lib:spawn_option()]}
+ | enter_loop_opt().
+-type start_ret() ::
+ {'ok', pid()}
+ | 'ignore'
+ | {'error', term()}.
+-type enter_loop_opt() ::
+ {'hibernate_after', HibernateAfterTimeout :: timeout()}
+ | {'debug', Dbgs :: [sys:debug_option()]}.
@@ -558,14 +564,14 @@ reply({To,Tag}, Reply) when is_pid(To) ->
%% started by proc_lib into a state machine using
%% the same arguments as you would have returned from init/1
-spec enter_loop(
- Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()],
+ Module :: module(), Opts :: [enter_loop_opt()],
State :: state(), Data :: data()) ->
no_return().
enter_loop(Module, Opts, State, Data) ->
enter_loop(Module, Opts, State, Data, self()).
%%
-spec enter_loop(
- Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()],
+ Module :: module(), Opts :: [enter_loop_opt()],
State :: state(), Data :: data(),
Server_or_Actions ::
server_name() | pid() | [action()]) ->
@@ -579,7 +585,7 @@ enter_loop(Module, Opts, State, Data, Server_or_Actions) ->
end.
%%
-spec enter_loop(
- Module :: module(), Opts :: [debug_opt() | hibernate_after_opt()],
+ Module :: module(), Opts :: [enter_loop_opt()],
State :: state(), Data :: data(),
Server :: server_name() | pid(),
Actions :: [action()] | action()) ->
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index 8223a52873..2b5a374cf2 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -87,6 +87,8 @@
-export([limit_term/2]).
+-export([chars_length/1]).
+
-export_type([chars/0, latin1_string/0, continuation/0,
fread_error/0, fread_item/0, format_spec/0, chars_limit/0]).
@@ -1131,3 +1133,17 @@ test_limit_map_assoc(K, V, D) ->
test_limit(V, D - 1).
test_limit_bitstring(_, _) -> ok.
+
+-spec chars_length(chars()) -> non_neg_integer().
+%% Optimized for deep lists S such that deep_latin1_char_list(S) is
+%% true. No binaries allowed! It is assumed that $\r is never followed
+%% by $\n if S is an iolist() (string:length() assigns such a
+%% sub-sequence length 1).
+chars_length(S) ->
+ try
+ %% true = deep_latin1_char_list(S),
+ iolist_size(S)
+ catch
+ _:_ ->
+ string:length(S)
+ end.
diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl
index ab9031573b..d1aa4cd157 100644
--- a/lib/stdlib/src/io_lib_format.erl
+++ b/lib/stdlib/src/io_lib_format.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -248,7 +248,7 @@ count_small([#{control_char := $s}|Cs], #{w := W} = Cnts) ->
count_small(Cs, Cnts#{w := W + 1});
count_small([S|Cs], #{other := Other} = Cnts) when is_list(S);
is_binary(S) ->
- count_small(Cs, Cnts#{other := Other + string:length(S)});
+ count_small(Cs, Cnts#{other := Other + io_lib:chars_length(S)});
count_small([C|Cs], #{other := Other} = Cnts) when is_integer(C) ->
count_small(Cs, Cnts#{other := Other + 1});
count_small([], #{p := P, s := S, w := W, other := Other}) ->
@@ -280,10 +280,15 @@ build_limited([#{control_char := C, args := As, width := F, adjust := Ad,
true -> MaxLen0 div Count0
end,
S = control_limited(C, As, F, Ad, P, Pad, Enc, Str, MaxChars, I),
- Len = string:length(S),
NumOfPs = decr_pc(C, NumOfPs0),
Count = Count0 - 1,
- MaxLen = sub(MaxLen0, Len),
+ MaxLen = if
+ MaxLen0 < 0 -> % optimization
+ MaxLen0;
+ true ->
+ Len = io_lib:chars_length(S),
+ sub(MaxLen0, Len)
+ end,
if
NumOfPs > 0 -> [S|build_limited(Cs, NumOfPs, Count,
MaxLen, indentation(S, I))];
@@ -406,7 +411,7 @@ base(B) when is_integer(B) ->
term(T, none, _Adj, none, _Pad) -> T;
term(T, none, Adj, P, Pad) -> term(T, P, Adj, P, Pad);
term(T, F, Adj, P0, Pad) ->
- L = string:length(T),
+ L = io_lib:chars_length(T),
P = erlang:min(L, case P0 of none -> F; _ -> min(P0, F) end),
if
L > P ->
@@ -713,7 +718,7 @@ fwrite_g(Fl, F, Adj, P, Pad) when P >= 1 ->
end.
-%% iolist_to_chars(iolist()) -> deep_char_list()
+%% iolist_to_chars(iolist()) -> io_lib:chars()
iolist_to_chars([C|Cs]) when is_integer(C), C >= $\000, C =< $\377 ->
[C | iolist_to_chars(Cs)];
@@ -729,7 +734,7 @@ iolist_to_chars(B) when is_binary(B) ->
%% cbinary() | nil())
%% cbinary() :: unicode:unicode_binary() | unicode:latin1_binary()
-%% cdata_to_chars(cdata()) -> io_lib:deep_char_list()
+%% cdata_to_chars(cdata()) -> io_lib:chars()
cdata_to_chars([C|Cs]) when is_integer(C), C >= $\000 ->
[C | cdata_to_chars(Cs)];
@@ -745,7 +750,7 @@ cdata_to_chars(B) when is_binary(B) ->
limit_string(S, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> S;
limit_string(S, _F, CharsLimit) ->
- case string:length(S) =< CharsLimit of
+ case io_lib:chars_length(S) =< CharsLimit of
true -> S;
false -> [string:slice(S, 0, sub(CharsLimit, 3)), "..."]
end.
@@ -759,11 +764,11 @@ limit_field(F, CharsLimit) ->
string(S, none, _Adj, none, _Pad) -> S;
string(S, F, Adj, none, Pad) ->
- string_field(S, F, Adj, string:length(S), Pad);
+ string_field(S, F, Adj, io_lib:chars_length(S), Pad);
string(S, none, _Adj, P, Pad) ->
- string_field(S, P, left, string:length(S), Pad);
+ string_field(S, P, left, io_lib:chars_length(S), Pad);
string(S, F, Adj, P, Pad) when F >= P ->
- N = string:length(S),
+ N = io_lib:chars_length(S),
if F > P ->
if N > P ->
adjust(flat_trunc(S, P), chars(Pad, F-P), Adj);
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index ba9d9e8434..8f2fd7ea8f 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -507,20 +507,20 @@ print_length(#{}=M, _D, _T, _RF, _Enc, _Str) when map_size(M) =:= 0 ->
{"#{}", 3, 0, no_more};
print_length(Atom, _D, _T, _RF, Enc, _Str) when is_atom(Atom) ->
S = write_atom(Atom, Enc),
- {S, string:length(S), 0, no_more};
+ {S, io_lib:chars_length(S), 0, no_more};
print_length(List, D, T, RF, Enc, Str) when is_list(List) ->
%% only flat lists are "printable"
case Str andalso printable_list(List, D, T, Enc) of
true ->
%% print as string, escaping double-quotes in the list
S = write_string(List, Enc),
- {S, string:length(S), 0, no_more};
+ {S, io_lib:chars_length(S), 0, no_more};
{true, Prefix} ->
%% Truncated lists when T < 0 could break some existing code.
S = write_string(Prefix, Enc),
%% NumOfDots = 0 to avoid looping--increasing the depth
%% does not make Prefix longer.
- {[S | "..."], 3 + string:length(S), 0, no_more};
+ {[S | "..."], 3 + io_lib:chars_length(S), 0, no_more};
false ->
case print_length_list(List, D, T, RF, Enc, Str) of
{What, Len, Dots, _More} when Dots > 0 ->
@@ -564,7 +564,7 @@ print_length(<<_/bitstring>> = Bin, D, T, RF, Enc, Str) ->
{[$<,$<,S,$>,$>], 4 + length(S), 0, no_more};
{false, List} when is_list(List) ->
S = io_lib:write_string(List, $"), %"
- {[$<,$<,S,"/utf8>>"], 9 + string:length(S), 0, no_more};
+ {[$<,$<,S,"/utf8>>"], 9 + io_lib:chars_length(S), 0, no_more};
{true, true, Prefix} ->
S = io_lib:write_string(Prefix, $"), %"
More = fun(T1, Dd) ->
@@ -576,7 +576,7 @@ print_length(<<_/bitstring>> = Bin, D, T, RF, Enc, Str) ->
More = fun(T1, Dd) ->
?FUNCTION_NAME(Bin, D+Dd, T1, RF, Enc, Str)
end,
- {[$<,$<,S|"/utf8...>>"], 12 + string:length(S), 3, More};
+ {[$<,$<,S|"/utf8...>>"], 12 + io_lib:chars_length(S), 3, More};
false ->
case io_lib:write_binary(Bin, D, T) of
{S, <<>>} ->
@@ -591,7 +591,7 @@ print_length(<<_/bitstring>> = Bin, D, T, RF, Enc, Str) ->
print_length(Term, _D, _T, _RF, _Enc, _Str) ->
S = io_lib:write(Term),
%% S can contain unicode, so iolist_size(S) cannot be used here
- {S, string:length(S), 0, no_more}.
+ {S, io_lib:chars_length(S), 0, no_more}.
print_length_map(Map, 1, _T, RF, Enc, Str) ->
More = fun(T1, Dd) -> ?FUNCTION_NAME(Map, 1+Dd, T1, RF, Enc, Str) end,
@@ -651,7 +651,7 @@ print_length_record(Tuple, 1, _T, RF, RDefs, Enc, Str) ->
{"{...}", 5, 3, More};
print_length_record(Tuple, D, T, RF, RDefs, Enc, Str) ->
Name = [$# | write_atom(element(1, Tuple), Enc)],
- NameL = string:length(Name),
+ NameL = io_lib:chars_length(Name),
T1 = tsub(T, NameL+2),
L = print_length_fields(RDefs, D - 1, T1, Tuple, 2, RF, Enc, Str),
{Len, Dots} = list_length(L, NameL + 2, 0),
@@ -677,7 +677,7 @@ print_length_fields([Def | Defs], D, T, Tuple, I, RF, Enc, Str) ->
print_length_field(Def, D, T, E, RF, Enc, Str) ->
Name = write_atom(Def, Enc),
- NameL = string:length(Name) + 3,
+ NameL = io_lib:chars_length(Name) + 3,
{_, Len, Dots, _} =
Field = print_length(E, D, tsub(T, NameL), RF, Enc, Str),
{{field, Name, NameL, Field}, NameL + Len, Dots, no_more}.
@@ -721,7 +721,7 @@ printable_list(_L, 1, _T, _Enc) ->
printable_list(L, _D, T, latin1) when T < 0 ->
io_lib:printable_latin1_list(L);
printable_list(L, _D, T, Enc) when T >= 0 ->
- case slice(L, tsub(T, 2)) of
+ case slice(L, tsub(T, 2), Enc) of
false ->
false;
{prefix, Prefix} when Enc =:= latin1 ->
@@ -737,20 +737,46 @@ printable_list(L, _D, T, Enc) when T >= 0 ->
printable_list(L, _D, T, _Uni) when T < 0->
io_lib:printable_list(L).
-slice(L, N) ->
- try string:length(L) =< N of
- true ->
+slice(L, N, latin1) ->
+ try lists:split(N, L) of
+ {_, []} ->
all;
- false ->
- case string:slice(L, 0, N) of
- "" ->
- false;
- Prefix ->
- {prefix, Prefix}
+ {[], _} ->
+ false;
+ {L1, _} ->
+ {prefix, L1}
+ catch
+ _:_ ->
+ all
+ end;
+slice(L, N, _Uni) ->
+ %% Be careful not to traverse more of L than necessary.
+ try string:slice(L, 0, N) of
+ "" ->
+ false;
+ Prefix ->
+ %% Assume no binaries are introduced by string:slice().
+ case is_flat(L, lists:flatlength(Prefix)) of
+ true ->
+ case string:equal(Prefix, L) of
+ true ->
+ all;
+ false ->
+ {prefix, Prefix}
+ end;
+ false ->
+ false
end
catch _:_ -> false
end.
+is_flat(_L, 0) ->
+ true;
+is_flat([C|Cs], N) when is_integer(C) ->
+ is_flat(Cs, N - 1);
+is_flat(_, _N) ->
+ false.
+
printable_bin0(Bin, D, T, Enc) ->
Len = case D >= 0 of
true ->
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index f2b50c354a..b95cb8f525 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -44,8 +44,19 @@ obsolete(Module, Name, Arity) ->
no
end.
-obsolete_1(net, _, _) ->
- {deprecated, "module 'net' obsolete; use 'net_adm'"};
+obsolete_1(net, call, 4) ->
+ {deprecated, {rpc, call, 4}};
+obsolete_1(net, cast, 4) ->
+ {deprecated, {rpc, cast, 4}};
+obsolete_1(net, broadcast, 3) ->
+ {deprecated, {rpc, eval_everywhere, 3}};
+obsolete_1(net, ping, 1) ->
+ {deprecated, {net_adm, ping, 1}};
+obsolete_1(net, sleep, 1) ->
+ {deprecated, "Use 'receive after T -> ok end' instead"};
+obsolete_1(net, relay, 1) ->
+ {deprecated, {slave, relay, 1}};
+
obsolete_1(erlang, now, 0) ->
{deprecated,
diff --git a/lib/stdlib/src/slave.erl b/lib/stdlib/src/slave.erl
index 5e8c1a43ea..4791e3ebda 100644
--- a/lib/stdlib/src/slave.erl
+++ b/lib/stdlib/src/slave.erl
@@ -104,18 +104,17 @@ relay1(Pid) ->
%% this to work is that the 'erl' program can be found in PATH.
%%
%% If the master and slave are on different hosts, start/N uses
-%% the 'rsh' program to spawn an Erlang node on the other host.
+%% the 'ssh' program to spawn an Erlang node on the other host.
%% Alternative, if the master was started as
%% 'erl -sname xxx -rsh my_rsh...', then 'my_rsh' will be used instead
-%% of 'rsh' (this is useful for systems where the rsh program is named
-%% 'remsh').
+%% of 'ssh' (this is useful for systems still using rsh or remsh).
%%
%% For this to work, the following conditions must be fulfilled:
%%
-%% 1. There must be an Rsh program on computer; if not an error
+%% 1. There must be an ssh program on computer; if not an error
%% is returned.
%%
-%% 2. The hosts must be configured to allowed 'rsh' access without
+%% 2. The hosts must be configured to allow 'ssh' access without
%% prompts for password.
%%
%% The slave node will have its filer and user server redirected
@@ -286,7 +285,7 @@ register_unique_name(Number) ->
%% Makes up the command to start the nodes.
%% If the node should run on the local host, there is
-%% no need to use rsh.
+%% no need to use a remote shell.
mk_cmd(Host, Name, Args, Waiter, Prog0) ->
Prog = quote_progname(Prog0),
@@ -342,9 +341,7 @@ do_quote_progname([Prog,Arg|Args]) ->
lists:flatten(lists:map(fun(X) -> [" ",X] end, [Arg|Args]))
end.
-%% Give the user an opportunity to run another program,
-%% than the "rsh". On HP-UX rsh is called remsh; thus HP users
-%% must start erlang as erl -rsh remsh.
+%% Give the user an opportunity to run another program than "ssh".
%%
%% Also checks that the given program exists.
%%
@@ -354,7 +351,7 @@ rsh() ->
Rsh =
case init:get_argument(rsh) of
{ok, [[Prog]]} -> Prog;
- _ -> "rsh"
+ _ -> "ssh"
end,
case os:find_executable(Rsh) of
false -> {error, no_rsh};
diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src
index 2a324aef82..37ea97c353 100644
--- a/lib/stdlib/src/stdlib.appup.src
+++ b/lib/stdlib/src/stdlib.appup.src
@@ -38,7 +38,10 @@
{<<"^3\\.5\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^3\\.5\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^3\\.6$">>,[restart_new_emulator]},
- {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}],
+ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.7$">>,[restart_new_emulator]},
+ {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}],
[{<<"^3\\.4$">>,[restart_new_emulator]},
{<<"^3\\.4\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^3\\.4\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
@@ -50,4 +53,7 @@
{<<"^3\\.5\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
{<<"^3\\.5\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]},
{<<"^3\\.6$">>,[restart_new_emulator]},
- {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]}]}.
+ {<<"^3\\.6\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.7$">>,[restart_new_emulator]},
+ {<<"^3\\.7\\.0(?:\\.[0-9]+)+$">>,[restart_new_emulator]},
+ {<<"^3\\.7\\.1(?:\\.[0-9]+)*$">>,[restart_new_emulator]}]}.
diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl
index a04195c9ed..6ff9aa33b4 100644
--- a/lib/stdlib/src/sys.erl
+++ b/lib/stdlib/src/sys.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -37,7 +37,7 @@
%% Types
%%-----------------------------------------------------------------
--export_type([dbg_opt/0]).
+-export_type([dbg_opt/0, dbg_fun/0, debug_option/0]).
-type name() :: pid() | atom()
| {'global', term()}
@@ -75,6 +75,16 @@
Event :: system_event(),
Extra :: term()) -> any()).
+-type debug_option() ::
+ 'trace'
+ | 'log'
+ | {'log', N :: pos_integer()}
+ | 'statistics'
+ | {'log_to_file', FileName :: file:name()}
+ | {'install',
+ {Func :: dbg_fun(), FuncState :: term()}
+ | {FuncId :: term(), Func :: dbg_fun(), FuncState :: term()}}.
+
%%-----------------------------------------------------------------
%% System messages
%%-----------------------------------------------------------------
@@ -734,19 +744,7 @@ nlog_get([_J|R]) ->
%% Returns: [debug_opts()]
%%-----------------------------------------------------------------
--spec debug_options(Options) -> [dbg_opt()] when
- Options :: [Opt],
- Opt :: 'trace'
- | 'log'
- | {'log', pos_integer()}
- | 'statistics'
- | {'log_to_file', FileName}
- | {'install', FuncSpec},
- FileName :: file:name(),
- FuncSpec :: {Func, FuncState} | {FuncId, Func, FuncState},
- FuncId :: term(),
- Func :: dbg_fun(),
- FuncState :: term().
+-spec debug_options([Opt :: debug_option()]) -> [dbg_opt()].
debug_options(Options) ->
debug_options(Options, []).
diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl
index c5cfea5e9e..9b2033ec4a 100644
--- a/lib/stdlib/test/binary_module_SUITE.erl
+++ b/lib/stdlib/test/binary_module_SUITE.erl
@@ -22,7 +22,8 @@
-export([all/0, suite/0,
interesting/1,scope_return/1,random_ref_comp/1,random_ref_sr_comp/1,
random_ref_fla_comp/1,parts/1, bin_to_list/1, list_to_bin/1,
- copy/1, referenced/1,guard/1,encode_decode/1,badargs/1,longest_common_trap/1]).
+ copy/1, referenced/1,guard/1,encode_decode/1,badargs/1,longest_common_trap/1,
+ check_no_invalid_read_bug/1]).
-export([random_number/1, make_unaligned/1]).
@@ -36,7 +37,7 @@ all() ->
[scope_return,interesting, random_ref_fla_comp, random_ref_sr_comp,
random_ref_comp, parts, bin_to_list, list_to_bin, copy,
referenced, guard, encode_decode, badargs,
- longest_common_trap].
+ longest_common_trap, check_no_invalid_read_bug].
-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))).
@@ -754,8 +755,9 @@ list_to_bin(Config) when is_list(Config) ->
copy(Config) when is_list(Config) ->
<<1,2,3>> = binary:copy(<<1,2,3>>),
RS = random_string({1,10000}),
- RS = RS2 = binary:copy(RS),
- false = erts_debug:same(RS,RS2),
+ RS2 = binary:copy(RS),
+ true = RS =:= RS2,
+ false = erts_debug:same(RS, RS2),
<<>> = ?MASK_ERROR(binary:copy(<<1,2,3>>,0)),
badarg = ?MASK_ERROR(binary:copy(<<1,2,3:3>>,2)),
badarg = ?MASK_ERROR(binary:copy([],0)),
@@ -1361,3 +1363,13 @@ make_unaligned2(Bin0) when is_binary(Bin0) ->
Bin.
id(I) -> I.
+
+check_no_invalid_read_bug(Config) when is_list(Config) ->
+ check_no_invalid_read_bug(24);
+check_no_invalid_read_bug(60) ->
+ ok;
+check_no_invalid_read_bug(I) ->
+ N = 1 bsl I,
+ binary:encode_unsigned(N+N),
+ binary:encode_unsigned(N+N, little),
+ check_no_invalid_read_bug(I+1).
diff --git a/lib/stdlib/test/calendar_SUITE.erl b/lib/stdlib/test/calendar_SUITE.erl
index df62c0921d..224c0d5625 100644
--- a/lib/stdlib/test/calendar_SUITE.erl
+++ b/lib/stdlib/test/calendar_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -24,6 +24,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
gregorian_days/1,
+ big_gregorian_days/1,
gregorian_seconds/1,
day_of_the_week/1,
day_of_the_week_calibrate/1,
@@ -36,13 +37,16 @@
-define(START_YEAR, 1947).
-define(END_YEAR, 2012).
+-define(BIG_START_YEAR, 20000000).
+-define(BIG_END_YEAR, 20000020).
+
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[gregorian_days, gregorian_seconds, day_of_the_week,
day_of_the_week_calibrate, leap_years,
last_day_of_the_month, local_time_to_universal_time_dst,
- iso_week_number, system_time, rfc3339].
+ iso_week_number, system_time, rfc3339, big_gregorian_days].
groups() ->
[].
@@ -67,6 +71,14 @@ gregorian_days(Config) when is_list(Config) ->
MaxDays = calendar:date_to_gregorian_days({?END_YEAR, 1, 1}),
check_gregorian_days(Days, MaxDays).
+%% Tests that date_to_gregorian_days and gregorian_days_to_date
+%% are each others inverses from ?BIG_START_YEAR-01-01 up to ?BIG_END_YEAR-01-01.
+%% At the same time valid_date is tested.
+big_gregorian_days(Config) when is_list(Config) ->
+ Days = calendar:date_to_gregorian_days({?BIG_START_YEAR, 1, 1}),
+ MaxDays = calendar:date_to_gregorian_days({?BIG_END_YEAR, 1, 1}),
+ check_gregorian_days(Days, MaxDays).
+
%% Tests that datetime_to_gregorian_seconds and
%% gregorian_seconds_to_date are each others inverses for a sampled
%% number of seconds from ?START_YEAR-01-01 up to ?END_YEAR-01-01: We check
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index f4019d477b..2436c8091c 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -1156,7 +1156,17 @@ simple() ->
{A}.
simple1() ->
- erlang:error(simple).
+ %% If the compiler could see that this function would always
+ %% throw an error exception, it would rewrite simple() like this:
+ %%
+ %% simple() -> simple1().
+ %%
+ %% That would change the stacktrace. To prevent the compiler from
+ %% doing that optimization, we must obfuscate the code.
+ case get(a_key_that_is_not_defined) of
+ undefined -> erlang:error(simple);
+ WillNeverHappen -> WillNeverHappen
+ end.
%% Simple cases, just to cover some code.
funs(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl
index dda8d0a12e..f5d80e7e68 100644
--- a/lib/stdlib/test/erl_pp_SUITE.erl
+++ b/lib/stdlib/test/erl_pp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2018. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -51,7 +51,7 @@
otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1,
otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1,
otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1, pr_1014/1,
- otp_13662/1, otp_14285/1]).
+ otp_13662/1, otp_14285/1, otp_15592/1]).
%% Internal export.
-export([ehook/6]).
@@ -81,7 +81,7 @@ groups() ->
[otp_6321, otp_6911, otp_6914, otp_8150, otp_8238,
otp_8473, otp_8522, otp_8567, otp_8664, otp_9147,
otp_10302, otp_10820, otp_11100, otp_11861, pr_1014, otp_13662,
- otp_14285]}].
+ otp_14285, otp_15592]}].
init_per_suite(Config) ->
Config.
@@ -1167,6 +1167,11 @@ otp_14285(_Config) ->
[{encoding,latin1}])),
ok.
+otp_15592(_Config) ->
+ ok = pp_expr(<<"long12345678901234567890123456789012345678901234"
+ "56789012345678901234:f(<<>>)">>),
+ ok.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
compile(Config, Tests) ->
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 22c77aa172..8561491d50 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -56,9 +56,11 @@
-export([t_match_spec_run/1]).
-export([t_bucket_disappears/1]).
-export([t_named_select/1]).
+-export([select_fixtab_owner_change/1]).
-export([otp_5340/1]).
-export([otp_6338/1]).
-export([otp_6842_select_1000/1]).
+-export([select_mbuf_trapping/1]).
-export([otp_7665/1]).
-export([meta_wb/1]).
-export([grow_shrink/1, grow_pseudo_deleted/1, shrink_pseudo_deleted/1]).
@@ -129,9 +131,10 @@ all() ->
t_insert_list, t_test_ms, t_select_delete, t_select_replace,
t_select_replace_next_bug,
t_ets_dets, memory, t_select_reverse, t_bucket_disappears,
- t_named_select,
+ t_named_select, select_fixtab_owner_change,
select_fail, t_insert_new, t_repair_continuation,
otp_5340, otp_6338, otp_6842_select_1000, otp_7665,
+ select_mbuf_trapping,
otp_8732, meta_wb, grow_shrink, grow_pseudo_deleted,
shrink_pseudo_deleted, {group, meta_smp}, smp_insert,
smp_fixed_delete, smp_unfix_fix, smp_select_replace,
@@ -247,7 +250,64 @@ t_named_select_do(Opts) ->
verify_etsmem(EtsMem).
+%% Verify select and friends release fixtab as they should
+%% even when owneship is changed between traps.
+select_fixtab_owner_change(_Config) ->
+ T = ets:new(xxx, [protected]),
+ NKeys = 2000,
+ [ets:insert(T,{K,K band 7}) || K <- lists:seq(1,NKeys)],
+ %% Buddy and Papa will ping-pong table ownership between them
+ %% and the aim is to give Buddy the table when he is
+ %% in the middle of a yielding select* call.
+ {Buddy,_} = spawn_opt(fun() -> sfoc_buddy_loop(T, 1, undefined) end,
+ [link,monitor]),
+
+ sfoc_papa_loop(T, Buddy),
+
+ receive {'DOWN', _, process, Buddy, _} -> ok end,
+ ets:delete(T),
+ ok.
+
+sfoc_buddy_loop(T, I, State0) ->
+ receive
+ {'ETS-TRANSFER', T, Papa, _} ->
+ ets:give_away(T, Papa, State0),
+ case State0 of
+ done ->
+ ok;
+ _ ->
+ State1 = sfoc_traverse(T, I, State0),
+ %% Verify no fixation left
+ {I, false} = {I, ets:info(T, safe_fixed_monotonic_time)},
+ sfoc_buddy_loop(T, I+1, State1)
+ end
+ end.
+
+sfoc_papa_loop(T, Buddy) ->
+ ets:give_away(T, Buddy, "Catch!"),
+ receive
+ {'ETS-TRANSFER', T, Buddy, State} ->
+ case State of
+ done ->
+ ok;
+ _ ->
+ sfoc_papa_loop(T, Buddy)
+ end
+ end.
+
+sfoc_traverse(T, 1, S) ->
+ ets:select(T, [{{'$1',7}, [], ['$1']}]), S;
+sfoc_traverse(T, 2, S) ->
+ 0 = ets:select_count(T, [{{'$1',7}, [], [false]}]), S;
+sfoc_traverse(T, 3, _) ->
+ Limit = ets:info(T, size) div 2,
+ {_, Continuation} = ets:select(T, [{{'$1',7}, [], ['$1']}],
+ Limit),
+ Continuation;
+sfoc_traverse(_T, 4, Continuation) ->
+ _ = ets:select(Continuation),
+ done.
%% Check ets:match_spec_run/2.
t_match_spec_run(Config) when is_list(Config) ->
@@ -5292,6 +5352,61 @@ otp_6338(Config) when is_list(Config) ->
end),
ok.
+%% OTP-15660: Verify select not doing excessive trapping
+%% when process have mbuf heap fragments.
+select_mbuf_trapping(Config) when is_list(Config) ->
+ select_mbuf_trapping_do(set),
+ select_mbuf_trapping_do(ordered_set).
+
+select_mbuf_trapping_do(Type) ->
+ T = ets:new(xxx, [Type]),
+ NKeys = 50,
+ [ets:insert(T, {K, value}) || K <- lists:seq(1,NKeys)],
+
+ {priority, Prio} = process_info(self(), priority),
+ Tracee = self(),
+ [SchedTracer]
+ = start_loopers(1, Prio,
+ fun (SC) ->
+ receive
+ {trace, Tracee, out, _} ->
+ SC+1;
+ done ->
+ Tracee ! {schedule_count, SC},
+ exit(normal)
+ end
+ end,
+ 0),
+
+ erlang:garbage_collect(),
+ 1 = erlang:trace(self(), true, [running,{tracer,SchedTracer}]),
+
+ %% Artificially create an mbuf heap fragment
+ MbufTerm = "Frag me up",
+ MbufTerm = erts_debug:set_internal_state(mbuf, MbufTerm),
+
+ Keys = ets:select(T, [{{'$1', value}, [], ['$1']}]),
+ NKeys = length(Keys),
+
+ 1 = erlang:trace(self(), false, [running]),
+ Ref = erlang:trace_delivered(Tracee),
+ receive
+ {trace_delivered, Tracee, Ref} ->
+ SchedTracer ! done
+ end,
+ receive
+ {schedule_count, N} ->
+ io:format("~p context switches: ~p", [Type,N]),
+ if
+ N < 3 -> ok;
+ true -> ct:fail(failed)
+ end
+ end,
+ true = ets:delete(T),
+ ok.
+
+
+
%% Elements could come in the wrong order in a bag if a rehash occurred.
otp_5340(Config) when is_list(Config) ->
repeat_for_opts(fun otp_5340_do/1).
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index f097552e8c..824f5d19f2 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2018. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -32,7 +32,7 @@
io_with_huge_message_queue/1, format_string/1,
maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1,
otp_14285/1, limit_term/1, otp_14983/1, otp_15103/1, otp_15076/1,
- otp_15159/1]).
+ otp_15159/1, otp_15639/1]).
-export([pretty/2, trf/3]).
@@ -64,7 +64,8 @@ all() ->
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
io_lib_width_too_small, io_with_huge_message_queue,
format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175,
- otp_14285, limit_term, otp_14983, otp_15103, otp_15076, otp_15159].
+ otp_14285, limit_term, otp_14983, otp_15103, otp_15076, otp_15159,
+ otp_15639].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -2647,3 +2648,35 @@ otp_15076(_Config) ->
{'EXIT', {badarg, _}} = (catch io_lib:build_text(L)),
{'EXIT', {badarg, _}} = (catch io_lib:build_text(L, [])),
ok.
+
+otp_15639(_Config) ->
+ L = lists:duplicate(10, "a"),
+ LOpts = [{encoding, latin1}, {chars_limit, 10}],
+ UOpts = [{encoding, unicode}, {chars_limit, 10}],
+ "[[...]|...]" = pretty(L, LOpts),
+ "[[...]|...]" = pretty(L, UOpts),
+ "[\"a\",[...]|...]" =
+ pretty(L, [{chars_limit, 12}, {encoding, latin1}]),
+ "[\"a\",[...]|...]" =
+ pretty(L, [{chars_limit, 12}, {encoding, unicode}]),
+
+ %% Latin-1
+ "\"12345678\"" = pretty("12345678", LOpts),
+ "\"12345678\"..." = pretty("123456789", LOpts),
+ "\"\\r\\n123456\"..." = pretty("\r\n1234567", LOpts),
+ "\"\\r1234567\"..." = pretty("\r12345678", LOpts),
+ "\"\\r\\n123456\"..." = pretty("\r\n12345678", LOpts),
+ "\"12345678\"..." = pretty("12345678"++[x], LOpts),
+ "[49,50|...]" = pretty("1234567"++[x], LOpts),
+ "[49,x]" = pretty("1"++[x], LOpts),
+ "[[...]|...]" = pretty(["1","2","3","4","5","6","7","8"], LOpts),
+ %% Unicode
+ "\"12345678\"" = pretty("12345678", UOpts),
+ "\"12345678\"..." = pretty("123456789", UOpts),
+ "\"\\r\\n1234567\"" = pretty("\r\n1234567", UOpts),
+ "\"\\r1234567\"..." = pretty("\r12345678", UOpts),
+ "\"\\r\\n1234567\"..." = pretty("\r\n12345678", UOpts),
+ "[49,50|...]" = pretty("12345678"++[x], UOpts),
+ "\"12345678\"..." = pretty("123456789"++[x], UOpts),
+ "[[...]|...]" = pretty(["1","2","3","4","5","6","7","8"], UOpts),
+ ok.
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index d7354438f9..2354a08f78 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -3163,19 +3163,13 @@ lookup2(Config) when is_list(Config) ->
[a] = lookup_keys(Q)
end, [{a},{b},{c}])">>,
- {cres,
- <<"etsc(fun(E) ->
+ <<"etsc(fun(E) ->
Q = qlc:q([X || {X}=Y <- ets:table(E),
element(2, Y) == b,
X =:= 1]),
[] = qlc:e(Q),
false = lookup_keys(Q)
- end, [{1,b},{2,3}])">>,
- %% {warnings,[{2,sys_core_fold,nomatch_guard},
- %% {3,qlc,nomatch_filter},
- %% {3,sys_core_fold,{eval_failure,badarg}}]}},
- {warnings,[{2,sys_core_fold,nomatch_guard},
- {3,sys_core_fold,{eval_failure,badarg}}]}},
+ end, [{1,b},{2,3}])">>,
<<"etsc(fun(E) ->
Q = qlc:q([X || {X} <- ets:table(E), element(1,{X}) =:= 1]),
diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk
index e0217418fe..cbefd6590a 100644
--- a/lib/stdlib/vsn.mk
+++ b/lib/stdlib/vsn.mk
@@ -1 +1 @@
-STDLIB_VSN = 3.7
+STDLIB_VSN = 3.8
diff --git a/lib/syntax_tools/doc/src/notes.xml b/lib/syntax_tools/doc/src/notes.xml
index dc13fe474b..772f5e6e04 100644
--- a/lib/syntax_tools/doc/src/notes.xml
+++ b/lib/syntax_tools/doc/src/notes.xml
@@ -32,6 +32,20 @@
<p>This document describes the changes made to the Syntax_Tools
application.</p>
+<section><title>Syntax_Tools 2.1.7</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> Fix pretty-printing of type funs. </p>
+ <p>
+ Own Id: OTP-15519 Aux Id: ERL-815 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Syntax_Tools 2.1.6</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/syntax_tools/vsn.mk b/lib/syntax_tools/vsn.mk
index 8959ebbd04..538c71dc24 100644
--- a/lib/syntax_tools/vsn.mk
+++ b/lib/syntax_tools/vsn.mk
@@ -1 +1 @@
-SYNTAX_TOOLS_VSN = 2.1.6
+SYNTAX_TOOLS_VSN = 2.1.7
diff --git a/lib/tools/c_src/Makefile.in b/lib/tools/c_src/Makefile.in
index cfe91917f8..289322b6fa 100644
--- a/lib/tools/c_src/Makefile.in
+++ b/lib/tools/c_src/Makefile.in
@@ -29,7 +29,6 @@ CC=@CC@
LD=@LD@
AR=@AR@
RANLIB=@RANLIB@
-RM=@RM@
MKDIR=@MKDIR@
INSTALL=@INSTALL@
INSTALL_DIR=@INSTALL_DIR@
@@ -158,9 +157,9 @@ $(ERTS_LIB):
docs:
clean:
- $(RM) -rf ../obj/*
- $(RM) -rf ../bin/*
- $(RM) -f ./*~
+ $(RM) -r ../obj/*
+ $(RM) -r ../bin/*
+ $(RM) ./*~
.PHONY: all erts_lib docs clean
diff --git a/lib/tools/doc/src/cover.xml b/lib/tools/doc/src/cover.xml
index 31bf7266c7..e9f782977d 100644
--- a/lib/tools/doc/src/cover.xml
+++ b/lib/tools/doc/src/cover.xml
@@ -128,14 +128,26 @@
</desc>
</func>
<func>
- <name since="">start(Nodes) -> {ok,StartedNodes} | {error,not_main_node}</name>
+ <name since="OTP 22.0">local_only() -> ok | {error,too_late}</name>
+ <fsummary>Only support running Cover on the local node.</fsummary>
+ <desc>
+ <p>Only support running Cover on the local node. This function
+ must be called before any modules have been compiled or any
+ nodes added. When running in this mode, modules will be Cover
+ compiled in a more efficient way, but the resulting code will
+ only work on the same node they were compiled on.</p>
+ </desc>
+ </func>
+ <func>
+ <name since="">start(Nodes) -> {ok,StartedNodes} | {error,not_main_node} | {error,local_only}</name>
<fsummary>Start Cover on remote nodes.</fsummary>
<type>
<v>Nodes = StartedNodes = [atom()]</v>
</type>
<desc>
<p>Starts a Cover server on the each of given nodes, and loads
- all cover compiled modules.</p>
+ all cover compiled modules. This call will fail if
+ <c>cover:local_only/0</c> has been called.</p>
</desc>
</func>
<func>
diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml
index a6781dfdb3..28f8346a19 100644
--- a/lib/tools/doc/src/notes.xml
+++ b/lib/tools/doc/src/notes.xml
@@ -31,6 +31,45 @@
</header>
<p>This document describes the changes made to the Tools application.</p>
+<section><title>Tools 3.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Minor fixes for <c>make clean</c>.</p>
+ <p>
+ Own Id: OTP-15657</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ In the HTML file generated by
+ <c>cover:analyse_to_file/1,2</c>, a link is now added to
+ the line number. This makes it easier to share pointers
+ to specific lines.</p>
+ <p>
+ Own Id: OTP-15541</p>
+ </item>
+ <item>
+ <p>
+ Uncovered lines are now marked with a sad face,
+ <c>:-(</c>, in the HTML output from
+ <c>cover:analyse_to_file/1,2</c>. This is to make these
+ lines easier to find by search.</p>
+ <p>
+ Own Id: OTP-15542</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Tools 3.0.2</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
index 8d4561ca9e..8fe866cb69 100644
--- a/lib/tools/src/cover.erl
+++ b/lib/tools/src/cover.erl
@@ -23,6 +23,7 @@
%% This module implements the Erlang coverage tool.
%%
%% ARCHITECTURE
+%%
%% The coverage tool consists of one process on each node involved in
%% coverage analysis. The process is registered as 'cover_server'
%% (?SERVER). The cover_server on the 'main' node is in charge, and
@@ -30,45 +31,62 @@
%% 'DOWN' message for another cover_server, it marks the node as
%% 'lost'. If a nodeup is received for a lost node the main node
%% ensures that the cover compiled modules are loaded again. If the
-%% remote node was alive during the disconnected periode, cover data
-%% for this periode will also be included in the analysis.
+%% remote node was alive during the disconnected period, cover data
+%% for this period will also be included in the analysis.
%%
%% The cover_server process on the main node is implemented by the
%% functions init_main/1 and main_process_loop/1. The cover_server on
%% the remote nodes are implemented by the functions init_remote/2 and
%% remote_process_loop/1.
%%
+%% COUNTERS
+%%
+%% The 'counters' modules is used for counting how many time each line
+%% executed. Each cover-compiled module will have its own array of
+%% counters.
+%%
+%% The counter reference for module Module is stored in a persistent
+%% term with the key {cover,Module}.
+%%
+%% When the cover:local_only/0 function has been called, the reference
+%% for the counter array will be compiled into each cover-compiled
+%% module directly (instead of retrieving it from a persistent term).
+%% That will be faster, but the resulting code can be only be used on
+%% the main node.
+%%
%% TABLES
-%% Each nodes has two tables: cover_internal_data_table (?COVER_TABLE) and.
-%% cover_internal_clause_table (?COVER_CLAUSE_TABLE).
-%% ?COVER_TABLE contains the bump data i.e. the data about which lines
-%% have been executed how many times.
+%%
+%% Each node has two tables: ?COVER_MAPPING_TABLE and ?COVER_CLAUSE_TABLE.
+%% ?COVER_MAPPING_TABLE maps from a #bump{} record to an index in the
+%% counter array for the module. It is used both during instrumentation
+%% of cover-compiled modules and when collecting the counter values.
+%%
%% ?COVER_CLAUSE_TABLE contains information about which clauses in which modules
%% cover is currently collecting statistics.
-%%
-%% The main node owns tables named
-%% 'cover_collected_remote_data_table' (?COLLECTION_TABLE) and
-%% 'cover_collected_remote_clause_table' (?COLLECTION_CLAUSE_TABLE).
-%% These tables contain data which is collected from remote nodes (either when a
-%% remote node is stopped with cover:stop/1 or when analysing). When
-%% analysing, data is even moved from the COVER tables on the main
-%% node to the COLLECTION tables.
%%
-%% The main node also has a table named 'cover_binary_code_table'
-%% (?BINARY_TABLE). This table contains the binary code for each cover
-%% compiled module. This is necessary so that the code can be loaded
-%% on remote nodes that are started after the compilation.
+%% The main node owns the tables ?COLLECTION_TABLE and
+%% ?COLLECTION_CLAUSE_TABLE. The counter data is consolidated into those
+%% tables from the counters on both the main node and from remote nodes.
+%% This consolidation is done when a remote node is stopped with
+%% cover:stop/1 or just before starting an analysis.
+%%
+%% The main node also has a table named ?BINARY_TABLE. This table
+%% contains the abstract code code for each cover-compiled
+%% module. This is necessary so that the code can be loaded on remote
+%% nodes that are started after the compilation.
%%
%% PARALLELISM
+%%
%% To take advantage of SMP when doing the cover analysis both the data
%% collection and analysis has been parallelized. One process is spawned for
%% each node when collecting data, and on the remote node when collecting data
%% one process is spawned per module.
%%
-%% When analyzing data it is possible to issue multiple analyse(_to_file)/X
-%% calls at once. They are however all calls (for backwards compatibility
-%% reasons) so the user of cover will have to spawn several processes to to the
-%% calls ( or use async_analyse_to_file ).
+%% When analyzing data it is possible to issue multiple
+%% analyse(_to_file)/X calls at once. They are, however, all calls
+%% (for backwards compatibility reasons), so the user of cover will
+%% have to spawn several processes to to the calls (or use
+%% async_analyse_to_file/X).
%%
%% External exports
@@ -89,7 +107,8 @@
modules/0, imported/0, imported_modules/0, which_nodes/0, is_compiled/1,
reset/1, reset/0,
flush/1,
- stop/0, stop/1]).
+ stop/0, stop/1,
+ local_only/0]).
-export([remote_start/1,get_main_node/0]).
%% Used internally to ensure we upgrade the code to the latest version.
@@ -98,9 +117,16 @@
-record(main_state, {compiled=[], % [{Module,File}]
imported=[], % [{Module,File,ImportFile}]
stopper, % undefined | pid()
+ local_only=false, % true | false
nodes=[], % [Node]
lost_nodes=[]}). % [Node]
+-record(remote_data, {module,
+ file,
+ code,
+ mapping,
+ clauses}).
+
-record(remote_state, {compiled=[], % [{Module,File}]
main_node}). % atom()
@@ -126,11 +152,12 @@
is_guard=false % boolean
}).
--define(COVER_TABLE, 'cover_internal_data_table').
+-define(COVER_MAPPING_TABLE, 'cover_internal_mapping_table').
-define(COVER_CLAUSE_TABLE, 'cover_internal_clause_table').
-define(BINARY_TABLE, 'cover_binary_code_table').
-define(COLLECTION_TABLE, 'cover_collected_remote_data_table').
-define(COLLECTION_CLAUSE_TABLE, 'cover_collected_remote_clause_table').
+
-define(TAG, cover_compiled).
-define(SERVER, cover_server).
@@ -186,6 +213,11 @@ start(Node) when is_atom(Node) ->
start(Nodes) ->
call({start_nodes,remove_myself(Nodes,[])}).
+%% local_only() -> ok | {error,too_late}
+
+local_only() ->
+ call(local_only).
+
%% compile(ModFiles) ->
%% compile(ModFiles, Options) ->
%% compile_module(ModFiles) -> Result
@@ -255,15 +287,8 @@ compile_directory(Dir, Options) when is_list(Dir), is_list(Options) ->
compile_modules(Files,Options) ->
Options2 = filter_options(Options),
- %% compile_modules(Files,Options2,[]).
call({compile, Files, Options2}).
-%% compile_modules([File|Files], Options, Result) ->
-%% R = call({compile, File, Options}),
-%% compile_modules(Files,Options,[R|Result]);
-%% compile_modules([],_Opts,Result) ->
-%% lists:reverse(Result).
-
filter_options(Options) ->
lists:filter(fun(Option) ->
case Option of
@@ -561,16 +586,6 @@ flush(Nodes) ->
get_main_node() ->
call(get_main_node).
-%% bump(Module, Function, Arity, Clause, Line)
-%% Module = Function = atom()
-%% Arity = Clause = Line = integer()
-%% This function is inserted into Cover compiled modules, once for each
-%% executable line.
-%bump(Module, Function, Arity, Clause, Line) ->
-% Key = #bump{module=Module, function=Function, arity=Arity, clause=Clause,
-% line=Line},
-% ets:update_counter(?COVER_TABLE, Key, 1).
-
call(Request) ->
Ref = erlang:monitor(process,?SERVER),
receive {'DOWN', Ref, _Type, _Object, noproc} ->
@@ -631,10 +646,8 @@ remote_reply(MainNode,Reply) ->
init_main(Starter) ->
register(?SERVER,self()),
- %% Having write concurrancy here gives a 40% performance boost
- %% when collect/1 is called.
- ?COVER_TABLE = ets:new(?COVER_TABLE, [set, public, named_table,
- {write_concurrency, true}]),
+ ?COVER_MAPPING_TABLE = ets:new(?COVER_MAPPING_TABLE,
+ [ordered_set, public, named_table]),
?COVER_CLAUSE_TABLE = ets:new(?COVER_CLAUSE_TABLE, [set, public,
named_table]),
?BINARY_TABLE = ets:new(?BINARY_TABLE, [set, public, named_table]),
@@ -648,10 +661,26 @@ init_main(Starter) ->
main_process_loop(State) ->
receive
+ {From, local_only} ->
+ case State of
+ #main_state{compiled=[],nodes=[]} ->
+ reply(From, ok),
+ main_process_loop(State#main_state{local_only=true});
+ #main_state{} ->
+ reply(From, {error,too_late}),
+ main_process_loop(State)
+ end;
+
{From, {start_nodes,Nodes}} ->
- {StartedNodes,State1} = do_start_nodes(Nodes, State),
- reply(From, {ok,StartedNodes}),
- main_process_loop(State1);
+ case State#main_state.local_only of
+ false ->
+ {StartedNodes,State1} = do_start_nodes(Nodes, State),
+ reply(From, {ok,StartedNodes}),
+ main_process_loop(State1);
+ true ->
+ reply(From, {error,local_only}),
+ main_process_loop(State)
+ end;
{From, {compile, Files, Options}} ->
{R,S} = do_compile(Files, Options, State),
@@ -742,11 +771,12 @@ main_process_loop(State) ->
end,
State#main_state.nodes),
reload_originals(State#main_state.compiled),
- ets:delete(?COVER_TABLE),
+ ets:delete(?COVER_MAPPING_TABLE),
ets:delete(?COVER_CLAUSE_TABLE),
ets:delete(?BINARY_TABLE),
ets:delete(?COLLECTION_TABLE),
ets:delete(?COLLECTION_CLAUSE_TABLE),
+ delete_all_counters(),
unregister(?SERVER),
reply(From, ok);
@@ -878,10 +908,8 @@ main_process_loop(State) ->
init_remote(Starter,MainNode) ->
register(?SERVER,self()),
- %% write_concurrency here makes otp_8270 break :(
- ?COVER_TABLE = ets:new(?COVER_TABLE, [set, public, named_table
- %,{write_concurrency, true}
- ]),
+ ?COVER_MAPPING_TABLE = ets:new(?COVER_MAPPING_TABLE,
+ [ordered_set, public, named_table]),
?COVER_CLAUSE_TABLE = ets:new(?COVER_CLAUSE_TABLE, [set, public,
named_table]),
Starter ! {self(),started},
@@ -904,7 +932,7 @@ remote_process_loop(State) ->
remote_process_loop(State#remote_state{compiled=Compiled});
{remote,reset,Module} ->
- do_reset(Module),
+ reset_counters(Module),
remote_reply(State#remote_state.main_node, ok),
remote_process_loop(State);
@@ -925,8 +953,9 @@ remote_process_loop(State) ->
{remote,stop} ->
reload_originals(State#remote_state.compiled),
- ets:delete(?COVER_TABLE),
+ ets:delete(?COVER_MAPPING_TABLE),
ets:delete(?COVER_CLAUSE_TABLE),
+ delete_all_counters(),
unregister(?SERVER),
ok; % not replying since 'DOWN' message will be received anyway
@@ -961,28 +990,12 @@ remote_process_loop(State) ->
end.
do_collect(Modules, CollectorPid, From) ->
- _ = pmap(
- fun(Module) ->
- Pattern = {#bump{module=Module, _='_'}, '$1'},
- MatchSpec = [{Pattern,[{'=/=','$1',0}],['$_']}],
- Match = ets:select(?COVER_TABLE,MatchSpec,?CHUNK_SIZE),
- send_chunks(Match, CollectorPid, [])
- end,Modules),
+ _ = pmap(fun(Module) ->
+ send_counters(Module, CollectorPid)
+ end, Modules),
CollectorPid ! done,
remote_reply(From, ok).
-send_chunks('$end_of_table', _CollectorPid, Mons) ->
- get_downs(Mons);
-send_chunks({Chunk,Continuation}, CollectorPid, Mons) ->
- Mon = spawn_monitor(
- fun() ->
- lists:foreach(fun({Bump,_N}) ->
- ets:insert(?COVER_TABLE, {Bump,0})
- end,
- Chunk) end),
- send_chunk(CollectorPid,Chunk),
- send_chunks(ets:select(Continuation), CollectorPid, [Mon|Mons]).
-
send_chunk(CollectorPid,Chunk) ->
CollectorPid ! {chunk,Chunk,self()},
receive continue -> ok end.
@@ -1021,10 +1034,15 @@ do_reload_original(Module) ->
ignore
end.
-load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) ->
- %% Make sure the #bump{} records are available *before* the
- %% module is loaded.
- insert_initial_data(InitialTable),
+load_compiled([Data|Compiled],Acc) ->
+ %% Make sure the #bump{} records and counters are available *before*
+ %% compiling and loading the code.
+ #remote_data{module=Module,file=File,code=Beam,
+ mapping=InitialMapping,clauses=InitialClauses} = Data,
+ ets:insert(?COVER_MAPPING_TABLE, InitialMapping),
+ ets:insert(?COVER_CLAUSE_TABLE, InitialClauses),
+ maybe_create_counters(Module, true),
+
Sticky = case code:is_sticky(Module) of
true ->
code:unstick_mod(Module),
@@ -1032,7 +1050,7 @@ load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) ->
false ->
false
end,
- NewAcc = case code:load_binary(Module, ?TAG, Binary) of
+ NewAcc = case code:load_binary(Module, ?TAG, Beam) of
{module,Module} ->
add_compiled(Module, File, Acc);
_ ->
@@ -1047,16 +1065,6 @@ load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) ->
load_compiled([],Acc) ->
Acc.
-insert_initial_data([Item|Items]) when is_atom(element(1,Item)) ->
- ets:insert(?COVER_CLAUSE_TABLE, Item),
- insert_initial_data(Items);
-insert_initial_data([Item|Items]) ->
- ets:insert(?COVER_TABLE, Item),
- insert_initial_data(Items);
-insert_initial_data([]) ->
- ok.
-
-
unload([Module|Modules]) ->
do_clear(Module),
do_reload_original(Module),
@@ -1177,7 +1185,7 @@ get_downs_r([]) ->
[];
get_downs_r(Mons) ->
receive
- {'DOWN', Ref, _Type, Pid, R={_,_,_,_}} ->
+ {'DOWN', Ref, _Type, Pid, #remote_data{}=R} ->
[R|get_downs_r(lists:delete({Pid,Ref},Mons))];
{'DOWN', Ref, _Type, Pid, Reason} = Down ->
case lists:member({Pid,Ref},Mons) of
@@ -1196,19 +1204,13 @@ get_downs_r(Mons) ->
%% Binary is the beam code for the module and InitialTable is the initial
%% data to insert in ?COVER_TABLE.
get_data_for_remote_loading({Module,File}) ->
- [{Module,Binary}] = ets:lookup(?BINARY_TABLE,Module),
+ [{Module,Code}] = ets:lookup(?BINARY_TABLE, Module),
%%! The InitialTable list will be long if the module is big - what to do??
- InitialBumps = ets:select(?COVER_TABLE,ms(Module)),
+ Mapping = counters_mapping_table(Module),
InitialClauses = ets:lookup(?COVER_CLAUSE_TABLE,Module),
- {Module,File,Binary,InitialBumps ++ InitialClauses}.
-
-%% Create a match spec which returns the clause info {Module,InitInfo} and
-%% all #bump keys for the given module with 0 number of calls.
-ms(Module) ->
- ets:fun2ms(fun({Key,_}) when Key#bump.module=:=Module ->
- {Key,0}
- end).
+ #remote_data{module=Module,file=File,code=Code,
+ mapping=Mapping,clauses=InitialClauses}.
%% Unload modules on remote nodes
remote_unload(Nodes,UnloadedModules) ->
@@ -1464,7 +1466,7 @@ get_compiled_still_loaded(Nodes,Compiled0) ->
do_compile_beams(ModsAndFiles, State) ->
Result0 = pmap(fun({ok,Module,File}) ->
- do_compile_beam(Module,File,State);
+ do_compile_beam(Module, File, State);
(Error) ->
Error
end,
@@ -1476,8 +1478,10 @@ do_compile_beams(ModsAndFiles, State) ->
do_compile_beam(Module,BeamFile0,State) ->
case get_beam_file(Module,BeamFile0,State#main_state.compiled) of
{ok,BeamFile} ->
+ LocalOnly = State#main_state.local_only,
UserOptions = get_compile_options(Module,BeamFile),
- case do_compile_beam1(Module,BeamFile,UserOptions) of
+ case do_compile_beam1(Module,BeamFile,
+ UserOptions,LocalOnly) of
{ok, Module} ->
{ok,Module,BeamFile};
error ->
@@ -1503,41 +1507,39 @@ fix_state_and_result([],State,Acc) ->
do_compile(Files, Options, State) ->
+ LocalOnly = State#main_state.local_only,
Result0 = pmap(fun(File) ->
- do_compile(File, Options)
+ do_compile1(File, Options, LocalOnly)
end,
Files),
Compiled = [{M,F} || {ok,M,F} <- Result0],
remote_load_compiled(State#main_state.nodes,Compiled),
fix_state_and_result(Result0,State,[]).
-do_compile(File, Options) ->
- case do_compile1(File, Options) of
+do_compile1(File, Options, LocalOnly) ->
+ case do_compile2(File, Options, LocalOnly) of
{ok, Module} ->
{ok,Module,File};
error ->
{error,File}
end.
-%% do_compile1(File, Options) -> {ok,Module} | error
-do_compile1(File, UserOptions) ->
+%% do_compile2(File, Options) -> {ok,Module} | error
+do_compile2(File, UserOptions, LocalOnly) ->
Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions,
case compile:file(File, Options) of
{ok, Module, Binary} ->
- do_compile_beam1(Module,Binary,UserOptions);
+ do_compile_beam1(Module,Binary,UserOptions,LocalOnly);
error ->
error
end.
%% Beam is a binary or a .beam file name
-do_compile_beam1(Module,Beam,UserOptions) ->
+do_compile_beam1(Module,Beam,UserOptions,LocalOnly) ->
%% Clear database
do_clear(Module),
- %% Extract the abstract format and insert calls to bump/6 at
- %% every executable line and, as a side effect, initiate
- %% the database
-
+ %% Extract the abstract format.
case get_abstract_code(Module, Beam) of
no_abstract_code=E ->
{error,E};
@@ -1547,7 +1549,8 @@ do_compile_beam1(Module,Beam,UserOptions) ->
Forms0 = epp:interpret_file_attribute(Code),
case find_main_filename(Forms0) of
{ok,MainFile} ->
- do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile);
+ do_compile_beam2(Module,Beam,UserOptions,
+ Forms0,MainFile,LocalOnly);
Error ->
Error
end;
@@ -1566,26 +1569,35 @@ get_abstract_code(Module, Beam) ->
Error -> Error
end.
-do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile) ->
- {Forms,Vars} = transform(Forms0, Module, MainFile),
+do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile,LocalOnly) ->
+ init_counter_mapping(Module),
+
+ %% Instrument the abstract code by inserting
+ %% calls to update the counters.
+ {Forms,Vars} = transform(Forms0, Module, MainFile, LocalOnly),
+
+ %% Create counters.
+ maybe_create_counters(Module, not LocalOnly),
%% We need to recover the source from the compilation
%% info otherwise the newly compiled module will have
%% source pointing to the current directory
SourceInfo = get_source_info(Module, Beam),
- %% Compile and load the result
+ %% Compile and load the result.
%% It's necessary to check the result of loading since it may
- %% fail, for example if Module resides in a sticky directory
- {ok, Module, Binary} = compile:forms(Forms, SourceInfo ++ UserOptions),
+ %% fail, for example if Module resides in a sticky directory.
+ Options = SourceInfo ++ UserOptions,
+ {ok, Module, Binary} = compile:forms(Forms, Options),
+
case code:load_binary(Module, ?TAG, Binary) of
{module, Module} ->
- %% Store info about all function clauses in database
+ %% Store info about all function clauses in database.
InitInfo = lists:reverse(Vars#vars.init_info),
ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}),
- %% Store binary code so it can be loaded on remote nodes
+ %% Store binary code so it can be loaded on remote nodes.
ets:insert(?BINARY_TABLE, {Module, Binary}),
{ok, Module};
@@ -1617,11 +1629,12 @@ get_compile_info(Module, Beam) ->
[]
end.
-transform(Code, Module, MainFile) ->
+transform(Code, Module, MainFile, LocalOnly) ->
Vars0 = #vars{module=Module},
- {ok,MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on),
+ {ok,MungedForms0,Vars} = transform_2(Code, [], Vars0, MainFile, on),
+ MungedForms = patch_code(Module, MungedForms0, LocalOnly),
{MungedForms,Vars}.
-
+
%% Helpfunction which returns the first found file-attribute, which can
%% be interpreted as the name of the main erlang source file.
find_main_filename([{attribute,_,file,{MainFile,_}}|_]) ->
@@ -1788,19 +1801,7 @@ munge_body([Expr|Body], Vars, MungedBody, LastExprBumpLines) ->
MungedExprs1 = [MungedExpr|MungedBody1],
munge_body(Body, Vars3, MungedExprs1, NewBumps);
false ->
- ets:insert(?COVER_TABLE, {#bump{module = Vars#vars.module,
- function = Vars#vars.function,
- arity = Vars#vars.arity,
- clause = Vars#vars.clause,
- line = Line},
- 0}),
Bump = bump_call(Vars, Line),
-% Bump = {call, 0, {remote, 0, {atom,0,cover}, {atom,0,bump}},
-% [{atom, 0, Vars#vars.module},
-% {atom, 0, Vars#vars.function},
-% {integer, 0, Vars#vars.arity},
-% {integer, 0, Vars#vars.clause},
-% {integer, 0, Line}]},
Lines2 = [Line|Lines],
{MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}),
NewBumps = new_bumps(Vars2, Vars),
@@ -1855,8 +1856,10 @@ maybe_fix_last_expr(MungedExprs, Vars, LastExprBumpLines) ->
last_expr_needs_fixing(Vars, LastExprBumpLines) ->
case common_elems(Vars#vars.no_bump_lines, LastExprBumpLines) of
- [Line] -> {yes, Line};
- _ -> no
+ [Line] ->
+ {yes, Line};
+ _ ->
+ no
end.
fix_last_expr([MungedExpr|MungedExprs], Line, Vars) ->
@@ -1921,9 +1924,7 @@ fix_cls([Cl | Cls], Line, Bump) ->
bumps_line(E, L) ->
try bumps_line1(E, L) catch true -> true end.
-bumps_line1({call,_,{remote,_,{atom,_,ets},{atom,_,update_counter}},
- [{atom,_,?COVER_TABLE},{tuple,_,[_,_,_,_,_,{integer,_,Line}]},_]},
- Line) ->
+bumps_line1({'BUMP',Line,_}, Line) ->
throw(true);
bumps_line1([E | Es], Line) ->
bumps_line1(E, Line),
@@ -1933,19 +1934,12 @@ bumps_line1(T, Line) when is_tuple(T) ->
bumps_line1(_, _) ->
false.
-%%% End of fix of last expression.
-
+%% Insert a place holder for the call to counters:add/3 in the
+%% abstract code.
bump_call(Vars, Line) ->
- A = erl_anno:new(0),
- {call,A,{remote,A,{atom,A,ets},{atom,A,update_counter}},
- [{atom,A,?COVER_TABLE},
- {tuple,A,[{atom,A,?BUMP_REC_NAME},
- {atom,A,Vars#vars.module},
- {atom,A,Vars#vars.function},
- {integer,A,Vars#vars.arity},
- {integer,A,Vars#vars.clause},
- {integer,A,Line}]},
- {integer,A,1}]}.
+ {'BUMP',Line,counter_index(Vars, Line)}.
+
+%%% End of fix of last expression.
munge_expr({match,Line,ExprL,ExprR}, Vars) ->
{MungedExprL, Vars2} = munge_expr(ExprL, Vars),
@@ -2105,6 +2099,159 @@ subtract(L1, L2) ->
common_elems(L1, L2) ->
[E || E <- L1, lists:member(E, L2)].
+%%%--Counters------------------------------------------------------------
+
+init_counter_mapping(Mod) ->
+ true = ets:insert_new(?COVER_MAPPING_TABLE, {Mod,0}),
+ ok.
+
+counter_index(Vars, Line) ->
+ #vars{module=Mod,function=F,arity=A,clause=C} = Vars,
+ Key = #bump{module=Mod,function=F,arity=A,
+ clause=C,line=Line},
+ case ets:lookup(?COVER_MAPPING_TABLE, Key) of
+ [] ->
+ Index = ets:update_counter(?COVER_MAPPING_TABLE,
+ Mod, {2,1}),
+ true = ets:insert(?COVER_MAPPING_TABLE, {Key,Index}),
+ Index;
+ [{Key,Index}] ->
+ Index
+ end.
+
+%% Create the counter array and store as a persistent term.
+maybe_create_counters(Mod, true) ->
+ Cref = create_counters(Mod),
+ Key = {?MODULE,Mod},
+ persistent_term:put(Key, Cref),
+ ok;
+maybe_create_counters(_Mod, false) ->
+ ok.
+
+create_counters(Mod) ->
+ Size0 = ets:lookup_element(?COVER_MAPPING_TABLE, Mod, 2),
+ Size = max(1, Size0), %Size must not be 0.
+ Cref = counters:new(Size, [write_concurrency]),
+ ets:insert(?COVER_MAPPING_TABLE, {{counters,Mod},Cref}),
+ Cref.
+
+patch_code(Mod, Forms, false) ->
+ A = erl_anno:new(0),
+ AbstrKey = {tuple,A,[{atom,A,?MODULE},{atom,A,Mod}]},
+ patch_code1(Forms, {distributed,AbstrKey});
+patch_code(Mod, Forms, true) ->
+ Cref = create_counters(Mod),
+ AbstrCref = cid_to_abstract(Cref),
+ patch_code1(Forms, {local_only,AbstrCref}).
+
+%% Go through the abstract code and replace 'BUMP' forms
+%% with the actual code to increment the counters.
+patch_code1({'BUMP',_Line,Index}, {distributed,AbstrKey}) ->
+ %% Replace with counters:add(persistent_term:get(Key), Index, 1).
+ %% This code will work on any node.
+ A = element(2, AbstrKey),
+ GetCref = {call,A,{remote,A,{atom,A,persistent_term},{atom,A,get}},
+ [AbstrKey]},
+ {call,A,{remote,A,{atom,A,counters},{atom,A,add}},
+ [GetCref,{integer,A,Index},{integer,A,1}]};
+patch_code1({'BUMP',_Line,Index}, {local_only,AbstrCref}) ->
+ %% Replace with counters:add(Cref, Index, 1). This code
+ %% will only work on the local node.
+ A = element(2, AbstrCref),
+ {call,A,{remote,A,{atom,A,counters},{atom,A,add}},
+ [AbstrCref,{integer,A,Index},{integer,A,1}]};
+patch_code1({clauses,Cs}, Key) ->
+ {clauses,[patch_code1(El, Key) || El <- Cs]};
+patch_code1([_|_]=List, Key) ->
+ [patch_code1(El, Key) || El <- List];
+patch_code1(Tuple, Key) when tuple_size(Tuple) >= 3 ->
+ Acc = [element(2, Tuple),element(1, Tuple)],
+ patch_code_tuple(3, tuple_size(Tuple), Tuple, Key, Acc);
+patch_code1(Other, _Key) ->
+ Other.
+
+patch_code_tuple(I, Size, Tuple, Key, Acc) when I =< Size ->
+ El = patch_code1(element(I, Tuple), Key),
+ patch_code_tuple(I + 1, Size, Tuple, Key, [El|Acc]);
+patch_code_tuple(_I, _Size, _Tuple, _Key, Acc) ->
+ list_to_tuple(lists:reverse(Acc)).
+
+%% Don't try this at home! Assumes knowledge of the internal
+%% representation of a counter ref.
+cid_to_abstract(Cref0) ->
+ A = erl_anno:new(0),
+ %% Disable dialyzer warning for breaking opacity.
+ Cref = binary_to_term(term_to_binary(Cref0)),
+ {write_concurrency,Ref} = Cref,
+ {tuple,A,[{atom,A,write_concurrency},{integer,A,Ref}]}.
+
+%% Called on the remote node. Collect and send counters to
+%% the main node. Also zero the counters.
+send_counters(Mod, CollectorPid) ->
+ Process = fun(Chunk) -> send_chunk(CollectorPid, Chunk) end,
+ move_counters(Mod, Process).
+
+%% Called on the main node. Collect the counters and consolidate
+%% them into the collection table. Also zero the counters.
+move_counters(Mod) ->
+ move_counters(Mod, fun insert_in_collection_table/1).
+
+move_counters(Mod, Process) ->
+ Pattern = {#bump{module=Mod,_='_'},'_'},
+ Matches = ets:match_object(?COVER_MAPPING_TABLE, Pattern, ?CHUNK_SIZE),
+ Cref = get_counters_ref(Mod),
+ move_counters1(Matches, Cref, Process).
+
+move_counters1({Mappings,Continuation}, Cref, Process) ->
+ Move = fun({Key,Index}) ->
+ Count = counters:get(Cref, Index),
+ ok = counters:sub(Cref, Index, Count),
+ {Key,Count}
+ end,
+ Process(lists:map(Move, Mappings)),
+ move_counters1(ets:match_object(Continuation), Cref, Process);
+move_counters1('$end_of_table', _Cref, _Process) ->
+ ok.
+
+counters_mapping_table(Mod) ->
+ Mapping = counters_mapping(Mod),
+ Cref = get_counters_ref(Mod),
+ #{size:=Size} = counters:info(Cref),
+ [{Mod,Size}|Mapping].
+
+get_counters_ref(Mod) ->
+ ets:lookup_element(?COVER_MAPPING_TABLE, {counters,Mod}, 2).
+
+counters_mapping(Mod) ->
+ Pattern = {#bump{module=Mod,_='_'},'_'},
+ ets:match_object(?COVER_MAPPING_TABLE, Pattern).
+
+clear_counters(Mod) ->
+ _ = persistent_term:erase({?MODULE,Mod}),
+ ets:delete(?COVER_MAPPING_TABLE, Mod),
+ Pattern = {#bump{module=Mod,_='_'},'_'},
+ _ = ets:match_delete(?COVER_MAPPING_TABLE, Pattern),
+ ok.
+
+%% Reset counters (set counters to 0).
+reset_counters(Mod) ->
+ Pattern = {#bump{module=Mod,_='_'},'$1'},
+ MatchSpec = [{Pattern,[],['$1']}],
+ Matches = ets:select(?COVER_MAPPING_TABLE,
+ MatchSpec, ?CHUNK_SIZE),
+ Cref = get_counters_ref(Mod),
+ reset_counters1(Matches, Cref).
+
+reset_counters1({Indices,Continuation}, Cref) ->
+ _ = [counters:put(Cref, N, 0) || N <- Indices],
+ reset_counters1(ets:select(Continuation), Cref);
+reset_counters1('$end_of_table', _Cref) ->
+ ok.
+
+delete_all_counters() ->
+ _ = [persistent_term:erase(Key) || {?MODULE,_}=Key <- persistent_term:get()],
+ ok.
+
%%%--Analysis------------------------------------------------------------
%% Collect data for all modules
@@ -2140,20 +2287,7 @@ collect(Module,Clauses,Nodes) ->
%% ?COLLECTION_TABLE. Resetting data in ?COVER_TABLE
move_modules({Module,Clauses}) ->
ets:insert(?COLLECTION_CLAUSE_TABLE,{Module,Clauses}),
- Pattern = {#bump{module=Module, _='_'}, '_'},
- MatchSpec = [{Pattern,[],['$_']}],
- Match = ets:select(?COVER_TABLE,MatchSpec,?CHUNK_SIZE),
- do_move_module(Match).
-
-do_move_module({Bumps,Continuation}) ->
- lists:foreach(fun({Key,Val}) ->
- ets:insert(?COVER_TABLE, {Key,0}),
- insert_in_collection_table(Key,Val)
- end,
- Bumps),
- do_move_module(ets:select(Continuation));
-do_move_module('$end_of_table') ->
- ok.
+ move_counters(Module).
%% Given a .beam file, find the .erl file. Look first in same directory as
%% the .beam file, then in ../src, then in compile info.
@@ -2709,7 +2843,7 @@ get_term(Fd) ->
%% Reset main node and all remote nodes
do_reset_main_node(Module,Nodes) ->
- do_reset(Module),
+ reset_counters(Module),
do_reset_collection_table(Module),
remote_reset(Module,Nodes).
@@ -2717,27 +2851,9 @@ do_reset_collection_table(Module) ->
ets:delete(?COLLECTION_CLAUSE_TABLE,Module),
ets:match_delete(?COLLECTION_TABLE, {#bump{module=Module},'_'}).
-%% do_reset(Module) -> ok
-%% The reset is done on ?CHUNK_SIZE number of bumps to avoid building
-%% long lists in the case of very large modules
-do_reset(Module) ->
- Pattern = {#bump{module=Module, _='_'}, '$1'},
- MatchSpec = [{Pattern,[{'=/=','$1',0}],['$_']}],
- Match = ets:select(?COVER_TABLE,MatchSpec,?CHUNK_SIZE),
- do_reset2(Match).
-
-do_reset2({Bumps,Continuation}) ->
- lists:foreach(fun({Bump,_N}) ->
- ets:insert(?COVER_TABLE, {Bump,0})
- end,
- Bumps),
- do_reset2(ets:select(Continuation));
-do_reset2('$end_of_table') ->
- ok.
-
do_clear(Module) ->
ets:match_delete(?COVER_CLAUSE_TABLE, {Module,'_'}),
- ets:match_delete(?COVER_TABLE, {#bump{module=Module},'_'}),
+ clear_counters(Module),
case lists:member(?COLLECTION_TABLE, ets:all()) of
true ->
%% We're on the main node
diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl
index 161b0105b9..ee58fd7a10 100644
--- a/lib/tools/test/cover_SUITE.erl
+++ b/lib/tools/test/cover_SUITE.erl
@@ -24,7 +24,8 @@
-include_lib("common_test/include/ct.hrl").
suite() ->
- [{ct_hooks,[ts_install_cth]}].
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,5}}].
all() ->
NoStartStop = [eif,otp_5305,otp_5418,otp_7095,otp_8273,
@@ -35,7 +36,8 @@ all() ->
distribution, reconnect, die_and_reconnect,
dont_reconnect_after_stop, stop_node_after_disconnect,
export_import, otp_5031, otp_6115,
- otp_8270, otp_10979_hanging_node, otp_14817],
+ otp_8270, otp_10979_hanging_node, otp_14817,
+ local_only],
case whereis(cover_server) of
undefined ->
[coverage,StartStop ++ NoStartStop];
@@ -1742,6 +1744,40 @@ otp_13289(Config) ->
ok = file:delete(File),
ok.
+local_only(Config) ->
+ ok = file:set_cwd(proplists:get_value(data_dir, Config)),
+
+ %% Trying restricting to local nodes too late.
+ cover:start(),
+ {ok,a} = cover:compile(a),
+ [a] = cover:modules(),
+ {error,too_late} = cover:local_only(),
+ cover:stop(),
+
+ %% Now test local only mode.
+ cover:start(),
+ ok = cover:local_only(),
+ [] = cover:modules(),
+ {ok,a} = cover:compile(a),
+ [a] = cover:modules(),
+ done = a:start(5),
+ {ok, {a,{17,2}}} = cover:analyse(a, coverage, module),
+ {ok, [{{a,exit_kalle,0},{1,0}},
+ {{a,loop,3},{5,1}},
+ {{a,pong,1},{1,0}},
+ {{a,start,1},{6,0}},
+ {{a,stop,1},{0,1}},
+ {{a,trycatch,1},{4,0}}]} =
+ cover:analyse(a, coverage, function),
+
+ %% Make sure that it is not possible to run cover on
+ %% slave nodes.
+ {ok,Name} = test_server:start_node(?FUNCTION_NAME, slave, []),
+ {error,local_only} = cover:start([Name]),
+ test_server:stop_node(Name),
+
+ ok.
+
%%--Auxiliary------------------------------------------------------------
analyse_expr(Expr, Config) ->
diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk
index bb8305e9f1..5700885549 100644
--- a/lib/tools/vsn.mk
+++ b/lib/tools/vsn.mk
@@ -1 +1 @@
-TOOLS_VSN = 3.0.2
+TOOLS_VSN = 3.1
diff --git a/lib/wx/api_gen/wx_extra/added_func.h b/lib/wx/api_gen/wx_extra/added_func.h
index bffe391140..28fecbf454 100644
--- a/lib/wx/api_gen/wx_extra/added_func.h
+++ b/lib/wx/api_gen/wx_extra/added_func.h
@@ -44,3 +44,9 @@ class wxWindowGTK {
public:
double GetContentScaleFactor();
};
+
+class wxDisplay {
+ public:
+ // get the resolution of this monitor in pixels per inch
+ wxSize GetPPI() const;
+};
diff --git a/lib/wx/api_gen/wx_gen.erl b/lib/wx/api_gen/wx_gen.erl
index cec6ac9ccf..8a00498319 100644
--- a/lib/wx/api_gen/wx_gen.erl
+++ b/lib/wx/api_gen/wx_gen.erl
@@ -701,8 +701,13 @@ parse_type2(["wxe_cb"|R],Info,Opts, T) ->
parse_type2(R,Info,Opts,T#type{name=int,base=wxe_cb});
parse_type2([const|R],Info,Opts,T=#type{mod=Mod}) ->
parse_type2(R,Info,Opts,T#type{mod=[const|Mod]});
-parse_type2(["unsigned"|R],Info,Opts,T=#type{mod=Mod}) ->
- parse_type2(R,Info,Opts,T#type{mod=[unsigned|Mod]});
+parse_type2(["unsigned"|R],Info,Opts,T=#type{mod=Mod}) ->
+ case T#type.base of
+ undefined ->
+ parse_type2(R,Info,Opts,T#type{name=int, base=int, mod=[unsigned|Mod]});
+ _ ->
+ parse_type2(R,Info,Opts,T#type{mod=[unsigned|Mod]})
+ end;
parse_type2(["int"|R],Info,Opts, T) ->
parse_type2(R,Info,Opts,T#type{name=int,base=int});
parse_type2(["wxByte"|R],Info,Opts, T) ->
diff --git a/lib/wx/api_gen/wx_gen_cpp.erl b/lib/wx/api_gen/wx_gen_cpp.erl
index f13d5873a0..c6f2534380 100644
--- a/lib/wx/api_gen/wx_gen_cpp.erl
+++ b/lib/wx/api_gen/wx_gen_cpp.erl
@@ -1165,6 +1165,7 @@ gen_macros() ->
w("#include <wx/fontdlg.h>~n"),
w("#include <wx/progdlg.h>~n"),
w("#include <wx/printdlg.h>~n"),
+ w("#include <wx/display.h>~n"),
w("#include <wx/dcbuffer.h>~n"),
w("#include <wx/dcmirror.h>~n"),
w("#include <wx/glcanvas.h>~n"),
@@ -1176,6 +1177,7 @@ gen_macros() ->
w("#include <wx/sashwin.h>~n"),
w("#include <wx/laywin.h>~n"),
w("#include <wx/graphics.h>~n"),
+ w("#include <wx/dcgraph.h>~n"),
w("#include <wx/aui/aui.h>~n"),
w("#include <wx/datectrl.h>~n"),
w("#include <wx/filepicker.h>~n"),
@@ -1330,8 +1332,10 @@ encode_events(Evs) ->
w(" } else {~n"),
w(" send_res = rt.send();~n"),
w(" if(cb->skip) event->Skip();~n"),
- #class{id=MouseId} = lists:keyfind("wxMouseEvent", #class.name, Evs),
- w(" if(app->recurse_level < 1 && Etype->cID != ~p) {~n", [MouseId]),
+ #class{id=SizeId} = lists:keyfind("wxSizeEvent", #class.name, Evs),
+ #class{id=MoveId} = lists:keyfind("wxMoveEvent", #class.name, Evs),
+ w(" if(app->recurse_level < 1 && (Etype->cID == ~w || Etype->cID == ~w)) {~n",
+ [SizeId, MoveId]),
w(" app->recurse_level++;~n"),
w(" app->dispatch_cmds();~n"),
w(" app->recurse_level--;~n"),
diff --git a/lib/wx/api_gen/wxapi.conf b/lib/wx/api_gen/wxapi.conf
index c1b55b6875..9707fedf67 100644
--- a/lib/wx/api_gen/wxapi.conf
+++ b/lib/wx/api_gen/wxapi.conf
@@ -27,7 +27,7 @@
{not_const, [wxHAS_INT64,wxBYTE_ORDER,wxRETAINED,
wxFONTENCODING_UTF32,wxFONTENCODING_UTF16,
wxDEFAULT_CONTROL_BORDER,wxMOD_CMD,
- wxMAJOR_VERSION, wxMINOR_VERSION,
+ wxMAJOR_VERSION, wxMINOR_VERSION,
wxRELEASE_NUMBER,wxSUBRELEASE_NUMBER,wxBETA_NUMBER,
%%
wxALWAYS_NATIVE_DOUBLE_BUFFER,
@@ -37,16 +37,30 @@
wxCURSOR_DEFAULT,
wxCURSOR_ARROWWAIT,
wxCURSOR_MAX,
- wxLanguage
+ wxLanguage,
+ wxFONTWEIGHT_NORMAL,
+ wxFONTWEIGHT_LIGHT,
+ wxFONTWEIGHT_BOLD,
+ wxFONTWEIGHT_MAX
]}.
-{gvars,
+{gvars,
[
{wxITALIC_FONT, wxFont},
{wxNORMAL_FONT, wxFont},
{wxSMALL_FONT, wxFont},
{wxSWISS_FONT, wxFont},
-
+
+ %% Added (enum) values in 3.1.2
+ {wxFONTWEIGHT_INVALID, {test_if, "wxCHECK_VERSION(3,1,2)"}},
+ {wxFONTWEIGHT_THIN, {test_if, "wxCHECK_VERSION(3,1,2)"}},
+ {wxFONTWEIGHT_EXTRALIGHT, {test_if, "wxCHECK_VERSION(3,1,2)"}},
+ {wxFONTWEIGHT_MEDIUM, {test_if, "wxCHECK_VERSION(3,1,2)"}},
+ {wxFONTWEIGHT_SEMIBOLD, {test_if, "wxCHECK_VERSION(3,1,2)"}},
+ {wxFONTWEIGHT_EXTRABOLD, {test_if, "wxCHECK_VERSION(3,1,2)"}},
+ {wxFONTWEIGHT_HEAVY, {test_if, "wxCHECK_VERSION(3,1,2)"}},
+ {wxFONTWEIGHT_EXTRAHEAVY, {test_if, "wxCHECK_VERSION(3,1,2)"}},
+
{wxBLACK_DASHED_PEN, wxPen},
{wxBLACK_PEN, wxPen},
{wxCYAN_PEN, wxPen},
@@ -2016,3 +2030,17 @@
['GetPosition', 'GetNumberOfFiles',
{'GetFiles', [{return, [{single, {list, 'm_noFiles'}}]}]}
]}.
+
+
+{class, wxDisplay, root, [{ifdef, wxUSE_DISPLAY}],
+ ['wxDisplay', '~wxDisplay',
+ 'IsOk',
+ {'GetClientArea', [{test_if, "wxCHECK_VERSION(2,8,12)"}]},
+ 'GetGeometry', 'GetName', 'IsPrimary',
+ 'GetCount', 'GetFromPoint', 'GetFromWindow',
+ {'GetPPI', [{test_if, "wxCHECK_VERSION(3,1,2)"}]}
+ ]}.
+
+{class, wxGCDC, wxDC, [{ifdef, wxUSE_GRAPHICS_CONTEXT}],
+ ['wxGCDC', '~wxGCDC', 'GetGraphicsContext', 'SetGraphicsContext'
+ ]}.
diff --git a/lib/wx/c_src/gen/wxe_derived_dest.h b/lib/wx/c_src/gen/wxe_derived_dest.h
index fc0ae0d9fc..a7114eb188 100644
--- a/lib/wx/c_src/gen/wxe_derived_dest.h
+++ b/lib/wx/c_src/gen/wxe_derived_dest.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2016. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2018. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -799,3 +799,11 @@ class EwxDCOverlay : public wxDCOverlay {
EwxDCOverlay(wxOverlay& overlay,wxWindowDC * dc) : wxDCOverlay(overlay,dc) {};
};
+#if wxUSE_GRAPHICS_CONTEXT
+class EwxGCDC : public wxGCDC {
+ public: ~EwxGCDC() {((WxeApp *)wxTheApp)->clearPtr(this);};
+ EwxGCDC(const wxWindowDC& dc) : wxGCDC(dc) {};
+ EwxGCDC() : wxGCDC() {};
+};
+#endif // wxUSE_GRAPHICS_CONTEXT
+
diff --git a/lib/wx/c_src/gen/wxe_events.cpp b/lib/wx/c_src/gen/wxe_events.cpp
index 01787c8a64..8c3283a670 100644
--- a/lib/wx/c_src/gen/wxe_events.cpp
+++ b/lib/wx/c_src/gen/wxe_events.cpp
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2016. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2019. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -910,7 +910,7 @@ case 238: {// wxDropFilesEvent
} else {
send_res = rt.send();
if(cb->skip) event->Skip();
- if(app->recurse_level < 1 && Etype->cID != 168) {
+ if(app->recurse_level < 1 && (Etype->cID == 171 || Etype->cID == 172)) {
app->recurse_level++;
app->dispatch_cmds();
app->recurse_level--;
diff --git a/lib/wx/c_src/gen/wxe_funcs.cpp b/lib/wx/c_src/gen/wxe_funcs.cpp
index 74961b2e5e..32e4bf855b 100644
--- a/lib/wx/c_src/gen/wxe_funcs.cpp
+++ b/lib/wx/c_src/gen/wxe_funcs.cpp
@@ -32113,6 +32113,120 @@ case wxDropFilesEvent_GetFiles: { // wxDropFilesEvent::GetFiles
rt.add(tmpArrayStr);
break;
}
+#if wxUSE_DISPLAY
+case wxDisplay_new: { // wxDisplay::wxDisplay
+ int n=0;
+ while( * (int*) bp) { switch (* (int*) bp) {
+ case 1: {bp += 4;
+ n = (int)*(unsigned int *) bp; bp += 4;
+ } break;
+ }};
+ wxDisplay * Result = new wxDisplay(n);
+ newPtr((void *) Result, 239, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxDisplay");
+ break;
+}
+case wxDisplay_destruct: { // wxDisplay::~wxDisplay
+ wxDisplay *This = (wxDisplay *) getPtr(bp,memenv); bp += 4;
+ if(This) { ((WxeApp *) wxTheApp)->clearPtr((void *) This);
+ delete This;}
+ break;
+}
+case wxDisplay_IsOk: { // wxDisplay::IsOk
+ wxDisplay *This = (wxDisplay *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+ bool Result = This->IsOk();
+ rt.addBool(Result);
+ break;
+}
+#if wxCHECK_VERSION(2,8,12)
+case wxDisplay_GetClientArea: { // wxDisplay::GetClientArea
+ wxDisplay *This = (wxDisplay *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+ wxRect Result = This->GetClientArea();
+ rt.add(Result);
+ break;
+}
+#endif
+case wxDisplay_GetGeometry: { // wxDisplay::GetGeometry
+ wxDisplay *This = (wxDisplay *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+ wxRect Result = This->GetGeometry();
+ rt.add(Result);
+ break;
+}
+case wxDisplay_GetName: { // wxDisplay::GetName
+ wxDisplay *This = (wxDisplay *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+ wxString Result = This->GetName();
+ rt.add(Result);
+ break;
+}
+case wxDisplay_IsPrimary: { // wxDisplay::IsPrimary
+ wxDisplay *This = (wxDisplay *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+ bool Result = This->IsPrimary();
+ rt.addBool(Result);
+ break;
+}
+case wxDisplay_GetCount: { // wxDisplay::GetCount
+ int Result = wxDisplay::GetCount();
+ rt.addUint(Result);
+ break;
+}
+case wxDisplay_GetFromPoint: { // wxDisplay::GetFromPoint
+ int * ptX = (int *) bp; bp += 4;
+ int * ptY = (int *) bp; bp += 4;
+ wxPoint pt = wxPoint(*ptX,*ptY);
+ int Result = wxDisplay::GetFromPoint(pt);
+ rt.addInt(Result);
+ break;
+}
+case wxDisplay_GetFromWindow: { // wxDisplay::GetFromWindow
+ wxWindow *window = (wxWindow *) getPtr(bp,memenv); bp += 4;
+ int Result = wxDisplay::GetFromWindow(window);
+ rt.addInt(Result);
+ break;
+}
+#if wxCHECK_VERSION(3,1,2)
+case wxDisplay_GetPPI: { // wxDisplay::GetPPI
+ wxDisplay *This = (wxDisplay *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+ wxSize Result = This->GetPPI();
+ rt.add(Result);
+ break;
+}
+#endif
+#endif // wxUSE_DISPLAY
+#if wxUSE_GRAPHICS_CONTEXT
+case wxGCDC_new_1: { // wxGCDC::wxGCDC
+ wxWindowDC *dc = (wxWindowDC *) getPtr(bp,memenv); bp += 4;
+ wxGCDC * Result = new EwxGCDC(*dc);
+ newPtr((void *) Result, 8, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxGCDC");
+ break;
+}
+case wxGCDC_new_0: { // wxGCDC::wxGCDC
+ wxGCDC * Result = new EwxGCDC();
+ newPtr((void *) Result, 8, memenv);
+ rt.addRef(getRef((void *)Result,memenv), "wxGCDC");
+ break;
+}
+case wxGCDC_GetGraphicsContext: { // wxGCDC::GetGraphicsContext
+ wxGCDC *This = (wxGCDC *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+ wxGraphicsContext * Result = (wxGraphicsContext*)This->GetGraphicsContext();
+ rt.addRef(getRef((void *)Result,memenv,8), "wxGraphicsContext");
+ break;
+}
+case wxGCDC_SetGraphicsContext: { // wxGCDC::SetGraphicsContext
+ wxGCDC *This = (wxGCDC *) getPtr(bp,memenv); bp += 4;
+ wxGraphicsContext *ctx = (wxGraphicsContext *) getPtr(bp,memenv); bp += 4;
+ if(!This) throw wxe_badarg(0);
+ This->SetGraphicsContext(ctx);
+ break;
+}
+#endif // wxUSE_GRAPHICS_CONTEXT
default: {
wxeReturn error = wxeReturn(WXE_DRV_PORT, Ecmd.caller, false); error.addAtom("_wxe_error_");
error.addInt((int) op);
@@ -32174,6 +32288,7 @@ bool WxeApp::delete_object(void *ptr, wxeRefData *refd) {
case 231: delete (EwxLocale *) ptr; return false;
case 236: delete (wxOverlay *) ptr; break;
case 237: delete (EwxDCOverlay *) ptr; return false;
+ case 239: delete (wxDisplay *) ptr; break;
default: delete (wxObject *) ptr; return false;
}
return true;
diff --git a/lib/wx/c_src/gen/wxe_init.cpp b/lib/wx/c_src/gen/wxe_init.cpp
index 6ce33a5449..5a52d69003 100644
--- a/lib/wx/c_src/gen/wxe_init.cpp
+++ b/lib/wx/c_src/gen/wxe_init.cpp
@@ -55,6 +55,14 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) {
rt.addTupleCount(2);
rt.addAtom("wxFONTENCODING_UTF32"); rt.addInt(wxFONTENCODING_UTF32);
rt.addTupleCount(2);
+ rt.addAtom("wxFONTWEIGHT_BOLD"); rt.addInt(wxFONTWEIGHT_BOLD);
+ rt.addTupleCount(2);
+ rt.addAtom("wxFONTWEIGHT_LIGHT"); rt.addInt(wxFONTWEIGHT_LIGHT);
+ rt.addTupleCount(2);
+ rt.addAtom("wxFONTWEIGHT_MAX"); rt.addInt(wxFONTWEIGHT_MAX);
+ rt.addTupleCount(2);
+ rt.addAtom("wxFONTWEIGHT_NORMAL"); rt.addInt(wxFONTWEIGHT_NORMAL);
+ rt.addTupleCount(2);
rt.addAtom("wxMOD_CMD"); rt.addInt(wxMOD_CMD);
rt.addTupleCount(2);
rt.addAtom("wxLANGUAGE_ABKHAZIAN"); rt.addInt(wxLANGUAGE_ABKHAZIAN);
@@ -654,6 +662,62 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) {
rt.addTupleCount(2);
rt.addAtom("wxCYAN_PEN"); rt.addRef(getRef((void *)wxCYAN_PEN,memenv),"wxPen");
rt.addTupleCount(2);
+#if wxCHECK_VERSION(3,1,2)
+ rt.addAtom("wxFONTWEIGHT_EXTRABOLD"); rt.addInt(wxFONTWEIGHT_EXTRABOLD);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wxFONTWEIGHT_EXTRABOLD"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,2)
+ rt.addAtom("wxFONTWEIGHT_EXTRAHEAVY"); rt.addInt(wxFONTWEIGHT_EXTRAHEAVY);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wxFONTWEIGHT_EXTRAHEAVY"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,2)
+ rt.addAtom("wxFONTWEIGHT_EXTRALIGHT"); rt.addInt(wxFONTWEIGHT_EXTRALIGHT);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wxFONTWEIGHT_EXTRALIGHT"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,2)
+ rt.addAtom("wxFONTWEIGHT_HEAVY"); rt.addInt(wxFONTWEIGHT_HEAVY);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wxFONTWEIGHT_HEAVY"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,2)
+ rt.addAtom("wxFONTWEIGHT_INVALID"); rt.addInt(wxFONTWEIGHT_INVALID);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wxFONTWEIGHT_INVALID"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,2)
+ rt.addAtom("wxFONTWEIGHT_MEDIUM"); rt.addInt(wxFONTWEIGHT_MEDIUM);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wxFONTWEIGHT_MEDIUM"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,2)
+ rt.addAtom("wxFONTWEIGHT_SEMIBOLD"); rt.addInt(wxFONTWEIGHT_SEMIBOLD);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wxFONTWEIGHT_SEMIBOLD"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
+#if wxCHECK_VERSION(3,1,2)
+ rt.addAtom("wxFONTWEIGHT_THIN"); rt.addInt(wxFONTWEIGHT_THIN);
+ rt.addTupleCount(2);
+#else
+ rt.addAtom("wxFONTWEIGHT_THIN"); rt.addAtom("undefined");
+ rt.addTupleCount(2);
+#endif
rt.addAtom("wxGREEN"); rt.add(*(wxGREEN));
rt.addTupleCount(2);
rt.addAtom("wxGREEN_BRUSH"); rt.addRef(getRef((void *)wxGREEN_BRUSH,memenv),"wxBrush");
@@ -723,7 +787,7 @@ void WxeApp::init_nonconsts(wxeMemEnv *memenv, ErlDrvTermData caller) {
rt.addAtom("wx_GL_COMPAT_PROFILE"); rt.addAtom("undefined");
rt.addTupleCount(2);
#endif
- rt.endList(309);
+ rt.endList(321);
rt.addTupleCount(2);
rt.send();
}
diff --git a/lib/wx/c_src/gen/wxe_macros.h b/lib/wx/c_src/gen/wxe_macros.h
index 4c8e52def2..c23e8a83bd 100644
--- a/lib/wx/c_src/gen/wxe_macros.h
+++ b/lib/wx/c_src/gen/wxe_macros.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2008-2017. All Rights Reserved.
+ * Copyright Ericsson AB 2008-2018. All Rights Reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
@@ -35,6 +35,7 @@
#include <wx/fontdlg.h>
#include <wx/progdlg.h>
#include <wx/printdlg.h>
+#include <wx/display.h>
#include <wx/dcbuffer.h>
#include <wx/dcmirror.h>
#include <wx/glcanvas.h>
@@ -46,6 +47,7 @@
#include <wx/sashwin.h>
#include <wx/laywin.h>
#include <wx/graphics.h>
+#include <wx/dcgraph.h>
#include <wx/aui/aui.h>
#include <wx/datectrl.h>
#include <wx/filepicker.h>
@@ -3426,5 +3428,21 @@
#define wxDropFilesEvent_GetPosition 3597
#define wxDropFilesEvent_GetNumberOfFiles 3598
#define wxDropFilesEvent_GetFiles 3599
+#define wxDisplay_new 3600
+#define wxDisplay_destruct 3601
+#define wxDisplay_IsOk 3602
+#define wxDisplay_GetClientArea 3603
+#define wxDisplay_GetGeometry 3604
+#define wxDisplay_GetName 3605
+#define wxDisplay_IsPrimary 3606
+#define wxDisplay_GetCount 3607
+#define wxDisplay_GetFromPoint 3608
+#define wxDisplay_GetFromWindow 3609
+#define wxDisplay_GetPPI 3610
+#define wxGCDC_new_1 3611
+#define wxGCDC_new_0 3612
+#define wxGCDC_destruct 3613
+#define wxGCDC_GetGraphicsContext 3614
+#define wxGCDC_SetGraphicsContext 3615
diff --git a/lib/wx/c_src/wxe_impl.cpp b/lib/wx/c_src/wxe_impl.cpp
index bd22502d00..43b5476073 100644
--- a/lib/wx/c_src/wxe_impl.cpp
+++ b/lib/wx/c_src/wxe_impl.cpp
@@ -267,7 +267,7 @@ int WxeApp::dispatch_cmds()
return more;
}
-#define BREAK_BATCH 10000
+#define CHECK_EVENTS 10000
int WxeApp::dispatch(wxeFifo * batch)
{
@@ -278,13 +278,14 @@ int WxeApp::dispatch(wxeFifo * batch)
erl_drv_mutex_lock(wxe_batch_locker_m);
while(true) {
while((event = batch->Get()) != NULL) {
+ wait += 1;
erl_drv_mutex_unlock(wxe_batch_locker_m);
switch(event->op) {
case WXE_BATCH_END:
if(blevel>0) {
blevel--;
if(blevel==0)
- wait += BREAK_BATCH/4;
+ wait += CHECK_EVENTS/4;
}
break;
case WXE_BATCH_BEGIN:
@@ -314,21 +315,18 @@ int WxeApp::dispatch(wxeFifo * batch)
break;
}
event->Delete();
+ if(wait > CHECK_EVENTS)
+ return 1; // Let wx check for events
erl_drv_mutex_lock(wxe_batch_locker_m);
batch->Cleanup();
}
- if(blevel <= 0 || wait >= BREAK_BATCH) {
+ if(blevel <= 0) {
erl_drv_mutex_unlock(wxe_batch_locker_m);
- if(blevel > 0) {
- return 1; // We are still in a batch but we can let wx check for events
- } else {
- return 0;
- }
+ return 0;
}
// sleep until something happens
// fprintf(stderr, "%s:%d sleep %d %d %d\r\n", __FILE__, __LINE__, batch->m_n, blevel, wait);fflush(stderr);
wxe_needs_signal = 1;
- wait += 1;
while(batch->m_n == 0) {
erl_drv_cond_wait(wxe_batch_locker_c, wxe_batch_locker_m);
}
diff --git a/lib/wx/doc/src/notes.xml b/lib/wx/doc/src/notes.xml
index 1061e73138..33d02e22ba 100644
--- a/lib/wx/doc/src/notes.xml
+++ b/lib/wx/doc/src/notes.xml
@@ -32,6 +32,25 @@
<p>This document describes the changes made to the wxErlang
application.</p>
+<section><title>Wx 1.8.7</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Improved support for wxWidgets 3.1.3 which have changed
+ <c>wxFONTWEIGTH</c>, also added <c>wxGCDC</c> and
+ <c>wxDisplay</c> modules.</p>
+ <p>
+ Fixed a crash on Mojave and check for events more often.</p>
+ <p>
+ Own Id: OTP-15587</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Wx 1.8.6</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/wx/include/wx.hrl b/lib/wx/include/wx.hrl
index 23f3b95403..2c145595ee 100644
--- a/lib/wx/include/wx.hrl
+++ b/lib/wx/include/wx.hrl
@@ -398,6 +398,14 @@
-define(wxCYAN, wxe_util:get_const(wxCYAN)).
-define(wxCYAN_BRUSH, wxe_util:get_const(wxCYAN_BRUSH)).
-define(wxCYAN_PEN, wxe_util:get_const(wxCYAN_PEN)).
+-define(wxFONTWEIGHT_EXTRABOLD, wxe_util:get_const(wxFONTWEIGHT_EXTRABOLD)).
+-define(wxFONTWEIGHT_EXTRAHEAVY, wxe_util:get_const(wxFONTWEIGHT_EXTRAHEAVY)).
+-define(wxFONTWEIGHT_EXTRALIGHT, wxe_util:get_const(wxFONTWEIGHT_EXTRALIGHT)).
+-define(wxFONTWEIGHT_HEAVY, wxe_util:get_const(wxFONTWEIGHT_HEAVY)).
+-define(wxFONTWEIGHT_INVALID, wxe_util:get_const(wxFONTWEIGHT_INVALID)).
+-define(wxFONTWEIGHT_MEDIUM, wxe_util:get_const(wxFONTWEIGHT_MEDIUM)).
+-define(wxFONTWEIGHT_SEMIBOLD, wxe_util:get_const(wxFONTWEIGHT_SEMIBOLD)).
+-define(wxFONTWEIGHT_THIN, wxe_util:get_const(wxFONTWEIGHT_THIN)).
-define(wxGREEN, wxe_util:get_const(wxGREEN)).
-define(wxGREEN_BRUSH, wxe_util:get_const(wxGREEN_BRUSH)).
-define(wxGREEN_PEN, wxe_util:get_const(wxGREEN_PEN)).
@@ -1685,10 +1693,10 @@
-define(wxFONTSTYLE_SLANT, ?wxSLANT).
-define(wxFONTSTYLE_MAX, (?wxSLANT+1)).
% From "font.h": wxFontWeight
--define(wxFONTWEIGHT_NORMAL, ?wxNORMAL).
--define(wxFONTWEIGHT_LIGHT, ?wxLIGHT).
--define(wxFONTWEIGHT_BOLD, ?wxBOLD).
--define(wxFONTWEIGHT_MAX, (?wxBOLD+1)).
+-define(wxFONTWEIGHT_NORMAL, wxe_util:get_const(wxFONTWEIGHT_NORMAL)).
+-define(wxFONTWEIGHT_LIGHT, wxe_util:get_const(wxFONTWEIGHT_LIGHT)).
+-define(wxFONTWEIGHT_BOLD, wxe_util:get_const(wxFONTWEIGHT_BOLD)).
+-define(wxFONTWEIGHT_MAX, wxe_util:get_const(wxFONTWEIGHT_MAX)).
% From "fontenc.h": wxFontEncoding
-define(wxFONTENCODING_SYSTEM, -1).
-define(wxFONTENCODING_DEFAULT, 0).
diff --git a/lib/wx/src/gen/wxDisplay.erl b/lib/wx/src/gen/wxDisplay.erl
new file mode 100644
index 0000000000..b6a2bf22ac
--- /dev/null
+++ b/lib/wx/src/gen/wxDisplay.erl
@@ -0,0 +1,131 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%% This file is generated DO NOT EDIT
+
+%% @doc See external documentation: <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html">wxDisplay</a>.
+%% @type wxDisplay(). An object reference, The representation is internal
+%% and can be changed without notice. It can't be used for comparsion
+%% stored on disc or distributed for use on other nodes.
+
+-module(wxDisplay).
+-include("wxe.hrl").
+-export([destroy/1,getClientArea/1,getCount/0,getFromPoint/1,getFromWindow/1,
+ getGeometry/1,getName/1,getPPI/1,isOk/1,isPrimary/1,new/0,new/1]).
+
+%% inherited exports
+-export([parent_class/1]).
+
+-export_type([wxDisplay/0]).
+%% @hidden
+parent_class(_Class) -> erlang:error({badtype, ?MODULE}).
+
+-type wxDisplay() :: wx:wx_object().
+%% @equiv new([])
+-spec new() -> wxDisplay().
+
+new() ->
+ new([]).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplaywxdisplay">external documentation</a>.
+-spec new([Option]) -> wxDisplay() when
+ Option :: {'n', integer()}.
+new(Options)
+ when is_list(Options) ->
+ MOpts = fun({n, N}, Acc) -> [<<1:32/?UI,N:32/?UI>>|Acc];
+ (BadOpt, _) -> erlang:error({badoption, BadOpt}) end,
+ BinOpt = list_to_binary(lists:foldl(MOpts, [<<0:32>>], Options)),
+ wxe_util:construct(?wxDisplay_new,
+ <<BinOpt/binary>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplayisok">external documentation</a>.
+-spec isOk(This) -> boolean() when
+ This::wxDisplay().
+isOk(#wx_ref{type=ThisT,ref=ThisRef}) ->
+ ?CLASS(ThisT,wxDisplay),
+ wxe_util:call(?wxDisplay_IsOk,
+ <<ThisRef:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplaygetclientarea">external documentation</a>.
+-spec getClientArea(This) -> {X::integer(), Y::integer(), W::integer(), H::integer()} when
+ This::wxDisplay().
+getClientArea(#wx_ref{type=ThisT,ref=ThisRef}) ->
+ ?CLASS(ThisT,wxDisplay),
+ wxe_util:call(?wxDisplay_GetClientArea,
+ <<ThisRef:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplaygetgeometry">external documentation</a>.
+-spec getGeometry(This) -> {X::integer(), Y::integer(), W::integer(), H::integer()} when
+ This::wxDisplay().
+getGeometry(#wx_ref{type=ThisT,ref=ThisRef}) ->
+ ?CLASS(ThisT,wxDisplay),
+ wxe_util:call(?wxDisplay_GetGeometry,
+ <<ThisRef:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplaygetname">external documentation</a>.
+-spec getName(This) -> unicode:charlist() when
+ This::wxDisplay().
+getName(#wx_ref{type=ThisT,ref=ThisRef}) ->
+ ?CLASS(ThisT,wxDisplay),
+ wxe_util:call(?wxDisplay_GetName,
+ <<ThisRef:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplayisprimary">external documentation</a>.
+-spec isPrimary(This) -> boolean() when
+ This::wxDisplay().
+isPrimary(#wx_ref{type=ThisT,ref=ThisRef}) ->
+ ?CLASS(ThisT,wxDisplay),
+ wxe_util:call(?wxDisplay_IsPrimary,
+ <<ThisRef:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplaygetcount">external documentation</a>.
+-spec getCount() -> integer().
+getCount() ->
+ wxe_util:call(?wxDisplay_GetCount,
+ <<>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplaygetfrompoint">external documentation</a>.
+-spec getFromPoint(Pt) -> integer() when
+ Pt::{X::integer(), Y::integer()}.
+getFromPoint({PtX,PtY})
+ when is_integer(PtX),is_integer(PtY) ->
+ wxe_util:call(?wxDisplay_GetFromPoint,
+ <<PtX:32/?UI,PtY:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplaygetfromwindow">external documentation</a>.
+-spec getFromWindow(Window) -> integer() when
+ Window::wxWindow:wxWindow().
+getFromWindow(#wx_ref{type=WindowT,ref=WindowRef}) ->
+ ?CLASS(WindowT,wxWindow),
+ wxe_util:call(?wxDisplay_GetFromWindow,
+ <<WindowRef:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxdisplay.html#wxdisplaygetppi">external documentation</a>.
+-spec getPPI(This) -> {W::integer(), H::integer()} when
+ This::wxDisplay().
+getPPI(#wx_ref{type=ThisT,ref=ThisRef}) ->
+ ?CLASS(ThisT,wxDisplay),
+ wxe_util:call(?wxDisplay_GetPPI,
+ <<ThisRef:32/?UI>>).
+
+%% @doc Destroys this object, do not use object again
+-spec destroy(This::wxDisplay()) -> 'ok'.
+destroy(Obj=#wx_ref{type=Type}) ->
+ ?CLASS(Type,wxDisplay),
+ wxe_util:destroy(?wxDisplay_destruct,Obj),
+ ok.
diff --git a/lib/wx/src/gen/wxGCDC.erl b/lib/wx/src/gen/wxGCDC.erl
new file mode 100644
index 0000000000..467013b14e
--- /dev/null
+++ b/lib/wx/src/gen/wxGCDC.erl
@@ -0,0 +1,287 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2018. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%% This file is generated DO NOT EDIT
+
+%% @doc See external documentation: <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxgcdc.html">wxGCDC</a>.
+%% <p>This class is derived (and can use functions) from:
+%% <br />{@link wxDC}
+%% </p>
+%% @type wxGCDC(). An object reference, The representation is internal
+%% and can be changed without notice. It can't be used for comparsion
+%% stored on disc or distributed for use on other nodes.
+
+-module(wxGCDC).
+-include("wxe.hrl").
+-export([destroy/1,getGraphicsContext/1,new/0,new/1,setGraphicsContext/2]).
+
+%% inherited exports
+-export([blit/5,blit/6,calcBoundingBox/3,clear/1,computeScaleAndOrigin/1,crossHair/2,
+ destroyClippingRegion/1,deviceToLogicalX/2,deviceToLogicalXRel/2,
+ deviceToLogicalY/2,deviceToLogicalYRel/2,drawArc/4,drawBitmap/3,drawBitmap/4,
+ drawCheckMark/2,drawCircle/3,drawEllipse/2,drawEllipse/3,drawEllipticArc/5,
+ drawIcon/3,drawLabel/3,drawLabel/4,drawLine/3,drawLines/2,drawLines/3,
+ drawPoint/2,drawPolygon/2,drawPolygon/3,drawRectangle/2,drawRectangle/3,
+ drawRotatedText/4,drawRoundedRectangle/3,drawRoundedRectangle/4,
+ drawText/3,endDoc/1,endPage/1,floodFill/3,floodFill/4,getBackground/1,
+ getBackgroundMode/1,getBrush/1,getCharHeight/1,getCharWidth/1,getClippingBox/1,
+ getFont/1,getLayoutDirection/1,getLogicalFunction/1,getMapMode/1,
+ getMultiLineTextExtent/2,getMultiLineTextExtent/3,getPPI/1,getPartialTextExtents/2,
+ getPen/1,getPixel/2,getSize/1,getSizeMM/1,getTextBackground/1,getTextExtent/2,
+ getTextExtent/3,getTextForeground/1,getUserScale/1,gradientFillConcentric/4,
+ gradientFillConcentric/5,gradientFillLinear/4,gradientFillLinear/5,
+ isOk/1,logicalToDeviceX/2,logicalToDeviceXRel/2,logicalToDeviceY/2,
+ logicalToDeviceYRel/2,maxX/1,maxY/1,minX/1,minY/1,parent_class/1,resetBoundingBox/1,
+ setAxisOrientation/3,setBackground/2,setBackgroundMode/2,setBrush/2,
+ setClippingRegion/2,setClippingRegion/3,setDeviceOrigin/3,setFont/2,
+ setLayoutDirection/2,setLogicalFunction/2,setMapMode/2,setPalette/2,
+ setPen/2,setTextBackground/2,setTextForeground/2,setUserScale/3,startDoc/2,
+ startPage/1]).
+
+-export_type([wxGCDC/0]).
+-compile([{nowarn_deprecated_function, {wxDC,computeScaleAndOrigin,1}}]).
+
+%% @hidden
+parent_class(wxDC) -> true;
+parent_class(_Class) -> erlang:error({badtype, ?MODULE}).
+
+-type wxGCDC() :: wx:wx_object().
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxgcdc.html#wxgcdcwxgcdc">external documentation</a>.
+-spec new() -> wxGCDC().
+new() ->
+ wxe_util:construct(?wxGCDC_new_0,
+ <<>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxgcdc.html#wxgcdcwxgcdc">external documentation</a>.
+-spec new(Dc) -> wxGCDC() when
+ Dc::wxWindowDC:wxWindowDC().
+new(#wx_ref{type=DcT,ref=DcRef}) ->
+ ?CLASS(DcT,wxWindowDC),
+ wxe_util:construct(?wxGCDC_new_1,
+ <<DcRef:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxgcdc.html#wxgcdcgetgraphicscontext">external documentation</a>.
+-spec getGraphicsContext(This) -> wxGraphicsContext:wxGraphicsContext() when
+ This::wxGCDC().
+getGraphicsContext(#wx_ref{type=ThisT,ref=ThisRef}) ->
+ ?CLASS(ThisT,wxGCDC),
+ wxe_util:call(?wxGCDC_GetGraphicsContext,
+ <<ThisRef:32/?UI>>).
+
+%% @doc See <a href="http://www.wxwidgets.org/manuals/2.8.12/wx_wxgcdc.html#wxgcdcsetgraphicscontext">external documentation</a>.
+-spec setGraphicsContext(This, Ctx) -> 'ok' when
+ This::wxGCDC(), Ctx::wxGraphicsContext:wxGraphicsContext().
+setGraphicsContext(#wx_ref{type=ThisT,ref=ThisRef},#wx_ref{type=CtxT,ref=CtxRef}) ->
+ ?CLASS(ThisT,wxGCDC),
+ ?CLASS(CtxT,wxGraphicsContext),
+ wxe_util:cast(?wxGCDC_SetGraphicsContext,
+ <<ThisRef:32/?UI,CtxRef:32/?UI>>).
+
+%% @doc Destroys this object, do not use object again
+-spec destroy(This::wxGCDC()) -> 'ok'.
+destroy(Obj=#wx_ref{type=Type}) ->
+ ?CLASS(Type,wxGCDC),
+ wxe_util:destroy(?DESTROY_OBJECT,Obj),
+ ok.
+ %% From wxDC
+%% @hidden
+startPage(This) -> wxDC:startPage(This).
+%% @hidden
+startDoc(This,Message) -> wxDC:startDoc(This,Message).
+%% @hidden
+setUserScale(This,X,Y) -> wxDC:setUserScale(This,X,Y).
+%% @hidden
+setTextForeground(This,Colour) -> wxDC:setTextForeground(This,Colour).
+%% @hidden
+setTextBackground(This,Colour) -> wxDC:setTextBackground(This,Colour).
+%% @hidden
+setPen(This,Pen) -> wxDC:setPen(This,Pen).
+%% @hidden
+setPalette(This,Palette) -> wxDC:setPalette(This,Palette).
+%% @hidden
+setMapMode(This,Mode) -> wxDC:setMapMode(This,Mode).
+%% @hidden
+setLogicalFunction(This,Function) -> wxDC:setLogicalFunction(This,Function).
+%% @hidden
+setLayoutDirection(This,Dir) -> wxDC:setLayoutDirection(This,Dir).
+%% @hidden
+setFont(This,Font) -> wxDC:setFont(This,Font).
+%% @hidden
+setDeviceOrigin(This,X,Y) -> wxDC:setDeviceOrigin(This,X,Y).
+%% @hidden
+setClippingRegion(This,Pt,Sz) -> wxDC:setClippingRegion(This,Pt,Sz).
+%% @hidden
+setClippingRegion(This,Region) -> wxDC:setClippingRegion(This,Region).
+%% @hidden
+setBrush(This,Brush) -> wxDC:setBrush(This,Brush).
+%% @hidden
+setBackgroundMode(This,Mode) -> wxDC:setBackgroundMode(This,Mode).
+%% @hidden
+setBackground(This,Brush) -> wxDC:setBackground(This,Brush).
+%% @hidden
+setAxisOrientation(This,XLeftRight,YBottomUp) -> wxDC:setAxisOrientation(This,XLeftRight,YBottomUp).
+%% @hidden
+resetBoundingBox(This) -> wxDC:resetBoundingBox(This).
+%% @hidden
+isOk(This) -> wxDC:isOk(This).
+%% @hidden
+minY(This) -> wxDC:minY(This).
+%% @hidden
+minX(This) -> wxDC:minX(This).
+%% @hidden
+maxY(This) -> wxDC:maxY(This).
+%% @hidden
+maxX(This) -> wxDC:maxX(This).
+%% @hidden
+logicalToDeviceYRel(This,Y) -> wxDC:logicalToDeviceYRel(This,Y).
+%% @hidden
+logicalToDeviceY(This,Y) -> wxDC:logicalToDeviceY(This,Y).
+%% @hidden
+logicalToDeviceXRel(This,X) -> wxDC:logicalToDeviceXRel(This,X).
+%% @hidden
+logicalToDeviceX(This,X) -> wxDC:logicalToDeviceX(This,X).
+%% @hidden
+gradientFillLinear(This,Rect,InitialColour,DestColour, Options) -> wxDC:gradientFillLinear(This,Rect,InitialColour,DestColour, Options).
+%% @hidden
+gradientFillLinear(This,Rect,InitialColour,DestColour) -> wxDC:gradientFillLinear(This,Rect,InitialColour,DestColour).
+%% @hidden
+gradientFillConcentric(This,Rect,InitialColour,DestColour,CircleCenter) -> wxDC:gradientFillConcentric(This,Rect,InitialColour,DestColour,CircleCenter).
+%% @hidden
+gradientFillConcentric(This,Rect,InitialColour,DestColour) -> wxDC:gradientFillConcentric(This,Rect,InitialColour,DestColour).
+%% @hidden
+getUserScale(This) -> wxDC:getUserScale(This).
+%% @hidden
+getTextForeground(This) -> wxDC:getTextForeground(This).
+%% @hidden
+getTextExtent(This,String, Options) -> wxDC:getTextExtent(This,String, Options).
+%% @hidden
+getTextExtent(This,String) -> wxDC:getTextExtent(This,String).
+%% @hidden
+getTextBackground(This) -> wxDC:getTextBackground(This).
+%% @hidden
+getSizeMM(This) -> wxDC:getSizeMM(This).
+%% @hidden
+getSize(This) -> wxDC:getSize(This).
+%% @hidden
+getPPI(This) -> wxDC:getPPI(This).
+%% @hidden
+getPixel(This,Pt) -> wxDC:getPixel(This,Pt).
+%% @hidden
+getPen(This) -> wxDC:getPen(This).
+%% @hidden
+getPartialTextExtents(This,Text) -> wxDC:getPartialTextExtents(This,Text).
+%% @hidden
+getMultiLineTextExtent(This,String, Options) -> wxDC:getMultiLineTextExtent(This,String, Options).
+%% @hidden
+getMultiLineTextExtent(This,String) -> wxDC:getMultiLineTextExtent(This,String).
+%% @hidden
+getMapMode(This) -> wxDC:getMapMode(This).
+%% @hidden
+getLogicalFunction(This) -> wxDC:getLogicalFunction(This).
+%% @hidden
+getLayoutDirection(This) -> wxDC:getLayoutDirection(This).
+%% @hidden
+getFont(This) -> wxDC:getFont(This).
+%% @hidden
+getClippingBox(This) -> wxDC:getClippingBox(This).
+%% @hidden
+getCharWidth(This) -> wxDC:getCharWidth(This).
+%% @hidden
+getCharHeight(This) -> wxDC:getCharHeight(This).
+%% @hidden
+getBrush(This) -> wxDC:getBrush(This).
+%% @hidden
+getBackgroundMode(This) -> wxDC:getBackgroundMode(This).
+%% @hidden
+getBackground(This) -> wxDC:getBackground(This).
+%% @hidden
+floodFill(This,Pt,Col, Options) -> wxDC:floodFill(This,Pt,Col, Options).
+%% @hidden
+floodFill(This,Pt,Col) -> wxDC:floodFill(This,Pt,Col).
+%% @hidden
+endPage(This) -> wxDC:endPage(This).
+%% @hidden
+endDoc(This) -> wxDC:endDoc(This).
+%% @hidden
+drawText(This,Text,Pt) -> wxDC:drawText(This,Text,Pt).
+%% @hidden
+drawRoundedRectangle(This,Pt,Sz,Radius) -> wxDC:drawRoundedRectangle(This,Pt,Sz,Radius).
+%% @hidden
+drawRoundedRectangle(This,R,Radius) -> wxDC:drawRoundedRectangle(This,R,Radius).
+%% @hidden
+drawRotatedText(This,Text,Pt,Angle) -> wxDC:drawRotatedText(This,Text,Pt,Angle).
+%% @hidden
+drawRectangle(This,Pt,Sz) -> wxDC:drawRectangle(This,Pt,Sz).
+%% @hidden
+drawRectangle(This,Rect) -> wxDC:drawRectangle(This,Rect).
+%% @hidden
+drawPoint(This,Pt) -> wxDC:drawPoint(This,Pt).
+%% @hidden
+drawPolygon(This,Points, Options) -> wxDC:drawPolygon(This,Points, Options).
+%% @hidden
+drawPolygon(This,Points) -> wxDC:drawPolygon(This,Points).
+%% @hidden
+drawLines(This,Points, Options) -> wxDC:drawLines(This,Points, Options).
+%% @hidden
+drawLines(This,Points) -> wxDC:drawLines(This,Points).
+%% @hidden
+drawLine(This,Pt1,Pt2) -> wxDC:drawLine(This,Pt1,Pt2).
+%% @hidden
+drawLabel(This,Text,Rect, Options) -> wxDC:drawLabel(This,Text,Rect, Options).
+%% @hidden
+drawLabel(This,Text,Rect) -> wxDC:drawLabel(This,Text,Rect).
+%% @hidden
+drawIcon(This,Icon,Pt) -> wxDC:drawIcon(This,Icon,Pt).
+%% @hidden
+drawEllipticArc(This,Pt,Sz,Sa,Ea) -> wxDC:drawEllipticArc(This,Pt,Sz,Sa,Ea).
+%% @hidden
+drawEllipse(This,Pt,Sz) -> wxDC:drawEllipse(This,Pt,Sz).
+%% @hidden
+drawEllipse(This,Rect) -> wxDC:drawEllipse(This,Rect).
+%% @hidden
+drawCircle(This,Pt,Radius) -> wxDC:drawCircle(This,Pt,Radius).
+%% @hidden
+drawCheckMark(This,Rect) -> wxDC:drawCheckMark(This,Rect).
+%% @hidden
+drawBitmap(This,Bmp,Pt, Options) -> wxDC:drawBitmap(This,Bmp,Pt, Options).
+%% @hidden
+drawBitmap(This,Bmp,Pt) -> wxDC:drawBitmap(This,Bmp,Pt).
+%% @hidden
+drawArc(This,Pt1,Pt2,Centre) -> wxDC:drawArc(This,Pt1,Pt2,Centre).
+%% @hidden
+deviceToLogicalYRel(This,Y) -> wxDC:deviceToLogicalYRel(This,Y).
+%% @hidden
+deviceToLogicalY(This,Y) -> wxDC:deviceToLogicalY(This,Y).
+%% @hidden
+deviceToLogicalXRel(This,X) -> wxDC:deviceToLogicalXRel(This,X).
+%% @hidden
+deviceToLogicalX(This,X) -> wxDC:deviceToLogicalX(This,X).
+%% @hidden
+destroyClippingRegion(This) -> wxDC:destroyClippingRegion(This).
+%% @hidden
+crossHair(This,Pt) -> wxDC:crossHair(This,Pt).
+%% @hidden
+computeScaleAndOrigin(This) -> wxDC:computeScaleAndOrigin(This).
+%% @hidden
+clear(This) -> wxDC:clear(This).
+%% @hidden
+calcBoundingBox(This,X,Y) -> wxDC:calcBoundingBox(This,X,Y).
+%% @hidden
+blit(This,DestPt,Sz,Source,SrcPt, Options) -> wxDC:blit(This,DestPt,Sz,Source,SrcPt, Options).
+%% @hidden
+blit(This,DestPt,Sz,Source,SrcPt) -> wxDC:blit(This,DestPt,Sz,Source,SrcPt).
diff --git a/lib/wx/src/gen/wxe_debug.hrl b/lib/wx/src/gen/wxe_debug.hrl
index 533f9f2df0..b64a1b4c61 100644
--- a/lib/wx/src/gen/wxe_debug.hrl
+++ b/lib/wx/src/gen/wxe_debug.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -3377,6 +3377,22 @@ wxdebug_table() ->
{3597, {wxDropFilesEvent, getPosition, 0}},
{3598, {wxDropFilesEvent, getNumberOfFiles, 0}},
{3599, {wxDropFilesEvent, getFiles, 0}},
+ {3600, {wxDisplay, new, 1}},
+ {3601, {wxDisplay, destruct, 0}},
+ {3602, {wxDisplay, isOk, 0}},
+ {3603, {wxDisplay, getClientArea, 0}},
+ {3604, {wxDisplay, getGeometry, 0}},
+ {3605, {wxDisplay, getName, 0}},
+ {3606, {wxDisplay, isPrimary, 0}},
+ {3607, {wxDisplay, getCount, 0}},
+ {3608, {wxDisplay, getFromPoint, 1}},
+ {3609, {wxDisplay, getFromWindow, 1}},
+ {3610, {wxDisplay, getPPI, 0}},
+ {3611, {wxGCDC, new_1, 1}},
+ {3612, {wxGCDC, new_0, 0}},
+ {3613, {wxGCDC, destruct, 0}},
+ {3614, {wxGCDC, getGraphicsContext, 0}},
+ {3615, {wxGCDC, setGraphicsContext, 1}},
{-1, {mod, func, -1}}
].
diff --git a/lib/wx/src/gen/wxe_funcs.hrl b/lib/wx/src/gen/wxe_funcs.hrl
index 14b5545676..030f7f117d 100644
--- a/lib/wx/src/gen/wxe_funcs.hrl
+++ b/lib/wx/src/gen/wxe_funcs.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2018. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -3374,3 +3374,19 @@
-define(wxDropFilesEvent_GetPosition, 3597).
-define(wxDropFilesEvent_GetNumberOfFiles, 3598).
-define(wxDropFilesEvent_GetFiles, 3599).
+-define(wxDisplay_new, 3600).
+-define(wxDisplay_destruct, 3601).
+-define(wxDisplay_IsOk, 3602).
+-define(wxDisplay_GetClientArea, 3603).
+-define(wxDisplay_GetGeometry, 3604).
+-define(wxDisplay_GetName, 3605).
+-define(wxDisplay_IsPrimary, 3606).
+-define(wxDisplay_GetCount, 3607).
+-define(wxDisplay_GetFromPoint, 3608).
+-define(wxDisplay_GetFromWindow, 3609).
+-define(wxDisplay_GetPPI, 3610).
+-define(wxGCDC_new_1, 3611).
+-define(wxGCDC_new_0, 3612).
+-define(wxGCDC_destruct, 3613).
+-define(wxGCDC_GetGraphicsContext, 3614).
+-define(wxGCDC_SetGraphicsContext, 3615).
diff --git a/lib/wx/vsn.mk b/lib/wx/vsn.mk
index d241a7a1b4..dac219fa98 100644
--- a/lib/wx/vsn.mk
+++ b/lib/wx/vsn.mk
@@ -1 +1 @@
-WX_VSN = 1.8.6
+WX_VSN = 1.8.7
diff --git a/make/install_dir_data.sh.in b/make/install_dir_data.sh.in
new file mode 100644
index 0000000000..8c1dc3d889
--- /dev/null
+++ b/make/install_dir_data.sh.in
@@ -0,0 +1,70 @@
+#!/bin/sh
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2019. 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%
+#
+
+#
+# install_dir_data.sh <SourceDir> <DestDir>
+#
+# Install all content in <SourceDir> including subdirectories
+# into <DestDir>.
+#
+
+INSTALL="@INSTALL@"
+INSTALL_DIR="@INSTALL_DIR@"
+INSTALL_DATA="@INSTALL_DATA@"
+
+debug=yes
+
+error () {
+ echo "ERROR: $1" 1>&2
+ exit 1
+}
+
+usage () {
+ error "$1\n Usage $progname <SourceDir> <DestDir>"
+}
+
+cmd () {
+ [ $debug = no ] || echo "$@"
+ "$@" || exit 1
+}
+
+progname="$0"
+
+[ $# -eq 2 ] || usage "Invalid amount of arguments"
+
+src="$1"
+dest="$2"
+
+cmd cd "$src"
+
+for dir in `find . -type d`; do
+ destdir="$dest"
+ [ "$dir" = "." ] || destdir="$dest/$dir"
+ cmd $INSTALL_DIR "$destdir"
+done
+
+for file in `find . -type f`; do
+ subdir=`dirname "$file"`
+ destdir="$dest"
+ [ "$subdir" = "." ] || destdir="$dest/$subdir"
+ cmd $INSTALL_DATA "$file" "$destdir"
+done
+
+exit 0
diff --git a/make/otp.mk.in b/make/otp.mk.in
index df29d26833..ceff8f7c31 100644
--- a/make/otp.mk.in
+++ b/make/otp.mk.in
@@ -73,6 +73,7 @@ INSTALL_DIR = @INSTALL_DIR@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_SCRIPT = @INSTALL_SCRIPT@
INSTALL_DATA = @INSTALL_DATA@
+INSTALL_DIR_DATA = $(ERL_TOP)/make/install_dir_data.sh
CC = @CC@
GCC = @GCC@
@@ -274,6 +275,7 @@ XSLTPROC = @XSLTPROC@
FOP = @FOP@
XMLLINT = @XMLLINT@
CP = @CP@
+MKDIR = @MKDIR@
DOCGEN=$(ERL_TOP)/lib/erl_docgen
FOP_CONFIG = $(DOCGEN)/priv/fop.xconf
diff --git a/make/otp_version_tickets_in_merge b/make/otp_version_tickets_in_merge
index e69de29bb2..77633c2ce2 100644
--- a/make/otp_version_tickets_in_merge
+++ b/make/otp_version_tickets_in_merge
@@ -0,0 +1,79 @@
+OTP-14702
+OTP-15229
+OTP-15298
+OTP-15369
+OTP-15375
+OTP-15398
+OTP-15423
+OTP-15442
+OTP-15445
+OTP-15447
+OTP-15460
+OTP-15479
+OTP-15484
+OTP-15490
+OTP-15493
+OTP-15494
+OTP-15498
+OTP-15502
+OTP-15503
+OTP-15508
+OTP-15514
+OTP-15518
+OTP-15519
+OTP-15527
+OTP-15529
+OTP-15539
+OTP-15540
+OTP-15541
+OTP-15542
+OTP-15545
+OTP-15552
+OTP-15553
+OTP-15555
+OTP-15556
+OTP-15557
+OTP-15558
+OTP-15561
+OTP-15562
+OTP-15567
+OTP-15569
+OTP-15570
+OTP-15572
+OTP-15576
+OTP-15577
+OTP-15578
+OTP-15580
+OTP-15583
+OTP-15584
+OTP-15586
+OTP-15587
+OTP-15592
+OTP-15599
+OTP-15600
+OTP-15601
+OTP-15602
+OTP-15604
+OTP-15605
+OTP-15619
+OTP-15624
+OTP-15625
+OTP-15629
+OTP-15630
+OTP-15634
+OTP-15637
+OTP-15639
+OTP-15642
+OTP-15647
+OTP-15650
+OTP-15654
+OTP-15657
+OTP-15659
+OTP-15660
+OTP-15662
+OTP-15663
+OTP-15665
+OTP-15666
+OTP-15667
+OTP-15669
+OTP-15670
diff --git a/otp_build b/otp_build
index 21d520e101..3dfe24a299 100755
--- a/otp_build
+++ b/otp_build
@@ -30,7 +30,7 @@ AUTOCONF_SUBDIRS="$AUTOCONF_SUBDIRS make erts"
# partly built in one of the bootstrap phases. Applications that
# only get some static includes copied into the bootstrap directory
# should not be included.
-bootstrap_apps="erts lib/asn1 lib/compiler lib/hipe lib/ic lib/kernel lib/parsetools lib/sasl lib/snmp lib/stdlib lib/syntax_tools"
+bootstrap_apps="erts lib/asn1 lib/compiler lib/erl_interface lib/hipe lib/kernel lib/jinterface lib/parsetools lib/sasl lib/snmp lib/stdlib lib/syntax_tools lib/wx"
# We will quote a bit more than needed, but the important thing is that
# all that needs quoting will be quoted...
@@ -1018,7 +1018,7 @@ do_debuginfo_win32 ()
fi
BINDIR="$ERL_TOP/bin/$TARGET"
EVSN=`grep '^VSN' erts/vsn.mk | sed 's,^VSN.*=[^0-9]*\([0-9].*\)$,@\1,g;s,^[^@].*,,g;s,^@,,g'`
- for f in beam.debug.dll beam.debug.smp.dll beam.pdb beam.smp.pdb erl.pdb werl.pdb erlexec.pdb; do
+ for f in beam.debug.smp.dll beam.smp.pdb erl.pdb werl.pdb erlexec.pdb; do
if [ -f $BINDIR/$f ]; then
rm -f $RELDIR/erts-$EVSN/bin/$f
cp $BINDIR/$f $RELDIR/erts-$EVSN/bin/$f
diff --git a/otp_patch_apply b/otp_patch_apply
index 0127b96a73..3ff929ccbb 100755
--- a/otp_patch_apply
+++ b/otp_patch_apply
@@ -19,7 +19,7 @@
# %CopyrightEnd%
#
-version="1.0.1"
+version="1.0.2"
force=
lib_path=
@@ -388,9 +388,7 @@ if [ $install_docs = yes ]; then
TESTROOT="$idir" release_docs) || exit 1
done
- (cd "$sdir/system/doc/top" && $MAKE clean)
-
- (cd "$sdir/system/doc/top" && \
+ (cd "$sdir/system/doc" && \
$MAKE MAKE="$MAKE" RELEASE_ROOT="$idir" RELEASE_PATH="$idir" \
TESTROOT="$idir" release_docs) || exit 1
diff --git a/otp_versions.table b/otp_versions.table
index cd64800534..eef6a9c8fe 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,3 +1,7 @@
+OTP-21.3 : common_test-1.17 compiler-7.3.2 crypto-4.4.1 dialyzer-3.3.2 diameter-2.2 edoc-0.10 erl_docgen-0.9 erl_interface-3.11 erts-10.3 ftp-1.0.2 hipe-3.18.3 inets-7.0.6 kernel-6.3 mnesia-4.15.6 observer-2.9 odbc-2.12.3 public_key-1.6.5 runtime_tools-1.13.2 ssh-4.7.4 ssl-9.2 stdlib-3.8 syntax_tools-2.1.7 tools-3.1 wx-1.8.7 # asn1-5.0.8 debugger-4.2.6 eldap-1.2.6 et-1.6.4 eunit-2.3.7 jinterface-1.9.1 megaco-3.18.4 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 reltool-0.7.8 sasl-3.3 snmp-5.2.12 tftp-1.0.1 xmerl-1.3.19 :
+OTP-21.2.7 : erts-10.2.5 kernel-6.2.1 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.5 jinterface-1.9.1 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 ssl-9.1.2 stdlib-3.7.1 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 :
+OTP-21.2.6 : erts-10.2.4 stdlib-3.7.1 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.5 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 ssl-9.1.2 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 :
+OTP-21.2.5 : inets-7.0.5 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 erts-10.2.3 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 ssl-9.1.2 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 :
OTP-21.2.4 : erts-10.2.3 inets-7.0.4 # asn1-5.0.8 common_test-1.16.1 compiler-7.3.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 ssl-9.1.2 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.19 :
OTP-21.2.3 : compiler-7.3.1 erts-10.2.2 ssl-9.1.2 xmerl-1.3.19 # asn1-5.0.8 common_test-1.16.1 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.3 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssh-4.7.3 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 :
OTP-21.2.2 : ssh-4.7.3 # asn1-5.0.8 common_test-1.16.1 compiler-7.3 crypto-4.4 debugger-4.2.6 dialyzer-3.3.1 diameter-2.1.6 edoc-0.9.4 eldap-1.2.6 erl_docgen-0.8.1 erl_interface-3.10.4 erts-10.2.1 et-1.6.4 eunit-2.3.7 ftp-1.0.1 hipe-3.18.2 inets-7.0.3 jinterface-1.9.1 kernel-6.2 megaco-3.18.4 mnesia-4.15.5 observer-2.8.2 odbc-2.12.2 os_mon-2.4.7 otp_mibs-1.2.1 parsetools-2.1.8 public_key-1.6.4 reltool-0.7.8 runtime_tools-1.13.1 sasl-3.3 snmp-5.2.12 ssl-9.1.1 stdlib-3.7 syntax_tools-2.1.6 tftp-1.0.1 tools-3.0.2 wx-1.8.6 xmerl-1.3.18 :
@@ -18,6 +22,8 @@ OTP-21.0.3 : erts-10.0.3 # asn1-5.0.6 common_test-1.16 compiler-7.2.2 crypto-4.3
OTP-21.0.2 : compiler-7.2.2 erts-10.0.2 public_key-1.6.1 stdlib-3.5.1 # asn1-5.0.6 common_test-1.16 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 :
OTP-21.0.1 : compiler-7.2.1 erts-10.0.1 # asn1-5.0.6 common_test-1.16 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 megaco-3.18.3 mnesia-4.15.4 observer-2.8 odbc-2.12.1 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 snmp-5.2.11 ssh-4.7 ssl-9.0 stdlib-3.5 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 :
OTP-21.0 : asn1-5.0.6 common_test-1.16 compiler-7.2 crypto-4.3 debugger-4.2.5 dialyzer-3.3 diameter-2.1.5 edoc-0.9.3 eldap-1.2.4 erl_docgen-0.8 erl_interface-3.10.3 erts-10.0 et-1.6.2 eunit-2.3.6 ftp-1.0 hipe-3.18 inets-7.0 jinterface-1.9 kernel-6.0 mnesia-4.15.4 observer-2.8 os_mon-2.4.5 otp_mibs-1.2 parsetools-2.1.7 public_key-1.6 reltool-0.7.6 runtime_tools-1.13 sasl-3.2 ssh-4.7 ssl-9.0 stdlib-3.5 syntax_tools-2.1.5 tftp-1.0 tools-3.0 wx-1.8.4 xmerl-1.3.17 # megaco-3.18.3 odbc-2.12.1 snmp-5.2.11 :
+OTP-20.3.8.20 : common_test-1.15.4.1 # asn1-5.0.5.2 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4.1 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.9 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16.1 :
+OTP-20.3.8.19 : diameter-2.1.4.1 erts-9.3.3.9 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16.1 :
OTP-20.3.8.18 : erts-9.3.3.8 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16.1 :
OTP-20.3.8.17 : xmerl-1.3.16.1 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 erts-9.3.3.7 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssh-4.6.9.3 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 :
OTP-20.3.8.16 : erts-9.3.3.7 ssh-4.6.9.3 # asn1-5.0.5.2 common_test-1.15.4 compiler-7.1.5.2 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.2.2 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3.1 erl_docgen-0.7.3 erl_interface-3.10.2.1 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4.2 inets-6.5.2.4 jinterface-1.8.1 kernel-5.4.3.2 megaco-3.18.3 mnesia-4.15.3.2 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.11 ssl-8.2.6.4 stdlib-3.4.5.1 syntax_tools-2.1.4.1 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
@@ -42,6 +48,7 @@ OTP-20.3.6 : crypto-4.2.2 ssh-4.6.9 # asn1-5.0.5 common_test-1.15.4 compiler-7.1
OTP-20.3.5 : erts-9.3.1 ssl-8.2.6 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.2 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.4 inets-6.5.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssh-4.6.8 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3.4 : erl_interface-3.10.2 ic-4.4.4 inets-6.5.1 ssh-4.6.8 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.2 snmp-5.2.10 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3.3 : sasl-3.1.2 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 snmp-5.2.10 ssh-4.6.7 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
+OTP-20.3.2.1 : common_test-1.15.4.0.1 # asn1-5.0.5 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.1 snmp-5.2.10 ssh-4.6.7 ssl-8.2.5 stdlib-3.4.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3.2 : ssh-4.6.7 stdlib-3.4.5 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.1 snmp-5.2.10 ssl-8.2.5 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3.1 : ssl-8.2.5 # asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 crypto-4.2.1 debugger-4.2.4 dialyzer-3.2.4 diameter-2.1.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 erts-9.3 et-1.6.1 eunit-2.3.5 hipe-3.17.1 ic-4.4.3 inets-6.5 jinterface-1.8.1 kernel-5.4.3 megaco-3.18.3 mnesia-4.15.3 observer-2.7 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 runtime_tools-1.12.5 sasl-3.1.1 snmp-5.2.10 ssh-4.6.6 stdlib-3.4.4 syntax_tools-2.1.4 tools-2.11.2 wx-1.8.3 xmerl-1.3.16 :
OTP-20.3 : asn1-5.0.5 common_test-1.15.4 compiler-7.1.5 crypto-4.2.1 dialyzer-3.2.4 diameter-2.1.4 erts-9.3 hipe-3.17.1 inets-6.5 kernel-5.4.3 observer-2.7 runtime_tools-1.12.5 snmp-5.2.10 ssh-4.6.6 ssl-8.2.4 stdlib-3.4.4 tools-2.11.2 # cosEvent-2.2.2 cosEventDomain-1.2.2 cosFileTransfer-1.2.2 cosNotification-1.2.3 cosProperty-1.2.3 cosTime-1.2.3 cosTransactions-1.3.3 debugger-4.2.4 edoc-0.9.2 eldap-1.2.3 erl_docgen-0.7.2 erl_interface-3.10.1 et-1.6.1 eunit-2.3.5 ic-4.4.3 jinterface-1.8.1 megaco-3.18.3 mnesia-4.15.3 odbc-2.12.1 orber-3.8.4 os_mon-2.4.4 otp_mibs-1.1.2 parsetools-2.1.6 public_key-1.5.2 reltool-0.7.5 sasl-3.1.1 syntax_tools-2.1.4 wx-1.8.3 xmerl-1.3.16 :
diff --git a/system/doc/Makefile b/system/doc/Makefile
index 0c4adf6554..8f2faeee04 100644
--- a/system/doc/Makefile
+++ b/system/doc/Makefile
@@ -24,6 +24,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
#
SUB_DIRECTORIES = design_principles \
+ general_info \
getting_started \
system_architecture_intro \
embedded \
diff --git a/system/doc/design_principles/Makefile b/system/doc/design_principles/Makefile
index 242bf1c9a4..2fbd7d087f 100644
--- a/system/doc/design_principles/Makefile
+++ b/system/doc/design_principles/Makefile
@@ -88,7 +88,6 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
$(HTMLDIR)/%.gif: %.gif
$(INSTALL_DATA) $< $@
@@ -107,8 +106,8 @@ images: $(IMAGE_FILES:%=$(HTMLDIR)/%)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml
index 07b4284cb8..45ea972ff2 100644
--- a/system/doc/design_principles/statem.xml
+++ b/system/doc/design_principles/statem.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2016</year><year>2018</year>
+ <year>2016</year><year>2019</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -2415,17 +2415,18 @@ handle_event(enter, _OldState, {open,_}, _Data) ->
<seealso marker="#Event Time-Outs">event time-out</seealso>
to trigger hibernation after a certain time of inactivity.
There is also a server start option
- <seealso marker="stdlib:gen_statem#type-hibernate_after_opt">
+ <seealso marker="stdlib:gen_statem#type-enter_loop_opt">
<c>{hibernate_after, Timeout}</c>
</seealso>
for
- <seealso marker="stdlib:gen_statem#start/3">
- <c>start/3,4</c>
- </seealso>
- or
+ <seealso marker="stdlib:gen_statem#start/3"><c>start/3,4</c></seealso>,
<seealso marker="stdlib:gen_statem#start_link/3">
<c>start_link/3,4</c>
</seealso>
+ or
+ <seealso marker="stdlib:gen_statem#enter_loop/4">
+ <c>enter_loop/4,5,6</c>
+ </seealso>
that may be used to automatically hibernate the server.
</p>
<p>
diff --git a/system/doc/efficiency_guide/Makefile b/system/doc/efficiency_guide/Makefile
index 72bcd2ee73..a2742a1354 100644
--- a/system/doc/efficiency_guide/Makefile
+++ b/system/doc/efficiency_guide/Makefile
@@ -87,7 +87,6 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
docs: html
@@ -98,8 +97,8 @@ html: $(GIF_FILES) $(HTML_UG_FILE)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/embedded/Makefile b/system/doc/embedded/Makefile
index 396aef276b..1604075312 100644
--- a/system/doc/embedded/Makefile
+++ b/system/doc/embedded/Makefile
@@ -75,7 +75,6 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
docs: html
@@ -86,8 +85,8 @@ html: $(GIF_FILES) $(HTML_UG_FILE)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/general_info/Makefile b/system/doc/general_info/Makefile
new file mode 100644
index 0000000000..539075280e
--- /dev/null
+++ b/system/doc/general_info/Makefile
@@ -0,0 +1,99 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1996-2018. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include $(ERL_TOP)/erts/vsn.mk
+#VSN=$(SYSTEM_VSN)
+
+APPLICATION=otp-system-documentation
+XMLDIR := $(XMLDIR)/general_info
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = "$(RELEASE_PATH)/doc/general_info"
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+XML_PART_FILES = part.xml
+
+include xmlfiles.mk
+
+XML_CHAPTER_FILES=$(GENERAL_INFO_CHAPTER_FILES)
+
+TOPDOCDIR=..
+
+BOOK_FILES = book.xml
+
+GIF_FILES =
+
+XML_FILES = \
+ $(BOOK_FILES) $(XML_CHAPTER_FILES) \
+ $(XML_PART_FILES)
+
+# ----------------------------------------------------
+
+HTMLDIR = ../html/general_info
+
+HTML_UG_FILE = $(HTMLDIR)/users_guide.html
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+XML_FLAGS +=
+DVIPS_FLAGS +=
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+docs: html
+
+local_docs: PDFDIR=../../pdf
+
+html: $(GIF_FILES) $(HTML_UG_FILE)
+
+debug opt:
+
+clean clean_docs:
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
+ rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+ rm -f errs core *~
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_docs_spec: docs
+# $(INSTALL_DIR) "$(RELEASE_PATH)/pdf"
+# $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELEASE_PATH)/pdf"
+ $(INSTALL_DIR) $(RELSYSDIR)
+ $(INSTALL_DATA) $(GIF_FILES) $(HTMLDIR)/*.html \
+ $(RELSYSDIR)
+
+release_spec:
+
diff --git a/system/doc/general_info/book.xml b/system/doc/general_info/book.xml
new file mode 100644
index 0000000000..ca9b5fae39
--- /dev/null
+++ b/system/doc/general_info/book.xml
@@ -0,0 +1,44 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE book SYSTEM "book.dtd">
+
+<book xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header titlestyle="normal">
+ <copyright>
+ <year>2019</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>General Information</title>
+ <prepared>OTP Team</prepared>
+ <docno></docno>
+ <date>2019-02-23</date>
+ <rev></rev>
+ <file>book.xml</file>
+ </header>
+ <insidecover>
+ </insidecover>
+ <pagetext>General Information</pagetext>
+ <preamble>
+ <contents level="2"></contents>
+ </preamble>
+ <parts lift="no">
+ <xi:include href="part.xml"/>
+ </parts>
+ <listofterms></listofterms>
+ <index></index>
+</book>
+
diff --git a/system/doc/general_info/deprecations.xml b/system/doc/general_info/deprecations.xml
new file mode 100644
index 0000000000..c748e60059
--- /dev/null
+++ b/system/doc/general_info/deprecations.xml
@@ -0,0 +1,98 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2019</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>Deprecations</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>deprecations.xml</file>
+ </header>
+ <section>
+ <title>Introduction</title>
+ <p>This document aim to list all deprecated functionality in Erlang/OTP. It
+ was introduced as of OTP 22, and have not yet been updated with all old
+ deprecations. Deprecations made in other parts of the documentation are of
+ course still valid. For more information regarding the strategy regarding
+ deprecations see the documentation of
+ <seealso marker="../system_principles/misc#deprecation">Support, Compatibility,
+ Deprecations, and Removal</seealso>.</p>
+ </section>
+ <section>
+ <marker id="OTP-22"/>
+ <title>OTP 22</title>
+ <section>
+ <title>VxWorks Support</title>
+ <p>Some parts of OTP has had limited VxWorks support, such as for
+ example <seealso marker="erl_interface:index"><c>erl_interface</c></seealso>.
+ This support is now deprecated and has also been
+ <seealso marker="scheduled_for_removal#OTP-23">scheduled for removal</seealso>.</p>
+ </section>
+ <section>
+ <title>Legacy parts of erl_interface</title>
+ <p>The old legacy <seealso marker="erl_interface:index"><c>erl_interface</c></seealso>
+ library (functions with prefix <c>erl_</c>) is deprecated as of OTP 22. These
+ parts of <c>erl_interface</c> has been informally deprecated
+ for a very long time. You typically want to replace the usage of
+ the <c>erl_interface</c> library with the use of the <c>ei</c> library
+ which also is part of the <c>erl_interface</c> application. The old legacy
+ <seealso marker="erl_interface:index"><c>erl_interface</c></seealso>
+ library has also been <seealso marker="scheduled_for_removal#OTP-23">scheduled
+ for removal</seealso>.</p>
+ </section>
+ <section>
+ <title>System Events</title>
+ <p>
+ The format of "System Events" as defined in the man page for
+ <seealso marker="stdlib:sys">sys</seealso>
+ has been clarified and cleaned up.
+ Due to this, code that relied on the internal badly
+ documented previous (before this change) format
+ of OTP's "System Events", needs to be changed.
+ </p>
+ <p>
+ In the wake of this the function
+ <seealso marker="stdlib:sys#get_debug/3">sys:get_debug/3</seealso>
+ that returns data with undocumented and internal format
+ (and therefore is practically useless) has been deprecated,
+ and a new function
+ <seealso marker="stdlib:sys#get_log/1">sys:get_log/1</seealso>
+ has been added,
+ that hopefully does what the deprecated function was intended for.
+ </p>
+ </section>
+ </section>
+ <section>
+ <marker id="OTP-18"/>
+ <title>OTP 18</title>
+ <section>
+ <title>erlang:now()</title>
+ <p>New time functionality and a new time API was introduced. For more information
+ see the <seealso marker="erts:time_correction">Time and Time Correction</seealso>
+ chapter in the ERTS User's guide and specifically the
+ <seealso marker="erts:time_correction#Dos_and_Donts">Dos and Donts</seealso>
+ section on how to replace usage of <c>erlang:now()</c>.</p>
+ </section>
+ </section>
+</chapter>
diff --git a/system/doc/general_info/part.xml b/system/doc/general_info/part.xml
new file mode 100644
index 0000000000..fead7d58e7
--- /dev/null
+++ b/system/doc/general_info/part.xml
@@ -0,0 +1,34 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE part SYSTEM "part.dtd">
+
+<part xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>2019</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>General Information</title>
+ <prepared>OTP Team</prepared>
+ <docno></docno>
+ <date>2019-02-23</date>
+ <rev></rev>
+ <file>part.xml</file>
+ </header>
+ <xi:include href="deprecations.xml"/>
+ <xi:include href="scheduled_for_removal.xml"/>
+</part>
diff --git a/system/doc/general_info/scheduled_for_removal.xml b/system/doc/general_info/scheduled_for_removal.xml
new file mode 100644
index 0000000000..a9421df385
--- /dev/null
+++ b/system/doc/general_info/scheduled_for_removal.xml
@@ -0,0 +1,61 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2019</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>Scheduled for Removal</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>scheduled_for_removal.xml</file>
+ </header>
+ <section>
+ <title>Introduction</title>
+ <p>This document list all functionality in Erlang/OTP that currently are
+ scheduled for removal. For more information regarding the strategy regarding
+ removal of functionality see the documentation of
+ <seealso marker="../system_principles/misc#removal">Support, Compatibility,
+ Deprecations, and Removal</seealso>.</p>
+ </section>
+ <section>
+ <marker id="OTP-23"/>
+ <title>OTP 23</title>
+ <section>
+ <title>VxWorks Support</title>
+ <p>Some parts of OTP has had limited VxWorks support, such as for
+ example <seealso marker="erl_interface:index"><c>erl_interface</c></seealso>.
+ This support will be removed as of OTP 23. This limited support
+ was formally deprecated as of OTP 22</p>
+ </section>
+ <section>
+ <title>Legacy parts of erl_interface</title>
+ <p>The old legacy <seealso marker="erl_interface:index"><c>erl_interface</c></seealso>
+ library (functions with prefix <c>erl_</c>) will be removed as of
+ OTP 23. These parts of <c>erl_interface</c> has been informally deprecated
+ for a very long time, and was formally deprecated in OTP 22. You typically
+ want to replace the usage of the <c>erl_interface</c> library with the use
+ of the <c>ei</c> library which also is part of the <c>erl_interface</c>
+ application.</p>
+ </section>
+ </section>
+</chapter>
diff --git a/system/doc/general_info/xmlfiles.mk b/system/doc/general_info/xmlfiles.mk
new file mode 100644
index 0000000000..eab1632a4f
--- /dev/null
+++ b/system/doc/general_info/xmlfiles.mk
@@ -0,0 +1,22 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2009-2018. All Rights Reserved.
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+# %CopyrightEnd%
+#
+GENERAL_INFO_CHAPTER_FILES = \
+ deprecations.xml \
+ scheduled_for_removal.xml
diff --git a/system/doc/getting_started/Makefile b/system/doc/getting_started/Makefile
index cdf1e121c2..1c917895d5 100644
--- a/system/doc/getting_started/Makefile
+++ b/system/doc/getting_started/Makefile
@@ -74,7 +74,6 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
docs: html
@@ -85,8 +84,8 @@ html: $(GIF_FILES) $(HTML_UG_FILE)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/html/design_principles/.gitignore b/system/doc/html/design_principles/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/design_principles/.gitignore
diff --git a/system/doc/html/efficiency_guide/.gitignore b/system/doc/html/efficiency_guide/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/efficiency_guide/.gitignore
diff --git a/system/doc/html/embedded/.gitignore b/system/doc/html/embedded/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/embedded/.gitignore
diff --git a/system/doc/html/general_info/.gitignore b/system/doc/html/general_info/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/general_info/.gitignore
diff --git a/system/doc/html/getting_started/.gitignore b/system/doc/html/getting_started/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/getting_started/.gitignore
diff --git a/system/doc/html/installation_guide/.gitignore b/system/doc/html/installation_guide/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/installation_guide/.gitignore
diff --git a/system/doc/html/installation_guide/source/.gitignore b/system/doc/html/installation_guide/source/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/installation_guide/source/.gitignore
diff --git a/system/doc/html/js/.gitignore b/system/doc/html/js/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/js/.gitignore
diff --git a/system/doc/html/oam/.gitignore b/system/doc/html/oam/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/oam/.gitignore
diff --git a/system/doc/html/programming_examples/.gitignore b/system/doc/html/programming_examples/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/programming_examples/.gitignore
diff --git a/system/doc/html/reference_manual/.gitignore b/system/doc/html/reference_manual/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/reference_manual/.gitignore
diff --git a/system/doc/html/system_architecture_intro/.gitignore b/system/doc/html/system_architecture_intro/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/system_architecture_intro/.gitignore
diff --git a/system/doc/html/system_principles/.gitignore b/system/doc/html/system_principles/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/system_principles/.gitignore
diff --git a/system/doc/html/tutorial/.gitignore b/system/doc/html/tutorial/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/html/tutorial/.gitignore
diff --git a/system/doc/installation_guide/Makefile b/system/doc/installation_guide/Makefile
index 4a1335cf31..38252757d6 100644
--- a/system/doc/installation_guide/Makefile
+++ b/system/doc/installation_guide/Makefile
@@ -91,7 +91,6 @@ $(XMLDIR)/%.xml: $(ERL_TOP)/HOWTO/%.md $(ERL_TOP)/make/emd2exml
$(ERL_TOP)/make/emd2exml $< $@
$(REDIRECT_HTML_DIR)/%.html: Makefile
- test -d $(REDIRECT_HTML_DIR) || $(INSTALL_DIR) $(REDIRECT_HTML_DIR)
echo "<html><head><meta HTTP-EQUIV=\"REFRESH\"" > $@
echo " content=\"5; url=../"$(notdir $@)"\">" >> $@
echo "<title>This page has moved</title></head><body>" >> $@
@@ -112,8 +111,8 @@ debug opt:
clean clean_docs:
rm -f $(GENERATED_XML_FILES)
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/oam/Makefile b/system/doc/oam/Makefile
index 147f56f885..2eb429e04d 100644
--- a/system/doc/oam/Makefile
+++ b/system/doc/oam/Makefile
@@ -71,10 +71,9 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
$(HTMLDIR)/%.gif: %.gif
- $(INSTALL_DATA) $< $@
+ $(CP) $< $@
docs: html
@@ -87,8 +86,8 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/programming_examples/Makefile b/system/doc/programming_examples/Makefile
index e4737ba069..9c67c24b64 100644
--- a/system/doc/programming_examples/Makefile
+++ b/system/doc/programming_examples/Makefile
@@ -74,7 +74,6 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
docs: html
local_docs: PDFDIR=../../pdf
@@ -84,8 +83,8 @@ html: $(GIF_FILES) $(HTML_UG_FILE)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/reference_manual/Makefile b/system/doc/reference_manual/Makefile
index d034ad2ff8..809eb2c979 100644
--- a/system/doc/reference_manual/Makefile
+++ b/system/doc/reference_manual/Makefile
@@ -84,7 +84,6 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
docs: html
@@ -95,8 +94,8 @@ html: $(GIF_FILES) $(HTML_UG_FILE)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/system_architecture_intro/Makefile b/system/doc/system_architecture_intro/Makefile
index eb885a744d..ea9ee85105 100644
--- a/system/doc/system_architecture_intro/Makefile
+++ b/system/doc/system_architecture_intro/Makefile
@@ -69,7 +69,6 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
docs: html
@@ -80,8 +79,8 @@ html: $(GIF_FILES) $(HTML_UG_FILE)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/system_principles/Makefile b/system/doc/system_principles/Makefile
index 1979deda4c..5110b73373 100644
--- a/system/doc/system_principles/Makefile
+++ b/system/doc/system_principles/Makefile
@@ -70,7 +70,6 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
docs: html
@@ -81,8 +80,8 @@ html: $(GIF_FILES) $(HTML_UG_FILE)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/system_principles/misc.xml b/system/doc/system_principles/misc.xml
index dd6c2a1336..ed3675d180 100644
--- a/system/doc/system_principles/misc.xml
+++ b/system/doc/system_principles/misc.xml
@@ -34,6 +34,14 @@
</header>
<section>
+ <title>Introduction</title>
+ <p>This document describes strategy regarding supported Releases,
+ compatibility, deprecations and removal of functionality. This
+ document was introduced in OTP 21. Actions taken regarding these
+ issues before OTP 21 did not adhere this document.</p>
+ </section>
+
+ <section>
<marker id="supported_releases"/>
<title>Supported Releases</title>
<p>
diff --git a/system/doc/top/Makefile b/system/doc/top/Makefile
index 0703b821f1..e3f9c4710a 100644
--- a/system/doc/top/Makefile
+++ b/system/doc/top/Makefile
@@ -39,6 +39,7 @@ INFO_FILES = ../../../README.md ../../COPYRIGHT PR.template
TOPDOCDIR=.
+include ../general_info/xmlfiles.mk
include ../installation_guide/xmlfiles.mk
include ../system_principles/xmlfiles.mk
include ../embedded/xmlfiles.mk
@@ -56,6 +57,7 @@ XML_FILES = \
$(BOOK_FILES)
XML_GUIDE_FILES = \
+ $(GENERAL_INFO_CHAPTER_FILES:%=general_info/%) \
$(INST_GUIDE_CHAPTER_FILES:%=installation_guide/%) \
$(INST_GUIDE_CHAPTER_GEN_FILES:%=installation_guide/%) \
$(SYSTEM_PRINCIPLES_CHAPTER_FILES:%=system_principles/%) \
@@ -79,6 +81,7 @@ XML_GUIDE_FILES = \
XML_GEN_FILES = \
$(XML_GUIDE_FILES:%=$(XMLDIR)/%) \
+ $(XMLDIR)/general_info/part.xml \
$(XMLDIR)/installation_guide/part.xml \
$(XMLDIR)/system_principles/part.xml \
$(XMLDIR)/embedded/part.xml \
@@ -91,13 +94,32 @@ XML_GEN_FILES = \
$(XMLDIR)/oam/part.xml
-XMLLINT_SRCDIRS= $(XMLDIR)/installation_guide:$(XMLDIR)/system_principles:$(XMLDIR)/embedded:$(XMLDIR)/getting_started:$(XMLDIR)/reference_manual:$(XMLDIR)/programming_examples:$(XMLDIR)/efficiency_guide:$(XMLDIR)/tutorial:$(XMLDIR)/design_principles:$(XMLDIR)/oam
+XMLLINT_SRCDIRS= $(XMLDIR)/general_info:$(XMLDIR)/installation_guide:$(XMLDIR)/system_principles:$(XMLDIR)/embedded:$(XMLDIR)/getting_started:$(XMLDIR)/reference_manual:$(XMLDIR)/programming_examples:$(XMLDIR)/efficiency_guide:$(XMLDIR)/tutorial:$(XMLDIR)/design_principles:$(XMLDIR)/oam
HTMLDIR= ../html
PDFREFDIR= pdf
TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
TOPDOC=true
+ifdef RELEASE_PATH
+INST_TYPE=rel
+INST_TYPE_SRC_DIR=$(RELEASE_PATH)
+# We build to the 'temporary' dir in order to be able to install
+# results using INSTALL_DATA (in order to get correct access
+# rights on installed files)
+INST_TYPE_DEST_DIR=$(RELSYSDIR)/temporary
+INST_TYPE_DEST_DIR_DEP=$(INST_TYPE_DEST_DIR)
+INST_TYPE_JS_DEST_DIR=$(INST_TYPE_DEST_DIR)
+INST_TYPE_VSN_FILE=$(INST_TYPE_DEST_DIR)/OTP_VERSION
+else
+INST_TYPE=src
+INST_TYPE_SRC_DIR=$(ERL_TOP)
+INST_TYPE_DEST_DIR=$(HTMLDIR)
+INST_TYPE_DEST_DIR_DEP=
+INST_TYPE_JS_DEST_DIR=$(INST_TYPE_DEST_DIR)/js
+INST_TYPE_VSN_FILE=$(ERL_TOP)/OTP_VERSION
+endif
+
#--------------------------------------------------------------------------
# We generate the index page from the installed system. This make
# it important that this is done last. The file index.html.src
@@ -107,17 +129,18 @@ EBIN = ebin
INDEX_SCRIPT = $(EBIN)/erl_html_tools.$(EMULATOR)
INDEX_SRC = src/erl_html_tools.erl
-INDEX_FILES = \
- $(HTMLDIR)/index.html \
- $(HTMLDIR)/applications.html
-JAVASCRIPT = $(HTMLDIR)/js/erlresolvelinks.js
+INDEX_HTML=$(INST_TYPE_DEST_DIR)/index.html
+APPLICATIONS_HTML=$(INST_TYPE_DEST_DIR)/applications.html
+INDEX_FILES = $(INDEX_HTML) $(APPLICATIONS_HTML)
+
+JAVASCRIPT = $(INST_TYPE_JS_DEST_DIR)/erlresolvelinks.js
JAVASCRIPT_BUILD_SCRIPT = $(EBIN)/erlresolvelinks.$(EMULATOR)
JAVASCRIPT_BUILD_SCRIPT_SRC = src/erlresolvelinks.erl
MAN_INDEX_SCRIPT = $(EBIN)/otp_man_index.$(EMULATOR)
MAN_INDEX_SRC = src/otp_man_index.erl
-MAN_INDEX = $(HTMLDIR)/man_index.html
+MAN_INDEX = $(INST_TYPE_DEST_DIR)/man_index.html
GLOSSARY = $(HTMLDIR)/glossary.html
GLOSSARY_SRC = $(ERL_TOP)/system/internal_tools/doctools/src/glossary.erl
@@ -132,45 +155,38 @@ TEMPLATES = \
$(INDEX_SCRIPT): $(INDEX_SRC)
$(ERLC) -o$(EBIN) +warn_unused_vars $<
-# We don't list toc_*.html as targets because we don't know
-$(HTMLDIR)/index.html + $(HTMLDIR)/applications.html: $(INDEX_SCRIPT) $(TEMPLATES)
- echo "Generating index $@"
-# Check if we are building the index from source or an installed release
- if test "$$RELEASE_ROOT" = "" ; then \
- $(ERL) -noshell -pa $(EBIN) -s erl_html_tools top_index src $(ERL_TOP) \
- $(HTMLDIR) `cat "$(ERL_TOP)/OTP_VERSION"` -s erlang halt ;\
+$(INST_TYPE_DEST_DIR)/OTP_VERSION: $(INST_TYPE_DEST_DIR_DEP)
+ if test -f "$(RELEASE_PATH)/releases/$(SYSTEM_VSN)/OTP_VERSION"; then \
+ $(CP) "$(RELEASE_PATH)/releases/$(SYSTEM_VSN)/OTP_VERSION" $@; \
else \
- $(ERL) -noshell -pa $(EBIN) -s erl_html_tools top_index rel $(RELEASE_ROOT) \
- $(HTMLDIR) `cat "$(RELEASE_ROOT)/releases/$(SYSTEM_VSN)/OTP_VERSION"` \
- -s erlang halt ;\
+ $(CP) $(ERL_TOP)/OTP_VERSION $@; \
fi
+# We don't list toc_*.html as targets because we don't know
+$(INDEX_HTML) + $(APPLICATIONS_HTML): $(INST_TYPE_DEST_DIR_DEP) $(INDEX_SCRIPT) $(TEMPLATES) $(INST_TYPE_VSN_FILE)
+ echo "Generating index $@"
+ $(ERL) -noshell -pa $(EBIN) -s erl_html_tools top_index $(INST_TYPE) \
+ $(INST_TYPE_SRC_DIR) $(INST_TYPE_DEST_DIR) \
+ `cat "$(INST_TYPE_VSN_FILE)"` -s erlang halt
+
#--------------------------------------------------------------------------
$(JAVASCRIPT_BUILD_SCRIPT): $(JAVASCRIPT_BUILD_SCRIPT_SRC)
$(ERLC) -o$(EBIN) +warn_unused_vars $<
-$(JAVASCRIPT): $(JAVASCRIPT_BUILD_SCRIPT)
- erl -noshell -pa $(EBIN) -s erlresolvelinks make -s erlang halt
- $(INSTALL_DIR) $(HTMLDIR)/js
- $(INSTALL_DATA) erlresolvelinks.js $(JAVASCRIPT)
+$(JAVASCRIPT): $(INST_TYPE_DEST_DIR_DEP) $(JAVASCRIPT_BUILD_SCRIPT)
+ erl -noshell -pa $(EBIN) -run erlresolvelinks make $(ERL_TOP) \
+ $(INST_TYPE_SRC_DIR) $(INST_TYPE_JS_DEST_DIR) -s erlang halt
#--------------------------------------------------------------------------
$(MAN_INDEX_SCRIPT): $(MAN_INDEX_SRC)
$(ERLC) -o$(EBIN) +warn_unused_vars $<
-$(MAN_INDEX): $(MAN_INDEX_SCRIPT)
-# Check if we are building the index from source or an installed release
- if test "$$RELEASE_ROOT" = "" ; then \
- $(ERL) -noshell -pa $(EBIN) -s otp_man_index gen src $(ERL_TOP) $@ \
- -s erlang halt ;\
- else \
- $(ERL) -noshell -pa $(EBIN) -s otp_man_index gen rel $(RELEASE_ROOT) $@ \
- -s erlang halt ;\
- fi
-
+$(MAN_INDEX): $(INST_TYPE_DEST_DIR_DEP) $(MAN_INDEX_SCRIPT)
+ $(ERL) -noshell -pa $(EBIN) -s otp_man_index gen $(INST_TYPE) \
+ $(INST_TYPE_SRC_DIR) $@ -s erlang halt
#--------------------------------------------------------------------------
@@ -248,18 +264,22 @@ html: $(INDEX_FILES) \
debug opt:
clean:
- rm -rf ../html/js
- rm -f PR.template
- rm -f $(INDEX_FILES) $(MAN_INDEX)
- rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
- rm -f $(INDEX_SCRIPT) $(GLOSSARY_SCRIPT) \
- $(JAVASCRIPT_BUILD_SCRIPT)
- rm -f erl_crash.dump errs core *~
+ $(RM) ../html/js/*.js
+ $(RM) PR.template
+ $(RM) $(XMLDIR)/*.xml
+ $(RM) $(INDEX_FILES) $(MAN_INDEX)
+ $(RM) $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
+ $(RM) $(INDEX_SCRIPT) $(GLOSSARY_SCRIPT) $(JAVASCRIPT_BUILD_SCRIPT)
+ $(RM) erl_crash.dump errs core *~
+
# ----------------------------------------------------
# Release Target
# ----------------------------------------------------
include $(ERL_TOP)/make/otp_release_targets.mk
+$(RELSYSDIR)/temporary:
+ $(INSTALL_DIR) $(RELSYSDIR)/temporary
+
release_docs_spec: docs
$(INSTALL_DIR) "$(RELEASE_PATH)"
$(INSTALL_DATA) $(INFO_FILES) "$(RELEASE_PATH)"
@@ -268,13 +288,13 @@ release_docs_spec: docs
$(INSTALL_DATA) \
$(TOP_PDF_FILE) $(RELSYSDIR)/pdf
$(INSTALL_DIR) $(RELSYSDIR)/js
- $(INSTALL_DATA) \
- $(JAVASCRIPT) $(RELSYSDIR)/js
+ $(INSTALL_DATA) $(JAVASCRIPT) $(RELSYSDIR)/js
$(INSTALL_DATA) $(INDEX_FILES) $(MAN_INDEX) $(RELSYSDIR)
$(INSTALL_DIR) $(RELSYSDIR)/docbuild
$(INSTALL_DATA) $(INDEX_SCRIPT) $(MAN_INDEX_SCRIPT) $(JAVASCRIPT_BUILD_SCRIPT) \
$(INDEX_SRC) $(MAN_INDEX_SRC) $(JAVASCRIPT_BUILD_SCRIPT_SRC) \
$(TEMPLATES) $(RELSYSDIR)/docbuild
+ $(RM) -r $(RELSYSDIR)/temporary
release_spec:
diff --git a/system/doc/top/book.xml b/system/doc/top/book.xml
index 61e75591ef..64c1e4caf6 100644
--- a/system/doc/top/book.xml
+++ b/system/doc/top/book.xml
@@ -36,6 +36,7 @@
<contents level="2"></contents>
</preamble>
<parts lift="no">
+ <xi:include href="../xml/general_info/part.xml"/>
<xi:include href="../xml/installation_guide/part.xml"/>
<xi:include href="../xml/system_principles/part.xml"/>
<xi:include href="../xml/embedded/part.xml"/>
diff --git a/system/doc/top/src/erl_html_tools.erl b/system/doc/top/src/erl_html_tools.erl
index 28a0649658..dee1871342 100644
--- a/system/doc/top/src/erl_html_tools.erl
+++ b/system/doc/top/src/erl_html_tools.erl
@@ -508,7 +508,7 @@ subst_app(App, [{VSN,_Path,Link,Text} | VerInfos]) ->
" <a href=\"",Link,"\" target=\"_top\">",uc(App),
"</a>\n",
" <a href=\"",Link,"\" target=\"_top\">",VSN,"</a>\n",
- " <td class=appnums>\n",
+ " <br/>\n",
subst_vsn(VerInfos),
" </td>\n",
" <td>\n",
@@ -522,7 +522,7 @@ subst_vsn([{VSN,_Path,Link,_Text} | VSNs]) ->
[
" <font size=\"2\"><a class=anum href=\"",Link,"\" target=\"_top\">",
VSN,
- "</a></font><br>\n",
+ "</a></font><br/>\n",
subst_vsn(VSNs)
];
subst_vsn([]) ->
diff --git a/system/doc/top/src/erlresolvelinks.erl b/system/doc/top/src/erlresolvelinks.erl
index cfe8d0fa0b..c1285fa1c3 100644
--- a/system/doc/top/src/erlresolvelinks.erl
+++ b/system/doc/top/src/erlresolvelinks.erl
@@ -27,40 +27,28 @@
%%-----------------------------------------------------------------
-module(erlresolvelinks).
--export([make/0, make/1]).
+-export([make/1]).
-include_lib("kernel/include/file.hrl").
-define(JAVASCRIPT_NAME, "erlresolvelinks.js").
-make() ->
- case os:getenv("ERL_TOP") of
- false ->
- io:format("Variable ERL_TOP is required\n",[]);
- Value ->
- make_from_src(Value, ".")
- end.
-
-make([RootDir, DestDir]) ->
- do_make(RootDir, DestDir);
-make(RootDir) when is_atom(RootDir) ->
- DestDir = filename:join(RootDir, "doc"),
- do_make(RootDir, DestDir).
-
-do_make(_RootDir, _DestDir) ->
- ok.
+make([ErlTop, RootDir, DestDir]) ->
+ make(ErlTop, RootDir, DestDir).
-make_from_src(RootDir, DestDir) ->
+make(ErlTop, RootDir, DestDir) ->
%% doc/Dir
%% erts-Vsn
%% lib/App-Vsn
Name = ?JAVASCRIPT_NAME,
- DocDirs0 = get_dirs(filename:join([RootDir, "system/doc"])),
+ DocDirs0 = get_dirs(filename:join([ErlTop, "system/doc"])),
DocDirs = lists:map(fun({Dir, _DirPath}) ->
D = filename:join(["doc", Dir]),
{D, D} end, DocDirs0),
- ErtsDirs = latest_app_dirs(RootDir, ""),
- AppDirs = latest_app_dirs(RootDir, "lib"),
+ Released = ErlTop /= RootDir,
+
+ ErtsDirs = latest_app_dirs(Released, RootDir, ""),
+ AppDirs = latest_app_dirs(Released, RootDir, "lib"),
AllAppDirs =
lists:map(
@@ -106,30 +94,46 @@ is_dir({File, AFile}) ->
false
end.
-latest_app_dirs(RootDir, Dir) ->
+released_app_vsns([]) ->
+ [];
+released_app_vsns([{AppVsn, Dir} | AVDirs]) ->
+ try
+ {ok, _} = file:read_file_info(filename:join([Dir, "doc", "html"])),
+ [App, Vsn] = string:tokens(AppVsn, "-"),
+ VsnNumList = vsnstr_to_numlist(Vsn),
+ [_Maj, _Min | _] = VsnNumList,
+ [{{App, VsnNumList}, AppVsn} | released_app_vsns(AVDirs)]
+ catch
+ _:_ -> released_app_vsns(AVDirs)
+ end.
+
+latest_app_dirs(Release, RootDir, Dir) ->
ADir = filename:join(RootDir, Dir),
RDirs0 = get_dirs(ADir),
- RDirs1 = lists:filter(fun is_app_dir/1, RDirs0),
-
- SDirs0 =
- lists:map(fun({App, Dir1}) ->
- File = filename:join(Dir1, "vsn.mk"),
- case file:read_file(File) of
- {ok, Bin} ->
- case re:run(Bin, ".*VSN\s*=\s*([0-9\.]+).*",[{capture,[1],list}]) of
- {match, [VsnStr]} ->
- VsnNumList = vsnstr_to_numlist(VsnStr),
- {{App, VsnNumList}, App++"-"++VsnStr};
- nomatch ->
- io:format("No VSN variable found in ~s\n", [File]),
- error
- end;
- {error, Reason} ->
- io:format("~p : ~s\n", [Reason, File]),
- error
- end
- end,
- RDirs1),
+ SDirs0 = case Release of
+ true ->
+ released_app_vsns(RDirs0);
+ false ->
+ lists:map(fun({App, Dir1}) ->
+ File = filename:join(Dir1, "vsn.mk"),
+ case file:read_file(File) of
+ {ok, Bin} ->
+ case re:run(Bin, ".*VSN\s*=\s*([0-9\.]+).*",[{capture,[1],list}]) of
+ {match, [VsnStr]} ->
+ VsnNumList = vsnstr_to_numlist(VsnStr),
+ {{App, VsnNumList}, App++"-"++VsnStr};
+ nomatch ->
+ io:format("No VSN variable found in ~s\n", [File]),
+ error
+ end;
+ {error, Reason} ->
+ io:format("~p : ~s\n", [Reason, File]),
+ error
+ end
+ end,
+ lists:filter(fun is_app_dir/1, RDirs0))
+ end,
+
SDirs1 = lists:keysort(1, SDirs0),
App2Dirs = lists:foldr(fun({{App, _VsnNumList}, AppVsn}, Acc) ->
case lists:keymember(App, 1, Acc) of
diff --git a/system/doc/top/templates/index.html.src b/system/doc/top/templates/index.html.src
index 747d19cf7e..3b61052b99 100644
--- a/system/doc/top/templates/index.html.src
+++ b/system/doc/top/templates/index.html.src
@@ -41,6 +41,8 @@ limitations under the License.
<ul class="section-links">
<li><a href="applications.html">Applications</a></li>
<li><a href="man_index.html" class="modules">Modules</a></li>
+ <li><a href="general_info/deprecations.html" class="modules">Deprecations</a></li>
+ <li><a href="general_info/scheduled_for_removal.html" class="modules">Scheduled for Removal</a></li>
</ul>
<ul class="expand-collapse-items">
diff --git a/system/doc/tutorial/Makefile b/system/doc/tutorial/Makefile
index 5867096fc8..4c62deeffd 100644
--- a/system/doc/tutorial/Makefile
+++ b/system/doc/tutorial/Makefile
@@ -93,10 +93,9 @@ DVIPS_FLAGS +=
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-_create_dirs := $(shell mkdir -p $(HTMLDIR))
$(HTMLDIR)/%.gif: %.gif
- $(INSTALL_DATA) $< $@
+ $(CP) $< $@
docs: html
@@ -109,8 +108,8 @@ gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
debug opt:
clean clean_docs:
- rm -rf $(HTMLDIR)
- rm -rf $(XMLDIR)
+ rm -f $(XMLDIR)/*.xml
+ rm -f $(HTMLDIR)/*.gif $(HTMLDIR)/*.html
rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo)
rm -f errs core *~
diff --git a/system/doc/xml/design_principles/.gitignore b/system/doc/xml/design_principles/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/design_principles/.gitignore
diff --git a/system/doc/xml/efficiency_guide/.gitignore b/system/doc/xml/efficiency_guide/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/efficiency_guide/.gitignore
diff --git a/system/doc/xml/embedded/.gitignore b/system/doc/xml/embedded/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/embedded/.gitignore
diff --git a/system/doc/xml/general_info/.gitignore b/system/doc/xml/general_info/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/general_info/.gitignore
diff --git a/system/doc/xml/getting_started/.gitignore b/system/doc/xml/getting_started/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/getting_started/.gitignore
diff --git a/system/doc/xml/installation_guide/.gitignore b/system/doc/xml/installation_guide/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/installation_guide/.gitignore
diff --git a/system/doc/xml/oam/.gitignore b/system/doc/xml/oam/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/oam/.gitignore
diff --git a/system/doc/xml/programming_examples/.gitignore b/system/doc/xml/programming_examples/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/programming_examples/.gitignore
diff --git a/system/doc/xml/reference_manual/.gitignore b/system/doc/xml/reference_manual/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/reference_manual/.gitignore
diff --git a/system/doc/xml/system_architecture_intro/.gitignore b/system/doc/xml/system_architecture_intro/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/system_architecture_intro/.gitignore
diff --git a/system/doc/xml/system_principles/.gitignore b/system/doc/xml/system_principles/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/system_principles/.gitignore
diff --git a/system/doc/xml/tutorial/.gitignore b/system/doc/xml/tutorial/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/system/doc/xml/tutorial/.gitignore
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-07 02:06:23 +0000